From 538da5ce8d7df5611f4fd5e404ffc71613ff7bb3 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Mon, 22 Feb 2021 15:20:15 +0100 Subject: [PATCH 01/16] test: add goldens for TH splices --- .gitignore | 3 + Setup.hs | 142 +++ symantic-parser.cabal | 4 +- test/Golden.hs | 164 +-- test/Golden/Grammar.hs | 36 + .../Grammar/OptimizeGrammar/G1.expected.txt | 1 + .../Grammar/OptimizeGrammar/G10.expected.txt | 1 + .../Grammar/OptimizeGrammar/G11.expected.txt | 1 + .../Grammar/OptimizeGrammar/G12.expected.txt | 1 + .../Grammar/OptimizeGrammar/G13.expected.txt | 1 + .../Grammar/OptimizeGrammar/G14.expected.txt | 1 + .../Grammar/OptimizeGrammar/G2.expected.txt | 1 + .../Grammar/OptimizeGrammar/G3.expected.txt | 1 + .../Grammar/OptimizeGrammar/G4.expected.txt | 1 + .../Grammar/OptimizeGrammar/G5.expected.txt | 1 + .../Grammar/OptimizeGrammar/G6.expected.txt | 1 + .../Grammar/OptimizeGrammar/G7.expected.txt | 1 + .../Grammar/OptimizeGrammar/G8.expected.txt | 1 + .../Grammar/OptimizeGrammar/G9.expected.txt | 1 + .../Grammar/ViewGrammar/G1.expected.txt | 3 + .../Grammar/ViewGrammar/G10.expected.txt | 8 + .../Grammar/ViewGrammar/G11.expected.txt | 12 + .../Grammar/ViewGrammar/G12.expected.txt | 11 + .../Grammar/ViewGrammar/G13.expected.txt | 55 + .../Grammar/ViewGrammar/G14.expected.txt | 450 ++++++++ .../Grammar/ViewGrammar/G2.expected.txt | 9 + .../Grammar/ViewGrammar/G3.expected.txt | 9 + .../Grammar/ViewGrammar/G4.expected.txt | 21 + .../Grammar/ViewGrammar/G5.expected.txt | 23 + .../Grammar/ViewGrammar/G6.expected.txt | 12 + .../Grammar/ViewGrammar/G7.expected.txt | 14 + .../Grammar/ViewGrammar/G8.expected.txt | 11 + .../{eof.dump => ViewGrammar/G9.expected.txt} | 0 test/Golden/Grammar/app.dump | 3 - test/Golden/Grammar/app.opt.dump | 1 - test/Golden/Grammar/boom.dump | 46 - test/Golden/Grammar/boom.opt.dump | 36 - test/Golden/Grammar/brainfuck.dump | 101 -- test/Golden/Grammar/brainfuck.opt.dump | 58 - test/Golden/Grammar/eof.opt.dump | 1 - test/Golden/Grammar/many-a.dump | 16 - test/Golden/Grammar/many-a.opt.dump | 10 - test/Golden/Grammar/many-char-eof.dump | 20 - test/Golden/Grammar/many-char-eof.opt.dump | 12 - test/Golden/Grammar/nandlang.dump | 993 ------------------ test/Golden/Grammar/nandlang.opt.dump | 479 --------- test/Golden/Grammar/string.dump | 35 - test/Golden/Grammar/string.opt.dump | 10 - test/Golden/Grammar/tokens.dump | 35 - test/Golden/Grammar/tokens.opt.dump | 10 - test/Golden/Grammar/unit-unit.dump | 8 - test/Golden/Grammar/unit-unit.opt.dump | 6 - test/Golden/Grammar/unit.dump | 1 - test/Golden/Grammar/unit.opt.dump | 1 - test/Golden/Machine.hs | 26 + test/Golden/Machine/G1.expected.txt | 4 + test/Golden/Machine/G10.expected.txt | 18 + test/Golden/Machine/G11.expected.txt | 24 + test/Golden/Machine/G12.expected.txt | 47 + test/Golden/Machine/G13.expected.txt | 92 ++ test/Golden/Machine/G14.expected.txt | 847 +++++++++++++++ test/Golden/Machine/G2.expected.txt | 14 + test/Golden/Machine/G3.expected.txt | 22 + test/Golden/Machine/G4.expected.txt | 38 + test/Golden/Machine/G5.expected.txt | 63 ++ test/Golden/Machine/G6.expected.txt | 22 + test/Golden/Machine/G7.expected.txt | 34 + test/Golden/Machine/G8.expected.txt | 47 + test/Golden/Machine/G9.expected.txt | 23 + test/Golden/Machine/a-or-b.dump | 18 - test/Golden/Machine/app.dump | 2 - test/Golden/Machine/boom.dump | 51 - test/Golden/Machine/brainfuck.dump | 104 -- test/Golden/Machine/eof.dump | 23 - test/Golden/Machine/many-a.dump | 23 - test/Golden/Machine/many-char-eof.dump | 48 - test/Golden/Machine/many-char-fail.dump | 25 - test/Golden/Machine/nandlang.dump | 938 ----------------- test/Golden/Machine/some-string.dump | 42 - test/Golden/Machine/string.dump | 16 - test/Golden/Machine/unit-unit.dump | 9 - test/Golden/Machine/unit.dump | 2 - test/Golden/Parser.hs | 51 + .../Parser/{char.dump => G1/P1.expected.txt} | 0 .../Parser/{char.txt => G1/P1.input.txt} | 0 .../P1.expected.txt} | 0 .../{alt-char-fail.txt => G10/P1.input.txt} | 0 .../P1.expected.txt} | 0 .../{many-char-fail.txt => G11/P1.input.txt} | 0 .../{many-oneOf.dump => G12/P1.expected.txt} | 0 .../{many-oneOf.txt => G12/P1.input.txt} | 0 .../{string.dump => G2/P1.expected.txt} | 0 .../{some-string-fail.txt => G2/P1.input.txt} | 0 .../P2.expected.txt} | 0 .../string.txt => Parser/G2/P2.input.txt} | 0 .../{many-char.dump => G3/P1.expected.txt} | 0 .../Parser/{many-char.txt => G3/P1.input.txt} | 0 .../{some-string.dump => G4/P1.expected.txt} | 0 .../{some-string.txt => G4/P1.input.txt} | 0 .../P1.expected.txt} | 0 .../Parser/{string.txt => G5/P1.input.txt} | 0 .../P2.expected.txt} | 0 .../P2.input.txt} | 0 .../P1.expected.txt} | 0 .../{alt-right-notry.txt => G6/P1.input.txt} | 0 .../P1.expected.txt} | 0 .../{alt-right-try.txt => G7/P1.input.txt} | 0 .../{alt-left.dump => G7/P2.expected.txt} | 0 .../Parser/{alt-left.txt => G7/P2.input.txt} | 0 .../P1.expected.txt} | 0 .../{many-char-eof.txt => G8/P1.input.txt} | 0 .../Parser/{eof.dump => G9/P1.expected.txt} | 0 .../Parser/{eof.txt => G9/P1.input.txt} | 0 .../{eof-fail.dump => G9/P2.expected.txt} | 0 .../Parser/{eof-fail.txt => G9/P2.input.txt} | 0 test/Golden/Parser/alt-char-try-fail.txt | 1 - test/Golden/Parser/string-fail-horizon.txt | 1 - test/Golden/Splice.hs | 35 + test/Golden/Splice/G1.expected.txt | 55 + test/Golden/Splice/G10.expected.txt | 104 ++ test/Golden/Splice/G11.expected.txt | 146 +++ test/Golden/Splice/G12.expected.txt | 200 ++++ test/Golden/Splice/G13.expected.txt | 14 + test/Golden/Splice/G14.expected.txt | 14 + test/Golden/Splice/G2.expected.txt | 100 ++ test/Golden/Splice/G3.expected.txt | 119 +++ test/Golden/Splice/G4.expected.txt | 241 +++++ test/Golden/Splice/G5.expected.txt | 350 ++++++ test/Golden/Splice/G6.expected.txt | 144 +++ test/Golden/Splice/G7.expected.txt | 184 ++++ test/Golden/Splice/G8.expected.txt | 197 ++++ test/Golden/Splice/G9.expected.txt | 93 ++ test/Golden/Splice/Utils.hs | 97 ++ test/Golden/Utils.hs | 30 + test/Grammar.hs | 52 + test/{Parser => Grammar}/Brainfuck.hs | 16 +- test/{Parser => Grammar}/Nandlang.hs | 6 +- test/{Parser => Grammar}/Playground.hs | 2 +- test/Main.hs | 15 +- test/Parser.hs | 60 +- 140 files changed, 4462 insertions(+), 3370 deletions(-) create mode 100644 Setup.hs create mode 100644 test/Golden/Grammar.hs create mode 100644 test/Golden/Grammar/OptimizeGrammar/G1.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G10.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G11.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G12.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G13.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G14.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G2.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G3.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G4.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G5.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G6.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G7.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G8.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G9.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G1.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G10.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G11.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G12.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G13.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G14.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G2.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G3.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G4.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G5.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G6.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G7.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G8.expected.txt rename test/Golden/Grammar/{eof.dump => ViewGrammar/G9.expected.txt} (100%) delete mode 100644 test/Golden/Grammar/app.dump delete mode 100644 test/Golden/Grammar/app.opt.dump delete mode 100644 test/Golden/Grammar/boom.dump delete mode 100644 test/Golden/Grammar/boom.opt.dump delete mode 100644 test/Golden/Grammar/brainfuck.dump delete mode 100644 test/Golden/Grammar/brainfuck.opt.dump delete mode 100644 test/Golden/Grammar/eof.opt.dump delete mode 100644 test/Golden/Grammar/many-a.dump delete mode 100644 test/Golden/Grammar/many-a.opt.dump delete mode 100644 test/Golden/Grammar/many-char-eof.dump delete mode 100644 test/Golden/Grammar/many-char-eof.opt.dump delete mode 100644 test/Golden/Grammar/nandlang.dump delete mode 100644 test/Golden/Grammar/nandlang.opt.dump delete mode 100644 test/Golden/Grammar/string.dump delete mode 100644 test/Golden/Grammar/string.opt.dump delete mode 100644 test/Golden/Grammar/tokens.dump delete mode 100644 test/Golden/Grammar/tokens.opt.dump delete mode 100644 test/Golden/Grammar/unit-unit.dump delete mode 100644 test/Golden/Grammar/unit-unit.opt.dump delete mode 100644 test/Golden/Grammar/unit.dump delete mode 100644 test/Golden/Grammar/unit.opt.dump create mode 100644 test/Golden/Machine.hs create mode 100644 test/Golden/Machine/G1.expected.txt create mode 100644 test/Golden/Machine/G10.expected.txt create mode 100644 test/Golden/Machine/G11.expected.txt create mode 100644 test/Golden/Machine/G12.expected.txt create mode 100644 test/Golden/Machine/G13.expected.txt create mode 100644 test/Golden/Machine/G14.expected.txt create mode 100644 test/Golden/Machine/G2.expected.txt create mode 100644 test/Golden/Machine/G3.expected.txt create mode 100644 test/Golden/Machine/G4.expected.txt create mode 100644 test/Golden/Machine/G5.expected.txt create mode 100644 test/Golden/Machine/G6.expected.txt create mode 100644 test/Golden/Machine/G7.expected.txt create mode 100644 test/Golden/Machine/G8.expected.txt create mode 100644 test/Golden/Machine/G9.expected.txt delete mode 100644 test/Golden/Machine/a-or-b.dump delete mode 100644 test/Golden/Machine/app.dump delete mode 100644 test/Golden/Machine/boom.dump delete mode 100644 test/Golden/Machine/brainfuck.dump delete mode 100644 test/Golden/Machine/eof.dump delete mode 100644 test/Golden/Machine/many-a.dump delete mode 100644 test/Golden/Machine/many-char-eof.dump delete mode 100644 test/Golden/Machine/many-char-fail.dump delete mode 100644 test/Golden/Machine/nandlang.dump delete mode 100644 test/Golden/Machine/some-string.dump delete mode 100644 test/Golden/Machine/string.dump delete mode 100644 test/Golden/Machine/unit-unit.dump delete mode 100644 test/Golden/Machine/unit.dump create mode 100644 test/Golden/Parser.hs rename test/Golden/Parser/{char.dump => G1/P1.expected.txt} (100%) rename test/Golden/Parser/{char.txt => G1/P1.input.txt} (100%) rename test/Golden/Parser/{alt-char-fail.dump => G10/P1.expected.txt} (100%) rename test/Golden/Parser/{alt-char-fail.txt => G10/P1.input.txt} (100%) rename test/Golden/Parser/{many-char-fail.dump => G11/P1.expected.txt} (100%) rename test/Golden/Parser/{many-char-fail.txt => G11/P1.input.txt} (100%) rename test/Golden/Parser/{many-oneOf.dump => G12/P1.expected.txt} (100%) rename test/Golden/Parser/{many-oneOf.txt => G12/P1.input.txt} (100%) rename test/Golden/Parser/{string.dump => G2/P1.expected.txt} (100%) rename test/Golden/Parser/{some-string-fail.txt => G2/P1.input.txt} (100%) rename test/Golden/Parser/{string-fail-horizon.dump => G2/P2.expected.txt} (100%) rename test/Golden/{Machine/string.txt => Parser/G2/P2.input.txt} (100%) rename test/Golden/Parser/{many-char.dump => G3/P1.expected.txt} (100%) rename test/Golden/Parser/{many-char.txt => G3/P1.input.txt} (100%) rename test/Golden/Parser/{some-string.dump => G4/P1.expected.txt} (100%) rename test/Golden/Parser/{some-string.txt => G4/P1.input.txt} (100%) rename test/Golden/Parser/{some-string-fail.dump => G5/P1.expected.txt} (100%) rename test/Golden/Parser/{string.txt => G5/P1.input.txt} (100%) rename test/Golden/Parser/{some-string-eof-fail.dump => G5/P2.expected.txt} (100%) rename test/Golden/Parser/{some-string-eof-fail.txt => G5/P2.input.txt} (100%) rename test/Golden/Parser/{alt-right-notry.dump => G6/P1.expected.txt} (100%) rename test/Golden/Parser/{alt-right-notry.txt => G6/P1.input.txt} (100%) rename test/Golden/Parser/{alt-right-try.dump => G7/P1.expected.txt} (100%) rename test/Golden/Parser/{alt-right-try.txt => G7/P1.input.txt} (100%) rename test/Golden/Parser/{alt-left.dump => G7/P2.expected.txt} (100%) rename test/Golden/Parser/{alt-left.txt => G7/P2.input.txt} (100%) rename test/Golden/Parser/{many-char-eof.dump => G8/P1.expected.txt} (100%) rename test/Golden/Parser/{many-char-eof.txt => G8/P1.input.txt} (100%) rename test/Golden/Parser/{eof.dump => G9/P1.expected.txt} (100%) rename test/Golden/Parser/{eof.txt => G9/P1.input.txt} (100%) rename test/Golden/Parser/{eof-fail.dump => G9/P2.expected.txt} (100%) rename test/Golden/Parser/{eof-fail.txt => G9/P2.input.txt} (100%) delete mode 100644 test/Golden/Parser/alt-char-try-fail.txt delete mode 100644 test/Golden/Parser/string-fail-horizon.txt create mode 100644 test/Golden/Splice.hs create mode 100644 test/Golden/Splice/G1.expected.txt create mode 100644 test/Golden/Splice/G10.expected.txt create mode 100644 test/Golden/Splice/G11.expected.txt create mode 100644 test/Golden/Splice/G12.expected.txt create mode 100644 test/Golden/Splice/G13.expected.txt create mode 100644 test/Golden/Splice/G14.expected.txt create mode 100644 test/Golden/Splice/G2.expected.txt create mode 100644 test/Golden/Splice/G3.expected.txt create mode 100644 test/Golden/Splice/G4.expected.txt create mode 100644 test/Golden/Splice/G5.expected.txt create mode 100644 test/Golden/Splice/G6.expected.txt create mode 100644 test/Golden/Splice/G7.expected.txt create mode 100644 test/Golden/Splice/G8.expected.txt create mode 100644 test/Golden/Splice/G9.expected.txt create mode 100644 test/Golden/Splice/Utils.hs create mode 100644 test/Golden/Utils.hs create mode 100644 test/Grammar.hs rename test/{Parser => Grammar}/Brainfuck.hs (87%) rename test/{Parser => Grammar}/Nandlang.hs (97%) rename test/{Parser => Grammar}/Playground.hs (92%) diff --git a/.gitignore b/.gitignore index 232b15f..ebe1d38 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,8 @@ +*.actual.* *.eventlog +*.hi *.hp +*.o *.prof *.root .direnv/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..5526186 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,142 @@ +{-# OPTIONS_GHC -Wall #-} +-- | This module autogenerates a Build_symantic_parser module +-- exporting ghcPath, ghcFlags and rootDir +-- used to build TemplateHaskell splices in golden tests. +-- The code is adapted from singletons-base's Setup.hs +module Main (main) where + +import Control.Monad (when) +import Data.List (nub) +import Data.String (fromString) +import Distribution.PackageDescription +import Distribution.Simple +import Distribution.Simple.BuildPaths +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.PackageIndex +import Distribution.Simple.Program +import Distribution.Simple.Setup +import Distribution.Simple.Utils +import Distribution.Text +import System.Directory (getCurrentDirectory) +import System.FilePath ((), (<.>), isRelative) + +buildModule :: FilePath +buildModule = "Build_symantic_parser" + +testSuiteName :: String +testSuiteName = "symantic-parser-test" + +main :: IO () +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule flags pkg lbi + buildHook simpleUserHooks pkg lbi hooks flags + , confHook = \(gpd, hbi) flags -> + confHook simpleUserHooks (amendGPD gpd, hbi) flags + , haddockHook = \pkg lbi hooks flags -> do + generateBuildModule (haddockToBuildFlags flags) pkg lbi + haddockHook simpleUserHooks pkg lbi hooks flags + } + +-- | Convert only flags used by 'generateBuildModule'. +haddockToBuildFlags :: HaddockFlags -> BuildFlags +haddockToBuildFlags f = emptyBuildFlags + { buildVerbosity = haddockVerbosity f + , buildDistPref = haddockDistPref f + } + +generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule flags pkg lbi = do + rootDir <- getCurrentDirectory + let verbosity = fromFlag (buildVerbosity flags) + distPref = fromFlag (buildDistPref flags) + distPref' | isRelative distPref = rootDirdistPref + | otherwise = distPref + -- Package DBs + dbStack = withPackageDB lbi <> [ SpecificPackageDB $ distPref'"package.conf.inplace" ] + dbFlags = "-hide-all-packages" : "-package-env=-" : packageDbArgsDb dbStack + + ghc = case lookupProgram ghcProgram (withPrograms lbi) of + Just fp -> locationPath $ programLocation fp + Nothing -> error "Can't find GHC path" + withTestLBI pkg lbi $ \suite suitecfg -> + when (testName suite == fromString testSuiteName) $ do + let testAutogenDir = autogenComponentModulesDir lbi suitecfg + createDirectoryIfMissingVerbose verbosity True testAutogenDir + let buildFile = testAutogenDirbuildModule<.>"hs" + withLibLBI pkg lbi $ \_ libCLBI -> do + let libDeps = fst <$> componentPackageDeps libCLBI + pidx = case dependencyClosure (installedPkgs lbi) libDeps of + Left p -> p + Right _ -> error "Broken dependency closure" + libTransDeps = installedUnitId <$> allPackages pidx + packageUnitId = componentUnitId libCLBI + depsFlags = formatDep <$> (packageUnitId:libTransDeps) + allFlags = dbFlags <> depsFlags <> + -- This -i enables to `import Grammar` + -- in TemplateHaskell splicing modules. + -- Because `test/Grammar.hs' is not in a package. + ["-i"<>buildDir lbitestSuiteNametestSuiteName<>"-tmp"] + writeFile buildFile $ unlines + [ "module "<>buildModule<>" where" + , "import Data.String (String)" + , "import System.FilePath (FilePath)" + , "" + , "ghcPath :: FilePath" + , "ghcPath = " <> show ghc + , "" + , "ghcFlags :: [String]" + , "ghcFlags = " <> show allFlags + , "" + , "rootDir :: FilePath" + , "rootDir = " <> show rootDir + ] + where + formatDep installedPkgId = "-package-id=" <> display installedPkgId + + -- GHC >= 7.6 uses the '-package-db' flag. + -- See https://ghc.haskell.org/trac/ghc/ticket/5977. + packageDbArgsDb :: [PackageDB] -> [String] + -- special cases to make arguments prettier in common scenarios + packageDbArgsDb dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) + | all isSpecific dbs -> + concatMap single dbs + (GlobalPackageDB:dbs) + | all isSpecific dbs -> + "-no-user-package-db" : concatMap single dbs + dbs -> "-clear-package-db" : concatMap single dbs + where + single (SpecificPackageDB db) = [ "-package-db=" <> db ] + single GlobalPackageDB = [ "-global-package-db" ] + single UserPackageDB = [ "-user-package-db" ] + isSpecific (SpecificPackageDB _) = True + isSpecific _ = False + +amendGPD :: GenericPackageDescription -> GenericPackageDescription +amendGPD gpd = gpd { condTestSuites = f <$> condTestSuites gpd } + where + f (name, condTree) + | name == fromString testSuiteName = (name, condTree') + | otherwise = (name, condTree) + where + condTree' = condTree { condTreeData = + testSuite { testBuildInfo = + bi { otherModules = om' + , autogenModules = am' } } } + testSuite = condTreeData condTree + bi = testBuildInfo testSuite + om = otherModules bi + am = autogenModules bi + + -- Cons the module to both other-modules and autogen-modules. + -- At the moment, cabal-spec-2.0 and cabal-spec-2.2 don't have + -- "all autogen-modules are other-modules + -- if they aren't exposed-modules" rule. + -- Hopefully cabal-spec-3.0 will have. + -- + -- Note: we `nub`, because it's unclear + -- if that's ok to have duplicate modules in the lists. + om' = nub $ mn : om + am' = nub $ mn : am + mn = fromString buildModule diff --git a/symantic-parser.cabal b/symantic-parser.cabal index 8347561..55dc46b 100644 --- a/symantic-parser.cabal +++ b/symantic-parser.cabal @@ -31,9 +31,7 @@ extra-source-files: flake.lock flake.nix shell.nix - test/Golden/**/*.expected.txt - test/Golden/**/*.input.txt - test/Golden/Splice/**/*.expected.hs + test/Golden/**/*.txt extra-tmp-files: build-type: Custom tested-with: GHC==9.0.1 diff --git a/test/Golden.hs b/test/Golden.hs index 858661c..33e297c 100644 --- a/test/Golden.hs +++ b/test/Golden.hs @@ -1,158 +1,16 @@ -{-# LANGUAGE DataKinds #-} -- For using P.viewGrammar -{-# LANGUAGE FlexibleContexts #-} -- For using P.Machine Char repr -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE TypeApplications #-} --- For TH splices -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE UnboxedTuples #-} -{-# OPTIONS_GHC -Wno-unused-local-binds #-} -{-# OPTIONS_GHC -Wno-unused-matches #-} module Golden where -import Data.Bool (Bool(..)) -import Control.Monad (Monad(..)) -import Data.Char (Char) -import Data.Either (Either(..)) -import Data.Function (($)) -import Data.Semigroup (Semigroup(..)) -import Data.String (String, IsString(..)) -import Data.Text (Text) -import Data.Text.IO (readFile) -import System.IO (IO, FilePath) import Test.Tasty -import Test.Tasty.Golden -import Text.Show (Show(..)) -import qualified Data.ByteString.Lazy as BSL -import qualified Data.IORef as IORef -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Encoding as TL -import qualified Language.Haskell.TH.Syntax as TH -import qualified Symantic.Parser as P -import qualified Symantic.Parser.Haskell as H -import qualified Parser ---import qualified Golden.Splice - -goldensIO :: IO TestTree -goldensIO = return $ testGroup "Golden" - [ goldensGrammar - , goldensMachine - , goldensParser - -- TODO: this will need cabal-install-3.4 to compile under GHC9. - --, Golden.Splice.goldens - ] - -goldensGrammar :: TestTree -goldensGrammar = testGroup "Grammar" - [ testGroup "ViewGrammar" $ tests $ \name repr -> - let file = "test/Golden/Grammar/"<>name<>".dump" in - goldenVsStringDiff file diffGolden file $ do - resetTHNameCounter - return $ fromString $ show $ - P.viewGrammar @'False $ - P.observeSharing repr - , testGroup "OptimizeGrammar" $ tests $ \name repr -> - let file = "test/Golden/Grammar/"<>name<>".opt.dump" in - goldenVsStringDiff file diffGolden file $ do - resetTHNameCounter - return $ fromString $ P.showGrammar @'False repr +import qualified Golden.Grammar +import qualified Golden.Machine +import qualified Golden.Parser +import qualified Golden.Splice + +goldens :: TestTree +goldens = testGroup "Golden" + [ Golden.Grammar.goldens + , Golden.Machine.goldens + , Golden.Splice.goldens + , Golden.Parser.goldens ] - where - tests :: P.Grammar Char repr => - (forall a. String -> repr a -> TestTree) -> [TestTree] - tests test = - [ test "unit" $ P.unit - , test "unit-unit" $ P.unit P.*> P.unit - , test "app" $ P.pure H.id P.<*> P.unit - , test "string" $ P.string "abcd" - , test "tokens" $ P.tokens "abcd" - , test "many-a" $ P.many (P.char 'a') - , test "boom" $ Parser.boom - , test "brainfuck" $ Parser.brainfuck - , test "many-char-eof" $ P.many (P.char 'r') P.<* P.eof - , test "eof" $ P.eof - , test "nandlang" $ Parser.nandlang - ] - -goldensMachine :: TestTree -goldensMachine = testGroup "Machine" - [ testGroup "View" $ tests $ \name repr -> - let file = "test/Golden/Machine/"<>name<>".dump" in - goldenVsStringDiff file diffGolden file $ do - resetTHNameCounter - return $ fromString $ show $ - P.viewMachine @'False repr - ] - where - tests :: - P.Machine Char repr => - (forall vs a. String -> repr Text vs a -> TestTree) -> [TestTree] - tests test = - [ test "unit" $ P.machine $ P.unit - , test "unit-unit" $ P.machine $ P.unit P.*> P.unit - , test "string" $ P.machine $ P.string "abcd" - , test "a-or-b" $ P.machine $ P.char 'a' P.<|> P.char 'b' - , test "app" $ P.machine $ P.pure H.id P.<*> P.unit - , test "many-a" $ P.machine $ P.many (P.char 'a') - , test "some-string" $ P.machine $ P.some (P.string "abcd") - , test "boom" $ P.machine $ Parser.boom - , test "brainfuck" $ P.machine $ Parser.brainfuck - , test "many-char-eof" $ P.machine $ P.many (P.char 'r') P.<* P.eof - , test "eof" $ P.machine $ P.eof - , test "many-char-fail" $ P.machine $ P.many (P.char 'a') P.<* P.char 'b' - , test "nandlang" $ P.machine $ Parser.nandlang - ] - -goldensParser :: TestTree -goldensParser = testGroup "Parser" - [ testGroup "runParser" $ tests $ \name p -> - let file = "test/Golden/Parser/"<>name in - goldenVsStringDiff (file<>".txt") diffGolden (file<>".dump") $ do - input :: Text <- readFile (file<>".txt") - return $ fromString $ - case p input of - Left err -> show err - Right a -> show a - ] - where - tests :: (forall a. Show a => String -> (Text -> Either (P.ParsingError Text) a) -> TestTree) -> [TestTree] - tests test = - [ test "char" $$(P.runParser $ P.char 'a') - , test "string" $$(P.runParser $ P.string "abc") - , test "string-fail-horizon" $$(P.runParser $ P.string "abc") - , test "many-char" $$(P.runParser $ P.many (P.char 'a')) - , test "some-string" $$(P.runParser $ P.some (P.string "abcd")) - , test "some-string-fail" $$(P.runParser $ P.some (P.string "abcd")) - , test "some-string-eof-fail" $$(P.runParser $ P.some (P.string "abcd") P.<* P.eof) - , test "alt-right-notry" $$(P.runParser $ P.traverse P.char "aa" P.<|> P.traverse P.char "ab") - , test "alt-right-try" $$(P.runParser $ P.string "aa" P.<|> P.string "ab") - , test "alt-left" $$(P.runParser $ P.string "aa" P.<|> P.string "ab") - , test "many-char-eof" $$(P.runParser $ P.many (P.char 'r') P.<* P.eof) - , test "eof" $$(P.runParser $ P.eof) - , test "eof-fail" $$(P.runParser $ P.eof) - , test "alt-char-fail" $$(P.runParser $ P.char 'a' P.<|> P.char 'b') - , test "many-char-fail" $$(P.runParser $ P.many (P.char 'a') P.<* P.char 'b') - , test "many-oneOf" $$(P.runParser $ P.many (P.oneOf ['a', 'b', 'c', 'd']) P.<* P.eof) - ] - --- | Resetting 'TH.counter' makes 'makeLetName' deterministic, --- except when GHC or executable flags change, like profiling --- or even --accept unfortunately, --- in those case the 'goldensMachine' tests may fail --- due to a different numbering of the 'def' and 'ref' combinators. --- Hence 'ShowLetName' is used with 'False'. -resetTHNameCounter :: IO () -resetTHNameCounter = IORef.writeIORef TH.counter 0 - --- * Golden testing utilities - -diffGolden :: FilePath -> FilePath -> [String] -diffGolden ref new = ["diff", "-u", ref, new] - -unLeft :: Either String BSL.ByteString -> IO BSL.ByteString -unLeft lr = case lr of - Left err -> return $ TL.encodeUtf8 $ TL.pack err - Right a -> return a diff --git a/test/Golden/Grammar.hs b/test/Golden/Grammar.hs new file mode 100644 index 0000000..6077cec --- /dev/null +++ b/test/Golden/Grammar.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DataKinds #-} -- For using P.viewGrammar +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeApplications #-} +module Golden.Grammar where + +import Data.Bool (Bool(..)) +import Control.Monad (Monad(..)) +import Data.Function (($)) +import Data.Semigroup (Semigroup(..)) +import Data.String (IsString(..)) +import Test.Tasty +import Test.Tasty.Golden +import Text.Show (Show(..)) +import Data.Int (Int) +import qualified Data.List as List + +import Golden.Utils +import qualified Symantic.Parser as P +import qualified Grammar + +goldens :: TestTree +goldens = testGroup "Grammar" $ + [ testGroup "ViewGrammar" $ + (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \(Grammar.G gram) g -> + let grammarFile = "test/Golden/Grammar/ViewGrammar/G"<>show g<>".expected.txt" in + goldenVsStringDiff grammarFile goldenDiff grammarFile $ do + return $ fromString $ show $ + P.viewGrammar @'False $ + P.observeSharing gram + , testGroup "OptimizeGrammar" $ + (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \(Grammar.G gram) g -> + let grammarFile = "test/Golden/Grammar/OptimizeGrammar/G"<>show g<>".expected.txt" in + goldenVsStringDiff grammarFile goldenDiff grammarFile $ do + return $ fromString $ show $ + P.showGrammar @'False gram + ] diff --git a/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt new file mode 100644 index 0000000..f1f6cce --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt @@ -0,0 +1 @@ +"<*>\n+ pure (\\u1 -> 'a')\n` satisfy\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt new file mode 100644 index 0000000..2c9ca60 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt @@ -0,0 +1 @@ +"<|>\n+ <*>\n| + pure (\\u1 -> 'a')\n| ` satisfy\n` <*>\n + pure (\\u1 -> 'b')\n ` satisfy\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt new file mode 100644 index 0000000..a3fec41 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt @@ -0,0 +1 @@ +"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u1 Term))\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'a' : u2 u3)))\n| | | ` satisfy\n| | ` rec \n| ` pure (\\u1 -> u1)\n` satisfy\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt new file mode 100644 index 0000000..3ca3b38 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt @@ -0,0 +1 @@ +"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u1 Term))\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u1 : u2 u3)))\n| | | ` satisfy\n| | ` rec \n| ` pure (\\u1 -> u1)\n` eof\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt new file mode 100644 index 0000000..717c0d5 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt @@ -0,0 +1 @@ +"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u2 Term))\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | ` satisfy\n| | ` rec \n| ` pure (\\u1 -> u1)\n` <|>\n + <*>\n | + <*>\n | | + <*>\n | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (u1 u2) (u3 u4)))))\n | | | ` conditional\n | | | + look\n | | | | ` satisfy\n | | | + bs\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | ` <*>\n | | | | + <*>\n | | | | | + <*>\n | | | | | | + <*>\n | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> cons (Term u3))))))\n | | | | | | | ` satisfy\n | | | | | | ` ref \n | | | | | ` rec \n | | | | ` satisfy\n | | | ` empty\n | | ` ref \n | ` rec \n ` pure (\\u1 -> u1)\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt new file mode 100644 index 0000000..180a05c --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt @@ -0,0 +1 @@ +"<*>\n+ <*>\n| + <*>\n| | + <*>\n| | | + <*>\n| | | | + <*>\n| | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> u5))))))\n| | | | | ` <|>\n| | | | | + <*>\n| | | | | | + <*>\n| | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | ` <|>\n| | | | | | | + <*>\n| | | | | | | | + <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> Term)))\n| | | | | | | | | | ` satisfy\n| | | | | | | | | ` ref \n| | | | | | | | ` <|>\n| | | | | | | | + <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | | ` ref \n| | | | | | | | | ` rec \n| | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | ` <*>\n| | | | | | | + <*>\n| | | | | | | | + <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> u5)))))\n| | | | | | | | | | | ` try\n| | | | | | | | | | | ` <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> '/' : ('/' : Term)))\n| | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | ` satisfy\n| | | | | | | | | | ` ref \n| | | | | | | | | ` <|>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | | | ` satisfy\n| | | | | | | | | | ` rec \n| | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | ` ref \n| | | | | | | ` ref \n| | | | | | ` rec \n| | | | | ` pure (\\u1 -> u1)\n| | | | ` ref \n| | | ` ref \n| | ` <|>\n| | + <*>\n| | | + <*>\n| | | | + <*>\n| | | | | + <*>\n| | | | | | + <*>\n| | | | | | | + <*>\n| | | | | | | | + <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> (\\u7 -> (\\u8 -> (\\u9 -> (\\u10 -> (\\u11 -> (\\u12 -> (\\u13 -> (\\u14 -> (\\u15 -> (\\u16 -> (\\u17 -> (\\u18 -> (\\u19 -> u18 u19)))))))))))))))))))\n| | | | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | | | ` <*\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> Term)\n| | | | | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> (\\u7 -> (\\u8 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : Term)))))))))))))))\n| | | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | ` negLook\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> u4))))\n| | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> Term)))))\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> Term))))))\n| | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> u4 u5)))))\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> Term)))\n| | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | ` ref \n| | | | | | | | | | ` satisfy\n| | | | | | | | | ` ref \n| | | | | | | | ` ref \n| | | | | | | ` <|>\n| | | | | | | + <*>\n| | | | | | | | + <*>\n| | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | ` <|>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> (\\u7 -> (\\u8 -> u8))))))))\n| | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'i' : ('f' : u3))))\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + pure (\\u1 -> '0')\n| | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> '1')\n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> u2))))\n| | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u3)))\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + pure (\\u1 -> Term)\n| | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2)))\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> Term))))\n| | | | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (u1 u3) (u4 u5))))))\n| | | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> u4 u5)))))\n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | ` ref \n| | | | | | | | | | | ` rec \n| | | | | | | | | | ` <|>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> Term)))\n| | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> 'e' : ('l' : ('s' : ('e' : u5))))))))\n| | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | ` ref \n| | | | | | | | | | | ` rec \n| | | | | | | | | | ` ref \n| | | | | | | | | ` <|>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> u4))))\n| | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6))))))))))\n| | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | ` ref \n| | | | | | | | | | | ` ref \n| | | | | | | | | | ` rec \n| | | | | | | | | ` <|>\n| | | | | | | | | + try\n| | | | | | | | | | ` <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> (\\u7 -> (\\u8 -> (\\u9 -> (\\u10 -> (\\u11 -> (\\u12 -> (\\u13 -> u11)))))))))))))\n| | | | | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> Term))\n| | | | | | | | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> 'v' : ('a' : ('r' : u4))))))\n| | | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (u1 u3) (u4 u5))))))\n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (u1 u3) (u4 u5))))))\n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | ` ref \n| | | | | | | | | | | ` satisfy\n| | | | | | | | | | ` ref \n| | | | | | | | | ` <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + pure (\\u1 -> (\\u2 -> u1))\n| | | | | | | | | | ` ref \n| | | | | | | | | ` ref \n| | | | | | | | ` rec \n| | | | | | | ` pure (\\u1 -> u1)\n| | | | | | ` ref \n| | | | | ` satisfy\n| | | | ` ref \n| | | ` rec \n| | ` pure (\\u1 -> u1)\n| ` ref \n` eof\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt new file mode 100644 index 0000000..9666ecb --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt @@ -0,0 +1 @@ +"try\n` <*>\n + <*>\n | + <*>\n | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'a' : ('b' : ('c' : Term)))))\n | | ` satisfy\n | ` satisfy\n ` satisfy\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt new file mode 100644 index 0000000..ddcbfae --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt @@ -0,0 +1 @@ +"<*>\n+ pure (\\u1 -> u1 Term)\n` <|>\n + <*>\n | + <*>\n | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'a' : u2 u3)))\n | | ` satisfy\n | ` rec \n ` pure (\\u1 -> u1)\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt new file mode 100644 index 0000000..fb60535 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt @@ -0,0 +1 @@ +"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u1 : u2 Term))\n| ` try\n| ` <*>\n| + <*>\n| | + <*>\n| | | + <*>\n| | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> 'a' : ('b' : ('c' : ('d' : Term)))))))\n| | | | ` satisfy\n| | | ` satisfy\n| | ` satisfy\n| ` satisfy\n` <|>\n + <*>\n | + <*>\n | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u1 : u2 u3)))\n | | ` ref \n | ` rec \n ` pure (\\u1 -> u1)\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt new file mode 100644 index 0000000..09186c8 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt @@ -0,0 +1 @@ +"<*>\n+ <*>\n| + <*>\n| | + pure (\\u1 -> (\\u2 -> (\\u3 -> u1 : u2 Term)))\n| | ` try\n| | ` <*>\n| | + <*>\n| | | + <*>\n| | | | + <*>\n| | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> 'a' : ('b' : ('c' : ('d' : Term)))))))\n| | | | | ` satisfy\n| | | | ` satisfy\n| | | ` satisfy\n| | ` satisfy\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u1 : u2 u3)))\n| | | ` ref \n| | ` rec \n| ` pure (\\u1 -> u1)\n` eof\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt new file mode 100644 index 0000000..08f7f1d --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt @@ -0,0 +1 @@ +"<|>\n+ <*>\n| + <*>\n| | + pure (\\u1 -> (\\u2 -> 'a' : ('a' : Term)))\n| | ` satisfy\n| ` satisfy\n` <*>\n + <*>\n | + pure (\\u1 -> (\\u2 -> 'a' : ('b' : Term)))\n | ` satisfy\n ` satisfy\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt new file mode 100644 index 0000000..ab36ceb --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt @@ -0,0 +1 @@ +"<|>\n+ try\n| ` <*>\n| + <*>\n| | + pure (\\u1 -> (\\u2 -> 'a' : ('a' : Term)))\n| | ` satisfy\n| ` satisfy\n` try\n ` <*>\n + <*>\n | + pure (\\u1 -> (\\u2 -> 'a' : ('b' : Term)))\n | ` satisfy\n ` satisfy\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt new file mode 100644 index 0000000..3e7689d --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt @@ -0,0 +1 @@ +"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u1 Term))\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'r' : u2 u3)))\n| | | ` satisfy\n| | ` rec \n| ` pure (\\u1 -> u1)\n` eof\n" \ No newline at end of file diff --git a/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt new file mode 100644 index 0000000..cfa33f0 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt @@ -0,0 +1 @@ +"eof\n" \ No newline at end of file diff --git a/test/Golden/Grammar/ViewGrammar/G1.expected.txt b/test/Golden/Grammar/ViewGrammar/G1.expected.txt new file mode 100644 index 0000000..0dbd765 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G1.expected.txt @@ -0,0 +1,3 @@ +<*> ++ pure (\u1 -> 'a') +` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G10.expected.txt b/test/Golden/Grammar/ViewGrammar/G10.expected.txt new file mode 100644 index 0000000..7a64c4e --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G10.expected.txt @@ -0,0 +1,8 @@ +<|> ++ <*> +| + pure (\u1 -> 'a') +| ` def +| ` satisfy +` <*> + + pure (\u1 -> 'b') + ` ref diff --git a/test/Golden/Grammar/ViewGrammar/G11.expected.txt b/test/Golden/Grammar/ViewGrammar/G11.expected.txt new file mode 100644 index 0000000..fd560e8 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G11.expected.txt @@ -0,0 +1,12 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 Term)) +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) +| | | ` def +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` ref diff --git a/test/Golden/Grammar/ViewGrammar/G12.expected.txt b/test/Golden/Grammar/ViewGrammar/G12.expected.txt new file mode 100644 index 0000000..0f63f6d --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G12.expected.txt @@ -0,0 +1,11 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 Term)) +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` eof diff --git a/test/Golden/Grammar/ViewGrammar/G13.expected.txt b/test/Golden/Grammar/ViewGrammar/G13.expected.txt new file mode 100644 index 0000000..332e104 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G13.expected.txt @@ -0,0 +1,55 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u2)) +| ` <*> +| + pure (\u1 -> Term) +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | ` def +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` <*> + + pure (\u1 -> u1 Term) + ` <|> + + <*> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) + | | | ` conditional + | | | + look + | | | | ` ref + | | | + bs + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` ref + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` ref + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` ref + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` ref + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` ref + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` ref + | | | | ` <*> + | | | | + <*> + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) + | | | | | | | ` ref + | | | | | | ` ref + | | | | | ` rec + | | | | ` ref + | | | ` empty + | | ` ref + | ` rec + ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/ViewGrammar/G14.expected.txt b/test/Golden/Grammar/ViewGrammar/G14.expected.txt new file mode 100644 index 0000000..1474b79 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G14.expected.txt @@ -0,0 +1,450 @@ +<*> ++ <*> +| + <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) +| | | | ` <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) +| | | | | | ` pure Term +| | | | | ` <|> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | ` <|> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> Term)) +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | ` def +| | | | | | | | | | ` satisfy +| | | | | | | | | ` ref +| | | | | | | | ` <|> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | | ` ref +| | | | | | | | | ` rec +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) +| | | | | | | | | | | ` try +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> '/' : ('/' : Term))) +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` ref +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | | | ` ref +| | | | | | | | | | ` rec +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` rec +| | | | | ` pure (\u1 -> u1) +| | | | ` ref +| | | ` ref +| | ` <|> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10)))))))))) +| | | | | | | | | | | ` try +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | ` try +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : u9)))))))))))))))) +| | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` pure Term +| | | | | | | | | | | ` negLook +| | | | | | | | | | | ` ref +| | | | | | | | | | ` ref +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | ` try +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` <|> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` rec +| | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | ` ref +| | | | | | | | | ` ref +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> '(')) +| | | | | | | | | ` ref +| | | | | | | | ` ref +| | | | | | | ` <|> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` <|> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> Term) +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` ref +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> ',')) +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` rec +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` <|> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) +| | | | | | | | | ` ref +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> ')')) +| | | | | | ` ref +| | | | | ` ref +| | | | ` <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5))))))) +| | | | | | | | | | ` ref +| | | | | | | | | ` ref +| | | | | | | | ` ref +| | | | | | | ` <|> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) +| | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> '0') +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> '1') +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) +| | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> Term) +| | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2))) +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) +| | | | | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` rec +| | | | | | | | | | ` <|> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) +| | | | | | | | | | | | | ` try +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` rec +| | | | | | | | | | ` ref +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | | | | | | | ` try +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` rec +| | | | | | | | | ` <|> +| | | | | | | | | + try +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11)))))))))))) +| | | | | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> Term)) +| | | | | | | | | | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) +| | | | | | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` <|> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` rec +| | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | ` ref +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> ';')) +| | | | | | | | | | | ` ref +| | | | | | | | | | ` ref +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` ref +| | | | | | | | | ` ref +| | | | | | | | ` rec +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` ref +| | | | | ` ref +| | | | ` ref +| | | ` rec +| | ` pure (\u1 -> u1) +| ` ref +` eof diff --git a/test/Golden/Grammar/ViewGrammar/G2.expected.txt b/test/Golden/Grammar/ViewGrammar/G2.expected.txt new file mode 100644 index 0000000..b988481 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G2.expected.txt @@ -0,0 +1,9 @@ +try +` <*> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : ('b' : ('c' : Term))))) + | | ` def + | | ` satisfy + | ` ref + ` ref diff --git a/test/Golden/Grammar/ViewGrammar/G3.expected.txt b/test/Golden/Grammar/ViewGrammar/G3.expected.txt new file mode 100644 index 0000000..6c86aca --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G3.expected.txt @@ -0,0 +1,9 @@ +<*> ++ pure (\u1 -> u1 Term) +` <|> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) + | | ` satisfy + | ` rec + ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/ViewGrammar/G4.expected.txt b/test/Golden/Grammar/ViewGrammar/G4.expected.txt new file mode 100644 index 0000000..c29ebd7 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G4.expected.txt @@ -0,0 +1,21 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 : u2 Term)) +| ` try +| ` <*> +| + <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | | | ` def +| | | | ` satisfy +| | | ` ref +| | ` ref +| ` ref +` <|> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) + | | ` ref + | ` rec + ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/ViewGrammar/G5.expected.txt b/test/Golden/Grammar/ViewGrammar/G5.expected.txt new file mode 100644 index 0000000..2778d27 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G5.expected.txt @@ -0,0 +1,23 @@ +<*> ++ <*> +| + <*> +| | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) +| | ` try +| | ` <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | | | | ` def +| | | | | ` satisfy +| | | | ` ref +| | | ` ref +| | ` ref +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) +` eof diff --git a/test/Golden/Grammar/ViewGrammar/G6.expected.txt b/test/Golden/Grammar/ViewGrammar/G6.expected.txt new file mode 100644 index 0000000..cf67b8a --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G6.expected.txt @@ -0,0 +1,12 @@ +<|> ++ <*> +| + <*> +| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) +| | ` def +| | ` satisfy +| ` ref +` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` ref + ` ref diff --git a/test/Golden/Grammar/ViewGrammar/G7.expected.txt b/test/Golden/Grammar/ViewGrammar/G7.expected.txt new file mode 100644 index 0000000..83b71f8 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G7.expected.txt @@ -0,0 +1,14 @@ +<|> ++ try +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) +| | ` def +| | ` satisfy +| ` ref +` try + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` ref + ` ref diff --git a/test/Golden/Grammar/ViewGrammar/G8.expected.txt b/test/Golden/Grammar/ViewGrammar/G8.expected.txt new file mode 100644 index 0000000..390fa44 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G8.expected.txt @@ -0,0 +1,11 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 Term)) +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` eof diff --git a/test/Golden/Grammar/eof.dump b/test/Golden/Grammar/ViewGrammar/G9.expected.txt similarity index 100% rename from test/Golden/Grammar/eof.dump rename to test/Golden/Grammar/ViewGrammar/G9.expected.txt diff --git a/test/Golden/Grammar/app.dump b/test/Golden/Grammar/app.dump deleted file mode 100644 index a924e39..0000000 --- a/test/Golden/Grammar/app.dump +++ /dev/null @@ -1,3 +0,0 @@ -<*> -+ pure (\u1 -> u1) -` pure Term diff --git a/test/Golden/Grammar/app.opt.dump b/test/Golden/Grammar/app.opt.dump deleted file mode 100644 index 10a8427..0000000 --- a/test/Golden/Grammar/app.opt.dump +++ /dev/null @@ -1 +0,0 @@ -pure Term diff --git a/test/Golden/Grammar/boom.dump b/test/Golden/Grammar/boom.dump deleted file mode 100644 index abe899b..0000000 --- a/test/Golden/Grammar/boom.dump +++ /dev/null @@ -1,46 +0,0 @@ -<*> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> u1)) -| | ` pure (\u1 -> u1) -| ` <*> -| + <*> -| | + def -| | | ` <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure (\u1 -> u1) -| | ` def -| | ` <*> -| | + <*> -| | | + def -| | | | ` <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure (\u1 -> u1) -| | | ` def -| | | ` <*> -| | | + <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` pure (\u1 -> u1) -| | | | ` rec -| | | ` rec -| | ` rec -| ` def -| ` pure Term -` <*> - + <*> - | + ref - | ` def - | ` <*> - | + <*> - | | + ref - | | ` def - | | ` <*> - | | + <*> - | | | + <*> - | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | ` pure (\u1 -> u1) - | | | ` rec - | | ` rec - | ` rec - ` ref diff --git a/test/Golden/Grammar/boom.opt.dump b/test/Golden/Grammar/boom.opt.dump deleted file mode 100644 index da92790..0000000 --- a/test/Golden/Grammar/boom.opt.dump +++ /dev/null @@ -1,36 +0,0 @@ -<*> -+ <*> -| + <*> -| | + <*> -| | | + <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (u4 u5) u6)))))) -| | | | | ` def -| | | | | ` pure (\u1 -> (\u2 -> u2)) -| | | | ` def -| | | | ` <*> -| | | | + <*> -| | | | | + def -| | | | | | ` pure (\u1 -> (\u2 -> u2)) -| | | | | ` def -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | ` rec -| | | | | ` rec -| | | | ` rec -| | | ` def -| | | ` pure Term -| | ` ref -| ` def -| ` <*> -| + <*> -| | + ref -| | ` def -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u2)) -| | | ` rec -| | ` rec -| ` rec -` ref diff --git a/test/Golden/Grammar/brainfuck.dump b/test/Golden/Grammar/brainfuck.dump deleted file mode 100644 index 17bde45..0000000 --- a/test/Golden/Grammar/brainfuck.dump +++ /dev/null @@ -1,101 +0,0 @@ -<*> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> u1)) -| | ` pure (\u1 -> u1) -| ` def -| ` <*> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure (\u1 -> u1) -| | ` <*> -| | + <*> -| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | ` pure Term -| | ` def -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | ` def -| | | | ` satisfy -| | | ` rec -| | ` pure (\u1 -> u1) -| ` pure Term -` def - ` <*> - + def - | ` <|> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) - | | | ` <*> - | | | + pure cons - | | | ` <*> - | | | + <*> - | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | ` conditional - | | | | + look - | | | | | ` ref - | | | | + bs - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` ref - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` ref - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` ref - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` ref - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` ref - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` ref - | | | | | ` <*> - | | | | | + <*> - | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | ` <*> - | | | | | | + <*> - | | | | | | | + <*> - | | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | | ` pure (\u1 -> u1) - | | | | | | | ` <*> - | | | | | | | + <*> - | | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | | ` ref - | | | | | | | ` ref - | | | | | | ` <*> - | | | | | | + pure Term - | | | | | | ` rec - | | | | | ` <*> - | | | | | + <*> - | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | ` pure ']' - | | | | | ` ref - | | | | ` empty - | | | ` ref - | | ` rec - | ` pure (\u1 -> u1) - ` pure Term diff --git a/test/Golden/Grammar/brainfuck.opt.dump b/test/Golden/Grammar/brainfuck.opt.dump deleted file mode 100644 index 1e445bc..0000000 --- a/test/Golden/Grammar/brainfuck.opt.dump +++ /dev/null @@ -1,58 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u2)) -| ` def -| ` <*> -| + pure (\u1 -> Term) -| ` def -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) -` def - ` <*> - + pure (\u1 -> u1 Term) - ` def - ` <|> - + <*> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) - | | | ` conditional - | | | + look - | | | | ` satisfy - | | | + bs - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | ` <*> - | | | | + <*> - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) - | | | | | | | ` satisfy - | | | | | | ` ref - | | | | | ` rec - | | | | ` satisfy - | | | ` empty - | | ` ref - | ` rec - ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/eof.opt.dump b/test/Golden/Grammar/eof.opt.dump deleted file mode 100644 index 37fb719..0000000 --- a/test/Golden/Grammar/eof.opt.dump +++ /dev/null @@ -1 +0,0 @@ -eof diff --git a/test/Golden/Grammar/many-a.dump b/test/Golden/Grammar/many-a.dump deleted file mode 100644 index 0154489..0000000 --- a/test/Golden/Grammar/many-a.dump +++ /dev/null @@ -1,16 +0,0 @@ -<*> -+ def -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | ` <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'a' -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) -` pure Term diff --git a/test/Golden/Grammar/many-a.opt.dump b/test/Golden/Grammar/many-a.opt.dump deleted file mode 100644 index d32bfda..0000000 --- a/test/Golden/Grammar/many-a.opt.dump +++ /dev/null @@ -1,10 +0,0 @@ -<*> -+ pure (\u1 -> u1 Term) -` def - ` <|> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) - | | ` satisfy - | ` rec - ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/many-char-eof.dump b/test/Golden/Grammar/many-char-eof.dump deleted file mode 100644 index 025f7a8..0000000 --- a/test/Golden/Grammar/many-char-eof.dump +++ /dev/null @@ -1,20 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> -| + def -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + pure cons -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` pure 'r' -| | | | ` satisfy -| | | ` rec -| | ` pure (\u1 -> u1) -| ` pure Term -` eof diff --git a/test/Golden/Grammar/many-char-eof.opt.dump b/test/Golden/Grammar/many-char-eof.opt.dump deleted file mode 100644 index 8218cf0..0000000 --- a/test/Golden/Grammar/many-char-eof.opt.dump +++ /dev/null @@ -1,12 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` def -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) -` eof diff --git a/test/Golden/Grammar/nandlang.dump b/test/Golden/Grammar/nandlang.dump deleted file mode 100644 index 44c99e9..0000000 --- a/test/Golden/Grammar/nandlang.dump +++ /dev/null @@ -1,993 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure (\u1 -> u1) -| | ` def -| | ` <*> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure (\u1 -> u1) -| | | ` <*> -| | | + <*> -| | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | ` def -| | | | ` pure Term -| | | ` def -| | | ` <|> -| | | + <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | ` <|> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` def -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` def -| | | | | | | | ` satisfy -| | | | | | | ` ref -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | ` pure Term -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` ref -| | | | | | | | ` rec -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` pure Term -| | | | | ` <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` try -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure cons -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure '/' -| | | | | | | | ` ref -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure cons -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure '/' -| | | | | | | | ` ref -| | | | | | | ` pure Term -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | ` ref -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` ref -| | | | | | | | ` rec -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` ref -| | | | | ` ref -| | | | ` rec -| | | ` pure (\u1 -> u1) -| | ` ref -| ` <*> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure (\u1 -> u1) -| | ` <*> -| | + <*> -| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | ` ref -| | ` def -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | ` <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | ` pure (\u1 -> u1) -| | | | | ` <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` try -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | ` try -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'f' -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'u' -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'n' -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'c' -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 't' -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'i' -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'o' -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'n' -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` pure Term -| | | | | | | | ` def -| | | | | | | | ` negLook -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` def -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` try -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` ref -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | ` ref -| | | | | | | | ` def -| | | | | | | | ` <|> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` ref -| | | | | | | | | ` rec -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` ref -| | | | | | ` ref -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` def -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure '(' -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure Term -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | ` def -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | ` ref -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure Term -| | | | | | | | | | ` def -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure '[' -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <|> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` rec -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` pure Term -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure ']' -| | | | | | | | | | | ` ref -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure ',' -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` <|> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure Term -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` pure ':' -| | | | | | | | | ` ref -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` ref -| | | | | ` def -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure ')' -| | | | | | ` ref -| | | | | ` ref -| | | | ` def -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure '{' -| | | | | | | ` ref -| | | | | | ` ref -| | | | | ` <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | ` ref -| | | | | | ` def -| | | | | | ` <|> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` <|> -| | | | | | | | + <|> -| | | | | | | | | + <|> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'i' -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'f' -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` def -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | + <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure '0' -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure '1' -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure '\'' -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure '\\' -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure '\'' -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | + ref -| | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure '!' -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` rec -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure 'e' -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure 'l' -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure 's' -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure 'e' -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` rec -| | | | | | | | | | | ` ref -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` try -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'w' -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'h' -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'i' -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'l' -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'e' -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` try -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'v' -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'a' -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'r' -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` def -| | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure '=' -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` ref -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` def -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + ref -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` rec -| | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure ';' -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` ref -| | | | | | | | ` ref -| | | | | | | ` rec -| | | | | | ` pure (\u1 -> u1) -| | | | | ` ref -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | ` pure '}' -| | | | | ` ref -| | | | ` ref -| | | ` rec -| | ` pure (\u1 -> u1) -| ` ref -` eof diff --git a/test/Golden/Grammar/nandlang.opt.dump b/test/Golden/Grammar/nandlang.opt.dump deleted file mode 100644 index b4f6e01..0000000 --- a/test/Golden/Grammar/nandlang.opt.dump +++ /dev/null @@ -1,479 +0,0 @@ -<*> -+ <*> -| + <*> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) -| | | | ` def -| | | | ` <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) -| | | | | | ` def -| | | | | | ` pure Term -| | | | | ` def -| | | | | ` <|> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> Term)) -| | | | | | | | | ` def -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | ` satisfy -| | | | | | | | | ` ref -| | | | | | | | ` def -| | | | | | | | ` <|> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | ` ref -| | | | | | | | | ` rec -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | | | | | | | | ` try -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> '/' : ('/' : Term))) -| | | | | | | | | | | | ` satisfy -| | | | | | | | | | | ` satisfy -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | ` satisfy -| | | | | | | | | | ` rec -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` rec -| | | | | ` pure (\u1 -> u1) -| | | | ` ref -| | | ` ref -| | ` def -| | ` <|> -| | + <*> -| | | + <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10)))))))))) -| | | | | | | | | | | ` try -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | ` try -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : u9)))))))))))))))) -| | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` pure Term -| | | | | | | | | | | ` def -| | | | | | | | | | | ` negLook -| | | | | | | | | | | ` satisfy -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | ` try -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` def -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` rec -| | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` def -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> '(')) -| | | | | | | | | ` satisfy -| | | | | | | | ` ref -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | | | | | | ` def -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> Term) -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | ` def -| | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> ',')) -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` <|> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | | ` satisfy -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` ref -| | | | | ` def -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> ')')) -| | | | | | ` satisfy -| | | | | ` ref -| | | | ` def -| | | | ` <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5))))))) -| | | | | | | | | | ` satisfy -| | | | | | | | | ` ref -| | | | | | | | ` ref -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> '0') -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> '1') -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) -| | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) -| | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> Term) -| | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2))) -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` def -| | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` rec -| | | | | | | | | | ` <|> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | | | | | | ` try -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` rec -| | | | | | | | | | ` ref -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | | ` try -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) -| | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` <|> -| | | | | | | | | + try -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11)))))))))))) -| | | | | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> Term)) -| | | | | | | | | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) -| | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <|> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` rec -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` ref -| | | | | | | | | | ` def -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> ';')) -| | | | | | | | | | | ` satisfy -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` rec -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` ref -| | | | | ` satisfy -| | | | ` ref -| | | ` rec -| | ` pure (\u1 -> u1) -| ` ref -` eof diff --git a/test/Golden/Grammar/string.dump b/test/Golden/Grammar/string.dump deleted file mode 100644 index e2f2f29..0000000 --- a/test/Golden/Grammar/string.dump +++ /dev/null @@ -1,35 +0,0 @@ -try -` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` def - | ` satisfy - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' - | ` ref - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'c' - | ` ref - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'd' - | ` ref - ` pure Term diff --git a/test/Golden/Grammar/string.opt.dump b/test/Golden/Grammar/string.opt.dump deleted file mode 100644 index f7aa3a9..0000000 --- a/test/Golden/Grammar/string.opt.dump +++ /dev/null @@ -1,10 +0,0 @@ -try -` <*> - + <*> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) - | | | ` satisfy - | | ` satisfy - | ` satisfy - ` satisfy diff --git a/test/Golden/Grammar/tokens.dump b/test/Golden/Grammar/tokens.dump deleted file mode 100644 index e2f2f29..0000000 --- a/test/Golden/Grammar/tokens.dump +++ /dev/null @@ -1,35 +0,0 @@ -try -` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` def - | ` satisfy - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' - | ` ref - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'c' - | ` ref - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'd' - | ` ref - ` pure Term diff --git a/test/Golden/Grammar/tokens.opt.dump b/test/Golden/Grammar/tokens.opt.dump deleted file mode 100644 index f7aa3a9..0000000 --- a/test/Golden/Grammar/tokens.opt.dump +++ /dev/null @@ -1,10 +0,0 @@ -try -` <*> - + <*> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) - | | | ` satisfy - | | ` satisfy - | ` satisfy - ` satisfy diff --git a/test/Golden/Grammar/unit-unit.dump b/test/Golden/Grammar/unit-unit.dump deleted file mode 100644 index e130748..0000000 --- a/test/Golden/Grammar/unit-unit.dump +++ /dev/null @@ -1,8 +0,0 @@ -<*> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> u1)) -| | ` pure (\u1 -> u1) -| ` def -| ` pure Term -` ref diff --git a/test/Golden/Grammar/unit-unit.opt.dump b/test/Golden/Grammar/unit-unit.opt.dump deleted file mode 100644 index 01ac485..0000000 --- a/test/Golden/Grammar/unit-unit.opt.dump +++ /dev/null @@ -1,6 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u2)) -| ` def -| ` pure Term -` ref diff --git a/test/Golden/Grammar/unit.dump b/test/Golden/Grammar/unit.dump deleted file mode 100644 index 10a8427..0000000 --- a/test/Golden/Grammar/unit.dump +++ /dev/null @@ -1 +0,0 @@ -pure Term diff --git a/test/Golden/Grammar/unit.opt.dump b/test/Golden/Grammar/unit.opt.dump deleted file mode 100644 index 10a8427..0000000 --- a/test/Golden/Grammar/unit.opt.dump +++ /dev/null @@ -1 +0,0 @@ -pure Term diff --git a/test/Golden/Machine.hs b/test/Golden/Machine.hs new file mode 100644 index 0000000..149a375 --- /dev/null +++ b/test/Golden/Machine.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DataKinds #-} -- For using P.viewMachine +{-# LANGUAGE TypeApplications #-} +module Golden.Machine where + +import Data.Bool (Bool(..)) +import Control.Monad (Monad(..)) +import Data.Int (Int) +import Data.Function (($)) +import Data.Semigroup (Semigroup(..)) +import Data.String (IsString(..)) +import Test.Tasty +import Test.Tasty.Golden +import Text.Show (Show(..)) +import qualified Data.List as List + +import Golden.Utils +import qualified Symantic.Parser as P +import qualified Machine + +goldens :: TestTree +goldens = testGroup "Machine" $ + (\f -> List.zipWith f Machine.machines [1::Int ..]) $ \(Machine.M mach) g -> + let machineFile = "test/Golden/Machine/G"<>show g<>".expected.txt" in + goldenVsStringDiff machineFile goldenDiff machineFile $ do + return $ fromString $ show $ + P.viewMachine @'False mach diff --git a/test/Golden/Machine/G1.expected.txt b/test/Golden/Machine/G1.expected.txt new file mode 100644 index 0000000..dc8fb40 --- /dev/null +++ b/test/Golden/Machine/G1.expected.txt @@ -0,0 +1,4 @@ +pushValue (\u1 -> 'a') +read ('a' ==) +lift2Value (\u1 -> (\u2 -> u1 u2)) +ret diff --git a/test/Golden/Machine/G10.expected.txt b/test/Golden/Machine/G10.expected.txt new file mode 100644 index 0000000..fc64d34 --- /dev/null +++ b/test/Golden/Machine/G10.expected.txt @@ -0,0 +1,18 @@ +catchException "fail" + + | pushValue (\u1 -> 'a') + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | ret + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> 'b') + | read ('b' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | ret + + raiseException "fail" diff --git a/test/Golden/Machine/G11.expected.txt b/test/Golden/Machine/G11.expected.txt new file mode 100644 index 0000000..c29c56b --- /dev/null +++ b/test/Golden/Machine/G11.expected.txt @@ -0,0 +1,24 @@ +pushValue (\u1 -> (\u2 -> u1 Term)) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| read ('b' ==) +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +catchException "fail" + + | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | call + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | refJoin + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> u1) + | refJoin + + raiseException "fail" diff --git a/test/Golden/Machine/G12.expected.txt b/test/Golden/Machine/G12.expected.txt new file mode 100644 index 0000000..e67278c --- /dev/null +++ b/test/Golden/Machine/G12.expected.txt @@ -0,0 +1,47 @@ +pushValue (\u1 -> (\u2 -> u1 Term)) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| : +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | ret +| catchException "fail" +| +| | catchException "fail" +| | +| | | pushInput +| | | read (\u1 -> Term) +| | | popValue +| | | popException "fail" +| | | loadInput +| | | raiseException "fail" +| | +| | loadInput +| | pushValue Term +| | popException "fail" +| | refJoin +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | raiseException "fail" +| +| raiseException "fail" +catchException "fail" + + | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) + | read Term + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | call + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | refJoin + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> u1) + | refJoin + + raiseException "fail" diff --git a/test/Golden/Machine/G13.expected.txt b/test/Golden/Machine/G13.expected.txt new file mode 100644 index 0000000..234dd25 --- /dev/null +++ b/test/Golden/Machine/G13.expected.txt @@ -0,0 +1,92 @@ +pushValue (\u1 -> (\u2 -> u2 Term)) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| : +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | ret +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) +| | : +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | call +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | call +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | popException "fail" +| | | refJoin +| | pushInput +| | read ((\u1 -> (\u2 -> u1)) Term) +| | swapValue +| | loadInput +| | choicesBranch [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)] +| | +| | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | refJoin +| | +| | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | refJoin +| | +| | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | refJoin +| | +| | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | refJoin +| | +| | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | refJoin +| | +| | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | refJoin +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | call +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | call +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | read (']' ==) +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | refJoin +| | +| | raiseException "fail" +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | refJoin +| +| raiseException "fail" +catchException "fail" + + | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) + | read Term + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | call + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | refJoin + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> u1) + | refJoin + + raiseException "fail" diff --git a/test/Golden/Machine/G14.expected.txt b/test/Golden/Machine/G14.expected.txt new file mode 100644 index 0000000..2d50a8b --- /dev/null +++ b/test/Golden/Machine/G14.expected.txt @@ -0,0 +1,847 @@ +pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> u5)))))) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| call +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| call +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| : +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | : +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | ret +| | catchException "fail" +| | +| | | catchException "fail" +| | | +| | | | pushInput +| | | | read (\u1 -> Term) +| | | | popValue +| | | | popException "fail" +| | | | loadInput +| | | | raiseException "fail" +| | | +| | | loadInput +| | | pushValue Term +| | | popException "fail" +| | | refJoin +| | +| | pushInput +| | lift2Value Term +| | choicesBranch [(\u1 -> u1)] +| | +| | | raiseException "fail" +| | +| | raiseException "fail" +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> (\u13 -> (\u14 -> (\u15 -> (\u16 -> (\u17 -> (\u18 -> (\u19 -> u18 u19))))))))))))))))))) +| | catchException "fail" +| | +| | | pushValue (\u1 -> Term) +| | | catchException "fail" +| | | +| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : Term))))))))))))))) +| | | | read ('f' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | read ('u' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | read ('n' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | read ('c' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | read ('t' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | read ('i' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | read ('o' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | read ('n' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | popException "fail" +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | catchException "fail" +| | | | +| | | | | pushInput +| | | | | read Term +| | | | | popValue +| | | | | popException "fail" +| | | | | loadInput +| | | | | raiseException "fail" +| | | | +| | | | loadInput +| | | | popException "fail" +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | catchException "fail" +| | | | +| | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | read Term +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | : +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | popException "fail" +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | read ('(' ==) +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | : +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | : +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | read (')' ==) +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | read ('{' ==) +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | : +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | read ('}' ==) +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | popException "fail" +| | | | | | | | | refJoin +| | | | | | | | catchException "fail" +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | : +| | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | call +| | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | popException "fail" +| | | | | | | | | | refJoin +| | | | | | | | | catchException "fail" +| | | | | | | | | +| | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> u8)))))))) +| | | | | | | | | | catchException "fail" +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) +| | | | | | | | | | | | read ('i' ==) +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | read ('f' ==) +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | : +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | : +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) +| | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) +| | | | | | | | | | | | | | | | | read ('e' ==) +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | read ('l' ==) +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | read ('s' ==) +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | read ('e' ==) +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | loadInput +| | | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | loadInput +| | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) +| | | | | | | | | | | | | | read ('!' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | +| | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | : +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> '0') +| | | | | | | | | | | | | | read ('0' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | +| | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> '1') +| | | | | | | | | | | | | | read ('1' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | pushInput +| | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | +| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) +| | | | | | | | | | | | | | read ('\'' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | read ('\'' ==) +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | read Term +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u3))) +| | | | | | | | | | | | | | | read ('\\' ==) +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | read Term +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> Term) +| | | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2))) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | +| | | | | | | | | | | loadInput +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | +| | | | | | | | | | loadInput +| | | | | | | | | | raiseException "fail" +| | | | | | | | | +| | | | | | | | | pushInput +| | | | | | | | | lift2Value Term +| | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | +| | | | | | | | | | catchException "fail" +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) +| | | | | | | | | | | | | read ('w' ==) +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | read ('h' ==) +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | read ('i' ==) +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | read ('l' ==) +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | read ('e' ==) +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | refJoin +| | | | | | | | | | | | +| | | | | | | | | | | | loadInput +| | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | +| | | | | | | | | | | loadInput +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | +| | | | | | | | | | pushInput +| | | | | | | | | | lift2Value Term +| | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | +| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | +| | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> (\u13 -> u11))))))))))))) +| | | | | | | | | | | | | : +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | read ('=' ==) +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | read (';' ==) +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> Term)) +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) +| | | | | | | | | | | | | | | | read ('v' ==) +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | read ('a' ==) +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | read ('r' ==) +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | loadInput +| | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | loadInput +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | loadInput +| | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | +| | | | | | | | | | | pushInput +| | | | | | | | | | | lift2Value Term +| | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | refJoin +| | | | | | | | | | | +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | +| | | | | | | | | | raiseException "fail" +| | | | | | | | | +| | | | | | | | | raiseException "fail" +| | | | | | | | +| | | | | | | | pushInput +| | | | | | | | lift2Value Term +| | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | refJoin +| | | | | | | | +| | | | | | | | raiseException "fail" +| | | | | | | catchException "fail" +| | | | | | | +| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) +| | | | | | | | read (':' ==) +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | popException "fail" +| | | | | | | | refJoin +| | | | | | | +| | | | | | | pushInput +| | | | | | | lift2Value Term +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | +| | | | | | | | call +| | | | | | | | refJoin +| | | | | | | +| | | | | | | raiseException "fail" +| | | | | | catchException "fail" +| | | | | | +| | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> Term))))) +| | | | | | | call +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | : +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | : +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | popException "fail" +| | | | | | | | | refJoin +| | | | | | | | catchException "fail" +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) +| | | | | | | | | read (',' ==) +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | popException "fail" +| | | | | | | | | refJoin +| | | | | | | | +| | | | | | | | pushInput +| | | | | | | | lift2Value Term +| | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | refJoin +| | | | | | | | +| | | | | | | | raiseException "fail" +| | | | | | | catchException "fail" +| | | | | | | +| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) +| | | | | | | | read ('[' ==) +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | read Term +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | : +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | read (']' ==) +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | popException "fail" +| | | | | | | | | refJoin +| | | | | | | | catchException "fail" +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | popException "fail" +| | | | | | | | | refJoin +| | | | | | | | +| | | | | | | | pushInput +| | | | | | | | lift2Value Term +| | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | refJoin +| | | | | | | | +| | | | | | | | raiseException "fail" +| | | | | | | +| | | | | | | pushInput +| | | | | | | lift2Value Term +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | +| | | | | | | | call +| | | | | | | | refJoin +| | | | | | | +| | | | | | | raiseException "fail" +| | | | | | +| | | | | | pushInput +| | | | | | lift2Value Term +| | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | +| | | | | | | call +| | | | | | | refJoin +| | | | | | +| | | | | | raiseException "fail" +| | | | | catchException "fail" +| | | | | +| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | read Term +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | popException "fail" +| | | | | | refJoin +| | | | | +| | | | | pushInput +| | | | | lift2Value Term +| | | | | choicesBranch [(\u1 -> u1)] +| | | | | +| | | | | | pushValue (\u1 -> u1) +| | | | | | refJoin +| | | | | +| | | | | raiseException "fail" +| | | | +| | | | loadInput +| | | | raiseException "fail" +| | | +| | | loadInput +| | | raiseException "fail" +| | +| | loadInput +| | raiseException "fail" +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | refJoin +| +| raiseException "fail" +catchException "fail" + + | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) + | : + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | call + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | popException "fail" + | | refJoin + | catchException "fail" + | + | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) + | | read Term + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | call + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | : + | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | popException "fail" + | | | refJoin + | | catchException "fail" + | | + | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) + | | | call + | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | call + | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | popException "fail" + | | | refJoin + | | + | | pushInput + | | lift2Value Term + | | choicesBranch [(\u1 -> u1)] + | | + | | | pushValue (\u1 -> u1) + | | | refJoin + | | + | | raiseException "fail" + | + | pushInput + | lift2Value Term + | choicesBranch [(\u1 -> u1)] + | + | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) + | | catchException "fail" + | | + | | | pushValue (\u1 -> (\u2 -> '/' : ('/' : Term))) + | | | read ('/' ==) + | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | read ('/' ==) + | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | popException "fail" + | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | call + | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | : + | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | | call + | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | | call + | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | | refJoin + | | | catchException "fail" + | | | + | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) + | | | | read Term + | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | | call + | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | | popException "fail" + | | | | refJoin + | | | + | | | pushInput + | | | lift2Value Term + | | | choicesBranch [(\u1 -> u1)] + | | | + | | | | pushValue (\u1 -> u1) + | | | | refJoin + | | | + | | | raiseException "fail" + | | + | | loadInput + | | raiseException "fail" + | + | raiseException "fail" + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> u1) + | refJoin + + raiseException "fail" diff --git a/test/Golden/Machine/G2.expected.txt b/test/Golden/Machine/G2.expected.txt new file mode 100644 index 0000000..28a0ccc --- /dev/null +++ b/test/Golden/Machine/G2.expected.txt @@ -0,0 +1,14 @@ +catchException "fail" + + | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : ('b' : ('c' : Term))))) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('b' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('c' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | ret + + loadInput + raiseException "fail" diff --git a/test/Golden/Machine/G3.expected.txt b/test/Golden/Machine/G3.expected.txt new file mode 100644 index 0000000..74e2e11 --- /dev/null +++ b/test/Golden/Machine/G3.expected.txt @@ -0,0 +1,22 @@ +pushValue (\u1 -> u1 Term) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +catchException "fail" + + | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | call + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | refJoin + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> u1) + | refJoin + + raiseException "fail" diff --git a/test/Golden/Machine/G4.expected.txt b/test/Golden/Machine/G4.expected.txt new file mode 100644 index 0000000..9553d9f --- /dev/null +++ b/test/Golden/Machine/G4.expected.txt @@ -0,0 +1,38 @@ +pushValue (\u1 -> (\u2 -> u1 : u2 Term)) +catchException "fail" + + | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('b' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('c' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('d' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | : + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | ret + | catchException "fail" + | + | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) + | | call + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | call + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | popException "fail" + | | refJoin + | + | pushInput + | lift2Value Term + | choicesBranch [(\u1 -> u1)] + | + | | pushValue (\u1 -> u1) + | | refJoin + | + | raiseException "fail" + + loadInput + raiseException "fail" diff --git a/test/Golden/Machine/G5.expected.txt b/test/Golden/Machine/G5.expected.txt new file mode 100644 index 0000000..3b59cd8 --- /dev/null +++ b/test/Golden/Machine/G5.expected.txt @@ -0,0 +1,63 @@ +pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) +catchException "fail" + + | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('b' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('c' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('d' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | : + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | : + | | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | | ret + | | catchException "fail" + | | + | | | catchException "fail" + | | | + | | | | pushInput + | | | | read (\u1 -> Term) + | | | | popValue + | | | | popException "fail" + | | | | loadInput + | | | | raiseException "fail" + | | | + | | | loadInput + | | | pushValue Term + | | | popException "fail" + | | | refJoin + | | + | | pushInput + | | lift2Value Term + | | choicesBranch [(\u1 -> u1)] + | | + | | | raiseException "fail" + | | + | | raiseException "fail" + | catchException "fail" + | + | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) + | | call + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | call + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | popException "fail" + | | refJoin + | + | pushInput + | lift2Value Term + | choicesBranch [(\u1 -> u1)] + | + | | pushValue (\u1 -> u1) + | | refJoin + | + | raiseException "fail" + + loadInput + raiseException "fail" diff --git a/test/Golden/Machine/G6.expected.txt b/test/Golden/Machine/G6.expected.txt new file mode 100644 index 0000000..eac5644 --- /dev/null +++ b/test/Golden/Machine/G6.expected.txt @@ -0,0 +1,22 @@ +catchException "fail" + + | pushValue (\u1 -> (\u2 -> 'a' : ('a' : Term))) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | ret + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('b' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | ret + + raiseException "fail" diff --git a/test/Golden/Machine/G7.expected.txt b/test/Golden/Machine/G7.expected.txt new file mode 100644 index 0000000..abe13b0 --- /dev/null +++ b/test/Golden/Machine/G7.expected.txt @@ -0,0 +1,34 @@ +catchException "fail" + + | catchException "fail" + | + | | pushValue (\u1 -> (\u2 -> 'a' : ('a' : Term))) + | | read ('a' ==) + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | read ('a' ==) + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | popException "fail" + | | popException "fail" + | | ret + | + | loadInput + | raiseException "fail" + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | catchException "fail" + | + | | pushValue (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | | read ('a' ==) + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | read ('b' ==) + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | popException "fail" + | | ret + | + | loadInput + | raiseException "fail" + + raiseException "fail" diff --git a/test/Golden/Machine/G8.expected.txt b/test/Golden/Machine/G8.expected.txt new file mode 100644 index 0000000..9e989e2 --- /dev/null +++ b/test/Golden/Machine/G8.expected.txt @@ -0,0 +1,47 @@ +pushValue (\u1 -> (\u2 -> u1 Term)) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| : +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | ret +| catchException "fail" +| +| | catchException "fail" +| | +| | | pushInput +| | | read (\u1 -> Term) +| | | popValue +| | | popException "fail" +| | | loadInput +| | | raiseException "fail" +| | +| | loadInput +| | pushValue Term +| | popException "fail" +| | refJoin +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | raiseException "fail" +| +| raiseException "fail" +catchException "fail" + + | pushValue (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) + | read ('r' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | call + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | refJoin + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> u1) + | refJoin + + raiseException "fail" diff --git a/test/Golden/Machine/G9.expected.txt b/test/Golden/Machine/G9.expected.txt new file mode 100644 index 0000000..be75595 --- /dev/null +++ b/test/Golden/Machine/G9.expected.txt @@ -0,0 +1,23 @@ +catchException "fail" + + | catchException "fail" + | + | | pushInput + | | read (\u1 -> Term) + | | popValue + | | popException "fail" + | | loadInput + | | raiseException "fail" + | + | loadInput + | pushValue Term + | popException "fail" + | ret + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | raiseException "fail" + + raiseException "fail" diff --git a/test/Golden/Machine/a-or-b.dump b/test/Golden/Machine/a-or-b.dump deleted file mode 100644 index 4bad202..0000000 --- a/test/Golden/Machine/a-or-b.dump +++ /dev/null @@ -1,18 +0,0 @@ -catchFail - - | push (\u1 -> 'a') - | read ('a' ==) - | lift (\u1 -> (\u2 -> u1 u2)) - | popFail - | ret - - pushInput - lift Term - choices [(\u1 -> u1)] - - | push (\u1 -> 'b') - | read ('b' ==) - | lift (\u1 -> (\u2 -> u1 u2)) - | ret - - fail diff --git a/test/Golden/Machine/app.dump b/test/Golden/Machine/app.dump deleted file mode 100644 index 5bbd8be..0000000 --- a/test/Golden/Machine/app.dump +++ /dev/null @@ -1,2 +0,0 @@ -push Term -ret diff --git a/test/Golden/Machine/boom.dump b/test/Golden/Machine/boom.dump deleted file mode 100644 index f1a3475..0000000 --- a/test/Golden/Machine/boom.dump +++ /dev/null @@ -1,51 +0,0 @@ -push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (u4 u5) u6)))))) -: -| push (\u1 -> (\u2 -> u2)) -| ret -call -lift (\u1 -> (\u2 -> u1 u2)) -: -| : -| | push (\u1 -> (\u2 -> u2)) -| | ret -| call -| : -| | push (\u1 -> (\u2 -> u2)) -| | call -| | lift (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift (\u1 -> (\u2 -> u1 u2)) -| | ret -| call -| lift (\u1 -> (\u2 -> u1 u2)) -| call -| lift (\u1 -> (\u2 -> u1 u2)) -| ret -call -lift (\u1 -> (\u2 -> u1 u2)) -: -| push Term -| ret -call -lift (\u1 -> (\u2 -> u1 u2)) -call -lift (\u1 -> (\u2 -> u1 u2)) -: -| call -| : -| | push (\u1 -> (\u2 -> u2)) -| | call -| | lift (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift (\u1 -> (\u2 -> u1 u2)) -| | ret -| call -| lift (\u1 -> (\u2 -> u1 u2)) -| call -| lift (\u1 -> (\u2 -> u1 u2)) -| ret -call -lift (\u1 -> (\u2 -> u1 u2)) -call -lift (\u1 -> (\u2 -> u1 u2)) -ret diff --git a/test/Golden/Machine/brainfuck.dump b/test/Golden/Machine/brainfuck.dump deleted file mode 100644 index cc34127..0000000 --- a/test/Golden/Machine/brainfuck.dump +++ /dev/null @@ -1,104 +0,0 @@ -push (\u1 -> (\u2 -> u2)) -: -| push (\u1 -> Term) -| : -| | catchFail -| | -| | | push (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | read Term -| | | lift (\u1 -> (\u2 -> u1 u2)) -| | | call -| | | lift (\u1 -> (\u2 -> u1 u2)) -| | | popFail -| | | ret -| | -| | pushInput -| | lift Term -| | choices [(\u1 -> u1)] -| | -| | | push (\u1 -> u1) -| | | ret -| | -| | fail -| call -| lift (\u1 -> (\u2 -> u1 u2)) -| ret -call -lift (\u1 -> (\u2 -> u1 u2)) -: -| push (\u1 -> u1 Term) -| : -| | catchFail -| | -| | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) -| | | : -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | popFail -| | | | ret -| | | pushInput -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | swap -| | | loadInput -| | | choices [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)] -| | | -| | | | push (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | push (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | push (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | push (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | push (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | push (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | read (']' ==) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | fail -| | -| | pushInput -| | lift Term -| | choices [(\u1 -> u1)] -| | -| | | push (\u1 -> u1) -| | | ret -| | -| | fail -| call -| lift (\u1 -> (\u2 -> u1 u2)) -| ret -call -lift (\u1 -> (\u2 -> u1 u2)) -ret diff --git a/test/Golden/Machine/eof.dump b/test/Golden/Machine/eof.dump deleted file mode 100644 index 4179dd1..0000000 --- a/test/Golden/Machine/eof.dump +++ /dev/null @@ -1,23 +0,0 @@ -catchFail - - | catchFail - | - | | pushInput - | | read (\u1 -> Term) - | | pop - | | popFail - | | loadInput - | | fail - | - | loadInput - | push Term - | popFail - | ret - - pushInput - lift Term - choices [(\u1 -> u1)] - - | fail - - fail diff --git a/test/Golden/Machine/many-a.dump b/test/Golden/Machine/many-a.dump deleted file mode 100644 index 0364fc4..0000000 --- a/test/Golden/Machine/many-a.dump +++ /dev/null @@ -1,23 +0,0 @@ -push (\u1 -> u1 Term) -: -| catchFail -| -| | push (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) -| | read ('a' ==) -| | lift (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift (\u1 -> (\u2 -> u1 u2)) -| | popFail -| | ret -| -| pushInput -| lift Term -| choices [(\u1 -> u1)] -| -| | push (\u1 -> u1) -| | ret -| -| fail -call -lift (\u1 -> (\u2 -> u1 u2)) -ret diff --git a/test/Golden/Machine/many-char-eof.dump b/test/Golden/Machine/many-char-eof.dump deleted file mode 100644 index 2329262..0000000 --- a/test/Golden/Machine/many-char-eof.dump +++ /dev/null @@ -1,48 +0,0 @@ -push (\u1 -> (\u2 -> u1 Term)) -: -| catchFail -| -| | push (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) -| | read ('r' ==) -| | lift (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift (\u1 -> (\u2 -> u1 u2)) -| | popFail -| | ret -| -| pushInput -| lift Term -| choices [(\u1 -> u1)] -| -| | push (\u1 -> u1) -| | ret -| -| fail -call -lift (\u1 -> (\u2 -> u1 u2)) -: -| lift (\u1 -> (\u2 -> u1 u2)) -| ret -catchFail - - | catchFail - | - | | pushInput - | | read (\u1 -> Term) - | | pop - | | popFail - | | loadInput - | | fail - | - | loadInput - | push Term - | popFail - | refJoin - - pushInput - lift Term - choices [(\u1 -> u1)] - - | fail - - fail diff --git a/test/Golden/Machine/many-char-fail.dump b/test/Golden/Machine/many-char-fail.dump deleted file mode 100644 index 75e219e..0000000 --- a/test/Golden/Machine/many-char-fail.dump +++ /dev/null @@ -1,25 +0,0 @@ -push (\u1 -> (\u2 -> u1 Term)) -: -| catchFail -| -| | push (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) -| | read ('a' ==) -| | lift (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift (\u1 -> (\u2 -> u1 u2)) -| | popFail -| | ret -| -| pushInput -| lift Term -| choices [(\u1 -> u1)] -| -| | push (\u1 -> u1) -| | ret -| -| fail -call -lift (\u1 -> (\u2 -> u1 u2)) -read ('b' ==) -lift (\u1 -> (\u2 -> u1 u2)) -ret diff --git a/test/Golden/Machine/nandlang.dump b/test/Golden/Machine/nandlang.dump deleted file mode 100644 index 00e0714..0000000 --- a/test/Golden/Machine/nandlang.dump +++ /dev/null @@ -1,938 +0,0 @@ -push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) -: -| push (\u1 -> (\u2 -> (\u3 -> u3))) -| : -| | push Term -| | ret -| call -| lift (\u1 -> (\u2 -> u1 u2)) -| : -| | catchFail -| | -| | | push (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | : -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | popFail -| | | | ret -| | | catchFail -| | | -| | | | push (\u1 -> (\u2 -> Term)) -| | | | : -| | | | | push (\u1 -> (\u2 -> u2)) -| | | | | read Term -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | ret -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | catchFail -| | | | | -| | | | | | push (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | popFail -| | | | | | ret -| | | | | -| | | | | pushInput -| | | | | lift Term -| | | | | choices [(\u1 -> u1)] -| | | | | -| | | | | | push (\u1 -> u1) -| | | | | | ret -| | | | | -| | | | | fail -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | popFail -| | | | refJoin -| | | -| | | pushInput -| | | lift Term -| | | choices [(\u1 -> u1)] -| | | -| | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | catchFail -| | | | -| | | | | push (\u1 -> (\u2 -> '/' : ('/' : Term))) -| | | | | read ('/' ==) -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | read ('/' ==) -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | popFail -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | : -| | | | | | catchFail -| | | | | | -| | | | | | | push (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | read Term -| | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | call -| | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | popFail -| | | | | | | ret -| | | | | | -| | | | | | pushInput -| | | | | | lift Term -| | | | | | choices [(\u1 -> u1)] -| | | | | | -| | | | | | | push (\u1 -> u1) -| | | | | | | ret -| | | | | | -| | | | | | fail -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | refJoin -| | | | -| | | | loadInput -| | | | fail -| | | -| | | fail -| | -| | pushInput -| | lift Term -| | choices [(\u1 -> u1)] -| | -| | | push (\u1 -> u1) -| | | ret -| | -| | fail -| call -| lift (\u1 -> (\u2 -> u1 u2)) -| call -| lift (\u1 -> (\u2 -> u1 u2)) -| ret -call -lift (\u1 -> (\u2 -> u1 u2)) -call -lift (\u1 -> (\u2 -> u1 u2)) -: -| catchFail -| -| | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10)))))))))) -| | catchFail -| | -| | | push (\u1 -> (\u2 -> u2)) -| | | catchFail -| | | -| | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : u9)))))))))))))))) -| | | | read ('f' ==) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | read ('u' ==) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | read ('n' ==) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | read ('c' ==) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | read ('t' ==) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | read ('i' ==) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | read ('o' ==) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | read ('n' ==) -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | push Term -| | | | | ret -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | popFail -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | catchFail -| | | | | -| | | | | | pushInput -| | | | | | read Term -| | | | | | pop -| | | | | | popFail -| | | | | | loadInput -| | | | | | fail -| | | | | -| | | | | loadInput -| | | | | push Term -| | | | | ret -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | popFail -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | push (\u1 -> (\u2 -> u2)) -| | | | | catchFail -| | | | | -| | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | read Term -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | : -| | | | | | | catchFail -| | | | | | | -| | | | | | | | push (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | read Term -| | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | popFail -| | | | | | | | ret -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift Term -| | | | | | | choices [(\u1 -> u1)] -| | | | | | | -| | | | | | | | push (\u1 -> u1) -| | | | | | | | ret -| | | | | | | -| | | | | | | fail -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | popFail -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | ret -| | | | | -| | | | | loadInput -| | | | | fail -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | push (\u1 -> (\u2 -> '(')) -| | | | | read ('(' ==) -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | ret -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | catchFail -| | | | | -| | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | : -| | | | | | | push (\u1 -> (\u2 -> u2)) -| | | | | | | call -| | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | : -| | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | ret -| | | | | | | catchFail -| | | | | | | -| | | | | | | | push (\u1 -> Term) -| | | | | | | | : -| | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) -| | | | | | | | | read ('[' ==) -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | : -| | | | | | | | | | read Term -| | | | | | | | | | ret -| | | | | | | | | call -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | : -| | | | | | | | | | catchFail -| | | | | | | | | | -| | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | call -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | popFail -| | | | | | | | | | | ret -| | | | | | | | | | -| | | | | | | | | | pushInput -| | | | | | | | | | lift Term -| | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | -| | | | | | | | | | | push (\u1 -> u1) -| | | | | | | | | | | ret -| | | | | | | | | | -| | | | | | | | | | fail -| | | | | | | | | call -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | read (']' ==) -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | ret -| | | | | | | | call -| | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | popFail -| | | | | | | | refJoin -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift Term -| | | | | | | choices [(\u1 -> u1)] -| | | | | | | -| | | | | | | | call -| | | | | | | | refJoin -| | | | | | | -| | | | | | | fail -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | : -| | | | | | | catchFail -| | | | | | | -| | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | : -| | | | | | | | | push (\u1 -> (\u2 -> u2)) -| | | | | | | | | ret -| | | | | | | | call -| | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | : -| | | | | | | | | push (\u1 -> (\u2 -> ',')) -| | | | | | | | | read (',' ==) -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | ret -| | | | | | | | call -| | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | popFail -| | | | | | | | ret -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift Term -| | | | | | | choices [(\u1 -> u1)] -| | | | | | | -| | | | | | | | push (\u1 -> u1) -| | | | | | | | ret -| | | | | | | -| | | | | | | fail -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | popFail -| | | | | | ret -| | | | | -| | | | | pushInput -| | | | | lift Term -| | | | | choices [(\u1 -> u1)] -| | | | | -| | | | | | jump -| | | | | -| | | | | fail -| | | | call -| | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | : -| | | | | | push (\u1 -> (\u2 -> ')')) -| | | | | | read (')' ==) -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | ret -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | : -| | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5))))))) -| | | | | | read ('{' ==) -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | : -| | | | | | | catchFail -| | | | | | | -| | | | | | | | push (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | : -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | popFail -| | | | | | | | | ret -| | | | | | | | catchFail -| | | | | | | | -| | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | | | | | | catchFail -| | | | | | | | | -| | | | | | | | | | push (\u1 -> (\u2 -> u2)) -| | | | | | | | | | catchFail -| | | | | | | | | | -| | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) -| | | | | | | | | | | read ('i' ==) -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | read ('f' ==) -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | popFail -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | popFail -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | : -| | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | : -| | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | -| | | | | | | | | | | | | | push (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | push (\u1 -> '0') -| | | | | | | | | | | | | | | read ('0' ==) -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | push (\u1 -> '1') -| | | | | | | | | | | | | | | read ('1' ==) -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | fail -| | | | | | | | | | | | | -| | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | -| | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) -| | | | | | | | | | | | | | | read ('\'' ==) -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | read ('\'' ==) -| | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | push (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | read Term -| | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> u3))) -| | | | | | | | | | | | | | | | read ('\\' ==) -| | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | read Term -| | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | fail -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | push (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | push (\u1 -> Term) -| | | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> u2))) -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | | | push (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | | fail -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | fail -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | fail -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | fail -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | fail -| | | | | | | | | | | | | -| | | | | | | | | | | | | fail -| | | | | | | | | | | | call -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | : -| | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | -| | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) -| | | | | | | | | | | | | | read ('!' ==) -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | ret -| | | | | | | | | | | | | -| | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | -| | | | | | | | | | | | | | push (\u1 -> u1) -| | | | | | | | | | | | | | ret -| | | | | | | | | | | | | -| | | | | | | | | | | | | fail -| | | | | | | | | | | | call -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | ret -| | | | | | | | | | | call -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | : -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popFail -| | | | | | | | | | | | refJoin -| | | | | | | | | | | catchFail -| | | | | | | | | | | -| | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | | | | | catchFail -| | | | | | | | | | | | -| | | | | | | | | | | | | push (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | -| | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) -| | | | | | | | | | | | | | read ('e' ==) -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | read ('l' ==) -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | read ('s' ==) -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | read ('e' ==) -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | -| | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | fail -| | | | | | | | | | | | -| | | | | | | | | | | | loadInput -| | | | | | | | | | | | fail -| | | | | | | | | | | -| | | | | | | | | | | pushInput -| | | | | | | | | | | lift Term -| | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | -| | | | | | | | | | | | call -| | | | | | | | | | | | refJoin -| | | | | | | | | | | -| | | | | | | | | | | fail -| | | | | | | | | | -| | | | | | | | | | loadInput -| | | | | | | | | | fail -| | | | | | | | | -| | | | | | | | | loadInput -| | | | | | | | | fail -| | | | | | | | -| | | | | | | | pushInput -| | | | | | | | lift Term -| | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | -| | | | | | | | | catchFail -| | | | | | | | | -| | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | catchFail -| | | | | | | | | | -| | | | | | | | | | | push (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | catchFail -| | | | | | | | | | | -| | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) -| | | | | | | | | | | | read ('w' ==) -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | read ('h' ==) -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | read ('i' ==) -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | read ('l' ==) -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | read ('e' ==) -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popFail -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popFail -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popFail -| | | | | | | | | | | | refJoin -| | | | | | | | | | | -| | | | | | | | | | | loadInput -| | | | | | | | | | | fail -| | | | | | | | | | -| | | | | | | | | | loadInput -| | | | | | | | | | fail -| | | | | | | | | -| | | | | | | | | pushInput -| | | | | | | | | lift Term -| | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | -| | | | | | | | | | catchFail -| | | | | | | | | | -| | | | | | | | | | | catchFail -| | | | | | | | | | | -| | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11)))))))))))) -| | | | | | | | | | | | : -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | : -| | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | push (\u1 -> u1) -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | fail -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | read ('=' ==) -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | : -| | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift Term -| | | | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | push (\u1 -> u1) -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | fail -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | : -| | | | | | | | | | | | | | push (\u1 -> (\u2 -> ';')) -| | | | | | | | | | | | | | read (';' ==) -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | ret -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | popFail -| | | | | | | | | | | | | popFail -| | | | | | | | | | | | | refJoin -| | | | | | | | | | | | catchFail -| | | | | | | | | | | | -| | | | | | | | | | | | | push (\u1 -> (\u2 -> Term)) -| | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | -| | | | | | | | | | | | | | push (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | catchFail -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) -| | | | | | | | | | | | | | | read ('v' ==) -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | read ('a' ==) -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | read ('r' ==) -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popFail -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | | fail -| | | | | | | | | | | | | -| | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | fail -| | | | | | | | | | | | -| | | | | | | | | | | | pushInput -| | | | | | | | | | | | lift Term -| | | | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | | | -| | | | | | | | | | | | | call -| | | | | | | | | | | | | refJoin -| | | | | | | | | | | | -| | | | | | | | | | | | fail -| | | | | | | | | | | -| | | | | | | | | | | loadInput -| | | | | | | | | | | fail -| | | | | | | | | | -| | | | | | | | | | pushInput -| | | | | | | | | | lift Term -| | | | | | | | | | choices [(\u1 -> u1)] -| | | | | | | | | | -| | | | | | | | | | | push (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | call -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | refJoin -| | | | | | | | | | -| | | | | | | | | | fail -| | | | | | | | | -| | | | | | | | | fail -| | | | | | | | -| | | | | | | | fail -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift Term -| | | | | | | choices [(\u1 -> u1)] -| | | | | | | -| | | | | | | | push (\u1 -> u1) -| | | | | | | | ret -| | | | | | | -| | | | | | | fail -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | read ('}' ==) -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | | ret -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | popFail -| | | | | ret -| | | | catchFail -| | | | -| | | | | push (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | read (':' ==) -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift (\u1 -> (\u2 -> u1 u2)) -| | | | | popFail -| | | | | refJoin -| | | | -| | | | pushInput -| | | | lift Term -| | | | choices [(\u1 -> u1)] -| | | | -| | | | | call -| | | | | refJoin -| | | | -| | | | fail -| | | -| | | loadInput -| | | fail -| | -| | loadInput -| | fail -| -| pushInput -| lift Term -| choices [(\u1 -> u1)] -| -| | push (\u1 -> u1) -| | ret -| -| fail -call -lift (\u1 -> (\u2 -> u1 u2)) -call -lift (\u1 -> (\u2 -> u1 u2)) -: -| lift (\u1 -> (\u2 -> u1 u2)) -| ret -catchFail - - | catchFail - | - | | pushInput - | | read (\u1 -> Term) - | | pop - | | popFail - | | loadInput - | | fail - | - | loadInput - | push Term - | popFail - | refJoin - - pushInput - lift Term - choices [(\u1 -> u1)] - - | fail - - fail diff --git a/test/Golden/Machine/some-string.dump b/test/Golden/Machine/some-string.dump deleted file mode 100644 index a945f4c..0000000 --- a/test/Golden/Machine/some-string.dump +++ /dev/null @@ -1,42 +0,0 @@ -push (\u1 -> (\u2 -> u1 : u2 Term)) -: -| catchFail -| -| | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | read ('a' ==) -| | lift (\u1 -> (\u2 -> u1 u2)) -| | read ('b' ==) -| | lift (\u1 -> (\u2 -> u1 u2)) -| | read ('c' ==) -| | lift (\u1 -> (\u2 -> u1 u2)) -| | read ('d' ==) -| | lift (\u1 -> (\u2 -> u1 u2)) -| | popFail -| | ret -| -| loadInput -| fail -call -lift (\u1 -> (\u2 -> u1 u2)) -: -| catchFail -| -| | push (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | call -| | lift (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift (\u1 -> (\u2 -> u1 u2)) -| | popFail -| | ret -| -| pushInput -| lift Term -| choices [(\u1 -> u1)] -| -| | push (\u1 -> u1) -| | ret -| -| fail -call -lift (\u1 -> (\u2 -> u1 u2)) -ret diff --git a/test/Golden/Machine/string.dump b/test/Golden/Machine/string.dump deleted file mode 100644 index 90f534c..0000000 --- a/test/Golden/Machine/string.dump +++ /dev/null @@ -1,16 +0,0 @@ -catchFail - - | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) - | read ('a' ==) - | lift (\u1 -> (\u2 -> u1 u2)) - | read ('b' ==) - | lift (\u1 -> (\u2 -> u1 u2)) - | read ('c' ==) - | lift (\u1 -> (\u2 -> u1 u2)) - | read ('d' ==) - | lift (\u1 -> (\u2 -> u1 u2)) - | popFail - | ret - - loadInput - fail diff --git a/test/Golden/Machine/unit-unit.dump b/test/Golden/Machine/unit-unit.dump deleted file mode 100644 index 7a359b7..0000000 --- a/test/Golden/Machine/unit-unit.dump +++ /dev/null @@ -1,9 +0,0 @@ -push (\u1 -> (\u2 -> u2)) -: -| push Term -| ret -call -lift (\u1 -> (\u2 -> u1 u2)) -call -lift (\u1 -> (\u2 -> u1 u2)) -ret diff --git a/test/Golden/Machine/unit.dump b/test/Golden/Machine/unit.dump deleted file mode 100644 index 5bbd8be..0000000 --- a/test/Golden/Machine/unit.dump +++ /dev/null @@ -1,2 +0,0 @@ -push Term -ret diff --git a/test/Golden/Parser.hs b/test/Golden/Parser.hs new file mode 100644 index 0000000..d2f8681 --- /dev/null +++ b/test/Golden/Parser.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DataKinds #-} -- For using P.viewGrammar +{-# LANGUAGE FlexibleContexts #-} -- For using P.Grammar Char +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeApplications #-} +module Golden.Parser where + +import Control.Monad (Monad(..)) +import Data.Either (Either(..)) +import Data.Function (($)) +import Data.Functor ((<$>)) +import Data.Int (Int) +import Data.Semigroup (Semigroup(..)) +import Data.String (IsString(..)) +import Data.Text.IO (readFile) +import Test.Tasty +import Test.Tasty.Golden +import Text.Show (Show(..)) +import System.IO.Unsafe (unsafePerformIO) +import System.FilePath ((<.>), (), dropExtensions) +import qualified Data.List as List +import qualified System.IO.Error as IO +import qualified System.Directory as IO +import qualified Control.Exception as IO + +import Golden.Utils +import Parser + +goldens :: TestTree +goldens = testGroup "Parser" $ + (\f -> List.zipWith f parsers [1::Int ..]) $ \(P p) g -> + let parserDir = "test/Golden/Parser/G"<>show g in + let inputs = + ((parserDir ) <$>) $ + List.sort $ + List.filter (List.isSuffixOf ".input.txt") $ + unsafePerformIO $ + IO.catchIOError + (IO.listDirectory parserDir) + (\exn -> + if IO.isDoesNotExistError exn + then return [] + else IO.throwIO exn + ) in + testGroup ("G"<>show g) $ (<$> inputs) $ \inp -> + goldenVsStringDiff inp goldenDiff + (dropExtensions inp<.>"expected.txt") $ do + input <- readFile inp + return $ fromString $ + case p input of + Left err -> show err + Right a -> show a diff --git a/test/Golden/Parser/char.dump b/test/Golden/Parser/G1/P1.expected.txt similarity index 100% rename from test/Golden/Parser/char.dump rename to test/Golden/Parser/G1/P1.expected.txt diff --git a/test/Golden/Parser/char.txt b/test/Golden/Parser/G1/P1.input.txt similarity index 100% rename from test/Golden/Parser/char.txt rename to test/Golden/Parser/G1/P1.input.txt diff --git a/test/Golden/Parser/alt-char-fail.dump b/test/Golden/Parser/G10/P1.expected.txt similarity index 100% rename from test/Golden/Parser/alt-char-fail.dump rename to test/Golden/Parser/G10/P1.expected.txt diff --git a/test/Golden/Parser/alt-char-fail.txt b/test/Golden/Parser/G10/P1.input.txt similarity index 100% rename from test/Golden/Parser/alt-char-fail.txt rename to test/Golden/Parser/G10/P1.input.txt diff --git a/test/Golden/Parser/many-char-fail.dump b/test/Golden/Parser/G11/P1.expected.txt similarity index 100% rename from test/Golden/Parser/many-char-fail.dump rename to test/Golden/Parser/G11/P1.expected.txt diff --git a/test/Golden/Parser/many-char-fail.txt b/test/Golden/Parser/G11/P1.input.txt similarity index 100% rename from test/Golden/Parser/many-char-fail.txt rename to test/Golden/Parser/G11/P1.input.txt diff --git a/test/Golden/Parser/many-oneOf.dump b/test/Golden/Parser/G12/P1.expected.txt similarity index 100% rename from test/Golden/Parser/many-oneOf.dump rename to test/Golden/Parser/G12/P1.expected.txt diff --git a/test/Golden/Parser/many-oneOf.txt b/test/Golden/Parser/G12/P1.input.txt similarity index 100% rename from test/Golden/Parser/many-oneOf.txt rename to test/Golden/Parser/G12/P1.input.txt diff --git a/test/Golden/Parser/string.dump b/test/Golden/Parser/G2/P1.expected.txt similarity index 100% rename from test/Golden/Parser/string.dump rename to test/Golden/Parser/G2/P1.expected.txt diff --git a/test/Golden/Parser/some-string-fail.txt b/test/Golden/Parser/G2/P1.input.txt similarity index 100% rename from test/Golden/Parser/some-string-fail.txt rename to test/Golden/Parser/G2/P1.input.txt diff --git a/test/Golden/Parser/string-fail-horizon.dump b/test/Golden/Parser/G2/P2.expected.txt similarity index 100% rename from test/Golden/Parser/string-fail-horizon.dump rename to test/Golden/Parser/G2/P2.expected.txt diff --git a/test/Golden/Machine/string.txt b/test/Golden/Parser/G2/P2.input.txt similarity index 100% rename from test/Golden/Machine/string.txt rename to test/Golden/Parser/G2/P2.input.txt diff --git a/test/Golden/Parser/many-char.dump b/test/Golden/Parser/G3/P1.expected.txt similarity index 100% rename from test/Golden/Parser/many-char.dump rename to test/Golden/Parser/G3/P1.expected.txt diff --git a/test/Golden/Parser/many-char.txt b/test/Golden/Parser/G3/P1.input.txt similarity index 100% rename from test/Golden/Parser/many-char.txt rename to test/Golden/Parser/G3/P1.input.txt diff --git a/test/Golden/Parser/some-string.dump b/test/Golden/Parser/G4/P1.expected.txt similarity index 100% rename from test/Golden/Parser/some-string.dump rename to test/Golden/Parser/G4/P1.expected.txt diff --git a/test/Golden/Parser/some-string.txt b/test/Golden/Parser/G4/P1.input.txt similarity index 100% rename from test/Golden/Parser/some-string.txt rename to test/Golden/Parser/G4/P1.input.txt diff --git a/test/Golden/Parser/some-string-fail.dump b/test/Golden/Parser/G5/P1.expected.txt similarity index 100% rename from test/Golden/Parser/some-string-fail.dump rename to test/Golden/Parser/G5/P1.expected.txt diff --git a/test/Golden/Parser/string.txt b/test/Golden/Parser/G5/P1.input.txt similarity index 100% rename from test/Golden/Parser/string.txt rename to test/Golden/Parser/G5/P1.input.txt diff --git a/test/Golden/Parser/some-string-eof-fail.dump b/test/Golden/Parser/G5/P2.expected.txt similarity index 100% rename from test/Golden/Parser/some-string-eof-fail.dump rename to test/Golden/Parser/G5/P2.expected.txt diff --git a/test/Golden/Parser/some-string-eof-fail.txt b/test/Golden/Parser/G5/P2.input.txt similarity index 100% rename from test/Golden/Parser/some-string-eof-fail.txt rename to test/Golden/Parser/G5/P2.input.txt diff --git a/test/Golden/Parser/alt-right-notry.dump b/test/Golden/Parser/G6/P1.expected.txt similarity index 100% rename from test/Golden/Parser/alt-right-notry.dump rename to test/Golden/Parser/G6/P1.expected.txt diff --git a/test/Golden/Parser/alt-right-notry.txt b/test/Golden/Parser/G6/P1.input.txt similarity index 100% rename from test/Golden/Parser/alt-right-notry.txt rename to test/Golden/Parser/G6/P1.input.txt diff --git a/test/Golden/Parser/alt-right-try.dump b/test/Golden/Parser/G7/P1.expected.txt similarity index 100% rename from test/Golden/Parser/alt-right-try.dump rename to test/Golden/Parser/G7/P1.expected.txt diff --git a/test/Golden/Parser/alt-right-try.txt b/test/Golden/Parser/G7/P1.input.txt similarity index 100% rename from test/Golden/Parser/alt-right-try.txt rename to test/Golden/Parser/G7/P1.input.txt diff --git a/test/Golden/Parser/alt-left.dump b/test/Golden/Parser/G7/P2.expected.txt similarity index 100% rename from test/Golden/Parser/alt-left.dump rename to test/Golden/Parser/G7/P2.expected.txt diff --git a/test/Golden/Parser/alt-left.txt b/test/Golden/Parser/G7/P2.input.txt similarity index 100% rename from test/Golden/Parser/alt-left.txt rename to test/Golden/Parser/G7/P2.input.txt diff --git a/test/Golden/Parser/many-char-eof.dump b/test/Golden/Parser/G8/P1.expected.txt similarity index 100% rename from test/Golden/Parser/many-char-eof.dump rename to test/Golden/Parser/G8/P1.expected.txt diff --git a/test/Golden/Parser/many-char-eof.txt b/test/Golden/Parser/G8/P1.input.txt similarity index 100% rename from test/Golden/Parser/many-char-eof.txt rename to test/Golden/Parser/G8/P1.input.txt diff --git a/test/Golden/Parser/eof.dump b/test/Golden/Parser/G9/P1.expected.txt similarity index 100% rename from test/Golden/Parser/eof.dump rename to test/Golden/Parser/G9/P1.expected.txt diff --git a/test/Golden/Parser/eof.txt b/test/Golden/Parser/G9/P1.input.txt similarity index 100% rename from test/Golden/Parser/eof.txt rename to test/Golden/Parser/G9/P1.input.txt diff --git a/test/Golden/Parser/eof-fail.dump b/test/Golden/Parser/G9/P2.expected.txt similarity index 100% rename from test/Golden/Parser/eof-fail.dump rename to test/Golden/Parser/G9/P2.expected.txt diff --git a/test/Golden/Parser/eof-fail.txt b/test/Golden/Parser/G9/P2.input.txt similarity index 100% rename from test/Golden/Parser/eof-fail.txt rename to test/Golden/Parser/G9/P2.input.txt diff --git a/test/Golden/Parser/alt-char-try-fail.txt b/test/Golden/Parser/alt-char-try-fail.txt deleted file mode 100644 index 3410062..0000000 --- a/test/Golden/Parser/alt-char-try-fail.txt +++ /dev/null @@ -1 +0,0 @@ -c \ No newline at end of file diff --git a/test/Golden/Parser/string-fail-horizon.txt b/test/Golden/Parser/string-fail-horizon.txt deleted file mode 100644 index 9ae9e86..0000000 --- a/test/Golden/Parser/string-fail-horizon.txt +++ /dev/null @@ -1 +0,0 @@ -ab \ No newline at end of file diff --git a/test/Golden/Splice.hs b/test/Golden/Splice.hs new file mode 100644 index 0000000..5b081c0 --- /dev/null +++ b/test/Golden/Splice.hs @@ -0,0 +1,35 @@ +module Golden.Splice where + +import Control.Monad (Monad(..)) +import Data.Int (Int) +import Data.Function (($)) +import Data.Functor ((<$>)) +import Data.Semigroup (Semigroup(..)) +import Text.Show (Show(..)) +import System.FilePath ((), (<.>)) +import System.IO (writeFile) +import System.Directory (removeFile) +import qualified Data.List as List +import Test.Tasty + +import Build_symantic_parser +import Golden.Splice.Utils +import qualified Grammar + +goldens :: TestTree +goldens = testGroup "Splice" $ + (<$> [1::Int .. List.length Grammar.grammars]) $ \g -> + let spliceFile = "test/Golden/Splice/""G"<>show g<.>"hs" in + withResource + (do + writeFile (rootDirspliceFile) $ List.unlines + [ "module Splice where" + , "import Data.Text (Text)" + , "import qualified Symantic.Parser as P" + , "import qualified Grammar" + , "" + , "splice = $$(P.runParser @Text Grammar.g"<>show g<>")" + ] + return (rootDirspliceFile)) + removeFile + (\_io -> testSplice spliceFile) diff --git a/test/Golden/Splice/G1.expected.txt b/test/Golden/Splice/G1.expected.txt new file mode 100644 index 0000000..463f9b3 --- /dev/null +++ b/test/Golden/Splice/G1.expected.txt @@ -0,0 +1,55 @@ +test/Golden/Splice/G1.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g1 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let readFail = finalRaise + in + if readMore init then + let !(# c, cs #) = readNext init + in + if ('a' ==) c then + let _ = "resume" + in + (((finalRet init) []) + (let _ = "resume.genCode" in ((\ x -> \ x -> x x) (\ x -> 'a')) c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((finalRaise init) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemHorizon 1] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) + GT -> (# init, [] #) + in ((finalRaise init) farInp) farExp diff --git a/test/Golden/Splice/G10.expected.txt b/test/Golden/Splice/G10.expected.txt new file mode 100644 index 0000000..df17a7a --- /dev/null +++ b/test/Golden/Splice/G10.expected.txt @@ -0,0 +1,104 @@ +test/Golden/Splice/G10.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g10 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + init) + failInp) then + let readFail = finalRaise + in + if readMore failInp then + let !(# c, cs #) = readNext failInp + in + if ('b' ==) c then + let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in ((\ x -> \ x -> x x) (\ x -> 'b')) c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) failInp + of + LT -> (# failInp, [P.ErrorItemToken 'b'] #) + EQ -> (# farInp, (farExp <> [P.ErrorItemToken 'b']) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) failInp of + LT -> (# failInp, [P.ErrorItemHorizon 1] #) + EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 1]) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + else + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) failInp of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + in + if readMore init then + let !(# c, cs #) = readNext init + in + if ('a' ==) c then + let _ = "resume" + in + (((finalRet init) []) + (let _ = "resume.genCode" in ((\ x -> \ x -> x x) (\ x -> 'a')) c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemHorizon 1] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp diff --git a/test/Golden/Splice/G11.expected.txt b/test/Golden/Splice/G11.expected.txt new file mode 100644 index 0000000..afbb732 --- /dev/null +++ b/test/Golden/Splice/G11.expected.txt @@ -0,0 +1,146 @@ +test/Golden/Splice/G11.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g11 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let + name + = \ !ok !inp !koByLabel + -> let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) (let _ = "resume.genCode" in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if ('a' ==) c then + let + _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x -> \ x -> \ x -> ('a' : x x))) + c)) + v)) + inp)) + cs) + Data.Map.Internal.Tip + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp in + let + _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let readFail = finalRaise + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if ('b' ==) c then + let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) (\ x -> \ x -> x [])) v)) + c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [P.ErrorItemToken 'b'] #) + EQ -> (# farInp, (farExp <> [P.ErrorItemToken 'b']) #) + GT -> (# farInp, farExp #) + in ((finalRaise inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 1]) #) + GT -> (# farInp, farExp #) + in ((finalRaise inp) farInp) farExp)) + init) + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G12.expected.txt b/test/Golden/Splice/G12.expected.txt new file mode 100644 index 0000000..e6503a2 --- /dev/null +++ b/test/Golden/Splice/G12.expected.txt @@ -0,0 +1,200 @@ +test/Golden/Splice/G12.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g12 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let + name + = \ !ok !inp !koByLabel + -> let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) (let _ = "resume.genCode" in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if (\ t + -> (('a' == t) + || (('b' == t) || (('c' == t) || (('d' == t) || False))))) + c then + let + _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x -> \ x -> \ x -> (x : x x))) + c)) + v)) + inp)) + cs) + Data.Map.Internal.Tip + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemLabel "oneOf"] #) + EQ -> (# init, ([] <> [P.ErrorItemLabel "oneOf"]) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp in + let + _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let + join + = \ farInp farExp v !inp + -> let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) (\ x -> \ x -> x [])) v)) + v)) + inp in + let _ = ("catchException lbl=" <> "fail") in + let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> let _ = "resume" + in (((join farInp) farExp) (let _ = "resume.genCode" in ())) inp + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if (\ x -> True) c then + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + failInp + of + LT -> (# failInp, [P.ErrorItemEnd] #) + EQ + -> (# farInp, + (farExp <> [P.ErrorItemEnd]) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + else + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp) + inp) + farInp) + farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 1]) #) + GT -> (# farInp, farExp #) + in ((readFail inp) farInp) farExp)) + init) + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G13.expected.txt b/test/Golden/Splice/G13.expected.txt new file mode 100644 index 0000000..5a190f0 --- /dev/null +++ b/test/Golden/Splice/G13.expected.txt @@ -0,0 +1,14 @@ + +test/Golden/Splice/G13.hs:0:0: error: + • Exception when trying to run compile-time code: + Map.!: given key is not an element in the map +CallStack (from HasCallStack): + error, called at libraries/containers/containers/src/Data/Map/Internal.hs:0:0 in containers-0.6.4.1:Data.Map.Internal + Code: (P.runParser @Text Grammar.g13) + • In the Template Haskell splice $$(P.runParser @Text Grammar.g13) + In the expression: $$(P.runParser @Text Grammar.g13) + In an equation for ‘splice’: + splice = $$(P.runParser @Text Grammar.g13) + | +6 | splice = $$(P.runParser @Text Grammar.g13) + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/test/Golden/Splice/G14.expected.txt b/test/Golden/Splice/G14.expected.txt new file mode 100644 index 0000000..7570682 --- /dev/null +++ b/test/Golden/Splice/G14.expected.txt @@ -0,0 +1,14 @@ + +test/Golden/Splice/G14.hs:0:0: error: + • Exception when trying to run compile-time code: + Map.!: given key is not an element in the map +CallStack (from HasCallStack): + error, called at libraries/containers/containers/src/Data/Map/Internal.hs:0:0 in containers-0.6.4.1:Data.Map.Internal + Code: (P.runParser @Text Grammar.g14) + • In the Template Haskell splice $$(P.runParser @Text Grammar.g14) + In the expression: $$(P.runParser @Text Grammar.g14) + In an equation for ‘splice’: + splice = $$(P.runParser @Text Grammar.g14) + | +6 | splice = $$(P.runParser @Text Grammar.g14) + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/test/Golden/Splice/G2.expected.txt b/test/Golden/Splice/G2.expected.txt new file mode 100644 index 0000000..d1b2977 --- /dev/null +++ b/test/Golden/Splice/G2.expected.txt @@ -0,0 +1,100 @@ +test/Golden/Splice/G2.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g2 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) init of + LT -> (# init, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((finalRaise init) farInp) farExp + in + if readMore ((P.shiftRightText 2) init) then + let !(# c, cs #) = readNext init + in + if ('a' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('b' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('c' ==) c then + let _ = "resume" + in + (((finalRet init) []) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x + -> \ x -> \ x -> ('a' : ('b' : ('c' : []))))) + c)) + c)) + c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) cs of + LT -> (# cs, [P.ErrorItemToken 'c'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'c']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) cs of + LT -> (# cs, [P.ErrorItemToken 'b'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'b']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemHorizon 3] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 3]) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp diff --git a/test/Golden/Splice/G3.expected.txt b/test/Golden/Splice/G3.expected.txt new file mode 100644 index 0000000..f938683 --- /dev/null +++ b/test/Golden/Splice/G3.expected.txt @@ -0,0 +1,119 @@ +test/Golden/Splice/G3.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g3 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let + name + = \ !ok !inp !koByLabel + -> let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) (let _ = "resume.genCode" in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if ('a' ==) c then + let + _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x -> \ x -> \ x -> ('a' : x x))) + c)) + v)) + inp)) + cs) + Data.Map.Internal.Tip + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp in + let + _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in ((\ x -> \ x -> x x) (\ x -> x [])) v)) + inp)) + init) + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G4.expected.txt b/test/Golden/Splice/G4.expected.txt new file mode 100644 index 0000000..89fdf74 --- /dev/null +++ b/test/Golden/Splice/G4.expected.txt @@ -0,0 +1,241 @@ +test/Golden/Splice/G4.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g4 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let + name + = \ !ok !inp !koByLabel + -> let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault finalRaise) "fail") + koByLabel) + inp) + farInp) + farExp + in + if readMore ((P.shiftRightText 3) inp) then + let !(# c, cs #) = readNext inp + in + if ('a' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('b' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('c' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('d' ==) c then + let _ = "resume" + in + (((ok init) []) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x + -> \ x + -> \ x + -> \ x + -> ('a' + : ('b' + : ('c' + : ('d' + : [])))))) + c)) + c)) + c)) + c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + init) + cs + of + LT -> (# cs, [P.ErrorItemToken 'd'] #) + EQ + -> (# init, + ([] <> [P.ErrorItemToken 'd']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) init) + cs + of + LT -> (# cs, [P.ErrorItemToken 'c'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'c']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) cs of + LT -> (# cs, [P.ErrorItemToken 'b'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'b']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemHorizon 4] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 4]) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp in + let + _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let + name + = \ !ok !inp !koByLabel + -> let _ = ("catchException lbl=" <> "fail") in + let + _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]" + in + \ farInp farExp v !inp + -> let + _ = "call exceptionsByName(name_2)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x + -> \ x + -> \ x + -> (x : x x))) + v)) + v)) + inp)) + inp) + Data.Map.Internal.Tip)) + inp) + (((((Data.Map.Internal.Bin 1) "fail") + (\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault + finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp)) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) in + let + _ = "call exceptionsByName(name_2)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) (\ x -> \ x -> (x : x []))) + v)) + v)) + inp)) + inp) + Data.Map.Internal.Tip)) + init) + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G5.expected.txt b/test/Golden/Splice/G5.expected.txt new file mode 100644 index 0000000..137bfbe --- /dev/null +++ b/test/Golden/Splice/G5.expected.txt @@ -0,0 +1,350 @@ +test/Golden/Splice/G5.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g5 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let + name + = \ !ok !inp !koByLabel + -> let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault finalRaise) "fail") + koByLabel) + inp) + farInp) + farExp + in + if readMore ((P.shiftRightText 3) inp) then + let !(# c, cs #) = readNext inp + in + if ('a' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('b' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('c' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('d' ==) c then + let _ = "resume" + in + (((ok init) []) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x + -> \ x + -> \ x + -> \ x + -> ('a' + : ('b' + : ('c' + : ('d' + : [])))))) + c)) + c)) + c)) + c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + init) + cs + of + LT -> (# cs, [P.ErrorItemToken 'd'] #) + EQ + -> (# init, + ([] <> [P.ErrorItemToken 'd']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) init) + cs + of + LT -> (# cs, [P.ErrorItemToken 'c'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'c']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) cs of + LT -> (# cs, [P.ErrorItemToken 'b'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'b']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemHorizon 4] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 4]) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp in + let + _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let + name + = \ !ok !inp !koByLabel + -> let _ = ("catchException lbl=" <> "fail") in + let + _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]" + in + \ farInp farExp v !inp + -> let + _ = "call exceptionsByName(name_2)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x + -> \ x + -> \ x + -> (x : x x))) + v)) + v)) + inp)) + inp) + Data.Map.Internal.Tip)) + inp) + (((((Data.Map.Internal.Bin 1) "fail") + (\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault + finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp)) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) in + let + _ = "call exceptionsByName(name_2)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let + join + = \ farInp farExp v !inp + -> let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x + -> \ x -> \ x -> (x : x []))) + v)) + v)) + v)) + inp in + let _ = ("catchException lbl=" <> "fail") in + let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> let _ = "resume" + in + (((join farInp) farExp) + (let _ = "resume.genCode" in ())) + inp + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if (\ x -> True) c then + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + inp + of + LT -> (# inp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + failInp + of + LT + -> (# failInp, + [P.ErrorItemEnd] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemEnd]) #) + GT -> (# farInp, farExp #) + in + ((finalRaise failInp) farInp) + farExp + else + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ + -> (# farInp, + (farExp <> []) #) + GT -> (# farInp, farExp #) + in + ((finalRaise failInp) farInp) + farExp) + inp) + farInp) + farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + inp + of + LT -> (# inp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) + inp + of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ + -> (# farInp, + (farExp <> [P.ErrorItemHorizon 1]) #) + GT -> (# farInp, farExp #) + in ((readFail inp) farInp) farExp)) + inp) + Data.Map.Internal.Tip)) + init) + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G6.expected.txt b/test/Golden/Splice/G6.expected.txt new file mode 100644 index 0000000..f82aa02 --- /dev/null +++ b/test/Golden/Splice/G6.expected.txt @@ -0,0 +1,144 @@ +test/Golden/Splice/G6.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g6 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + init) + failInp) then + let readFail = finalRaise + in + if readMore ((P.shiftRightText 1) failInp) then + let !(# c, cs #) = readNext failInp + in + if ('a' ==) c then + let readFail = finalRaise in + let !(# c, cs #) = readNext cs + in + if ('b' ==) c then + let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x -> \ x -> ('a' : ('b' : [])))) + c)) + c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) + cs + of + LT -> (# cs, [P.ErrorItemToken 'b'] #) + EQ + -> (# farInp, + (farExp <> [P.ErrorItemToken 'b']) #) + GT -> (# farInp, farExp #) + in ((finalRaise cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) failInp + of + LT -> (# failInp, [P.ErrorItemToken 'a'] #) + EQ -> (# farInp, (farExp <> [P.ErrorItemToken 'a']) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) failInp of + LT -> (# failInp, [P.ErrorItemHorizon 2] #) + EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 2]) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + else + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) failInp of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + in + if readMore ((P.shiftRightText 1) init) then + let !(# c, cs #) = readNext init + in + if ('a' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('a' ==) c then + let _ = "resume" + in + (((finalRet init) []) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) (\ x -> \ x -> ('a' : ('a' : [])))) c)) + c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) cs of + LT -> (# cs, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemHorizon 2] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 2]) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp diff --git a/test/Golden/Splice/G7.expected.txt b/test/Golden/Splice/G7.expected.txt new file mode 100644 index 0000000..b52908c --- /dev/null +++ b/test/Golden/Splice/G7.expected.txt @@ -0,0 +1,184 @@ +test/Golden/Splice/G7.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g7 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let _ = ("catchException lbl=" <> "fail") in + let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) init of + LT -> (# init, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + init) + failInp) then + let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + in + if readMore ((P.shiftRightText 1) failInp) then + let !(# c, cs #) = readNext failInp + in + if ('a' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('b' ==) c then + let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x + -> \ x -> ('a' : ('b' : [])))) + c)) + c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + cs + of + LT -> (# cs, [P.ErrorItemToken 'b'] #) + EQ + -> (# farInp, + (farExp + <> [P.ErrorItemToken 'b']) #) + GT -> (# farInp, farExp #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + failInp + of + LT -> (# failInp, [P.ErrorItemToken 'a'] #) + EQ + -> (# farInp, + (farExp <> [P.ErrorItemToken 'a']) #) + GT -> (# farInp, farExp #) + in ((readFail failInp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) + failInp + of + LT -> (# failInp, [P.ErrorItemHorizon 2] #) + EQ + -> (# farInp, + (farExp <> [P.ErrorItemHorizon 2]) #) + GT -> (# farInp, farExp #) + in ((readFail failInp) farInp) farExp + else + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp) + init) + farInp) + farExp + in + if readMore ((P.shiftRightText 1) init) then + let !(# c, cs #) = readNext init + in + if ('a' ==) c then + let readFail = readFail in + let !(# c, cs #) = readNext cs + in + if ('a' ==) c then + let _ = "resume" + in + (((finalRet init) []) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) (\ x -> \ x -> ('a' : ('a' : [])))) c)) + c)) + cs + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) cs of + LT -> (# cs, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail cs) farInp) farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemToken 'a'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemHorizon 2] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 2]) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp diff --git a/test/Golden/Splice/G8.expected.txt b/test/Golden/Splice/G8.expected.txt new file mode 100644 index 0000000..e329484 --- /dev/null +++ b/test/Golden/Splice/G8.expected.txt @@ -0,0 +1,197 @@ +test/Golden/Splice/G8.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g8 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let + name + = \ !ok !inp !koByLabel + -> let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) (let _ = "resume.genCode" in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if ('r' ==) c then + let + _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x -> \ x -> \ x -> ('r' : x x))) + c)) + v)) + inp)) + cs) + Data.Map.Internal.Tip + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemToken 'r'] #) + EQ -> (# init, ([] <> [P.ErrorItemToken 'r']) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp in + let + _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let + join + = \ farInp farExp v !inp + -> let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) (\ x -> \ x -> x [])) v)) + v)) + inp in + let _ = ("catchException lbl=" <> "fail") in + let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> let _ = "resume" + in (((join farInp) farExp) (let _ = "resume.genCode" in ())) inp + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if (\ x -> True) c then + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + failInp + of + LT -> (# failInp, [P.ErrorItemEnd] #) + EQ + -> (# farInp, + (farExp <> [P.ErrorItemEnd]) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + else + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp) + inp) + farInp) + farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) farInp) inp of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 1]) #) + GT -> (# farInp, farExp #) + in ((readFail inp) farInp) farExp)) + init) + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G9.expected.txt b/test/Golden/Splice/G9.expected.txt new file mode 100644 index 0000000..564b1a2 --- /dev/null +++ b/test/Golden/Splice/G9.expected.txt @@ -0,0 +1,93 @@ +test/Golden/Splice/G9.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g9 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let _ = ("catchException lbl=" <> "fail") in + let _ = ("catchException lbl=" <> "fail") in + let + readFail + = \ !failInp !farInp !farExp + -> let _ = "resume" + in + (((finalRet farInp) farExp) (let _ = "resume.genCode" in ())) init + in + if readMore init then + let !(# c, cs #) = readNext init + in + if (\ x -> True) c then + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [] #) + EQ -> (# init, ([] <> []) #) + GT -> (# init, [] #) + in + (((\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + init) + failInp) then + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) failInp + of + LT -> (# failInp, [P.ErrorItemEnd] #) + EQ -> (# farInp, (farExp <> [P.ErrorItemEnd]) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp + else + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) farInp) failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((finalRaise failInp) farInp) farExp) + init) + farInp) + farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [] #) + EQ -> (# init, ([] <> []) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) init of + LT -> (# init, [P.ErrorItemHorizon 1] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) + GT -> (# init, [] #) + in ((readFail init) farInp) farExp diff --git a/test/Golden/Splice/Utils.hs b/test/Golden/Splice/Utils.hs new file mode 100644 index 0000000..5afd150 --- /dev/null +++ b/test/Golden/Splice/Utils.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +module Golden.Splice.Utils where + +-- Build_symantic_parser is auto-generated by Setup.hs +import Build_symantic_parser (ghcPath, ghcFlags, rootDir) +import Control.Applicative (Applicative(..)) +import Data.Foldable (asum) +import Data.Function (($), (.), const) +import Data.Functor ((<$>), (<$)) +import Data.List (cycle, zipWith) +import Data.Maybe (Maybe(..)) +import Data.Semigroup (Semigroup(..)) +import Data.String (String, IsString(..)) +import Data.Text (Text) +import System.FilePath (FilePath, (), (<.>), (-<.>)) +import System.IO (IO, IOMode(..), openFile) +import System.Process (CreateProcess(..), StdStream(..), createProcess, proc, waitForProcess, callCommand) +import Test.Tasty (TestTree) +import Test.Tasty.Golden (goldenVsFileDiff) +import qualified Turtle +import Golden.Utils + +ghcOpts :: [String] +ghcOpts = ghcFlags <> + [ "-v0" + , "-c" + , "-ddump-splices" + , "-dsuppress-uniques" + , "-fforce-recomp" + , "-fprint-explicit-kinds" + , "-O0" + --, "-i" <>rootDir"test" + --, "-XConstraintKinds" + , "-XDataKinds" + --, "-XDefaultSignatures" + --, "-XEmptyCase" + , "-XFlexibleContexts" + , "-XFlexibleInstances" + , "-XGADTs" + --, "-XInstanceSigs" + --, "-XKindSignatures" + , "-XLambdaCase" + , "-XMultiParamTypeClasses" + --, "-XNoStarIsType" + --, "-XPolyKinds" + , "-XRankNTypes" + , "-XScopedTypeVariables" + --, "-XStandaloneDeriving" + --, "-XStandaloneKindSignatures" + , "-XTemplateHaskell" + , "-XTypeApplications" + , "-XTypeFamilies" + , "-XTypeOperators" + , "-XUnboxedTuples" + --, "-XUndecidableInstances" + ] + +testSplice :: FilePath -> TestTree +testSplice spliceFile = + goldenVsFileDiff spliceFile goldenDiff + (rootDirspliceFile-<.>"expected"<.>"txt") + actualFile $ do + h <- openFile actualFile WriteMode + (_, _, _, pid) <- createProcess + (proc ghcPath (spliceFile : ghcOpts)) + { std_out = UseHandle h + , std_err = UseHandle h + , cwd = Just rootDir } + _ <- waitForProcess pid + normalizeSplice actualFile + where + actualFile = rootDirspliceFile-<.>"actual"<.>"hs" + +normalizeSplice :: FilePath -> IO () +normalizeSplice = Turtle.inplace pat . fromString + where + pat :: Turtle.Pattern Text + pat = asum + [ "(0,0)-(0,0)" <$ numPair <* "-" <* numPair + , ":0:0:" <$ ":" <* d <* ":" <* d <* "-" <* d + , ":0:0" <$ ":" <* d <* ":" <* d + , fromString @Text . numPeriod <$> Turtle.lowerBounded 10 Turtle.digit + , fromString @Text . ('%' <$) <$> Turtle.lowerBounded 10 punctSym + -- Remove pretty-printed references to the symantic-parser package + -- (e.g., turn `symantic-parser-2.4.1:Sing` into `Sing`) + -- to make the output more stable. + , "" <$ "symantic-parser-" <* verNum <* ":" + ] + verNum = d `Turtle.sepBy` Turtle.char '.' + numPair = () <$ "(" <* d <* "," <* d <* ")" + punctSym = Turtle.oneOf "!#$%&*+./>" + numPeriod = zipWith const (cycle "0123456789876543210") + d = Turtle.some Turtle.digit + +cleanFiles :: IO () +cleanFiles = callCommand $ "rm -f " <> rootDir "test/Golden/Splice/*/*.{actual.hs,hi,o}" diff --git a/test/Golden/Utils.hs b/test/Golden/Utils.hs new file mode 100644 index 0000000..1538345 --- /dev/null +++ b/test/Golden/Utils.hs @@ -0,0 +1,30 @@ +module Golden.Utils where + +import Control.Monad (Monad(..)) +import Data.Either (Either(..)) +import Data.Function (($)) +import Data.String (String) +import System.IO (IO, FilePath) +import qualified Data.ByteString.Lazy as BSL +import qualified Data.IORef as IORef + +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL +import qualified Language.Haskell.TH.Syntax as TH + +goldenDiff :: FilePath -> FilePath -> [String] +goldenDiff ref new = ["diff", "-u", "-w", "-B", ref, new] + +-- | Resetting 'TH.counter' makes 'makeLetName' deterministic, +-- except when GHC or executable flags change, like profiling +-- or even --accept unfortunately, +-- in those case the 'goldensMachine' tests may fail +-- due to a different numbering of the 'def' and 'ref' combinators. +-- Hence 'ShowLetName' is used with 'False'. +resetTHNameCounter :: IO () +resetTHNameCounter = IORef.writeIORef TH.counter 0 + +unLeft :: Either String BSL.ByteString -> IO BSL.ByteString +unLeft lr = case lr of + Left err -> return $ TL.encodeUtf8 $ TL.pack err + Right a -> return a diff --git a/test/Grammar.hs b/test/Grammar.hs new file mode 100644 index 0000000..9de5668 --- /dev/null +++ b/test/Grammar.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies#-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +module Grammar where +import Data.Char (Char) +import qualified Grammar.Brainfuck +import qualified Grammar.Nandlang + +import Symantic.Parser + +data G = forall a. G ( + forall repr. + Grammar Char repr => + repr a + ) + +grammars :: [G] +grammars = + [ G (grammar @Char g1) + , G (grammar @Char g2) + , G (grammar @Char g3) + , G (grammar @Char g4) + , G (grammar @Char g5) + , G (grammar @Char g6) + , G (grammar @Char g7) + , G (grammar @Char g8) + , G (grammar @Char g9) + , G (grammar @Char g10) + , G (grammar @Char g11) + , G (grammar @Char g12) + , G (grammar @Char g13) + , G (grammar @Char g14) + ] + +g1 = char 'a' +g2 = string "abc" +g3 = many (char 'a') +g4 = some (string "abcd") +g5 = some (string "abcd") <* eof +g6 = traverse char "aa" <|> traverse char "ab" +g7 = string "aa" <|> string "ab" +g8 = many (char 'r') <* eof +g9 = eof +g10 = char 'a' <|> char 'b' +g11 = many (char 'a') <* char 'b' +g12 = many (oneOf ['a', 'b', 'c', 'd']) <* eof +g13 = Grammar.Brainfuck.grammar +g14 = Grammar.Nandlang.grammar diff --git a/test/Parser/Brainfuck.hs b/test/Grammar/Brainfuck.hs similarity index 87% rename from test/Parser/Brainfuck.hs rename to test/Grammar/Brainfuck.hs index cd3cc10..00cbaea 100644 --- a/test/Parser/Brainfuck.hs +++ b/test/Grammar/Brainfuck.hs @@ -5,7 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} -module Parser.Brainfuck where +module Grammar.Brainfuck where import Data.Char (Char) import Data.Eq (Eq(..)) @@ -17,29 +17,29 @@ import Symantic.Univariant.Trans import qualified Symantic.Parser as P import qualified Symantic.Parser.Haskell as H -data BrainFuckOp +data Operator = RightPointer | LeftPointer | Increment | Decrement | Output | Input - | Loop [BrainFuckOp] + | Loop [Operator] deriving (Show, Eq, TH.Lift) haskell :: TH.Lift a => a -> P.TermGrammar a haskell a = H.Term (H.ValueCode a [||a||]) -brainfuck :: forall repr. +grammar :: forall repr. P.Grammar Char repr => - repr [BrainFuckOp] -brainfuck = whitespace P.*> bf + repr [Operator] +grammar = whitespace P.*> bf where whitespace = P.skipMany (P.noneOf "<>+-[],.$") lexeme p = p P.<* whitespace - bf :: repr [BrainFuckOp] + bf :: repr [Operator] bf = P.many (lexeme (P.match (P.look P.anyChar) (haskell Prelude.<$> "><+-.,[") op P.empty)) - op :: H.Term H.ValueCode Char -> repr BrainFuckOp + op :: H.Term H.ValueCode Char -> repr Operator op (trans -> H.ValueCode c _) = case c of '>' -> P.anyChar P.$> H.Term (H.ValueCode RightPointer [||RightPointer||]) '<' -> P.anyChar P.$> H.Term (H.ValueCode LeftPointer [||LeftPointer||]) diff --git a/test/Parser/Nandlang.hs b/test/Grammar/Nandlang.hs similarity index 97% rename from test/Parser/Nandlang.hs rename to test/Grammar/Nandlang.hs index 5b4224f..e9fe194 100644 --- a/test/Parser/Nandlang.hs +++ b/test/Grammar/Nandlang.hs @@ -6,7 +6,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnboxedTuples #-} -module Parser.Nandlang where +module Grammar.Nandlang where import Data.Bool import Data.Char (isSpace, isAlpha, isAlphaNum) @@ -37,10 +37,10 @@ nandUnreservedName = \s -> not (Set.member s keys) nandStringLetter :: Char -> Bool nandStringLetter c = (c /= '"') && (c /= '\\') && (c > '\026') -nandlang :: forall repr. +grammar :: forall repr. P.Grammar Char repr => repr () -nandlang = whitespace P.*> P.skipMany funcdef P.<* P.eof +grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof where index :: repr () index = brackets nat diff --git a/test/Parser/Playground.hs b/test/Grammar/Playground.hs similarity index 92% rename from test/Parser/Playground.hs rename to test/Grammar/Playground.hs index 1c6981d..3a0f2aa 100644 --- a/test/Parser/Playground.hs +++ b/test/Grammar/Playground.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE TemplateHaskell #-} -module Parser.Playground where +module Grammar.Playground where import Symantic.Parser import qualified Symantic.Parser.Haskell as H diff --git a/test/Main.hs b/test/Main.hs index 7ef5869..2a3db37 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,17 +1,14 @@ module Main where import System.IO (IO) -import Data.Function (($)) - import Test.Tasty import Golden --import HUnit main :: IO () -main = do - goldens <- goldensIO - defaultMain $ - testGroup "" - [ goldens - --, hunits - ] +main = defaultMain ( + testGroup "" + [ Golden.goldens + --, hunits + ] + ) diff --git a/test/Parser.hs b/test/Parser.hs index 22e5138..3721fd0 100644 --- a/test/Parser.hs +++ b/test/Parser.hs @@ -1,8 +1,52 @@ -module Parser - ( module Parser.Brainfuck - , module Parser.Nandlang - , module Parser.Playground - ) where -import Parser.Brainfuck -import Parser.Nandlang -import Parser.Playground +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +-- For TH splices +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +module Parser where + +import Data.Either (Either(..)) +import Data.Text (Text) +import Text.Show (Show) +import Symantic.Parser +import Grammar + +data P = forall a. Show a => P ( + Text -> Either (ParsingError Text) a + ) + +parsers :: [P] +parsers = + [ P p1 + , P p2 + , P p3 + , P p4 + , P p5 + , P p6 + , P p7 + , P p8 + , P p9 + , P p10 + , P p11 + , P p12 + ] + +p1 = $$(runParser @Text g1) +p2 = $$(runParser @Text g2) +p3 = $$(runParser @Text g3) +p4 = $$(runParser @Text g4) +p5 = $$(runParser @Text g5) +p6 = $$(runParser @Text g6) +p7 = $$(runParser @Text g7) +p8 = $$(runParser @Text g8) +p9 = $$(runParser @Text g9) +p10 = $$(runParser @Text g10) +p11 = $$(runParser @Text g11) +p12 = $$(runParser @Text g12) -- 2.44.1 From b49a874a779814711246c42933601b0cc445158a Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Mon, 1 Mar 2021 17:09:42 +0100 Subject: [PATCH 02/16] bug: a ref outside its def must be supported --- Makefile | 8 +- flake.lock | 10 +- src/Symantic/Parser/Grammar/ObserveSharing.hs | 7 + src/Symantic/Parser/Haskell/View.hs | 3 +- src/Symantic/Parser/Machine/Generate.hs | 7 +- src/Symantic/Univariant/Letable.hs | 29 +- test/Golden/Grammar.hs | 12 +- .../Grammar/OptimizeGrammar/G1.expected.txt | 4 +- .../Grammar/OptimizeGrammar/G10.expected.txt | 8 +- .../Grammar/OptimizeGrammar/G11.expected.txt | 13 +- .../Grammar/OptimizeGrammar/G12.expected.txt | 13 +- .../Grammar/OptimizeGrammar/G13.expected.txt | 59 +- .../Grammar/OptimizeGrammar/G14.expected.txt | 480 ++++- .../Grammar/OptimizeGrammar/G15.expected.txt | 10 + .../Grammar/OptimizeGrammar/G16.expected.txt | 22 + .../Grammar/OptimizeGrammar/G17.expected.txt | 24 + .../Grammar/OptimizeGrammar/G18.expected.txt | 11 + .../Grammar/OptimizeGrammar/G19.expected.txt | 13 + .../Grammar/OptimizeGrammar/G2.expected.txt | 9 +- .../Grammar/OptimizeGrammar/G20.expected.txt | 12 + .../Grammar/OptimizeGrammar/G21.expected.txt | 1 + .../Grammar/OptimizeGrammar/G22.expected.txt | 7 + .../Grammar/OptimizeGrammar/G23.expected.txt | 12 + .../Grammar/OptimizeGrammar/G24.expected.txt | 12 + .../Grammar/OptimizeGrammar/G25.expected.txt | 58 + .../Grammar/OptimizeGrammar/G3.expected.txt | 11 +- .../Grammar/OptimizeGrammar/G4.expected.txt | 23 +- .../Grammar/OptimizeGrammar/G5.expected.txt | 25 +- .../Grammar/OptimizeGrammar/G6.expected.txt | 12 +- .../Grammar/OptimizeGrammar/G7.expected.txt | 14 +- .../Grammar/OptimizeGrammar/G8.expected.txt | 13 +- .../Grammar/OptimizeGrammar/G9.expected.txt | 2 +- .../Grammar/ViewGrammar/G1.expected.txt | 4 +- .../Grammar/ViewGrammar/G10.expected.txt | 13 +- .../Grammar/ViewGrammar/G11.expected.txt | 32 +- .../Grammar/ViewGrammar/G12.expected.txt | 21 +- .../Grammar/ViewGrammar/G13.expected.txt | 147 +- .../Grammar/ViewGrammar/G14.expected.txt | 1437 ++++++++++----- .../Grammar/ViewGrammar/G15.expected.txt | 16 + .../Grammar/ViewGrammar/G16.expected.txt | 50 + .../Grammar/ViewGrammar/G17.expected.txt | 54 + .../Grammar/ViewGrammar/G18.expected.txt | 35 + .../Grammar/ViewGrammar/G19.expected.txt | 37 + .../Grammar/ViewGrammar/G2.expected.txt | 29 +- .../Grammar/ViewGrammar/G20.expected.txt | 20 + .../Grammar/ViewGrammar/G21.expected.txt | 1 + .../Grammar/ViewGrammar/G22.expected.txt | 11 + .../Grammar/ViewGrammar/G23.expected.txt | 24 + .../Grammar/ViewGrammar/G24.expected.txt | 16 + .../Grammar/ViewGrammar/G25.expected.txt | 100 + .../Grammar/ViewGrammar/G3.expected.txt | 23 +- .../Grammar/ViewGrammar/G4.expected.txt | 67 +- .../Grammar/ViewGrammar/G5.expected.txt | 69 +- .../Grammar/ViewGrammar/G6.expected.txt | 35 +- .../Grammar/ViewGrammar/G7.expected.txt | 35 +- .../Grammar/ViewGrammar/G8.expected.txt | 25 +- test/Golden/Machine.hs | 2 +- test/Golden/Machine/G11.expected.txt | 45 +- test/Golden/Machine/G12.expected.txt | 55 +- test/Golden/Machine/G13.expected.txt | 190 +- test/Golden/Machine/G14.expected.txt | 1639 +++++++++-------- test/Golden/Machine/G15.expected.txt | 23 + test/Golden/Machine/G16.expected.txt | 42 + test/Golden/Machine/G17.expected.txt | 67 + test/Golden/Machine/G18.expected.txt | 22 + test/Golden/Machine/G19.expected.txt | 34 + test/Golden/Machine/G20.expected.txt | 48 + test/Golden/Machine/G21.expected.txt | 23 + test/Golden/Machine/G22.expected.txt | 18 + test/Golden/Machine/G23.expected.txt | 25 + test/Golden/Machine/G24.expected.txt | 48 + test/Golden/Machine/G25.expected.txt | 104 ++ test/Golden/Machine/G3.expected.txt | 41 +- test/Golden/Machine/G4.expected.txt | 78 +- test/Golden/Machine/G5.expected.txt | 114 +- test/Golden/Machine/G8.expected.txt | 55 +- test/Golden/Parser.hs | 4 +- test/Golden/Splice.hs | 33 +- test/Golden/Splice/G10.expected.txt | 2 +- test/Golden/Splice/G11.expected.txt | 6 +- test/Golden/Splice/G12.expected.txt | 10 +- test/Golden/Splice/G13.expected.txt | 1259 ++++++++++++- test/Golden/Splice/G2.expected.txt | 2 +- test/Golden/Splice/G3.expected.txt | 6 +- test/Golden/Splice/G4.expected.txt | 49 +- test/Golden/Splice/G5.expected.txt | 53 +- test/Golden/Splice/G6.expected.txt | 2 +- test/Golden/Splice/G7.expected.txt | 6 +- test/Golden/Splice/G8.expected.txt | 10 +- test/Golden/Splice/G9.expected.txt | 4 +- test/Golden/Splice/Utils.hs | 34 +- test/Grammar.hs | 30 +- test/Machine.hs | 23 + test/Parser.hs | 5 +- 94 files changed, 5681 insertions(+), 1775 deletions(-) create mode 100644 test/Golden/Grammar/OptimizeGrammar/G15.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G16.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G17.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G18.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G19.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G20.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G21.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G22.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G23.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G24.expected.txt create mode 100644 test/Golden/Grammar/OptimizeGrammar/G25.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G15.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G16.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G17.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G18.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G19.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G20.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G21.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G22.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G23.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G24.expected.txt create mode 100644 test/Golden/Grammar/ViewGrammar/G25.expected.txt create mode 100644 test/Golden/Machine/G15.expected.txt create mode 100644 test/Golden/Machine/G16.expected.txt create mode 100644 test/Golden/Machine/G17.expected.txt create mode 100644 test/Golden/Machine/G18.expected.txt create mode 100644 test/Golden/Machine/G19.expected.txt create mode 100644 test/Golden/Machine/G20.expected.txt create mode 100644 test/Golden/Machine/G21.expected.txt create mode 100644 test/Golden/Machine/G22.expected.txt create mode 100644 test/Golden/Machine/G23.expected.txt create mode 100644 test/Golden/Machine/G24.expected.txt create mode 100644 test/Golden/Machine/G25.expected.txt create mode 100644 test/Machine.hs diff --git a/Makefile b/Makefile index e4f099f..c8a11de 100644 --- a/Makefile +++ b/Makefile @@ -10,13 +10,13 @@ repl: cabal repl t: - cabal test -fdump-splices --test-show-details always --test-options "--color always --size-cutoff 100000" + cabal test --test-show-details always --test-options "--color always --size-cutoff 1000000 $${p:+-p $$p}" t/accept: - cabal test --test-show-details always --test-options "--accept --color always --size-cutoff 100000" + cabal test --test-show-details always --test-options "--accept --color always $${p:+-p $$p}" t/prof: - cabal test --enable-profiling -fprof-auto -fprof-auto-calls --test-show-details always --test-options "+RTS -p -L100 -hc" + cabal test --enable-profiling -fprof-auto -fprof-auto-calls --test-show-details always --test-options "$${p:+-p $$p} +RTS -p -L100 -hc" t/cover: - cabal test --enable-profiling --enable-library-coverage --enable-coverage --test-show-details always + cabal test --enable-profiling --enable-library-coverage --enable-coverage --test-show-details always --test-options "$${p:+-p $$p}" t/prof-th: cabal v2-build lib:symantic-parser --enable-debug --enable-profiling --write-ghc-environment-files=always ghc -prof -fprof-auto -eventlog -debug -fexternal-interpreter -opti+RTS -opti-p -opti-L100 -opti-ls -opti-hy --make -XHaskell2010 -XNoImplicitPrelude -itest test/Main.hs -Wall -ddump-splices diff --git a/flake.lock b/flake.lock index 6269c19..19b7a80 100644 --- a/flake.lock +++ b/flake.lock @@ -2,11 +2,11 @@ "nodes": { "flake-utils": { "locked": { - "lastModified": 1610051610, - "narHash": "sha256-U9rPz/usA1/Aohhk7Cmc2gBrEEKRzcW4nwPWMPwja4Y=", + "lastModified": 1614513358, + "narHash": "sha256-LakhOx3S1dRjnh0b5Dg3mbZyH0ToC9I8Y2wKSkBaTzU=", "owner": "numtide", "repo": "flake-utils", - "rev": "3982c9903e93927c2164caa727cd3f6a0e6d14cc", + "rev": "5466c5bbece17adaab2d82fae80b46e807611bf3", "type": "github" }, "original": { @@ -17,8 +17,8 @@ }, "nixpkgs": { "locked": { - "narHash": "sha256-ASkGJKmjuNn38MFvNCEbq9lNRn2+HwBtY7M+UxO6N/Y=", - "path": "/nix/store/krdlm8w2pjp9m0qpz8m5w7jkpwc049i6-nixpkgs-patched", + "narHash": "sha256-0rr9cOiNhJnQ7DgjZouhNFo8dKnTiw+/Vee+EQuN5sY=", + "path": "/nix/store/bxgglm21wj8pxmza3m87rkdwwm8gz54k-nixpkgs-patched", "type": "path" }, "original": { diff --git a/src/Symantic/Parser/Grammar/ObserveSharing.hs b/src/Symantic/Parser/Grammar/ObserveSharing.hs index d17ce33..33648cd 100644 --- a/src/Symantic/Parser/Grammar/ObserveSharing.hs +++ b/src/Symantic/Parser/Grammar/ObserveSharing.hs @@ -33,6 +33,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName , Satisfiable tok repr ) => Satisfiable tok (ObserveSharing letName repr) instance @@ -40,6 +41,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName , Alternable repr ) => Alternable (ObserveSharing letName repr) instance @@ -47,6 +49,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName , Applicable repr ) => Applicable (ObserveSharing letName repr) instance @@ -54,6 +57,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName , Selectable repr ) => Selectable (ObserveSharing letName repr) instance @@ -61,6 +65,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName , Matchable repr ) => Matchable (ObserveSharing letName repr) where -- Here the default definition does not fit @@ -78,6 +83,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName , Foldable repr {- TODO: the following constraints are for the current Foldable, - they will have to be removed when Foldable will have Sym.lift2 as defaults @@ -90,6 +96,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName , Lookable repr ) => Lookable (ObserveSharing letName repr) diff --git a/src/Symantic/Parser/Haskell/View.hs b/src/Symantic/Parser/Haskell/View.hs index a017487..38a4ca1 100644 --- a/src/Symantic/Parser/Haskell/View.hs +++ b/src/Symantic/Parser/Haskell/View.hs @@ -17,7 +17,8 @@ import Symantic.Parser.Grammar.Fixity import qualified Symantic.Parser.Haskell.Optimize as H -- * Type 'ViewTerm' -newtype ViewTerm a = ViewTerm { unViewTerm :: ViewTermInh -> ShowS } +newtype ViewTerm a = ViewTerm { unViewTerm :: + ViewTermInh -> ShowS } instance IsString (ViewTerm a) where fromString s = ViewTerm $ \_inh -> showString s diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs index b63802d..a350b55 100644 --- a/src/Symantic/Parser/Machine/Generate.hs +++ b/src/Symantic/Parser/Machine/Generate.hs @@ -38,6 +38,8 @@ import Symantic.Parser.Machine.Input import Symantic.Parser.Machine.Instructions import qualified Symantic.Parser.Haskell as H +import Debug.Trace (trace) + genCode :: TermInstr a -> CodeQ a genCode = trans @@ -261,13 +263,14 @@ instance InstrExceptionable Gen where { minHorizon = \hs -> minHorizon ok hs `min` minHorizon ko hs , exceptions = \hs -> exceptions ok hs <> exceptions ko hs , unGen = \ctx@GenCtx{} -> [|| - let _ = "catchException lbl="<> $$(TH.liftTyped (symbolVal lbl)) in + let _ = $$(TH.liftTyped ("catchException lbl="<>symbolVal lbl)) in $$(unGen ok ctx { catchStackByLabel = Map.insertWith (<>) (symbolVal lbl) (NE.singleton ([|| \ !failInp !farInp !farExp -> $$(unGen ko ctx -- PushValue the input as it was when entering the catchFail. { valueStack = ValueStackCons (H.Term (input ctx)) (valueStack ctx) + -- Note that 'catchStackByLabel' is reset. -- Move the input to the failing position. , input = [||failInp||] -- Set the farthestInput to the farthest computed by 'fail' @@ -369,7 +372,7 @@ instance InstrLetable Gen where { minHorizon = (Map.! n) , exceptions = (Map.! n) , unGen = \ctx -> let ks = (Map.keys (catchStackByLabel ctx)) in [|| - let _ = $$(TH.liftTyped $ "call exceptionsByName("<>show n<>")="<>show (Map.keys (exceptionsByName ctx Map.! n)) <> " catchStackByLabel(ctx)="<> show ks) in + let _ = $$(TH.liftTyped $ "call exceptionsByName("<>show n<>")="<>show (Map.keys (Map.findWithDefault Map.empty n (exceptionsByName ctx))) <> " catchStackByLabel(ctx)="<> show ks) in $$(Code (TH.unsafeTExpCoerce (return (TH.VarE n)))) {-ok-}$$(generateSuspend k ctx) $$(input ctx) diff --git a/src/Symantic/Univariant/Letable.hs b/src/Symantic/Univariant/Letable.hs index 373caec..b0955ce 100644 --- a/src/Symantic/Univariant/Letable.hs +++ b/src/Symantic/Univariant/Letable.hs @@ -24,7 +24,7 @@ import Data.String (String) -- import GHC.Prim (unsafeCoerce#) import GHC.StableName (StableName(..), makeStableName, hashStableName, eqStableName) -- import Numeric (showHex) -import Prelude ((+)) +import Prelude ((+), error) import System.IO (IO) import System.IO.Unsafe (unsafePerformIO) import Text.Show (Show(..)) @@ -36,7 +36,7 @@ import qualified Data.HashSet as HS import Symantic.Univariant.Trans --- import Debug.Trace (trace) +--import Debug.Trace (trace) -- * Class 'Letable' -- | This class is not for end-users like usual symantic operators, @@ -103,18 +103,22 @@ instance Show SharingName where -} -- * Type 'ObserveSharing' --- | Interpreter detecting some (Haskell embedded) @let@ definitions used at --- least once and/or recursively, in order to replace them --- with the 'def' and 'ref' combinators. --- See [Type-safe observable sharing in Haskell](https://doi.org/10.1145/1596638.1596653) newtype ObserveSharing letName repr a = ObserveSharing { unObserveSharing :: MT.ReaderT (HashSet SharingName) (MT.State (ObserveSharingState letName)) (CleanDefs letName repr a) } +-- | Interpreter detecting some (Haskell embedded) @let@ definitions used at +-- least once and/or recursively, in order to replace them +-- with the 'def' and 'ref' combinators. +-- See [Type-safe observable sharing in Haskell](https://doi.org/10.1145/1596638.1596653) +-- +-- Beware not to apply 'observeSharing' more than once on the same term +-- otherwise some 'def' introduced by the first call would be removed by the second call. observeSharing :: Eq letName => Hashable letName => + Show letName => ObserveSharing letName repr a -> repr a observeSharing (ObserveSharing m) = do @@ -126,7 +130,7 @@ observeSharing (ObserveSharing m) = do let refs = HS.fromList $ (`foldMap` oss_refs st) $ (\(letName, refCount) -> if refCount > 0 then [letName] else []) - -- trace (show refs) $ + --trace (show refs) $ unCleanDefs a refs -- ** Type 'ObserveSharingState' @@ -139,6 +143,7 @@ data ObserveSharingState letName = ObserveSharingState observeSharingNode :: Eq letName => Hashable letName => + Show letName => Letable letName repr => MakeLetName letName => ObserveSharing letName repr a -> @@ -174,6 +179,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName ) => Trans (CleanDefs letName repr) (ObserveSharing letName repr) where trans = observeSharingNode . ObserveSharing . return instance @@ -181,6 +187,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName ) => Trans1 (CleanDefs letName repr) (ObserveSharing letName repr) where trans1 f x = observeSharingNode $ ObserveSharing $ f <$> unObserveSharing x @@ -189,6 +196,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName ) => Trans2 (CleanDefs letName repr) (ObserveSharing letName repr) where trans2 f x y = observeSharingNode $ ObserveSharing $ f <$> unObserveSharing x @@ -198,6 +206,7 @@ instance , MakeLetName letName , Eq letName , Hashable letName + , Show letName ) => Trans3 (CleanDefs letName repr) (ObserveSharing letName repr) where trans3 f x y z = observeSharingNode $ ObserveSharing $ f <$> unObserveSharing x @@ -208,7 +217,10 @@ instance , MakeLetName letName , Eq letName , Hashable letName - ) => Letable letName (ObserveSharing letName repr) + , Show letName + ) => Letable letName (ObserveSharing letName repr) where + def = error "[BUG]: observeSharing MUST NOT be applied twice" + ref = error "[BUG]: observeSharing MUST NOT be applied twice" -- * Type 'CleanDefs' -- | Remove 'def' when non-recursive or unused. @@ -233,6 +245,7 @@ instance ( Letable letName repr , Eq letName , Hashable letName + , Show letName ) => Letable letName (CleanDefs letName repr) where def name x = CleanDefs $ \refs -> if name `HS.member` refs diff --git a/test/Golden/Grammar.hs b/test/Golden/Grammar.hs index 6077cec..5ed73a9 100644 --- a/test/Golden/Grammar.hs +++ b/test/Golden/Grammar.hs @@ -23,14 +23,16 @@ goldens = testGroup "Grammar" $ [ testGroup "ViewGrammar" $ (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \(Grammar.G gram) g -> let grammarFile = "test/Golden/Grammar/ViewGrammar/G"<>show g<>".expected.txt" in - goldenVsStringDiff grammarFile goldenDiff grammarFile $ do + goldenVsStringDiff ("G"<>show g) goldenDiff grammarFile $ do + resetTHNameCounter return $ fromString $ show $ - P.viewGrammar @'False $ + P.viewGrammar @'True $ P.observeSharing gram , testGroup "OptimizeGrammar" $ (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \(Grammar.G gram) g -> let grammarFile = "test/Golden/Grammar/OptimizeGrammar/G"<>show g<>".expected.txt" in - goldenVsStringDiff grammarFile goldenDiff grammarFile $ do - return $ fromString $ show $ - P.showGrammar @'False gram + goldenVsStringDiff ("G"<>show g) goldenDiff grammarFile $ do + resetTHNameCounter + return $ fromString $ + P.showGrammar @'True gram ] diff --git a/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt index f1f6cce..0dbd765 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt @@ -1 +1,3 @@ -"<*>\n+ pure (\\u1 -> 'a')\n` satisfy\n" \ No newline at end of file +<*> ++ pure (\u1 -> 'a') +` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt index 2c9ca60..7e96757 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt @@ -1 +1,7 @@ -"<|>\n+ <*>\n| + pure (\\u1 -> 'a')\n| ` satisfy\n` <*>\n + pure (\\u1 -> 'b')\n ` satisfy\n" \ No newline at end of file +<|> ++ <*> +| + pure (\u1 -> 'a') +| ` satisfy +` <*> + + pure (\u1 -> 'b') + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt index a3fec41..033eb10 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt @@ -1 +1,12 @@ -"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u1 Term))\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'a' : u2 u3)))\n| | | ` satisfy\n| | ` rec \n| ` pure (\\u1 -> u1)\n` satisfy\n" \ No newline at end of file +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 Term)) +| ` def +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt index 3ca3b38..3e17f2b 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt @@ -1 +1,12 @@ -"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u1 Term))\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u1 : u2 u3)))\n| | | ` satisfy\n| | ` rec \n| ` pure (\\u1 -> u1)\n` eof\n" \ No newline at end of file +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 Term)) +| ` def +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt index 717c0d5..9e1c6e1 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt @@ -1 +1,58 @@ -"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u2 Term))\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | ` satisfy\n| | ` rec \n| ` pure (\\u1 -> u1)\n` <|>\n + <*>\n | + <*>\n | | + <*>\n | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (u1 u2) (u3 u4)))))\n | | | ` conditional\n | | | + look\n | | | | ` satisfy\n | | | + bs\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | + <*>\n | | | | | + pure (\\u1 -> (\\u2 -> cons Term))\n | | | | | ` satisfy\n | | | | ` <*>\n | | | | + <*>\n | | | | | + <*>\n | | | | | | + <*>\n | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> cons (Term u3))))))\n | | | | | | | ` satisfy\n | | | | | | ` ref \n | | | | | ` rec \n | | | | ` satisfy\n | | | ` empty\n | | ` ref \n | ` rec \n ` pure (\\u1 -> u1)\n" \ No newline at end of file +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u2)) +| ` def name_1 +| ` <*> +| + pure (\u1 -> Term) +| ` def name_4 +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | ` satisfy +| | ` rec name_4 +| ` pure (\u1 -> u1) +` def name_2 + ` <*> + + pure (\u1 -> u1 Term) + ` def name_3 + ` <|> + + <*> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) + | | | ` conditional + | | | + look + | | | | ` satisfy + | | | + bs + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | ` <*> + | | | | + <*> + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) + | | | | | | | ` satisfy + | | | | | | ` ref name_1 + | | | | | ` rec name_2 + | | | | ` satisfy + | | | ` empty + | | ` ref name_1 + | ` rec name_3 + ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt index 180a05c..b4f6e01 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt @@ -1 +1,479 @@ -"<*>\n+ <*>\n| + <*>\n| | + <*>\n| | | + <*>\n| | | | + <*>\n| | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> u5))))))\n| | | | | ` <|>\n| | | | | + <*>\n| | | | | | + <*>\n| | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | ` <|>\n| | | | | | | + <*>\n| | | | | | | | + <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> Term)))\n| | | | | | | | | | ` satisfy\n| | | | | | | | | ` ref \n| | | | | | | | ` <|>\n| | | | | | | | + <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | | ` ref \n| | | | | | | | | ` rec \n| | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | ` <*>\n| | | | | | | + <*>\n| | | | | | | | + <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> u5)))))\n| | | | | | | | | | | ` try\n| | | | | | | | | | | ` <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> '/' : ('/' : Term)))\n| | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | ` satisfy\n| | | | | | | | | | ` ref \n| | | | | | | | | ` <|>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | | | ` satisfy\n| | | | | | | | | | ` rec \n| | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | ` ref \n| | | | | | | ` ref \n| | | | | | ` rec \n| | | | | ` pure (\\u1 -> u1)\n| | | | ` ref \n| | | ` ref \n| | ` <|>\n| | + <*>\n| | | + <*>\n| | | | + <*>\n| | | | | + <*>\n| | | | | | + <*>\n| | | | | | | + <*>\n| | | | | | | | + <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> (\\u7 -> (\\u8 -> (\\u9 -> (\\u10 -> (\\u11 -> (\\u12 -> (\\u13 -> (\\u14 -> (\\u15 -> (\\u16 -> (\\u17 -> (\\u18 -> (\\u19 -> u18 u19)))))))))))))))))))\n| | | | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | | | ` <*\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> Term)\n| | | | | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> (\\u7 -> (\\u8 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : Term)))))))))))))))\n| | | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | ` negLook\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> u4))))\n| | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> Term)))))\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> Term))))))\n| | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> u4 u5)))))\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> Term)))\n| | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | ` ref \n| | | | | | | | | | ` satisfy\n| | | | | | | | | ` ref \n| | | | | | | | ` ref \n| | | | | | | ` <|>\n| | | | | | | + <*>\n| | | | | | | | + <*>\n| | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2 u3)))\n| | | | | | | | | ` <|>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> (\\u7 -> (\\u8 -> u8))))))))\n| | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'i' : ('f' : u3))))\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + pure (\\u1 -> '0')\n| | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> '1')\n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> u2))))\n| | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u3)))\n| | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + pure (\\u1 -> Term)\n| | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u2)))\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> Term))))\n| | | | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (u1 u3) (u4 u5))))))\n| | | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> u4 u5)))))\n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | ` ref \n| | | | | | | | | | | ` rec \n| | | | | | | | | | ` <|>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> Term)))\n| | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> 'e' : ('l' : ('s' : ('e' : u5))))))))\n| | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | ` ref \n| | | | | | | | | | | ` rec \n| | | | | | | | | | ` ref \n| | | | | | | | | ` <|>\n| | | | | | | | | + <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> u4))))\n| | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6))))))))))\n| | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | ` ref \n| | | | | | | | | | | ` ref \n| | | | | | | | | | ` rec \n| | | | | | | | | ` <|>\n| | | | | | | | | + try\n| | | | | | | | | | ` <*>\n| | | | | | | | | | + <*>\n| | | | | | | | | | | + <*>\n| | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (\\u6 -> (\\u7 -> (\\u8 -> (\\u9 -> (\\u10 -> (\\u11 -> (\\u12 -> (\\u13 -> u11)))))))))))))\n| | | | | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> Term))\n| | | | | | | | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> u2))\n| | | | | | | | | | | | | | | | | | | | | | | | | ` try\n| | | | | | | | | | | | | | | | | | | | | | | | | ` <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> 'v' : ('a' : ('r' : u4))))))\n| | | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (u1 u3) (u4 u5))))))\n| | | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | | ` satisfy\n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | ` <|>\n| | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | + <*>\n| | | | | | | | | | | | | | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> (\\u5 -> (u1 u3) (u4 u5))))))\n| | | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | | ` ref \n| | | | | | | | | | | | | | ` rec \n| | | | | | | | | | | | | ` pure (\\u1 -> u1)\n| | | | | | | | | | | | ` ref \n| | | | | | | | | | | ` satisfy\n| | | | | | | | | | ` ref \n| | | | | | | | | ` <*>\n| | | | | | | | | + <*>\n| | | | | | | | | | + pure (\\u1 -> (\\u2 -> u1))\n| | | | | | | | | | ` ref \n| | | | | | | | | ` ref \n| | | | | | | | ` rec \n| | | | | | | ` pure (\\u1 -> u1)\n| | | | | | ` ref \n| | | | | ` satisfy\n| | | | ` ref \n| | | ` rec \n| | ` pure (\\u1 -> u1)\n| ` ref \n` eof\n" \ No newline at end of file +<*> ++ <*> +| + <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) +| | | | ` def +| | | | ` <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) +| | | | | | ` def +| | | | | | ` pure Term +| | | | | ` def +| | | | | ` <|> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | ` <|> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> Term)) +| | | | | | | | | ` def +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | ` satisfy +| | | | | | | | | ` ref +| | | | | | | | ` def +| | | | | | | | ` <|> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | | ` ref +| | | | | | | | | ` rec +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) +| | | | | | | | | | | ` try +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> '/' : ('/' : Term))) +| | | | | | | | | | | | ` satisfy +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` ref +| | | | | | | | | ` def +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` rec +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` rec +| | | | | ` pure (\u1 -> u1) +| | | | ` ref +| | | ` ref +| | ` def +| | ` <|> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10)))))))))) +| | | | | | | | | | | ` try +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | ` try +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : u9)))))))))))))))) +| | | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | ` def +| | | | | | | | | | | | ` pure Term +| | | | | | | | | | | ` def +| | | | | | | | | | | ` negLook +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` ref +| | | | | | | | | ` def +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | ` try +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` def +| | | | | | | | | | | ` <|> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | ` rec +| | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | ` ref +| | | | | | | | | ` ref +| | | | | | | | ` def +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> '(')) +| | | | | | | | | ` satisfy +| | | | | | | | ` ref +| | | | | | | ` def +| | | | | | | ` <|> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) +| | | | | | | | | | | ` def +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` <|> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> Term) +| | | | | | | | | | | | ` def +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` def +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` def +| | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` ref +| | | | | | | | | ` def +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | ` def +| | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | ` def +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> ',')) +| | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` rec +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` <|> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) +| | | | | | | | | ` satisfy +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` def +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> ')')) +| | | | | | ` satisfy +| | | | | ` ref +| | | | ` def +| | | | ` <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5))))))) +| | | | | | | | | | ` satisfy +| | | | | | | | | ` ref +| | | | | | | | ` ref +| | | | | | | ` def +| | | | | | | ` <|> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) +| | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` def +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | | | | | | | | | ` def +| | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> '0') +| | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> '1') +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) +| | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) +| | | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> Term) +| | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2))) +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) +| | | | | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | ` def +| | | | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` def +| | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` rec +| | | | | | | | | | ` <|> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) +| | | | | | | | | | | | | ` try +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) +| | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` rec +| | | | | | | | | | ` ref +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | | | | | | | ` try +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) +| | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` rec +| | | | | | | | | ` <|> +| | | | | | | | | + try +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11)))))))))))) +| | | | | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> Term)) +| | | | | | | | | | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) +| | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | ` def +| | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` def +| | | | | | | | | | | | ` <|> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` rec +| | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | ` ref +| | | | | | | | | | ` def +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> ';')) +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` ref +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` ref +| | | | | | | | | ` ref +| | | | | | | | ` rec +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` ref +| | | | | ` satisfy +| | | | ` ref +| | | ` rec +| | ` pure (\u1 -> u1) +| ` ref +` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt new file mode 100644 index 0000000..2450553 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt @@ -0,0 +1,10 @@ +<*> ++ pure (\u1 -> u1 Term) +` def name_401 + ` <|> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) + | | ` satisfy + | ` rec name_401 + ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt new file mode 100644 index 0000000..8088504 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt @@ -0,0 +1,22 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 : u2 Term)) +| ` def name_416 +| ` try +| ` <*> +| + <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | | | ` satisfy +| | | ` satisfy +| | ` satisfy +| ` satisfy +` def name_415 + ` <|> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) + | | ` ref name_416 + | ` rec name_415 + ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/OptimizeGrammar/G17.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G17.expected.txt new file mode 100644 index 0000000..2d0bb4a --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G17.expected.txt @@ -0,0 +1,24 @@ +<*> ++ <*> +| + <*> +| | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) +| | ` def name_462 +| | ` try +| | ` <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | | | | ` satisfy +| | | | ` satisfy +| | | ` satisfy +| | ` satisfy +| ` def name_461 +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | | ` ref name_462 +| | ` rec name_461 +| ` pure (\u1 -> u1) +` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G18.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G18.expected.txt new file mode 100644 index 0000000..5167dd7 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G18.expected.txt @@ -0,0 +1,11 @@ +<|> ++ <*> +| + <*> +| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) +| | ` satisfy +| ` satisfy +` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G19.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G19.expected.txt new file mode 100644 index 0000000..17ce3a3 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G19.expected.txt @@ -0,0 +1,13 @@ +<|> ++ try +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) +| | ` satisfy +| ` satisfy +` try + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt index 9666ecb..4460a7d 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt @@ -1 +1,8 @@ -"try\n` <*>\n + <*>\n | + <*>\n | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'a' : ('b' : ('c' : Term)))))\n | | ` satisfy\n | ` satisfy\n ` satisfy\n" \ No newline at end of file +try +` <*> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : ('b' : ('c' : Term))))) + | | ` satisfy + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G20.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G20.expected.txt new file mode 100644 index 0000000..52b9fa5 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G20.expected.txt @@ -0,0 +1,12 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 Term)) +| ` def name_583 +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) +| | | ` satisfy +| | ` rec name_583 +| ` pure (\u1 -> u1) +` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G21.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G21.expected.txt new file mode 100644 index 0000000..37fb719 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G21.expected.txt @@ -0,0 +1 @@ +eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G22.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G22.expected.txt new file mode 100644 index 0000000..7e96757 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G22.expected.txt @@ -0,0 +1,7 @@ +<|> ++ <*> +| + pure (\u1 -> 'a') +| ` satisfy +` <*> + + pure (\u1 -> 'b') + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G23.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G23.expected.txt new file mode 100644 index 0000000..52bba00 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G23.expected.txt @@ -0,0 +1,12 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 Term)) +| ` def name_613 +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) +| | | ` satisfy +| | ` rec name_613 +| ` pure (\u1 -> u1) +` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G24.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G24.expected.txt new file mode 100644 index 0000000..109452f --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G24.expected.txt @@ -0,0 +1,12 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 Term)) +| ` def name_635 +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | | ` satisfy +| | ` rec name_635 +| ` pure (\u1 -> u1) +` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G25.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G25.expected.txt new file mode 100644 index 0000000..5f17659 --- /dev/null +++ b/test/Golden/Grammar/OptimizeGrammar/G25.expected.txt @@ -0,0 +1,58 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u2)) +| ` def name_651 +| ` <*> +| + pure (\u1 -> Term) +| ` def name_652 +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | ` satisfy +| | ` rec name_652 +| ` pure (\u1 -> u1) +` def name_650 + ` <*> + + pure (\u1 -> u1 Term) + ` def name_649 + ` <|> + + <*> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) + | | | ` conditional + | | | + look + | | | | ` satisfy + | | | + bs + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | + <*> + | | | | | + pure (\u1 -> (\u2 -> cons Term)) + | | | | | ` satisfy + | | | | ` <*> + | | | | + <*> + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) + | | | | | | | ` satisfy + | | | | | | ` ref name_651 + | | | | | ` rec name_650 + | | | | ` satisfy + | | | ` empty + | | ` ref name_651 + | ` rec name_649 + ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt index ddcbfae..d32bfda 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt @@ -1 +1,10 @@ -"<*>\n+ pure (\\u1 -> u1 Term)\n` <|>\n + <*>\n | + <*>\n | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'a' : u2 u3)))\n | | ` satisfy\n | ` rec \n ` pure (\\u1 -> u1)\n" \ No newline at end of file +<*> ++ pure (\u1 -> u1 Term) +` def + ` <|> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) + | | ` satisfy + | ` rec + ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt index fb60535..b6b25c7 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt @@ -1 +1,22 @@ -"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u1 : u2 Term))\n| ` try\n| ` <*>\n| + <*>\n| | + <*>\n| | | + <*>\n| | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> 'a' : ('b' : ('c' : ('d' : Term)))))))\n| | | | ` satisfy\n| | | ` satisfy\n| | ` satisfy\n| ` satisfy\n` <|>\n + <*>\n | + <*>\n | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u1 : u2 u3)))\n | | ` ref \n | ` rec \n ` pure (\\u1 -> u1)\n" \ No newline at end of file +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 : u2 Term)) +| ` def +| ` try +| ` <*> +| + <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | | | ` satisfy +| | | ` satisfy +| | ` satisfy +| ` satisfy +` def + ` <|> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) + | | ` ref + | ` rec + ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt index 09186c8..bcaeec5 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt @@ -1 +1,24 @@ -"<*>\n+ <*>\n| + <*>\n| | + pure (\\u1 -> (\\u2 -> (\\u3 -> u1 : u2 Term)))\n| | ` try\n| | ` <*>\n| | + <*>\n| | | + <*>\n| | | | + <*>\n| | | | | + pure (\\u1 -> (\\u2 -> (\\u3 -> (\\u4 -> 'a' : ('b' : ('c' : ('d' : Term)))))))\n| | | | | ` satisfy\n| | | | ` satisfy\n| | | ` satisfy\n| | ` satisfy\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> u1 : u2 u3)))\n| | | ` ref \n| | ` rec \n| ` pure (\\u1 -> u1)\n` eof\n" \ No newline at end of file +<*> ++ <*> +| + <*> +| | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) +| | ` def +| | ` try +| | ` <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | | | | ` satisfy +| | | | ` satisfy +| | | ` satisfy +| | ` satisfy +| ` def +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) +` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt index 08f7f1d..5167dd7 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt @@ -1 +1,11 @@ -"<|>\n+ <*>\n| + <*>\n| | + pure (\\u1 -> (\\u2 -> 'a' : ('a' : Term)))\n| | ` satisfy\n| ` satisfy\n` <*>\n + <*>\n | + pure (\\u1 -> (\\u2 -> 'a' : ('b' : Term)))\n | ` satisfy\n ` satisfy\n" \ No newline at end of file +<|> ++ <*> +| + <*> +| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) +| | ` satisfy +| ` satisfy +` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt index ab36ceb..17ce3a3 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt @@ -1 +1,13 @@ -"<|>\n+ try\n| ` <*>\n| + <*>\n| | + pure (\\u1 -> (\\u2 -> 'a' : ('a' : Term)))\n| | ` satisfy\n| ` satisfy\n` try\n ` <*>\n + <*>\n | + pure (\\u1 -> (\\u2 -> 'a' : ('b' : Term)))\n | ` satisfy\n ` satisfy\n" \ No newline at end of file +<|> ++ try +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) +| | ` satisfy +| ` satisfy +` try + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt index 3e7689d..8218cf0 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt @@ -1 +1,12 @@ -"<*>\n+ <*>\n| + pure (\\u1 -> (\\u2 -> u1 Term))\n| ` <|>\n| + <*>\n| | + <*>\n| | | + pure (\\u1 -> (\\u2 -> (\\u3 -> 'r' : u2 u3)))\n| | | ` satisfy\n| | ` rec \n| ` pure (\\u1 -> u1)\n` eof\n" \ No newline at end of file +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1 Term)) +| ` def +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt index cfa33f0..37fb719 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt @@ -1 +1 @@ -"eof\n" \ No newline at end of file +eof diff --git a/test/Golden/Grammar/ViewGrammar/G1.expected.txt b/test/Golden/Grammar/ViewGrammar/G1.expected.txt index 0dbd765..b4ac9ea 100644 --- a/test/Golden/Grammar/ViewGrammar/G1.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G1.expected.txt @@ -1,3 +1,5 @@ <*> -+ pure (\u1 -> 'a') ++ <*> +| + pure (\u1 -> (\u2 -> u1)) +| ` pure 'a' ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G10.expected.txt b/test/Golden/Grammar/ViewGrammar/G10.expected.txt index 7a64c4e..79525bf 100644 --- a/test/Golden/Grammar/ViewGrammar/G10.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G10.expected.txt @@ -1,8 +1,11 @@ <|> + <*> -| + pure (\u1 -> 'a') -| ` def -| ` satisfy +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` pure 'a' +| ` satisfy ` <*> - + pure (\u1 -> 'b') - ` ref + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'b' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G11.expected.txt b/test/Golden/Grammar/ViewGrammar/G11.expected.txt index fd560e8..da95145 100644 --- a/test/Golden/Grammar/ViewGrammar/G11.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G11.expected.txt @@ -1,12 +1,24 @@ <*> + <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) -| | | ` def -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) -` ref +| + pure (\u1 -> (\u2 -> u1)) +| ` <*> +| + def +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + pure cons +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure 'a' +| | | | ` satisfy +| | | ` rec +| | ` pure (\u1 -> u1) +| ` pure Term +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'b' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G12.expected.txt b/test/Golden/Grammar/ViewGrammar/G12.expected.txt index 0f63f6d..6bed0a7 100644 --- a/test/Golden/Grammar/ViewGrammar/G12.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G12.expected.txt @@ -1,11 +1,16 @@ <*> + <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) +| + pure (\u1 -> (\u2 -> u1)) +| ` <*> +| + def +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + pure cons +| | | | ` satisfy +| | | ` rec +| | ` pure (\u1 -> u1) +| ` pure Term ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G13.expected.txt b/test/Golden/Grammar/ViewGrammar/G13.expected.txt index 332e104..bcb2e13 100644 --- a/test/Golden/Grammar/ViewGrammar/G13.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G13.expected.txt @@ -1,55 +1,100 @@ <*> + <*> -| + pure (\u1 -> (\u2 -> u2)) -| ` <*> -| + pure (\u1 -> Term) -| ` <|> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` pure (\u1 -> u1) +| ` def name_1 +| ` <*> | + <*> | | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | ` def -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) -` <*> - + pure (\u1 -> u1 Term) - ` <|> - + <*> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) - | | | ` conditional - | | | + look - | | | | ` ref - | | | + bs - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` ref - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` ref - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` ref - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` ref - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` ref - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` ref - | | | | ` <*> - | | | | + <*> - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) - | | | | | | | ` ref - | | | | | | ` ref - | | | | | ` rec - | | | | ` ref - | | | ` empty - | | ` ref - | ` rec - ` pure (\u1 -> u1) +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` <*> +| | + <*> +| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | ` pure Term +| | ` def name_4 +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | ` satisfy +| | | ` rec name_4 +| | ` pure (\u1 -> u1) +| ` pure Term +` def name_2 + ` <*> + + def name_3 + | ` <|> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) + | | | ` <*> + | | | + pure cons + | | | ` <*> + | | | + <*> + | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | ` conditional + | | | | + look + | | | | | ` satisfy + | | | | + bs + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | ` <*> + | | | | | + <*> + | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | ` <*> + | | | | | | + <*> + | | | | | | | + <*> + | | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | | ` pure (\u1 -> u1) + | | | | | | | ` <*> + | | | | | | | + <*> + | | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | | ` satisfy + | | | | | | | ` ref name_1 + | | | | | | ` <*> + | | | | | | + pure Term + | | | | | | ` rec name_2 + | | | | | ` <*> + | | | | | + <*> + | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | ` pure ']' + | | | | | ` satisfy + | | | | ` empty + | | | ` ref name_1 + | | ` rec name_3 + | ` pure (\u1 -> u1) + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G14.expected.txt b/test/Golden/Grammar/ViewGrammar/G14.expected.txt index 1474b79..2acd52f 100644 --- a/test/Golden/Grammar/ViewGrammar/G14.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G14.expected.txt @@ -1,450 +1,993 @@ <*> + <*> -| + <*> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) -| | | | ` <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) -| | | | | | ` pure Term -| | | | | ` <|> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> Term)) -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | ` def -| | | | | | | | | | ` satisfy -| | | | | | | | | ` ref -| | | | | | | | ` <|> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | ` ref -| | | | | | | | | ` rec -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | | | | | | | | ` try -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> '/' : ('/' : Term))) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` ref -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` rec -| | | | | ` pure (\u1 -> u1) -| | | | ` ref -| | | ` ref -| | ` <|> -| | + <*> -| | | + <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10)))))))))) -| | | | | | | | | | | ` try -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | ` try -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : u9)))))))))))))))) -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` pure Term -| | | | | | | | | | | ` negLook -| | | | | | | | | | | ` ref -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | ` try -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` rec -| | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> '(')) -| | | | | | | | | ` ref -| | | | | | | | ` ref -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> Term) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` ref -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> ',')) -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` <|> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | | ` ref -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` ref -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> ')')) -| | | | | | ` ref -| | | | | ` ref -| | | | ` <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5))))))) -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` ref -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> '0') -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> '1') -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> Term) -| | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2))) -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` rec -| | | | | | | | | | ` <|> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | | | | | | ` try -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` rec -| | | | | | | | | | ` ref -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | | ` try -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` <|> -| | | | | | | | | + try -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11)))))))))))) -| | | | | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> Term)) -| | | | | | | | | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) -| | | | | | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` <|> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` rec -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` ref -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> ';')) -| | | | | | | | | | | ` ref -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` rec -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` ref -| | | | | ` ref -| | | | ` ref -| | | ` rec -| | ` pure (\u1 -> u1) -| ` ref +| + pure (\u1 -> (\u2 -> u1)) +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` def +| | ` <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure (\u1 -> u1) +| | | ` <*> +| | | + <*> +| | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | ` def +| | | | ` pure Term +| | | ` def +| | | ` <|> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | | ` <|> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` def +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` satisfy +| | | | | | | ` ref +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | ` pure Term +| | | | | | | ` def +| | | | | | | ` <|> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` ref +| | | | | | | | ` rec +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` pure Term +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` try +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure '/' +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure '/' +| | | | | | | | ` satisfy +| | | | | | | ` pure Term +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | ` ref +| | | | | | | ` def +| | | | | | | ` <|> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` satisfy +| | | | | | | | ` rec +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` ref +| | | | | ` ref +| | | | ` rec +| | | ` pure (\u1 -> u1) +| | ` ref +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` <*> +| | + <*> +| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | ` ref +| | ` def +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | ` <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` pure (\u1 -> u1) +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` try +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | ` try +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure cons +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure 'f' +| | | | | | | | | | ` satisfy +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure cons +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure 'u' +| | | | | | | | | | ` satisfy +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure cons +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure 'n' +| | | | | | | | | | ` satisfy +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure cons +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure 'c' +| | | | | | | | | | ` satisfy +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure cons +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure 't' +| | | | | | | | | | ` satisfy +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure cons +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure 'i' +| | | | | | | | | | ` satisfy +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure cons +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure 'o' +| | | | | | | | | | ` satisfy +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure cons +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure 'n' +| | | | | | | | | | ` satisfy +| | | | | | | | | ` def +| | | | | | | | | ` pure Term +| | | | | | | | ` def +| | | | | | | | ` negLook +| | | | | | | | ` satisfy +| | | | | | | ` ref +| | | | | | ` def +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` try +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | ` ref +| | | | | | | | ` def +| | | | | | | | ` <|> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` satisfy +| | | | | | | | | ` rec +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` def +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure '(' +| | | | | | | | ` satisfy +| | | | | | | ` ref +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` def +| | | | | | | ` <|> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure Term +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | ` def +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | ` ref +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure Term +| | | | | | | | | | ` def +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | ` pure '[' +| | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` def +| | | | | | | | | | | | ` satisfy +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | | | | | ` pure Term +| | | | | | | | | | | | ` def +| | | | | | | | | | | | ` <|> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` rec +| | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | ` pure Term +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | ` pure ']' +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` ref +| | | | | | | | | ` ref +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | | ` ref +| | | | | | | | | ` def +| | | | | | | | | ` <|> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + def +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` def +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | ` pure ',' +| | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` rec +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` <|> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure Term +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure ':' +| | | | | | | | | ` satisfy +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` def +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure ')' +| | | | | | ` satisfy +| | | | | ` ref +| | | | ` def +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure '{' +| | | | | | | ` satisfy +| | | | | | ` ref +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | ` ref +| | | | | | ` def +| | | | | | ` <|> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` <|> +| | | | | | | | + <|> +| | | | | | | | | + <|> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure 'i' +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure 'f' +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` def +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | ` def +| | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | + <|> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | | ` pure '0' +| | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure '1' +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure '\'' +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure '\\' +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | ` pure '\'' +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure Term +| | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | | ` pure Term +| | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | ` def +| | | | | | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | | | | + ref +| | | | | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` def +| | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | | ` pure '!' +| | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` rec +| | | | | | | | | | | ` <|> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` pure Term +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | ` pure 'e' +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | ` pure 'l' +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | ` pure 's' +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | ` pure 'e' +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` rec +| | | | | | | | | | | ` ref +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | ` try +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure 'w' +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure 'h' +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure 'i' +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure 'l' +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure 'e' +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` rec +| | | | | | | | | ` try +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | ` pure Term +| | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure 'v' +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure 'a' +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure cons +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | | ` pure 'r' +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` def +| | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + ref +| | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` rec +| | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | ` <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | ` pure '=' +| | | | | | | | | | | | ` satisfy +| | | | | | | | | | | ` ref +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | ` ref +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` def +| | | | | | | | | | | ` <|> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + ref +| | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` rec +| | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | ` ref +| | | | | | | | | ` def +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure ';' +| | | | | | | | | | ` satisfy +| | | | | | | | | ` ref +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` ref +| | | | | | | | ` ref +| | | | | | | ` rec +| | | | | | ` pure (\u1 -> u1) +| | | | | ` ref +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` pure '}' +| | | | | ` satisfy +| | | | ` ref +| | | ` rec +| | ` pure (\u1 -> u1) +| ` ref ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G15.expected.txt b/test/Golden/Grammar/ViewGrammar/G15.expected.txt new file mode 100644 index 0000000..f3aba12 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G15.expected.txt @@ -0,0 +1,16 @@ +<*> ++ def name_32 +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'a' +| | | ` satisfy +| | ` rec name_32 +| ` pure (\u1 -> u1) +` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G16.expected.txt b/test/Golden/Grammar/ViewGrammar/G16.expected.txt new file mode 100644 index 0000000..e627081 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G16.expected.txt @@ -0,0 +1,50 @@ +<*> ++ <*> +| + pure cons +| ` def name_47 +| ` try +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'b' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'c' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'd' +| | ` satisfy +| ` pure Term +` <*> + + def name_46 + | ` <|> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) + | | | ` <*> + | | | + pure cons + | | | ` ref name_47 + | | ` rec name_46 + | ` pure (\u1 -> u1) + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G17.expected.txt b/test/Golden/Grammar/ViewGrammar/G17.expected.txt new file mode 100644 index 0000000..bc14d25 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G17.expected.txt @@ -0,0 +1,54 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1)) +| ` <*> +| + <*> +| | + pure cons +| | ` def name_92 +| | ` try +| | ` <*> +| | + <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'a' +| | | ` satisfy +| | ` <*> +| | + <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'b' +| | | ` satisfy +| | ` <*> +| | + <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'c' +| | | ` satisfy +| | ` <*> +| | + <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'd' +| | | ` satisfy +| | ` pure Term +| ` <*> +| + def name_93 +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + pure cons +| | | | ` ref name_92 +| | | ` rec name_93 +| | ` pure (\u1 -> u1) +| ` pure Term +` eof diff --git a/test/Golden/Grammar/ViewGrammar/G18.expected.txt b/test/Golden/Grammar/ViewGrammar/G18.expected.txt new file mode 100644 index 0000000..277a90d --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G18.expected.txt @@ -0,0 +1,35 @@ +<|> ++ <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy +| ` pure Term +` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'a' + | ` satisfy + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G19.expected.txt b/test/Golden/Grammar/ViewGrammar/G19.expected.txt new file mode 100644 index 0000000..76c8c9d --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G19.expected.txt @@ -0,0 +1,37 @@ +<|> ++ try +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy +| ` pure Term +` try + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'a' + | ` satisfy + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G2.expected.txt b/test/Golden/Grammar/ViewGrammar/G2.expected.txt index b988481..5b58cc9 100644 --- a/test/Golden/Grammar/ViewGrammar/G2.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G2.expected.txt @@ -1,9 +1,26 @@ try ` <*> + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : ('b' : ('c' : Term))))) - | | ` def - | | ` satisfy - | ` ref - ` ref + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'a' + | ` satisfy + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'c' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G20.expected.txt b/test/Golden/Grammar/ViewGrammar/G20.expected.txt new file mode 100644 index 0000000..02f4801 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G20.expected.txt @@ -0,0 +1,20 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1)) +| ` <*> +| + def name_214 +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + pure cons +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure 'r' +| | | | ` satisfy +| | | ` rec name_214 +| | ` pure (\u1 -> u1) +| ` pure Term +` eof diff --git a/test/Golden/Grammar/ViewGrammar/G21.expected.txt b/test/Golden/Grammar/ViewGrammar/G21.expected.txt new file mode 100644 index 0000000..37fb719 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G21.expected.txt @@ -0,0 +1 @@ +eof diff --git a/test/Golden/Grammar/ViewGrammar/G22.expected.txt b/test/Golden/Grammar/ViewGrammar/G22.expected.txt new file mode 100644 index 0000000..79525bf --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G22.expected.txt @@ -0,0 +1,11 @@ +<|> ++ <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` pure 'a' +| ` satisfy +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'b' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G23.expected.txt b/test/Golden/Grammar/ViewGrammar/G23.expected.txt new file mode 100644 index 0000000..9314083 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G23.expected.txt @@ -0,0 +1,24 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1)) +| ` <*> +| + def name_244 +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + pure cons +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure 'a' +| | | | ` satisfy +| | | ` rec name_244 +| | ` pure (\u1 -> u1) +| ` pure Term +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'b' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G24.expected.txt b/test/Golden/Grammar/ViewGrammar/G24.expected.txt new file mode 100644 index 0000000..5794e39 --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G24.expected.txt @@ -0,0 +1,16 @@ +<*> ++ <*> +| + pure (\u1 -> (\u2 -> u1)) +| ` <*> +| + def name_266 +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + pure cons +| | | | ` satisfy +| | | ` rec name_266 +| | ` pure (\u1 -> u1) +| ` pure Term +` eof diff --git a/test/Golden/Grammar/ViewGrammar/G25.expected.txt b/test/Golden/Grammar/ViewGrammar/G25.expected.txt new file mode 100644 index 0000000..0bcd98d --- /dev/null +++ b/test/Golden/Grammar/ViewGrammar/G25.expected.txt @@ -0,0 +1,100 @@ +<*> ++ <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` pure (\u1 -> u1) +| ` def name_282 +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` <*> +| | + <*> +| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | ` pure Term +| | ` def name_283 +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | | ` pure (\u1 -> (\u2 -> u1)) +| | | | ` satisfy +| | | ` rec name_283 +| | ` pure (\u1 -> u1) +| ` pure Term +` def name_281 + ` <*> + + def name_280 + | ` <|> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) + | | | ` <*> + | | | + pure cons + | | | ` <*> + | | | + <*> + | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | ` conditional + | | | | + look + | | | | | ` satisfy + | | | | + bs + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | + <*> + | | | | | | + <*> + | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | ` pure Term + | | | | | | ` satisfy + | | | | | ` <*> + | | | | | + <*> + | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | ` <*> + | | | | | | + <*> + | | | | | | | + <*> + | | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | | ` pure (\u1 -> u1) + | | | | | | | ` <*> + | | | | | | | + <*> + | | | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | | | ` satisfy + | | | | | | | ` ref name_282 + | | | | | | ` <*> + | | | | | | + pure Term + | | | | | | ` rec name_281 + | | | | | ` <*> + | | | | | + <*> + | | | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | | | ` pure ']' + | | | | | ` satisfy + | | | | ` empty + | | | ` ref name_282 + | | ` rec name_280 + | ` pure (\u1 -> u1) + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G3.expected.txt b/test/Golden/Grammar/ViewGrammar/G3.expected.txt index 6c86aca..0154489 100644 --- a/test/Golden/Grammar/ViewGrammar/G3.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G3.expected.txt @@ -1,9 +1,16 @@ <*> -+ pure (\u1 -> u1 Term) -` <|> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) - | | ` satisfy - | ` rec - ` pure (\u1 -> u1) ++ def +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'a' +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G4.expected.txt b/test/Golden/Grammar/ViewGrammar/G4.expected.txt index c29ebd7..abeef3c 100644 --- a/test/Golden/Grammar/ViewGrammar/G4.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G4.expected.txt @@ -1,21 +1,50 @@ <*> + <*> -| + pure (\u1 -> (\u2 -> u1 : u2 Term)) -| ` try -| ` <*> -| + <*> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | | | ` def -| | | | ` satisfy -| | | ` ref -| | ` ref -| ` ref -` <|> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) - | | ` ref - | ` rec - ` pure (\u1 -> u1) +| + pure cons +| ` def +| ` try +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'b' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'c' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'd' +| | ` satisfy +| ` pure Term +` <*> + + def + | ` <|> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) + | | | ` <*> + | | | + pure cons + | | | ` ref + | | ` rec + | ` pure (\u1 -> u1) + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G5.expected.txt b/test/Golden/Grammar/ViewGrammar/G5.expected.txt index 2778d27..b6b1666 100644 --- a/test/Golden/Grammar/ViewGrammar/G5.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G5.expected.txt @@ -1,23 +1,54 @@ <*> + <*> -| + <*> -| | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) -| | ` try -| | ` <*> -| | + <*> -| | | + <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | | | | ` def -| | | | | ` satisfy -| | | | ` ref -| | | ` ref -| | ` ref -| ` <|> +| + pure (\u1 -> (\u2 -> u1)) +| ` <*> | + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | | ` ref -| | ` rec -| ` pure (\u1 -> u1) +| | + pure cons +| | ` def +| | ` try +| | ` <*> +| | + <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'a' +| | | ` satisfy +| | ` <*> +| | + <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'b' +| | | ` satisfy +| | ` <*> +| | + <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'c' +| | | ` satisfy +| | ` <*> +| | + <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'd' +| | | ` satisfy +| | ` pure Term +| ` <*> +| + def +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + pure cons +| | | | ` ref +| | | ` rec +| | ` pure (\u1 -> u1) +| ` pure Term ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G6.expected.txt b/test/Golden/Grammar/ViewGrammar/G6.expected.txt index cf67b8a..277a90d 100644 --- a/test/Golden/Grammar/ViewGrammar/G6.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G6.expected.txt @@ -1,12 +1,35 @@ <|> + <*> | + <*> -| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) -| | ` def +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' | | ` satisfy -| ` ref +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy +| ` pure Term ` <*> + <*> - | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | ` ref - ` ref + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'a' + | ` satisfy + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G7.expected.txt b/test/Golden/Grammar/ViewGrammar/G7.expected.txt index 83b71f8..76c8c9d 100644 --- a/test/Golden/Grammar/ViewGrammar/G7.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G7.expected.txt @@ -2,13 +2,36 @@ + try | ` <*> | + <*> -| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) -| | ` def +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' | | ` satisfy -| ` ref +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy +| ` pure Term ` try ` <*> + <*> - | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | ` ref - ` ref + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'a' + | ` satisfy + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G8.expected.txt b/test/Golden/Grammar/ViewGrammar/G8.expected.txt index 390fa44..025f7a8 100644 --- a/test/Golden/Grammar/ViewGrammar/G8.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G8.expected.txt @@ -1,11 +1,20 @@ <*> + <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) +| + pure (\u1 -> (\u2 -> u1)) +| ` <*> +| + def +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | | ` <*> +| | | | + pure cons +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure 'r' +| | | | ` satisfy +| | | ` rec +| | ` pure (\u1 -> u1) +| ` pure Term ` eof diff --git a/test/Golden/Machine.hs b/test/Golden/Machine.hs index 149a375..d5fc55e 100644 --- a/test/Golden/Machine.hs +++ b/test/Golden/Machine.hs @@ -21,6 +21,6 @@ goldens :: TestTree goldens = testGroup "Machine" $ (\f -> List.zipWith f Machine.machines [1::Int ..]) $ \(Machine.M mach) g -> let machineFile = "test/Golden/Machine/G"<>show g<>".expected.txt" in - goldenVsStringDiff machineFile goldenDiff machineFile $ do + goldenVsStringDiff ("G"<>show g) goldenDiff machineFile $ do return $ fromString $ show $ P.viewMachine @'False mach diff --git a/test/Golden/Machine/G11.expected.txt b/test/Golden/Machine/G11.expected.txt index c29c56b..4618809 100644 --- a/test/Golden/Machine/G11.expected.txt +++ b/test/Golden/Machine/G11.expected.txt @@ -1,24 +1,25 @@ pushValue (\u1 -> (\u2 -> u1 Term)) : -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| read ('b' ==) -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| ret -catchException "fail" - - | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | call - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | refJoin - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | pushValue (\u1 -> u1) - | refJoin - - raiseException "fail" +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) +| | read ('a' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +read ('b' ==) +lift2Value (\u1 -> (\u2 -> u1 u2)) +ret diff --git a/test/Golden/Machine/G12.expected.txt b/test/Golden/Machine/G12.expected.txt index e67278c..3e2e572 100644 --- a/test/Golden/Machine/G12.expected.txt +++ b/test/Golden/Machine/G12.expected.txt @@ -1,47 +1,48 @@ pushValue (\u1 -> (\u2 -> u1 Term)) : -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| : -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | ret | catchException "fail" | -| | catchException "fail" -| | -| | | pushInput -| | | read (\u1 -> Term) -| | | popValue -| | | popException "fail" -| | | loadInput -| | | raiseException "fail" -| | -| | loadInput -| | pushValue Term -| | popException "fail" -| | refJoin +| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | read Term +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret | | pushInput | lift2Value Term | choicesBranch [(\u1 -> u1)] | -| | raiseException "fail" +| | pushValue (\u1 -> u1) +| | ret | | raiseException "fail" +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret catchException "fail" - | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) - | read Term - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | call - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | refJoin + | catchException "fail" + | + | | pushInput + | | read (\u1 -> Term) + | | popValue + | | popException "fail" + | | loadInput + | | raiseException "fail" + | + | loadInput + | pushValue Term + | popException "fail" + | refJoin pushInput lift2Value Term choicesBranch [(\u1 -> u1)] - | pushValue (\u1 -> u1) - | refJoin + | raiseException "fail" raiseException "fail" diff --git a/test/Golden/Machine/G13.expected.txt b/test/Golden/Machine/G13.expected.txt index 234dd25..6b8ef1b 100644 --- a/test/Golden/Machine/G13.expected.txt +++ b/test/Golden/Machine/G13.expected.txt @@ -1,92 +1,104 @@ -pushValue (\u1 -> (\u2 -> u2 Term)) +pushValue (\u1 -> (\u2 -> u2)) : +| pushValue (\u1 -> Term) +| : +| | catchException "fail" +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | read Term +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | call +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | popException "fail" +| | | ret +| | +| | pushInput +| | lift2Value Term +| | choicesBranch [(\u1 -> u1)] +| | +| | | pushValue (\u1 -> u1) +| | | ret +| | +| | raiseException "fail" +| call | lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +: +| pushValue (\u1 -> u1 Term) | : -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | ret -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) -| | : -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | call -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | call -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | popException "fail" -| | | refJoin -| | pushInput -| | read ((\u1 -> (\u2 -> u1)) Term) -| | swapValue -| | loadInput -| | choicesBranch [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)] -| | -| | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | refJoin -| | -| | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | refJoin -| | -| | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | refJoin -| | -| | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | refJoin -| | -| | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | refJoin -| | -| | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | refJoin -| | -| | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | call -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | call -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | read (']' ==) -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | refJoin -| | -| | raiseException "fail" -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | refJoin -| -| raiseException "fail" -catchException "fail" - - | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) - | read Term - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | call - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | refJoin - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | pushValue (\u1 -> u1) - | refJoin - - raiseException "fail" +| | catchException "fail" +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) +| | | : +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | popException "fail" +| | | | ret +| | | pushInput +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | swapValue +| | | loadInput +| | | choicesBranch [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)] +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin +| | | +| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | read (']' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin +| | | +| | | raiseException "fail" +| | +| | pushInput +| | lift2Value Term +| | choicesBranch [(\u1 -> u1)] +| | +| | | pushValue (\u1 -> u1) +| | | ret +| | +| | raiseException "fail" +| call +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +ret diff --git a/test/Golden/Machine/G14.expected.txt b/test/Golden/Machine/G14.expected.txt index 2d50a8b..921d9e7 100644 --- a/test/Golden/Machine/G14.expected.txt +++ b/test/Golden/Machine/G14.expected.txt @@ -1,49 +1,132 @@ -pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> u5)))))) +pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) : -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| call -| lift2Value (\u1 -> (\u2 -> u1 u2)) +| pushValue (\u1 -> (\u2 -> (\u3 -> u3))) +| : +| | pushValue Term +| | ret | call | lift2Value (\u1 -> (\u2 -> u1 u2)) | : -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | : -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | ret | | catchException "fail" | | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | : +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | popException "fail" +| | | | ret | | | catchException "fail" | | | -| | | | pushInput -| | | | read (\u1 -> Term) -| | | | popValue +| | | | pushValue (\u1 -> (\u2 -> Term)) +| | | | : +| | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | read Term +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | ret +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | : +| | | | | catchException "fail" +| | | | | +| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | popException "fail" +| | | | | | ret +| | | | | +| | | | | pushInput +| | | | | lift2Value Term +| | | | | choicesBranch [(\u1 -> u1)] +| | | | | +| | | | | | pushValue (\u1 -> u1) +| | | | | | ret +| | | | | +| | | | | raiseException "fail" +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | popException "fail" -| | | | loadInput -| | | | raiseException "fail" +| | | | refJoin | | | -| | | loadInput -| | | pushValue Term -| | | popException "fail" -| | | refJoin +| | | pushInput +| | | lift2Value Term +| | | choicesBranch [(\u1 -> u1)] +| | | +| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) +| | | | catchException "fail" +| | | | +| | | | | pushValue (\u1 -> (\u2 -> '/' : ('/' : Term))) +| | | | | read ('/' ==) +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | read ('/' ==) +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | popException "fail" +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | : +| | | | | | catchException "fail" +| | | | | | +| | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | read Term +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | call +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | popException "fail" +| | | | | | | ret +| | | | | | +| | | | | | pushInput +| | | | | | lift2Value Term +| | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | +| | | | | | | pushValue (\u1 -> u1) +| | | | | | | ret +| | | | | | +| | | | | | raiseException "fail" +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | refJoin +| | | | +| | | | loadInput +| | | | raiseException "fail" +| | | +| | | raiseException "fail" | | | | pushInput | | lift2Value Term | | choicesBranch [(\u1 -> u1)] | | -| | | raiseException "fail" +| | | pushValue (\u1 -> u1) +| | | ret | | | | raiseException "fail" +| call +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| call +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +: | catchException "fail" | -| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> (\u13 -> (\u14 -> (\u15 -> (\u16 -> (\u17 -> (\u18 -> (\u19 -> u18 u19))))))))))))))))))) +| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10)))))))))) | | catchException "fail" | | -| | | pushValue (\u1 -> Term) +| | | pushValue (\u1 -> (\u2 -> u2)) | | | catchException "fail" | | | -| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : Term))))))))))))))) +| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : u9)))))))))))))))) | | | | read ('f' ==) | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | read ('u' ==) @@ -60,681 +143,753 @@ pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> u5)))))) | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | read ('n' ==) | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | : +| | | | | pushValue Term +| | | | | ret +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | popException "fail" | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | : +| | | | | catchException "fail" +| | | | | +| | | | | | pushInput +| | | | | | read Term +| | | | | | popValue +| | | | | | popException "fail" +| | | | | | loadInput +| | | | | | raiseException "fail" +| | | | | +| | | | | loadInput +| | | | | pushValue Term +| | | | | ret +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | popException "fail" +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | : +| | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | catchException "fail" +| | | | | +| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | read Term +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | : +| | | | | | | catchException "fail" +| | | | | | | +| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | read Term +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | popException "fail" +| | | | | | | | ret +| | | | | | | +| | | | | | | pushInput +| | | | | | | lift2Value Term +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | +| | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | ret +| | | | | | | +| | | | | | | raiseException "fail" +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | popException "fail" +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | ret +| | | | | +| | | | | loadInput +| | | | | raiseException "fail" +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | : +| | | | | pushValue (\u1 -> (\u2 -> '(')) +| | | | | read ('(' ==) +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | ret +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | : +| | | | | catchException "fail" +| | | | | +| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) +| | | | | | : +| | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | call +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | : +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | ret +| | | | | | | catchException "fail" +| | | | | | | +| | | | | | | | pushValue (\u1 -> Term) +| | | | | | | | : +| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) +| | | | | | | | | read ('[' ==) +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | : +| | | | | | | | | | read Term +| | | | | | | | | | ret +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | : +| | | | | | | | | | catchException "fail" +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | | | | call +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | call +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | popException "fail" +| | | | | | | | | | | ret +| | | | | | | | | | +| | | | | | | | | | pushInput +| | | | | | | | | | lift2Value Term +| | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | ret +| | | | | | | | | | +| | | | | | | | | | raiseException "fail" +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | read (']' ==) +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | ret +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | popException "fail" +| | | | | | | | refJoin +| | | | | | | +| | | | | | | pushInput +| | | | | | | lift2Value Term +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | +| | | | | | | | call +| | | | | | | | refJoin +| | | | | | | +| | | | | | | raiseException "fail" +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | : +| | | | | | | catchException "fail" +| | | | | | | +| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | : +| | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | ret +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | : +| | | | | | | | | pushValue (\u1 -> (\u2 -> ',')) +| | | | | | | | | read (',' ==) +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | ret +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | call +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | popException "fail" +| | | | | | | | ret +| | | | | | | +| | | | | | | pushInput +| | | | | | | lift2Value Term +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | +| | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | ret +| | | | | | | +| | | | | | | raiseException "fail" +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | popException "fail" +| | | | | | ret +| | | | | +| | | | | pushInput +| | | | | lift2Value Term +| | | | | choicesBranch [(\u1 -> u1)] +| | | | | +| | | | | | jump +| | | | | +| | | | | raiseException "fail" +| | | | call +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | : +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | : +| | | | | | pushValue (\u1 -> (\u2 -> ')')) +| | | | | | read (')' ==) +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | ret +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | : +| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5))))))) +| | | | | | read ('{' ==) +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | : +| | | | | | | catchException "fail" +| | | | | | | +| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | | | | | | : +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | call +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | popException "fail" +| | | | | | | | | ret +| | | | | | | | catchException "fail" +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) +| | | | | | | | | catchException "fail" +| | | | | | | | | +| | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | catchException "fail" +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) +| | | | | | | | | | | read ('i' ==) +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | read ('f' ==) +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | call +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | popException "fail" +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | call +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | popException "fail" +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | call +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | : +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | | | | | | : +| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | ret +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> '0') +| | | | | | | | | | | | | | | read ('0' ==) +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> '1') +| | | | | | | | | | | | | | | read ('1' ==) +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) +| | | | | | | | | | | | | | | read ('\'' ==) +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | read ('\'' ==) +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | ret +| | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | | read Term +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u3))) +| | | | | | | | | | | | | | | | read ('\\' ==) +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | read Term +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | ret +| | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushValue (\u1 -> Term) +| | | | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2))) +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | : +| | | | | | | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | | | | ret +| | | | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | | | | | | | | | ret +| | | | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | +| | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | : +| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) +| | | | | | | | | | | | | | read ('!' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | ret +| | | | | | | | | | | | | +| | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | | | ret +| | | | | | | | | | | | | +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | ret +| | | | | | | | | | | call +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | call +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | : +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | refJoin +| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) +| | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) +| | | | | | | | | | | | | | read ('e' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | read ('l' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | read ('s' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | read ('e' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | +| | | | | | | | | | | | | loadInput +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | loadInput +| | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | +| | | | | | | | | | | pushInput +| | | | | | | | | | | lift2Value Term +| | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | +| | | | | | | | | | | | call +| | | | | | | | | | | | refJoin +| | | | | | | | | | | +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | +| | | | | | | | | | loadInput +| | | | | | | | | | raiseException "fail" +| | | | | | | | | +| | | | | | | | | loadInput +| | | | | | | | | raiseException "fail" +| | | | | | | | +| | | | | | | | pushInput +| | | | | | | | lift2Value Term +| | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | +| | | | | | | | | catchException "fail" +| | | | | | | | | +| | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | | | | catchException "fail" +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) +| | | | | | | | | | | | read ('w' ==) +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | read ('h' ==) +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | read ('i' ==) +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | read ('l' ==) +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | read ('e' ==) +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | call +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | refJoin +| | | | | | | | | | | +| | | | | | | | | | | loadInput +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | +| | | | | | | | | | loadInput +| | | | | | | | | | raiseException "fail" +| | | | | | | | | +| | | | | | | | | pushInput +| | | | | | | | | lift2Value Term +| | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | +| | | | | | | | | | catchException "fail" +| | | | | | | | | | +| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11)))))))))))) +| | | | | | | | | | | | : +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | : +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | ret +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | | | | ret +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | read ('=' ==) +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | : +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | ret +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | | | | ret +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | : +| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> ';')) +| | | | | | | | | | | | | | read (';' ==) +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | call +| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | ret +| | | | | | | | | | | | | call +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | refJoin +| | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> Term)) +| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) +| | | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) +| | | | | | | | | | | | | | | read ('v' ==) +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | read ('a' ==) +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | read ('r' ==) +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | loadInput +| | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | +| | | | | | | | | | | | | loadInput +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | +| | | | | | | | | | | | pushInput +| | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | +| | | | | | | | | | | | | call +| | | | | | | | | | | | | refJoin +| | | | | | | | | | | | +| | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | +| | | | | | | | | | | loadInput +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | +| | | | | | | | | | pushInput +| | | | | | | | | | lift2Value Term +| | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | call +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | call +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | refJoin +| | | | | | | | | | +| | | | | | | | | | raiseException "fail" +| | | | | | | | | +| | | | | | | | | raiseException "fail" +| | | | | | | | +| | | | | | | | raiseException "fail" +| | | | | | | +| | | | | | | pushInput +| | | | | | | lift2Value Term +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | +| | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | ret +| | | | | | | +| | | | | | | raiseException "fail" +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | read ('}' ==) +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | call +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | ret +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | popException "fail" +| | | | | ret | | | | catchException "fail" | | | | -| | | | | pushInput -| | | | | read Term -| | | | | popValue +| | | | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) +| | | | | read (':' ==) +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | call +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | popException "fail" -| | | | | loadInput -| | | | | raiseException "fail" +| | | | | refJoin | | | | -| | | | loadInput -| | | | popException "fail" -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | catchException "fail" -| | | | -| | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | read Term -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | pushInput +| | | | lift2Value Term +| | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | : -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | popException "fail" -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | read ('(' ==) -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | : -| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | : -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | read (')' ==) -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | read ('{' ==) -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | : -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | read ('}' ==) -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | popException "fail" -| | | | | | | | | refJoin -| | | | | | | | catchException "fail" -| | | | | | | | -| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | : -| | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | call -| | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | popException "fail" -| | | | | | | | | | refJoin -| | | | | | | | | catchException "fail" -| | | | | | | | | -| | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> u8)))))))) -| | | | | | | | | | catchException "fail" -| | | | | | | | | | -| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | catchException "fail" -| | | | | | | | | | | -| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) -| | | | | | | | | | | | read ('i' ==) -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | read ('f' ==) -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | : -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | : -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) -| | | | | | | | | | | | | | | | | read ('e' ==) -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | read ('l' ==) -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | read ('s' ==) -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | read ('e' ==) -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) -| | | | | | | | | | | | | | read ('!' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | -| | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | : -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> '0') -| | | | | | | | | | | | | | read ('0' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | -| | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> '1') -| | | | | | | | | | | | | | read ('1' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | pushInput -| | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | -| | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) -| | | | | | | | | | | | | | read ('\'' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | read ('\'' ==) -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | read Term -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u3))) -| | | | | | | | | | | | | | | read ('\\' ==) -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | read Term -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> Term) -| | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2))) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | -| | | | | | | | | | | loadInput -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | -| | | | | | | | | | loadInput -| | | | | | | | | | raiseException "fail" -| | | | | | | | | -| | | | | | | | | pushInput -| | | | | | | | | lift2Value Term -| | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | -| | | | | | | | | | catchException "fail" -| | | | | | | | | | -| | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | catchException "fail" -| | | | | | | | | | | -| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) -| | | | | | | | | | | | | read ('w' ==) -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | read ('h' ==) -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | read ('i' ==) -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | read ('l' ==) -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | read ('e' ==) -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | refJoin -| | | | | | | | | | | | -| | | | | | | | | | | | loadInput -| | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | -| | | | | | | | | | | loadInput -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | -| | | | | | | | | | pushInput -| | | | | | | | | | lift2Value Term -| | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | -| | | | | | | | | | | catchException "fail" -| | | | | | | | | | | -| | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> (\u13 -> u11))))))))))))) -| | | | | | | | | | | | | : -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | read ('=' ==) -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | read (';' ==) -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> Term)) -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) -| | | | | | | | | | | | | | | | read ('v' ==) -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | read ('a' ==) -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | read ('r' ==) -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | loadInput -| | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | -| | | | | | | | | | | pushInput -| | | | | | | | | | | lift2Value Term -| | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | -| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | refJoin -| | | | | | | | | | | -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | -| | | | | | | | | | raiseException "fail" -| | | | | | | | | -| | | | | | | | | raiseException "fail" -| | | | | | | | -| | | | | | | | pushInput -| | | | | | | | lift2Value Term -| | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | -| | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | refJoin -| | | | | | | | -| | | | | | | | raiseException "fail" -| | | | | | | catchException "fail" -| | | | | | | -| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | read (':' ==) -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | popException "fail" -| | | | | | | | refJoin -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift2Value Term -| | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | -| | | | | | | | call -| | | | | | | | refJoin -| | | | | | | -| | | | | | | raiseException "fail" -| | | | | | catchException "fail" -| | | | | | -| | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> Term))))) -| | | | | | | call -| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | : -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | : -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | popException "fail" -| | | | | | | | | refJoin -| | | | | | | | catchException "fail" -| | | | | | | | -| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) -| | | | | | | | | read (',' ==) -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | popException "fail" -| | | | | | | | | refJoin -| | | | | | | | -| | | | | | | | pushInput -| | | | | | | | lift2Value Term -| | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | -| | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | refJoin -| | | | | | | | -| | | | | | | | raiseException "fail" -| | | | | | | catchException "fail" -| | | | | | | -| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) -| | | | | | | | read ('[' ==) -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | read Term -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | : -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | read (']' ==) -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | popException "fail" -| | | | | | | | | refJoin -| | | | | | | | catchException "fail" -| | | | | | | | -| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | popException "fail" -| | | | | | | | | refJoin -| | | | | | | | -| | | | | | | | pushInput -| | | | | | | | lift2Value Term -| | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | -| | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | refJoin -| | | | | | | | -| | | | | | | | raiseException "fail" -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift2Value Term -| | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | -| | | | | | | | call -| | | | | | | | refJoin -| | | | | | | -| | | | | | | raiseException "fail" -| | | | | | -| | | | | | pushInput -| | | | | | lift2Value Term -| | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | -| | | | | | | call -| | | | | | | refJoin -| | | | | | -| | | | | | raiseException "fail" -| | | | | catchException "fail" -| | | | | -| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | read Term -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | popException "fail" -| | | | | | refJoin -| | | | | -| | | | | pushInput -| | | | | lift2Value Term -| | | | | choicesBranch [(\u1 -> u1)] -| | | | | -| | | | | | pushValue (\u1 -> u1) -| | | | | | refJoin -| | | | | -| | | | | raiseException "fail" -| | | | -| | | | loadInput +| | | | | refJoin +| | | | | | | | raiseException "fail" | | | | | | loadInput @@ -748,100 +903,36 @@ pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> u5)))))) | choicesBranch [(\u1 -> u1)] | | | pushValue (\u1 -> u1) -| | refJoin +| | ret | | raiseException "fail" +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret catchException "fail" - | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) - | : - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | call - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | popException "fail" - | | refJoin | catchException "fail" | - | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) - | | read Term - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | call - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | : - | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | popException "fail" - | | | refJoin - | | catchException "fail" - | | - | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) - | | | call - | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | call - | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | popException "fail" - | | | refJoin - | | - | | pushInput - | | lift2Value Term - | | choicesBranch [(\u1 -> u1)] - | | - | | | pushValue (\u1 -> u1) - | | | refJoin - | | - | | raiseException "fail" + | | pushInput + | | read (\u1 -> Term) + | | popValue + | | popException "fail" + | | loadInput + | | raiseException "fail" | - | pushInput - | lift2Value Term - | choicesBranch [(\u1 -> u1)] - | - | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) - | | catchException "fail" - | | - | | | pushValue (\u1 -> (\u2 -> '/' : ('/' : Term))) - | | | read ('/' ==) - | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | read ('/' ==) - | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | popException "fail" - | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | call - | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | : - | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | | call - | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | | call - | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | | refJoin - | | | catchException "fail" - | | | - | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) - | | | | read Term - | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | | call - | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | | popException "fail" - | | | | refJoin - | | | - | | | pushInput - | | | lift2Value Term - | | | choicesBranch [(\u1 -> u1)] - | | | - | | | | pushValue (\u1 -> u1) - | | | | refJoin - | | | - | | | raiseException "fail" - | | - | | loadInput - | | raiseException "fail" - | - | raiseException "fail" + | loadInput + | pushValue Term + | popException "fail" + | refJoin pushInput lift2Value Term choicesBranch [(\u1 -> u1)] - | pushValue (\u1 -> u1) - | refJoin + | raiseException "fail" raiseException "fail" diff --git a/test/Golden/Machine/G15.expected.txt b/test/Golden/Machine/G15.expected.txt new file mode 100644 index 0000000..f215fc0 --- /dev/null +++ b/test/Golden/Machine/G15.expected.txt @@ -0,0 +1,23 @@ +pushValue (\u1 -> u1 Term) +name_770: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) +| | read ('a' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call name_770 +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call name_770 +lift2Value (\u1 -> (\u2 -> u1 u2)) +ret diff --git a/test/Golden/Machine/G16.expected.txt b/test/Golden/Machine/G16.expected.txt new file mode 100644 index 0000000..5551214 --- /dev/null +++ b/test/Golden/Machine/G16.expected.txt @@ -0,0 +1,42 @@ +pushValue (\u1 -> (\u2 -> u1 : u2 Term)) +name_785: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | read ('a' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('b' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('c' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('d' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| loadInput +| raiseException "fail" +call name_785 +lift2Value (\u1 -> (\u2 -> u1 u2)) +name_784: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | call name_785 +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call name_784 +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call name_784 +lift2Value (\u1 -> (\u2 -> u1 u2)) +ret diff --git a/test/Golden/Machine/G17.expected.txt b/test/Golden/Machine/G17.expected.txt new file mode 100644 index 0000000..d396465 --- /dev/null +++ b/test/Golden/Machine/G17.expected.txt @@ -0,0 +1,67 @@ +pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) +name_830: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | read ('a' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('b' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('c' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('d' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| loadInput +| raiseException "fail" +call name_830 +lift2Value (\u1 -> (\u2 -> u1 u2)) +name_831: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | call name_830 +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call name_831 +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call name_831 +lift2Value (\u1 -> (\u2 -> u1 u2)) +join_879: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +catchException "fail" + + | catchException "fail" + | + | | pushInput + | | read (\u1 -> Term) + | | popValue + | | popException "fail" + | | loadInput + | | raiseException "fail" + | + | loadInput + | pushValue Term + | popException "fail" + | refJoin join_879 + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | raiseException "fail" + + raiseException "fail" diff --git a/test/Golden/Machine/G18.expected.txt b/test/Golden/Machine/G18.expected.txt new file mode 100644 index 0000000..eac5644 --- /dev/null +++ b/test/Golden/Machine/G18.expected.txt @@ -0,0 +1,22 @@ +catchException "fail" + + | pushValue (\u1 -> (\u2 -> 'a' : ('a' : Term))) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | ret + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | read ('b' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | ret + + raiseException "fail" diff --git a/test/Golden/Machine/G19.expected.txt b/test/Golden/Machine/G19.expected.txt new file mode 100644 index 0000000..abe13b0 --- /dev/null +++ b/test/Golden/Machine/G19.expected.txt @@ -0,0 +1,34 @@ +catchException "fail" + + | catchException "fail" + | + | | pushValue (\u1 -> (\u2 -> 'a' : ('a' : Term))) + | | read ('a' ==) + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | read ('a' ==) + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | popException "fail" + | | popException "fail" + | | ret + | + | loadInput + | raiseException "fail" + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | catchException "fail" + | + | | pushValue (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | | read ('a' ==) + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | read ('b' ==) + | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | popException "fail" + | | ret + | + | loadInput + | raiseException "fail" + + raiseException "fail" diff --git a/test/Golden/Machine/G20.expected.txt b/test/Golden/Machine/G20.expected.txt new file mode 100644 index 0000000..42e1f06 --- /dev/null +++ b/test/Golden/Machine/G20.expected.txt @@ -0,0 +1,48 @@ +pushValue (\u1 -> (\u2 -> u1 Term)) +name_953: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) +| | read ('r' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call name_953 +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call name_953 +lift2Value (\u1 -> (\u2 -> u1 u2)) +join_879: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +catchException "fail" + + | catchException "fail" + | + | | pushInput + | | read (\u1 -> Term) + | | popValue + | | popException "fail" + | | loadInput + | | raiseException "fail" + | + | loadInput + | pushValue Term + | popException "fail" + | refJoin join_879 + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | raiseException "fail" + + raiseException "fail" diff --git a/test/Golden/Machine/G21.expected.txt b/test/Golden/Machine/G21.expected.txt new file mode 100644 index 0000000..be75595 --- /dev/null +++ b/test/Golden/Machine/G21.expected.txt @@ -0,0 +1,23 @@ +catchException "fail" + + | catchException "fail" + | + | | pushInput + | | read (\u1 -> Term) + | | popValue + | | popException "fail" + | | loadInput + | | raiseException "fail" + | + | loadInput + | pushValue Term + | popException "fail" + | ret + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | raiseException "fail" + + raiseException "fail" diff --git a/test/Golden/Machine/G22.expected.txt b/test/Golden/Machine/G22.expected.txt new file mode 100644 index 0000000..fc64d34 --- /dev/null +++ b/test/Golden/Machine/G22.expected.txt @@ -0,0 +1,18 @@ +catchException "fail" + + | pushValue (\u1 -> 'a') + | read ('a' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | popException "fail" + | ret + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | pushValue (\u1 -> 'b') + | read ('b' ==) + | lift2Value (\u1 -> (\u2 -> u1 u2)) + | ret + + raiseException "fail" diff --git a/test/Golden/Machine/G23.expected.txt b/test/Golden/Machine/G23.expected.txt new file mode 100644 index 0000000..134ded7 --- /dev/null +++ b/test/Golden/Machine/G23.expected.txt @@ -0,0 +1,25 @@ +pushValue (\u1 -> (\u2 -> u1 Term)) +name_983: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) +| | read ('a' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call name_983 +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call name_983 +lift2Value (\u1 -> (\u2 -> u1 u2)) +read ('b' ==) +lift2Value (\u1 -> (\u2 -> u1 u2)) +ret diff --git a/test/Golden/Machine/G24.expected.txt b/test/Golden/Machine/G24.expected.txt new file mode 100644 index 0000000..d167b18 --- /dev/null +++ b/test/Golden/Machine/G24.expected.txt @@ -0,0 +1,48 @@ +pushValue (\u1 -> (\u2 -> u1 Term)) +name_1005: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | read Term +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call name_1005 +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call name_1005 +lift2Value (\u1 -> (\u2 -> u1 u2)) +join_879: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +catchException "fail" + + | catchException "fail" + | + | | pushInput + | | read (\u1 -> Term) + | | popValue + | | popException "fail" + | | loadInput + | | raiseException "fail" + | + | loadInput + | pushValue Term + | popException "fail" + | refJoin join_879 + + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | raiseException "fail" + + raiseException "fail" diff --git a/test/Golden/Machine/G25.expected.txt b/test/Golden/Machine/G25.expected.txt new file mode 100644 index 0000000..9ee1494 --- /dev/null +++ b/test/Golden/Machine/G25.expected.txt @@ -0,0 +1,104 @@ +pushValue (\u1 -> (\u2 -> u2)) +name_1021: +| pushValue (\u1 -> Term) +| name_1022: +| | catchException "fail" +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | read Term +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | call name_1022 +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | popException "fail" +| | | ret +| | +| | pushInput +| | lift2Value Term +| | choicesBranch [(\u1 -> u1)] +| | +| | | pushValue (\u1 -> u1) +| | | ret +| | +| | raiseException "fail" +| call name_1022 +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +call name_1021 +lift2Value (\u1 -> (\u2 -> u1 u2)) +name_1020: +| pushValue (\u1 -> u1 Term) +| name_1019: +| | catchException "fail" +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) +| | | join_879: +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call name_1021 +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call name_1019 +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | popException "fail" +| | | | ret +| | | pushInput +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | swapValue +| | | loadInput +| | | choicesBranch [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)] +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin join_879 +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin join_879 +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin join_879 +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin join_879 +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin join_879 +| | | +| | | | pushValue (\u1 -> (\u2 -> cons Term)) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin join_879 +| | | +| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) +| | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call name_1021 +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | call name_1020 +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | read (']' ==) +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | refJoin join_879 +| | | +| | | raiseException "fail" +| | +| | pushInput +| | lift2Value Term +| | choicesBranch [(\u1 -> u1)] +| | +| | | pushValue (\u1 -> u1) +| | | ret +| | +| | raiseException "fail" +| call name_1019 +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret +call name_1020 +lift2Value (\u1 -> (\u2 -> u1 u2)) +ret diff --git a/test/Golden/Machine/G3.expected.txt b/test/Golden/Machine/G3.expected.txt index 74e2e11..eec290a 100644 --- a/test/Golden/Machine/G3.expected.txt +++ b/test/Golden/Machine/G3.expected.txt @@ -1,22 +1,23 @@ pushValue (\u1 -> u1 Term) : -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| ret -catchException "fail" - - | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | call - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | refJoin - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | pushValue (\u1 -> u1) - | refJoin - - raiseException "fail" +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) +| | read ('a' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +ret diff --git a/test/Golden/Machine/G4.expected.txt b/test/Golden/Machine/G4.expected.txt index 9553d9f..911b2b9 100644 --- a/test/Golden/Machine/G4.expected.txt +++ b/test/Golden/Machine/G4.expected.txt @@ -1,38 +1,42 @@ pushValue (\u1 -> (\u2 -> u1 : u2 Term)) -catchException "fail" - - | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('b' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('c' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('d' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | : - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | ret - | catchException "fail" - | - | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) - | | call - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | call - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | popException "fail" - | | refJoin - | - | pushInput - | lift2Value Term - | choicesBranch [(\u1 -> u1)] - | - | | pushValue (\u1 -> u1) - | | refJoin - | - | raiseException "fail" - - loadInput - raiseException "fail" +: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | read ('a' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('b' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('c' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('d' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| loadInput +| raiseException "fail" +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | call +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +ret diff --git a/test/Golden/Machine/G5.expected.txt b/test/Golden/Machine/G5.expected.txt index 3b59cd8..714a023 100644 --- a/test/Golden/Machine/G5.expected.txt +++ b/test/Golden/Machine/G5.expected.txt @@ -1,63 +1,67 @@ pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) +: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | read ('a' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('b' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('c' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | read ('d' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| loadInput +| raiseException "fail" +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +: +| catchException "fail" +| +| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | call +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret +| +| pushInput +| lift2Value Term +| choicesBranch [(\u1 -> u1)] +| +| | pushValue (\u1 -> u1) +| | ret +| +| raiseException "fail" +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret catchException "fail" - | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('b' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('c' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('d' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | : - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | : - | | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | | ret - | | catchException "fail" - | | - | | | catchException "fail" - | | | - | | | | pushInput - | | | | read (\u1 -> Term) - | | | | popValue - | | | | popException "fail" - | | | | loadInput - | | | | raiseException "fail" - | | | - | | | loadInput - | | | pushValue Term - | | | popException "fail" - | | | refJoin - | | - | | pushInput - | | lift2Value Term - | | choicesBranch [(\u1 -> u1)] - | | - | | | raiseException "fail" - | | - | | raiseException "fail" | catchException "fail" | - | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) - | | call - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | call - | | lift2Value (\u1 -> (\u2 -> u1 u2)) + | | pushInput + | | read (\u1 -> Term) + | | popValue | | popException "fail" - | | refJoin + | | loadInput + | | raiseException "fail" | - | pushInput - | lift2Value Term - | choicesBranch [(\u1 -> u1)] - | - | | pushValue (\u1 -> u1) - | | refJoin - | - | raiseException "fail" + | loadInput + | pushValue Term + | popException "fail" + | refJoin - loadInput - raiseException "fail" + pushInput + lift2Value Term + choicesBranch [(\u1 -> u1)] + + | raiseException "fail" + + raiseException "fail" diff --git a/test/Golden/Machine/G8.expected.txt b/test/Golden/Machine/G8.expected.txt index 9e989e2..499c666 100644 --- a/test/Golden/Machine/G8.expected.txt +++ b/test/Golden/Machine/G8.expected.txt @@ -1,47 +1,48 @@ pushValue (\u1 -> (\u2 -> u1 Term)) : -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| : -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | ret | catchException "fail" | -| | catchException "fail" -| | -| | | pushInput -| | | read (\u1 -> Term) -| | | popValue -| | | popException "fail" -| | | loadInput -| | | raiseException "fail" -| | -| | loadInput -| | pushValue Term -| | popException "fail" -| | refJoin +| | pushValue (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) +| | read ('r' ==) +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | call +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | popException "fail" +| | ret | | pushInput | lift2Value Term | choicesBranch [(\u1 -> u1)] | -| | raiseException "fail" +| | pushValue (\u1 -> u1) +| | ret | | raiseException "fail" +call +lift2Value (\u1 -> (\u2 -> u1 u2)) +: +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| ret catchException "fail" - | pushValue (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) - | read ('r' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | call - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | refJoin + | catchException "fail" + | + | | pushInput + | | read (\u1 -> Term) + | | popValue + | | popException "fail" + | | loadInput + | | raiseException "fail" + | + | loadInput + | pushValue Term + | popException "fail" + | refJoin pushInput lift2Value Term choicesBranch [(\u1 -> u1)] - | pushValue (\u1 -> u1) - | refJoin + | raiseException "fail" raiseException "fail" diff --git a/test/Golden/Parser.hs b/test/Golden/Parser.hs index d2f8681..43ac71b 100644 --- a/test/Golden/Parser.hs +++ b/test/Golden/Parser.hs @@ -16,7 +16,7 @@ import Test.Tasty import Test.Tasty.Golden import Text.Show (Show(..)) import System.IO.Unsafe (unsafePerformIO) -import System.FilePath ((<.>), (), dropExtensions) +import System.FilePath ((<.>), (), dropExtensions, takeBaseName) import qualified Data.List as List import qualified System.IO.Error as IO import qualified System.Directory as IO @@ -42,7 +42,7 @@ goldens = testGroup "Parser" $ else IO.throwIO exn ) in testGroup ("G"<>show g) $ (<$> inputs) $ \inp -> - goldenVsStringDiff inp goldenDiff + goldenVsStringDiff (takeBaseName (dropExtensions inp)) goldenDiff (dropExtensions inp<.>"expected.txt") $ do input <- readFile inp return $ fromString $ diff --git a/test/Golden/Splice.hs b/test/Golden/Splice.hs index 5b081c0..4e29ac4 100644 --- a/test/Golden/Splice.hs +++ b/test/Golden/Splice.hs @@ -1,16 +1,14 @@ module Golden.Splice where -import Control.Monad (Monad(..)) -import Data.Int (Int) import Data.Function (($)) import Data.Functor ((<$>)) +import Data.Int (Int) import Data.Semigroup (Semigroup(..)) -import Text.Show (Show(..)) -import System.FilePath ((), (<.>)) +import System.FilePath ((), (<.>), (-<.>)) import System.IO (writeFile) -import System.Directory (removeFile) -import qualified Data.List as List import Test.Tasty +import Text.Show (Show(..)) +import qualified Data.List as List import Build_symantic_parser import Golden.Splice.Utils @@ -21,15 +19,16 @@ goldens = testGroup "Splice" $ (<$> [1::Int .. List.length Grammar.grammars]) $ \g -> let spliceFile = "test/Golden/Splice/""G"<>show g<.>"hs" in withResource - (do - writeFile (rootDirspliceFile) $ List.unlines - [ "module Splice where" - , "import Data.Text (Text)" - , "import qualified Symantic.Parser as P" - , "import qualified Grammar" - , "" - , "splice = $$(P.runParser @Text Grammar.g"<>show g<>")" - ] - return (rootDirspliceFile)) - removeFile + (writeFile (rootDirspliceFile) $ List.unlines + [ "module Splice where" + , "import Data.Text (Text)" + , "import qualified Symantic.Parser as P" + , "import qualified Grammar" + , "" + , "splice = $$(P.runParser @Text Grammar.g"<>show g<>")" + ]) + (\() -> do + rmFile (rootDirspliceFile) + rmFile (rootDirspliceFile-<.>"hi") + rmFile (rootDirspliceFile-<.>"o")) (\_io -> testSplice spliceFile) diff --git a/test/Golden/Splice/G10.expected.txt b/test/Golden/Splice/G10.expected.txt index df17a7a..e759055 100644 --- a/test/Golden/Splice/G10.expected.txt +++ b/test/Golden/Splice/G10.expected.txt @@ -24,7 +24,7 @@ test/Golden/Splice/G10.hs:0:0:: Splicing expression else Nothing, P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = ("catchException lbl=" <> "fail") in + let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp diff --git a/test/Golden/Splice/G11.expected.txt b/test/Golden/Splice/G11.expected.txt index afbb732..7747a10 100644 --- a/test/Golden/Splice/G11.expected.txt +++ b/test/Golden/Splice/G11.expected.txt @@ -27,7 +27,7 @@ test/Golden/Splice/G11.hs:0:0:: Splicing expression let name = \ !ok !inp !koByLabel - -> let _ = ("catchException lbl=" <> "fail") in + -> let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp @@ -82,7 +82,9 @@ test/Golden/Splice/G11.hs:0:0:: Splicing expression v)) inp)) cs) - Data.Map.Internal.Tip + (((((Data.Map.Internal.Bin 1) "fail") readFail) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) else let _ = "checkToken.else" in let diff --git a/test/Golden/Splice/G12.expected.txt b/test/Golden/Splice/G12.expected.txt index e6503a2..5338d87 100644 --- a/test/Golden/Splice/G12.expected.txt +++ b/test/Golden/Splice/G12.expected.txt @@ -27,7 +27,7 @@ test/Golden/Splice/G12.hs:0:0:: Splicing expression let name = \ !ok !inp !koByLabel - -> let _ = ("catchException lbl=" <> "fail") in + -> let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp @@ -85,7 +85,9 @@ test/Golden/Splice/G12.hs:0:0:: Splicing expression v)) inp)) cs) - Data.Map.Internal.Tip + (((((Data.Map.Internal.Bin 1) "fail") readFail) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) else let _ = "checkToken.else" in let @@ -124,8 +126,8 @@ test/Golden/Splice/G12.hs:0:0:: Splicing expression (((\ x -> \ x -> x x) (\ x -> \ x -> x [])) v)) v)) inp in - let _ = ("catchException lbl=" <> "fail") in - let _ = ("catchException lbl=" <> "fail") in + let _ = "catchException lbl=fail" in + let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp diff --git a/test/Golden/Splice/G13.expected.txt b/test/Golden/Splice/G13.expected.txt index 5a190f0..98bb7a1 100644 --- a/test/Golden/Splice/G13.expected.txt +++ b/test/Golden/Splice/G13.expected.txt @@ -1,14 +1,1245 @@ - -test/Golden/Splice/G13.hs:0:0: error: - • Exception when trying to run compile-time code: - Map.!: given key is not an element in the map -CallStack (from HasCallStack): - error, called at libraries/containers/containers/src/Data/Map/Internal.hs:0:0 in containers-0.6.4.1:Data.Map.Internal - Code: (P.runParser @Text Grammar.g13) - • In the Template Haskell splice $$(P.runParser @Text Grammar.g13) - In the expression: $$(P.runParser @Text Grammar.g13) - In an equation for ‘splice’: - splice = $$(P.runParser @Text Grammar.g13) - | -6 | splice = $$(P.runParser @Text Grammar.g13) - | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +test/Golden/Splice/G13.hs:0:0:: Splicing expression + P.runParser @Text Grammar.g13 + ======> + \ (input :: inp) + -> let + !(# init, readMore, readNext #) + = let _ = "cursorOf" in + let + next t@(Data.Text.Internal.Text arr off unconsumed) + = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 + in + (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) + more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) + in (# input, more, next #) in + let finalRet = \ _farInp _farExp v _inp -> Right v in + let + finalRaise :: forall b. P.Catcher inp b + = \ _failInp !farInp !farExp + -> Left + P.ParsingErrorStandard + {P.parsingErrorOffset = P.offset farInp, + P.parsingErrorUnexpected = if readMore farInp then + Just (let (# c, _ #) = readNext farInp in c) + else + Nothing, + P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in + let + name + = \ !ok !inp !koByLabel + -> let + name + = \ !ok !inp !koByLabel + -> let _ = "catchException lbl=fail" in + let + readFail + = \ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault + finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if (\ c + -> not + (('<' == c) + || + (('>' == c) + || + (('+' == c) + || + (('-' == c) + || + (('[' == c) + || + ((']' == c) + || + ((',' == c) + || + (('.' == c) + || + (('$' + == c) + || + False)))))))))) + c then + let + _ = "call exceptionsByName(name_4)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList []),(name_4,fromList [])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) + (\ x -> \ x -> \ x -> x x)) + c)) + v)) + inp)) + cs) + (((((Data.Map.Internal.Bin 1) "fail") readFail) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) init) + inp + of + LT + -> (# inp, + [P.ErrorItemToken '<', + P.ErrorItemToken '>', + P.ErrorItemToken '+', + P.ErrorItemToken '-', + P.ErrorItemToken '[', + P.ErrorItemToken ']', + P.ErrorItemToken ',', + P.ErrorItemToken '.', + P.ErrorItemToken '$'] #) + EQ + -> (# init, + ([] + <> + [P.ErrorItemToken '<', + P.ErrorItemToken '>', + P.ErrorItemToken '+', + P.ErrorItemToken '-', + P.ErrorItemToken '[', + P.ErrorItemToken ']', + P.ErrorItemToken ',', + P.ErrorItemToken '.', + P.ErrorItemToken '$']) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case ((compare `Data.Function.on` P.offset) init) inp of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) + GT -> (# init, [] #) + in ((readFail inp) farInp) farExp in + let + _ = "call exceptionsByName(name_4)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList []),(name_4,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in ((\ x -> \ x -> x x) (\ x -> ())) v)) + inp)) + inp) + Data.Map.Internal.Tip in + let + _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=[]" + in + ((name + (let _ = "suspend raiseException=fromList [(name_1,fromList [])]" + in + \ farInp farExp v !inp + -> let + name + = \ !ok !inp !koByLabel + -> let + name + = \ !ok !inp !koByLabel + -> let _ = "catchException lbl=fail" in + let + join + = \ farInp farExp v !inp + -> let + _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList [])]" + in + \ farInp farExp v !inp + -> let + _ = "call exceptionsByName(name_3)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList [])]" + in + \ farInp + farExp + v + !inp + -> let _ = "resume" + in + (((ok farInp) + farExp) + (let + _ = "resume.genCode" + in + ((\ x + -> \ x + -> x x) + (((\ x + -> \ x + -> x x) + (((\ x + -> \ x + -> x x) + (\ x + -> \ x + -> \ x + -> \ x + -> (x x) + (x x))) + v)) + v)) + v)) + inp)) + inp) + (((((Data.Map.Internal.Bin + 1) + "fail") + (\ !failInp + !farInp + !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ + i + _) + (Data.Text.Internal.Text _ + j + _) + -> (i == + j)) + inp) + failInp) then + let + _ = "resume" + in + (((ok + farInp) + farExp) + (let + _ = "resume.genCode" + in + \ x + -> x)) + failInp + else + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + failInp + of + LT + -> (# failInp, + [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault + finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp)) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip))) + inp) + (((((Data.Map.Internal.Bin 1) "fail") + (\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ + i + _) + (Data.Text.Internal.Text _ + j + _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) + (let + _ = "resume.genCode" + in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + failInp + of + LT + -> (# failInp, + [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault + finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp)) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) in + let + readFail + = \ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ i _) + (Data.Text.Internal.Text _ j _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ + -> (# farInp, + (farExp <> []) #) + GT -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault + finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp + in + if readMore inp then + let !(# c, cs #) = readNext inp + in + if ((\ x -> \ x -> x) True) c then + if ('>' == c) then + let readFail = readFail + in + if readMore + ((P.shiftRightText 666) + inp) then + let !(# c, cs #) = readNext inp + in + if ((\ x -> \ x -> x) True) + c then + let _ = "resume" + in + (((join farInp) farExp) + (let + _ = "resume.genCode" + in + ((\ x + -> \ x -> x x) + (\ x + -> \ x + -> (Grammar.Brainfuck.RightPointer + :))) + c)) + cs + else + let + _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT -> (# inp, [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + ((readFail inp) farInp) + farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [P.ErrorItemHorizon + 667] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemHorizon + 667]) #) + GT + -> (# farInp, farExp #) + in ((readFail inp) farInp) farExp + else + if ('<' == c) then + let readFail = readFail + in + if readMore + ((P.shiftRightText 666) + inp) then + let + !(# c, cs #) = readNext inp + in + if ((\ x -> \ x -> x) True) + c then + let _ = "resume" + in + (((join farInp) + farExp) + (let + _ = "resume.genCode" + in + ((\ x + -> \ x + -> x x) + (\ x + -> \ x + -> (Grammar.Brainfuck.LeftPointer + :))) + c)) + cs + else + let + _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + ((readFail inp) + farInp) + farExp + else + let + _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [P.ErrorItemHorizon + 667] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemHorizon + 667]) #) + GT + -> (# farInp, + farExp #) + in + ((readFail inp) farInp) + farExp + else + if ('+' == c) then + let readFail = readFail + in + if readMore + ((P.shiftRightText 666) + inp) then + let + !(# c, cs #) + = readNext inp + in + if ((\ x -> \ x -> x) + True) + c then + let _ = "resume" + in + (((join farInp) + farExp) + (let + _ = "resume.genCode" + in + ((\ x + -> \ x + -> x x) + (\ x + -> \ x + -> (Grammar.Brainfuck.Increment + :))) + c)) + cs + else + let + _ = "checkToken.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + ((readFail inp) + farInp) + farExp + else + let + _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [P.ErrorItemHorizon + 667] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemHorizon + 667]) #) + GT + -> (# farInp, + farExp #) + in + ((readFail inp) farInp) + farExp + else + if ('-' == c) then + let readFail = readFail + in + if readMore + ((P.shiftRightText + 666) + inp) then + let + !(# c, cs #) + = readNext inp + in + if ((\ x + -> \ x -> x) + True) + c then + let + _ = "resume" + in + (((join + farInp) + farExp) + (let + _ = "resume.genCode" + in + ((\ x + -> \ x + -> x x) + (\ x + -> \ x + -> (Grammar.Brainfuck.Decrement + :))) + c)) + cs + else + let + _ = "checkToken.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + ((readFail + inp) + farInp) + farExp + else + let + _ = "checkHorizon.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [P.ErrorItemHorizon + 667] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemHorizon + 667]) #) + GT + -> (# farInp, + farExp #) + in + ((readFail inp) + farInp) + farExp + else + if ('.' == c) then + let readFail = readFail + in + if readMore + ((P.shiftRightText + 666) + inp) then + let + !(# c, cs #) + = readNext + inp + in + if ((\ x + -> \ x + -> x) + True) + c then + let + _ = "resume" + in + (((join + farInp) + farExp) + (let + _ = "resume.genCode" + in + ((\ x + -> \ x + -> x x) + (\ x + -> \ x + -> (Grammar.Brainfuck.Output + :))) + c)) + cs + else + let + _ = "checkToken.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + ((readFail + inp) + farInp) + farExp + else + let + _ = "checkHorizon.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [P.ErrorItemHorizon + 667] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemHorizon + 667]) #) + GT + -> (# farInp, + farExp #) + in + ((readFail inp) + farInp) + farExp + else + if (',' == c) then + let + readFail + = readFail + in + if readMore + ((P.shiftRightText + 666) + inp) then + let + !(# c, + cs #) + = readNext + inp + in + if ((\ x + -> \ x + -> x) + True) + c then + let + _ = "resume" + in + (((join + farInp) + farExp) + (let + _ = "resume.genCode" + in + ((\ x + -> \ x + -> x x) + (\ x + -> \ x + -> (Grammar.Brainfuck.Input + :))) + c)) + cs + else + let + _ = "checkToken.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + ((readFail + inp) + farInp) + farExp + else + let + _ = "checkHorizon.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [P.ErrorItemHorizon + 667] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemHorizon + 667]) #) + GT + -> (# farInp, + farExp #) + in + ((readFail + inp) + farInp) + farExp + else + if ('[' == c) then + let + readFail + = readFail + in + if readMore + ((P.shiftRightText + 666) + inp) then + let + !(# c, + cs #) + = readNext + inp + in + if ((\ x + -> \ x + -> x) + True) + c then + let + _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList []),(join_46,fromList [])]" + in + \ farInp + farExp + v + !inp + -> let + _ = "call exceptionsByName(name_2)=[] catchStackByLabel(ctx)=["fail"]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList []),(join_46,fromList [])]" + in + \ farInp + farExp + v + !inp + -> let + readFail + = readFail + in + if readMore + ((P.shiftRightText + 666) + inp) then + let + !(# c, + cs #) + = readNext + inp + in + if (']' + ==) + c then + let + _ = "resume" + in + (((join + farInp) + farExp) + (let + _ = "resume.genCode" + in + ((\ x + -> \ x + -> x x) + (((\ x + -> \ x + -> x x) + (((\ x + -> \ x + -> x x) + (((\ x + -> \ x + -> x x) + (\ x + -> \ x + -> \ x + -> \ x + -> \ x + -> (Grammar.Brainfuck.Loop + x + :))) + c)) + v)) + v)) + c)) + cs + else + let + _ = "checkToken.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [P.ErrorItemToken + ']'] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemToken + ']']) #) + GT + -> (# farInp, + farExp #) + in + ((readFail + inp) + farInp) + farExp + else + let + _ = "checkHorizon.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [P.ErrorItemHorizon + 667] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemHorizon + 667]) #) + GT + -> (# farInp, + farExp #) + in + ((readFail + inp) + farInp) + farExp)) + inp) + (((((Data.Map.Internal.Bin + 1) + "fail") + readFail) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip))) + cs) + (((((Data.Map.Internal.Bin + 1) + "fail") + readFail) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) + else + let + _ = "checkToken.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + ((readFail + inp) + farInp) + farExp + else + let + _ = "checkHorizon.else" in + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [P.ErrorItemHorizon + 667] #) + EQ + -> (# farInp, + (farExp + <> + [P.ErrorItemHorizon + 667]) #) + GT + -> (# farInp, + farExp #) + in + ((readFail + inp) + farInp) + farExp + else + let + (# farInp, + farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + inp + of + LT + -> (# inp, + [] #) + EQ + -> (# farInp, + (farExp + <> + []) #) + GT + -> (# farInp, + farExp #) + in + ((readFail + inp) + farInp) + farExp + else + let _ = "checkToken.else" in + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` P.offset) + farInp) + inp + of + LT -> (# inp, [] #) + EQ -> (# farInp, (farExp <> []) #) + GT -> (# farInp, farExp #) + in ((readFail inp) farInp) farExp + else + let _ = "checkHorizon.else" in + let + (# farInp, farExp #) + = case + ((compare `Data.Function.on` P.offset) + farInp) + inp + of + LT -> (# inp, [P.ErrorItemHorizon 1] #) + EQ + -> (# farInp, + (farExp + <> [P.ErrorItemHorizon 1]) #) + GT -> (# farInp, farExp #) + in ((readFail inp) farInp) farExp in + let + _ = "call exceptionsByName(name_3)=["fail"] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList [("fail",())])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in ((\ x -> \ x -> x x) (\ x -> x [])) v)) + inp)) + inp) + Data.Map.Internal.Tip in + let + _ = "call exceptionsByName(name_2)=[] catchStackByLabel(ctx)=[]" + in + ((name + (let + _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList [])]" + in + \ farInp farExp v !inp + -> let _ = "resume" + in + (((finalRet farInp) farExp) + (let _ = "resume.genCode" + in + ((\ x -> \ x -> x x) + (((\ x -> \ x -> x x) (\ x -> \ x -> x)) v)) + v)) + inp)) + inp) + Data.Map.Internal.Tip)) + init) + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G2.expected.txt b/test/Golden/Splice/G2.expected.txt index d1b2977..b288272 100644 --- a/test/Golden/Splice/G2.expected.txt +++ b/test/Golden/Splice/G2.expected.txt @@ -24,7 +24,7 @@ test/Golden/Splice/G2.hs:0:0:: Splicing expression else Nothing, P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = ("catchException lbl=" <> "fail") in + let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp diff --git a/test/Golden/Splice/G3.expected.txt b/test/Golden/Splice/G3.expected.txt index f938683..ad0eb94 100644 --- a/test/Golden/Splice/G3.expected.txt +++ b/test/Golden/Splice/G3.expected.txt @@ -27,7 +27,7 @@ test/Golden/Splice/G3.hs:0:0:: Splicing expression let name = \ !ok !inp !koByLabel - -> let _ = ("catchException lbl=" <> "fail") in + -> let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp @@ -82,7 +82,9 @@ test/Golden/Splice/G3.hs:0:0:: Splicing expression v)) inp)) cs) - Data.Map.Internal.Tip + (((((Data.Map.Internal.Bin 1) "fail") readFail) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) else let _ = "checkToken.else" in let diff --git a/test/Golden/Splice/G4.expected.txt b/test/Golden/Splice/G4.expected.txt index 89fdf74..1efbe08 100644 --- a/test/Golden/Splice/G4.expected.txt +++ b/test/Golden/Splice/G4.expected.txt @@ -27,7 +27,7 @@ test/Golden/Splice/G4.hs:0:0:: Splicing expression let name = \ !ok !inp !koByLabel - -> let _ = ("catchException lbl=" <> "fail") in + -> let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp @@ -148,7 +148,7 @@ test/Golden/Splice/G4.hs:0:0:: Splicing expression -> let name = \ !ok !inp !koByLabel - -> let _ = ("catchException lbl=" <> "fail") in + -> let _ = "catchException lbl=fail" in let _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=["fail"]" in @@ -180,7 +180,50 @@ test/Golden/Splice/G4.hs:0:0:: Splicing expression v)) inp)) inp) - Data.Map.Internal.Tip)) + (((((Data.Map.Internal.Bin 1) "fail") + (\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ + i + _) + (Data.Text.Internal.Text _ + j + _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ + -> (# farInp, + (farExp <> []) #) + GT + -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault + finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp)) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip))) inp) (((((Data.Map.Internal.Bin 1) "fail") (\ !failInp !farInp !farExp diff --git a/test/Golden/Splice/G5.expected.txt b/test/Golden/Splice/G5.expected.txt index 137bfbe..7aed34c 100644 --- a/test/Golden/Splice/G5.expected.txt +++ b/test/Golden/Splice/G5.expected.txt @@ -27,7 +27,7 @@ test/Golden/Splice/G5.hs:0:0:: Splicing expression let name = \ !ok !inp !koByLabel - -> let _ = ("catchException lbl=" <> "fail") in + -> let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp @@ -148,7 +148,7 @@ test/Golden/Splice/G5.hs:0:0:: Splicing expression -> let name = \ !ok !inp !koByLabel - -> let _ = ("catchException lbl=" <> "fail") in + -> let _ = "catchException lbl=fail" in let _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=["fail"]" in @@ -180,7 +180,50 @@ test/Golden/Splice/G5.hs:0:0:: Splicing expression v)) inp)) inp) - Data.Map.Internal.Tip)) + (((((Data.Map.Internal.Bin 1) "fail") + (\ !failInp !farInp !farExp + -> if (\ x -> x) + (((\ (Data.Text.Internal.Text _ + i + _) + (Data.Text.Internal.Text _ + j + _) + -> (i == j)) + inp) + failInp) then + let _ = "resume" + in + (((ok farInp) farExp) + (let _ = "resume.genCode" + in \ x -> x)) + failInp + else + let + (# farInp, farExp #) + = case + ((compare + `Data.Function.on` + P.offset) + farInp) + failInp + of + LT -> (# failInp, [] #) + EQ + -> (# farInp, + (farExp <> []) #) + GT + -> (# farInp, farExp #) + in + (((((Data.Map.Strict.Internal.findWithDefault + finalRaise) + "fail") + koByLabel) + failInp) + farInp) + farExp)) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip))) inp) (((((Data.Map.Internal.Bin 1) "fail") (\ !failInp !farInp !farExp @@ -242,8 +285,8 @@ test/Golden/Splice/G5.hs:0:0:: Splicing expression v)) v)) inp in - let _ = ("catchException lbl=" <> "fail") in - let _ = ("catchException lbl=" <> "fail") in + let _ = "catchException lbl=fail" in + let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp diff --git a/test/Golden/Splice/G6.expected.txt b/test/Golden/Splice/G6.expected.txt index f82aa02..8aac1fb 100644 --- a/test/Golden/Splice/G6.expected.txt +++ b/test/Golden/Splice/G6.expected.txt @@ -24,7 +24,7 @@ test/Golden/Splice/G6.hs:0:0:: Splicing expression else Nothing, P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = ("catchException lbl=" <> "fail") in + let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp diff --git a/test/Golden/Splice/G7.expected.txt b/test/Golden/Splice/G7.expected.txt index b52908c..d734a2d 100644 --- a/test/Golden/Splice/G7.expected.txt +++ b/test/Golden/Splice/G7.expected.txt @@ -24,8 +24,8 @@ test/Golden/Splice/G7.hs:0:0:: Splicing expression else Nothing, P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = ("catchException lbl=" <> "fail") in - let _ = ("catchException lbl=" <> "fail") in + let _ = "catchException lbl=fail" in + let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp @@ -43,7 +43,7 @@ test/Golden/Splice/G7.hs:0:0:: Splicing expression -> (i == j)) init) failInp) then - let _ = ("catchException lbl=" <> "fail") in + let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp diff --git a/test/Golden/Splice/G8.expected.txt b/test/Golden/Splice/G8.expected.txt index e329484..5ddcaa0 100644 --- a/test/Golden/Splice/G8.expected.txt +++ b/test/Golden/Splice/G8.expected.txt @@ -27,7 +27,7 @@ test/Golden/Splice/G8.hs:0:0:: Splicing expression let name = \ !ok !inp !koByLabel - -> let _ = ("catchException lbl=" <> "fail") in + -> let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp @@ -82,7 +82,9 @@ test/Golden/Splice/G8.hs:0:0:: Splicing expression v)) inp)) cs) - Data.Map.Internal.Tip + (((((Data.Map.Internal.Bin 1) "fail") readFail) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) else let _ = "checkToken.else" in let @@ -121,8 +123,8 @@ test/Golden/Splice/G8.hs:0:0:: Splicing expression (((\ x -> \ x -> x x) (\ x -> \ x -> x [])) v)) v)) inp in - let _ = ("catchException lbl=" <> "fail") in - let _ = ("catchException lbl=" <> "fail") in + let _ = "catchException lbl=fail" in + let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp diff --git a/test/Golden/Splice/G9.expected.txt b/test/Golden/Splice/G9.expected.txt index 564b1a2..244b9cb 100644 --- a/test/Golden/Splice/G9.expected.txt +++ b/test/Golden/Splice/G9.expected.txt @@ -24,8 +24,8 @@ test/Golden/Splice/G9.hs:0:0:: Splicing expression else Nothing, P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = ("catchException lbl=" <> "fail") in - let _ = ("catchException lbl=" <> "fail") in + let _ = "catchException lbl=fail" in + let _ = "catchException lbl=fail" in let readFail = \ !failInp !farInp !farExp diff --git a/test/Golden/Splice/Utils.hs b/test/Golden/Splice/Utils.hs index 5afd150..1377fda 100644 --- a/test/Golden/Splice/Utils.hs +++ b/test/Golden/Splice/Utils.hs @@ -5,6 +5,7 @@ module Golden.Splice.Utils where -- Build_symantic_parser is auto-generated by Setup.hs import Build_symantic_parser (ghcPath, ghcFlags, rootDir) import Control.Applicative (Applicative(..)) +import Control.Monad (unless) import Data.Foldable (asum) import Data.Function (($), (.), const) import Data.Functor ((<$>), (<$)) @@ -13,12 +14,16 @@ import Data.Maybe (Maybe(..)) import Data.Semigroup (Semigroup(..)) import Data.String (String, IsString(..)) import Data.Text (Text) -import System.FilePath (FilePath, (), (<.>), (-<.>)) +import System.FilePath (FilePath, dropExtensions, takeBaseName, (), (<.>), (-<.>)) import System.IO (IO, IOMode(..), openFile) -import System.Process (CreateProcess(..), StdStream(..), createProcess, proc, waitForProcess, callCommand) import Test.Tasty (TestTree) import Test.Tasty.Golden (goldenVsFileDiff) +import qualified System.Process as Process +import qualified Control.Exception as IO +import qualified System.Directory as IO +import qualified System.IO.Error as IO import qualified Turtle + import Golden.Utils ghcOpts :: [String] @@ -58,19 +63,19 @@ ghcOpts = ghcFlags <> testSplice :: FilePath -> TestTree testSplice spliceFile = - goldenVsFileDiff spliceFile goldenDiff + goldenVsFileDiff (takeBaseName (dropExtensions spliceFile)) goldenDiff (rootDirspliceFile-<.>"expected"<.>"txt") actualFile $ do h <- openFile actualFile WriteMode - (_, _, _, pid) <- createProcess - (proc ghcPath (spliceFile : ghcOpts)) - { std_out = UseHandle h - , std_err = UseHandle h - , cwd = Just rootDir } - _ <- waitForProcess pid + (_, _, _, pid) <- Process.createProcess + (Process.proc ghcPath (spliceFile : ghcOpts)) + { Process.std_out = Process.UseHandle h + , Process.std_err = Process.UseHandle h + , Process.cwd = Just rootDir } + _ <- Process.waitForProcess pid normalizeSplice actualFile where - actualFile = rootDirspliceFile-<.>"actual"<.>"hs" + actualFile = rootDirspliceFile-<.>"actual"<.>"txt" normalizeSplice :: FilePath -> IO () normalizeSplice = Turtle.inplace pat . fromString @@ -83,7 +88,7 @@ normalizeSplice = Turtle.inplace pat . fromString , fromString @Text . numPeriod <$> Turtle.lowerBounded 10 Turtle.digit , fromString @Text . ('%' <$) <$> Turtle.lowerBounded 10 punctSym -- Remove pretty-printed references to the symantic-parser package - -- (e.g., turn `symantic-parser-2.4.1:Sing` into `Sing`) + -- (e.g., turn `symantic-parser-1.2.3:Catcher` into `Catcher`) -- to make the output more stable. , "" <$ "symantic-parser-" <* verNum <* ":" ] @@ -93,5 +98,8 @@ normalizeSplice = Turtle.inplace pat . fromString numPeriod = zipWith const (cycle "0123456789876543210") d = Turtle.some Turtle.digit -cleanFiles :: IO () -cleanFiles = callCommand $ "rm -f " <> rootDir "test/Golden/Splice/*/*.{actual.hs,hi,o}" +rmFile :: FilePath -> IO () +rmFile path = + IO.catchIOError (IO.removeFile path) $ \exn -> + unless (IO.isDoesNotExistError exn) $ + IO.throwIO exn diff --git a/test/Grammar.hs b/test/Grammar.hs index 9de5668..f045bbd 100644 --- a/test/Grammar.hs +++ b/test/Grammar.hs @@ -20,20 +20,20 @@ data G = forall a. G ( grammars :: [G] grammars = - [ G (grammar @Char g1) - , G (grammar @Char g2) - , G (grammar @Char g3) - , G (grammar @Char g4) - , G (grammar @Char g5) - , G (grammar @Char g6) - , G (grammar @Char g7) - , G (grammar @Char g8) - , G (grammar @Char g9) - , G (grammar @Char g10) - , G (grammar @Char g11) - , G (grammar @Char g12) - , G (grammar @Char g13) - , G (grammar @Char g14) + [ G g1 + , G g2 + , G g3 + , G g4 + , G g5 + , G g6 + , G g7 + , G g8 + , G g9 + , G g10 + , G g11 + , G g12 + , G g13 + --, G g14 ] g1 = char 'a' @@ -49,4 +49,4 @@ g10 = char 'a' <|> char 'b' g11 = many (char 'a') <* char 'b' g12 = many (oneOf ['a', 'b', 'c', 'd']) <* eof g13 = Grammar.Brainfuck.grammar -g14 = Grammar.Nandlang.grammar +--g14 = Grammar.Nandlang.grammar diff --git a/test/Machine.hs b/test/Machine.hs new file mode 100644 index 0000000..ee434cc --- /dev/null +++ b/test/Machine.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +module Machine where + +import Data.Text (Text) +import Data.Functor ((<$>)) + +import qualified Symantic.Parser as P +import Grammar + +-- | Existential type to gather machines +-- returning different values in the same @('machines')@ list. +data M = forall a. M ( + forall repr inp. inp ~ Text => + P.Machine (P.InputToken inp) repr => + repr inp '[] a + ) + +machines :: [M] +machines = (\(G g) -> M (P.machine g)) <$> grammars diff --git a/test/Parser.hs b/test/Parser.hs index 3721fd0..5f2b1ed 100644 --- a/test/Parser.hs +++ b/test/Parser.hs @@ -36,8 +36,9 @@ parsers = , P p10 , P p11 , P p12 + -- , P p13 + -- , P p14 ] - p1 = $$(runParser @Text g1) p2 = $$(runParser @Text g2) p3 = $$(runParser @Text g3) @@ -50,3 +51,5 @@ p9 = $$(runParser @Text g9) p10 = $$(runParser @Text g10) p11 = $$(runParser @Text g11) p12 = $$(runParser @Text g12) +--p13 = $$(runParser @Text g13) +--p14 = $$(runParser @Text g14) -- 2.44.1 From 1dc23986c85bd235f714f42ee680591f19f5f540 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 12 Mar 2021 08:08:09 +0100 Subject: [PATCH 03/16] fix: use a global polyfix for defLet and defRef --- Makefile | 22 +- Setup.hs | 69 +- default.nix | 3 +- flake.lock | 4 +- src/Symantic/Parser.hs | 6 +- src/Symantic/Parser/Grammar.hs | 5 +- src/Symantic/Parser/Grammar/Combinators.hs | 10 +- src/Symantic/Parser/Grammar/ObserveSharing.hs | 91 +- src/Symantic/Parser/Grammar/Optimize.hs | 50 +- src/Symantic/Parser/Grammar/View.hs | 88 +- src/Symantic/Parser/Grammar/Write.hs | 26 +- src/Symantic/Parser/Haskell/Optimize.hs | 4 +- src/Symantic/Parser/Machine.hs | 3 +- src/Symantic/Parser/Machine/Generate.hs | 560 ++- src/Symantic/Parser/Machine/Instructions.hs | 28 +- src/Symantic/Parser/Machine/Optimize.hs | 42 +- src/Symantic/Parser/Machine/Program.hs | 96 +- src/Symantic/Parser/Machine/View.hs | 224 +- src/Symantic/Univariant/Letable.hs | 181 +- symantic-parser.cabal | 9 +- test/Golden/Grammar.hs | 8 +- .../Grammar/OptimizeGrammar/G1.expected.txt | 7 +- .../Grammar/OptimizeGrammar/G10.expected.txt | 15 +- .../Grammar/OptimizeGrammar/G11.expected.txt | 26 +- .../Grammar/OptimizeGrammar/G12.expected.txt | 26 +- .../Grammar/OptimizeGrammar/G13.expected.txt | 121 +- .../Grammar/OptimizeGrammar/G14.expected.txt | 889 ++-- .../Grammar/OptimizeGrammar/G15.expected.txt | 22 +- .../Grammar/OptimizeGrammar/G16.expected.txt | 38 +- .../Grammar/OptimizeGrammar/G17.expected.txt | 24 - .../Grammar/OptimizeGrammar/G18.expected.txt | 11 - .../Grammar/OptimizeGrammar/G19.expected.txt | 13 - .../Grammar/OptimizeGrammar/G2.expected.txt | 17 +- .../Grammar/OptimizeGrammar/G20.expected.txt | 12 - .../Grammar/OptimizeGrammar/G21.expected.txt | 1 - .../Grammar/OptimizeGrammar/G22.expected.txt | 7 - .../Grammar/OptimizeGrammar/G23.expected.txt | 12 - .../Grammar/OptimizeGrammar/G24.expected.txt | 12 - .../Grammar/OptimizeGrammar/G25.expected.txt | 58 - .../Grammar/OptimizeGrammar/G3.expected.txt | 22 +- .../Grammar/OptimizeGrammar/G4.expected.txt | 47 +- .../Grammar/OptimizeGrammar/G5.expected.txt | 47 +- .../Grammar/OptimizeGrammar/G6.expected.txt | 19 +- .../Grammar/OptimizeGrammar/G7.expected.txt | 27 +- .../Grammar/OptimizeGrammar/G8.expected.txt | 26 +- .../Grammar/OptimizeGrammar/G9.expected.txt | 3 +- .../Grammar/ViewGrammar/G1.expected.txt | 11 +- .../Grammar/ViewGrammar/G10.expected.txt | 21 +- .../Grammar/ViewGrammar/G11.expected.txt | 44 +- .../Grammar/ViewGrammar/G12.expected.txt | 34 +- .../Grammar/ViewGrammar/G13.expected.txt | 205 +- .../Grammar/ViewGrammar/G14.expected.txt | 1797 ++++--- .../Grammar/ViewGrammar/G15.expected.txt | 36 +- .../Grammar/ViewGrammar/G16.expected.txt | 70 +- .../Grammar/ViewGrammar/G17.expected.txt | 54 - .../Grammar/ViewGrammar/G18.expected.txt | 35 - .../Grammar/ViewGrammar/G19.expected.txt | 37 - .../Grammar/ViewGrammar/G2.expected.txt | 25 +- .../Grammar/ViewGrammar/G20.expected.txt | 20 - .../Grammar/ViewGrammar/G21.expected.txt | 1 - .../Grammar/ViewGrammar/G22.expected.txt | 11 - .../Grammar/ViewGrammar/G23.expected.txt | 24 - .../Grammar/ViewGrammar/G24.expected.txt | 16 - .../Grammar/ViewGrammar/G25.expected.txt | 100 - .../Grammar/ViewGrammar/G3.expected.txt | 8 +- .../Grammar/ViewGrammar/G4.expected.txt | 59 +- .../Grammar/ViewGrammar/G5.expected.txt | 105 +- .../Grammar/ViewGrammar/G6.expected.txt | 51 +- .../Grammar/ViewGrammar/G7.expected.txt | 61 +- .../Grammar/ViewGrammar/G8.expected.txt | 42 +- .../Grammar/ViewGrammar/G9.expected.txt | 3 +- test/Golden/Machine.hs | 4 +- test/Golden/Machine/G1.expected.txt | 16 +- test/Golden/Machine/G10.expected.txt | 74 +- test/Golden/Machine/G11.expected.txt | 116 +- test/Golden/Machine/G12.expected.txt | 172 +- test/Golden/Machine/G13.expected.txt | 492 +- test/Golden/Machine/G14.expected.txt | 4227 +++++++++++++---- test/Golden/Machine/G15.expected.txt | 111 +- test/Golden/Machine/G16.expected.txt | 176 +- test/Golden/Machine/G17.expected.txt | 67 - test/Golden/Machine/G18.expected.txt | 22 - test/Golden/Machine/G19.expected.txt | 34 - test/Golden/Machine/G2.expected.txt | 104 +- test/Golden/Machine/G20.expected.txt | 48 - test/Golden/Machine/G21.expected.txt | 23 - test/Golden/Machine/G22.expected.txt | 18 - test/Golden/Machine/G23.expected.txt | 25 - test/Golden/Machine/G24.expected.txt | 48 - test/Golden/Machine/G25.expected.txt | 104 - test/Golden/Machine/G3.expected.txt | 94 +- test/Golden/Machine/G4.expected.txt | 228 +- test/Golden/Machine/G5.expected.txt | 318 +- test/Golden/Machine/G6.expected.txt | 150 +- test/Golden/Machine/G7.expected.txt | 190 +- test/Golden/Machine/G8.expected.txt | 184 +- test/Golden/Machine/G9.expected.txt | 78 +- test/Golden/Parser.hs | 10 +- test/Golden/Parser/G1/P1.expected.txt | 1 - test/Golden/Parser/G1/P1.input.txt | 1 - test/Golden/Parser/G10/P1.expected.txt | 1 - test/Golden/Parser/G10/P1.input.txt | 1 - test/Golden/Parser/G11/P1.expected.txt | 1 - test/Golden/Parser/G11/P1.input.txt | 1 - test/Golden/Parser/G12/P1.expected.txt | 1 - test/Golden/Parser/G12/P1.input.txt | 1 - test/Golden/Parser/G2/P1.expected.txt | 1 - test/Golden/Parser/G2/P1.input.txt | 1 - test/Golden/Parser/G2/P2.expected.txt | 1 - test/Golden/Parser/G2/P2.input.txt | 1 - test/Golden/Parser/G3/P1.expected.txt | 1 - test/Golden/Parser/G3/P1.input.txt | 1 - test/Golden/Parser/G4/P1.expected.txt | 1 - test/Golden/Parser/G4/P1.input.txt | 1 - test/Golden/Parser/G5/P1.expected.txt | 1 - test/Golden/Parser/G5/P1.input.txt | 1 - test/Golden/Parser/G5/P2.expected.txt | 1 - test/Golden/Parser/G5/P2.input.txt | 1 - test/Golden/Parser/G6/P1.expected.txt | 1 - test/Golden/Parser/G6/P1.input.txt | 1 - test/Golden/Parser/G7/P1.expected.txt | 1 - test/Golden/Parser/G7/P1.input.txt | 1 - test/Golden/Parser/G7/P2.expected.txt | 1 - test/Golden/Parser/G7/P2.input.txt | 1 - test/Golden/Parser/G8/P1.expected.txt | 1 - test/Golden/Parser/G8/P1.input.txt | 1 - test/Golden/Parser/G9/P1.expected.txt | 1 - test/Golden/Parser/G9/P1.input.txt | 0 test/Golden/Parser/G9/P2.expected.txt | 1 - test/Golden/Parser/G9/P2.input.txt | 1 - test/Golden/Parser/left-right.txt | 1 - test/Golden/Splice.hs | 41 +- test/Golden/Splice/G1.expected.txt | 171 +- test/Golden/Splice/G10.expected.txt | 319 +- test/Golden/Splice/G11.expected.txt | 386 +- test/Golden/Splice/G12.expected.txt | 532 ++- test/Golden/Splice/G13.expected.txt | 2147 ++++----- test/Golden/Splice/G14.expected.txt | 4200 +++++++++++++++- test/Golden/Splice/G15.expected.txt | 279 ++ test/Golden/Splice/G16.expected.txt | 389 ++ test/Golden/Splice/G2.expected.txt | 295 +- test/Golden/Splice/G3.expected.txt | 306 +- test/Golden/Splice/G4.expected.txt | 597 +-- test/Golden/Splice/G5.expected.txt | 851 ++-- test/Golden/Splice/G6.expected.txt | 415 +- test/Golden/Splice/G7.expected.txt | 503 +- test/Golden/Splice/G8.expected.txt | 529 ++- test/Golden/Splice/G9.expected.txt | 293 +- test/Golden/Splice/Utils.hs | 66 +- test/Grammar.hs | 15 +- test/Grammar/Nandlang.hs | 75 +- test/Machine.hs | 17 +- test/Main.hs | 13 +- test/Parser.hs | 28 +- 154 files changed, 17269 insertions(+), 8264 deletions(-) delete mode 100644 test/Golden/Grammar/OptimizeGrammar/G17.expected.txt delete mode 100644 test/Golden/Grammar/OptimizeGrammar/G18.expected.txt delete mode 100644 test/Golden/Grammar/OptimizeGrammar/G19.expected.txt delete mode 100644 test/Golden/Grammar/OptimizeGrammar/G20.expected.txt delete mode 100644 test/Golden/Grammar/OptimizeGrammar/G21.expected.txt delete mode 100644 test/Golden/Grammar/OptimizeGrammar/G22.expected.txt delete mode 100644 test/Golden/Grammar/OptimizeGrammar/G23.expected.txt delete mode 100644 test/Golden/Grammar/OptimizeGrammar/G24.expected.txt delete mode 100644 test/Golden/Grammar/OptimizeGrammar/G25.expected.txt delete mode 100644 test/Golden/Grammar/ViewGrammar/G17.expected.txt delete mode 100644 test/Golden/Grammar/ViewGrammar/G18.expected.txt delete mode 100644 test/Golden/Grammar/ViewGrammar/G19.expected.txt delete mode 100644 test/Golden/Grammar/ViewGrammar/G20.expected.txt delete mode 100644 test/Golden/Grammar/ViewGrammar/G21.expected.txt delete mode 100644 test/Golden/Grammar/ViewGrammar/G22.expected.txt delete mode 100644 test/Golden/Grammar/ViewGrammar/G23.expected.txt delete mode 100644 test/Golden/Grammar/ViewGrammar/G24.expected.txt delete mode 100644 test/Golden/Grammar/ViewGrammar/G25.expected.txt delete mode 100644 test/Golden/Machine/G17.expected.txt delete mode 100644 test/Golden/Machine/G18.expected.txt delete mode 100644 test/Golden/Machine/G19.expected.txt delete mode 100644 test/Golden/Machine/G20.expected.txt delete mode 100644 test/Golden/Machine/G21.expected.txt delete mode 100644 test/Golden/Machine/G22.expected.txt delete mode 100644 test/Golden/Machine/G23.expected.txt delete mode 100644 test/Golden/Machine/G24.expected.txt delete mode 100644 test/Golden/Machine/G25.expected.txt delete mode 100644 test/Golden/Parser/G1/P1.expected.txt delete mode 100644 test/Golden/Parser/G1/P1.input.txt delete mode 100644 test/Golden/Parser/G10/P1.expected.txt delete mode 100644 test/Golden/Parser/G10/P1.input.txt delete mode 100644 test/Golden/Parser/G11/P1.expected.txt delete mode 100644 test/Golden/Parser/G11/P1.input.txt delete mode 100644 test/Golden/Parser/G12/P1.expected.txt delete mode 100644 test/Golden/Parser/G12/P1.input.txt delete mode 100644 test/Golden/Parser/G2/P1.expected.txt delete mode 100644 test/Golden/Parser/G2/P1.input.txt delete mode 100644 test/Golden/Parser/G2/P2.expected.txt delete mode 100644 test/Golden/Parser/G2/P2.input.txt delete mode 100644 test/Golden/Parser/G3/P1.expected.txt delete mode 100644 test/Golden/Parser/G3/P1.input.txt delete mode 100644 test/Golden/Parser/G4/P1.expected.txt delete mode 100644 test/Golden/Parser/G4/P1.input.txt delete mode 100644 test/Golden/Parser/G5/P1.expected.txt delete mode 100644 test/Golden/Parser/G5/P1.input.txt delete mode 100644 test/Golden/Parser/G5/P2.expected.txt delete mode 100644 test/Golden/Parser/G5/P2.input.txt delete mode 100644 test/Golden/Parser/G6/P1.expected.txt delete mode 100644 test/Golden/Parser/G6/P1.input.txt delete mode 100644 test/Golden/Parser/G7/P1.expected.txt delete mode 100644 test/Golden/Parser/G7/P1.input.txt delete mode 100644 test/Golden/Parser/G7/P2.expected.txt delete mode 100644 test/Golden/Parser/G7/P2.input.txt delete mode 100644 test/Golden/Parser/G8/P1.expected.txt delete mode 100644 test/Golden/Parser/G8/P1.input.txt delete mode 100644 test/Golden/Parser/G9/P1.expected.txt delete mode 100644 test/Golden/Parser/G9/P1.input.txt delete mode 100644 test/Golden/Parser/G9/P2.expected.txt delete mode 100644 test/Golden/Parser/G9/P2.input.txt delete mode 100644 test/Golden/Parser/left-right.txt create mode 100644 test/Golden/Splice/G15.expected.txt create mode 100644 test/Golden/Splice/G16.expected.txt diff --git a/Makefile b/Makefile index c8a11de..ad5e24d 100644 --- a/Makefile +++ b/Makefile @@ -10,20 +10,20 @@ repl: cabal repl t: - cabal test --test-show-details always --test-options "--color always --size-cutoff 1000000 $${p:+-p $$p}" -t/accept: - cabal test --test-show-details always --test-options "--accept --color always $${p:+-p $$p}" + cabal test $(TESTFLAGS) --test-show-details always --test-options "$(TESTOPTIONS) --color always --size-cutoff 1000000 $${p:+-p $$p}" +%/accept: TESTOPTIONS+=--accept +%/accept: % + +%/cover: TESTFLAGS+=--enable-coverage +%/cover: % + t/prof: - cabal test --enable-profiling -fprof-auto -fprof-auto-calls --test-show-details always --test-options "$${p:+-p $$p} +RTS -p -L100 -hc" -t/cover: - cabal test --enable-profiling --enable-library-coverage --enable-coverage --test-show-details always --test-options "$${p:+-p $$p}" -t/prof-th: - cabal v2-build lib:symantic-parser --enable-debug --enable-profiling --write-ghc-environment-files=always - ghc -prof -fprof-auto -eventlog -debug -fexternal-interpreter -opti+RTS -opti-p -opti-L100 -opti-ls -opti-hy --make -XHaskell2010 -XNoImplicitPrelude -itest test/Main.hs -Wall -ddump-splices + cabal v2-build lib:symantic-parser --enable-profiling --write-ghc-environment-files=always + cabal test $(TESTFLAGS) --enable-profiling -fprof-auto -fprof-auto-calls \ + --test-show-details always --test-options "$(TESTOPTIONS) $${p:+-p $$p}" \ + --ghc-options "-opti+RTS -opti-p -opti-L100 -opti-ls -opti-xc" t/repl: cabal repl --enable-tests symantic-parser-test -t/splices: t - shopt -s globstar; $$EDITOR dist-newstyle/build/**/t/**/*.dump-splices doc: cabal haddock --haddock-css ocean --haddock-hyperlink-source diff --git a/Setup.hs b/Setup.hs index 5526186..b649c36 100644 --- a/Setup.hs +++ b/Setup.hs @@ -17,8 +17,8 @@ import Distribution.Simple.Program import Distribution.Simple.Setup import Distribution.Simple.Utils import Distribution.Text -import System.Directory (getCurrentDirectory) -import System.FilePath ((), (<.>), isRelative) +import System.Directory (getCurrentDirectory, makeAbsolute) +import System.FilePath ((), (<.>)) buildModule :: FilePath buildModule = "Build_symantic_parser" @@ -48,63 +48,66 @@ haddockToBuildFlags f = emptyBuildFlags generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () generateBuildModule flags pkg lbi = do rootDir <- getCurrentDirectory + distPref{-ix-} <- makeAbsolute $ fromFlag (buildDistPref flags) let verbosity = fromFlag (buildVerbosity flags) - distPref = fromFlag (buildDistPref flags) - distPref' | isRelative distPref = rootDirdistPref - | otherwise = distPref - -- Package DBs - dbStack = withPackageDB lbi <> [ SpecificPackageDB $ distPref'"package.conf.inplace" ] + dbStack = withPackageDB lbi <> [ SpecificPackageDB $ distPref"package.conf.inplace" ] dbFlags = "-hide-all-packages" : "-package-env=-" : packageDbArgsDb dbStack - - ghc = case lookupProgram ghcProgram (withPrograms lbi) of - Just fp -> locationPath $ programLocation fp - Nothing -> error "Can't find GHC path" - withTestLBI pkg lbi $ \suite suitecfg -> - when (testName suite == fromString testSuiteName) $ do - let testAutogenDir = autogenComponentModulesDir lbi suitecfg - createDirectoryIfMissingVerbose verbosity True testAutogenDir + Just ghc = lookupProgram ghcProgram (withPrograms lbi) + -- globalAutogenDir = autogenPackageModulesDir lbi + -- createDirectoryIfMissingVerbose verbosity True globalAutogenDir + withTestLBI pkg lbi $ \testSuite testCLBI -> + when (testName testSuite == fromString testSuiteName) $ do + let testAutogenDir = autogenComponentModulesDir lbi testCLBI let buildFile = testAutogenDirbuildModule<.>"hs" - withLibLBI pkg lbi $ \_ libCLBI -> do + createDirectoryIfMissingVerbose verbosity True testAutogenDir + withLibLBI pkg lbi $ \_libSuite libCLBI -> do let libDeps = fst <$> componentPackageDeps libCLBI - pidx = case dependencyClosure (installedPkgs lbi) libDeps of - Left p -> p - Right _ -> error "Broken dependency closure" + Left pidx = dependencyClosure (installedPkgs lbi) libDeps libTransDeps = installedUnitId <$> allPackages pidx packageUnitId = componentUnitId libCLBI - depsFlags = formatDep <$> (packageUnitId:libTransDeps) - allFlags = dbFlags <> depsFlags <> - -- This -i enables to `import Grammar` - -- in TemplateHaskell splicing modules. + depsFlags = (\installedPkgId -> "-package-id=" <> display installedPkgId) <$> (packageUnitId:libTransDeps) + PerCompilerFlavor profFlags _ghcjs = profOptions (testBuildInfo testSuite) + TestSuiteExeV10 _ mainFile = testInterface testSuite + exe = Executable { + exeName = testName testSuite, + modulePath = mainFile, + exeScope = ExecutablePublic, + buildInfo = testBuildInfo testSuite + } + ghcFlags = mconcat + [ dbFlags + , depsFlags + -- This -i enables to `import Grammar` in TemplateHaskell splicing modules. -- Because `test/Grammar.hs' is not in a package. - ["-i"<>buildDir lbitestSuiteNametestSuiteName<>"-tmp"] + , [ "-i"<>exeBuildDir lbi exe ] + , [ x | withProfExe lbi, x <- ["-prof", "-osuf", "p_o", "-hisuf", "p_hi"] <> profFlags ] + -- , [ x | libCoverage lbi, x <- ["-fhpc"] <> profFlags ] + , programOverrideArgs ghc + ] writeFile buildFile $ unlines [ "module "<>buildModule<>" where" , "import Data.String (String)" , "import System.FilePath (FilePath)" , "" , "ghcPath :: FilePath" - , "ghcPath = " <> show ghc + , "ghcPath = "<>show (locationPath $ programLocation ghc) , "" , "ghcFlags :: [String]" - , "ghcFlags = " <> show allFlags + , "ghcFlags = "<>show ghcFlags , "" , "rootDir :: FilePath" - , "rootDir = " <> show rootDir + , "rootDir = "<>show rootDir ] where - formatDep installedPkgId = "-package-id=" <> display installedPkgId - -- GHC >= 7.6 uses the '-package-db' flag. -- See https://ghc.haskell.org/trac/ghc/ticket/5977. packageDbArgsDb :: [PackageDB] -> [String] -- special cases to make arguments prettier in common scenarios packageDbArgsDb dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) - | all isSpecific dbs -> - concatMap single dbs + | all isSpecific dbs -> concatMap single dbs (GlobalPackageDB:dbs) - | all isSpecific dbs -> - "-no-user-package-db" : concatMap single dbs + | all isSpecific dbs -> "-no-user-package-db" : concatMap single dbs dbs -> "-clear-package-db" : concatMap single dbs where single (SpecificPackageDB db) = [ "-package-db=" <> db ] diff --git a/default.nix b/default.nix index 98293bf..532e292 100644 --- a/default.nix +++ b/default.nix @@ -16,6 +16,7 @@ let these = doJailbreak hsuper.these; dump-core = dontCheck (unmarkBroken hsuper.dump-core); #profunctors = doJailbreak (unmarkBroken hsuper.profunctors); + #th-expand-syns = doJailbreak (unmarkBroken hsuper.th-expand-syns); profunctors = dontCheck (unmarkBroken (doJailbreak (hsuper.callHackageDirect { pkg = "profunctors"; ver = "5.6.2"; @@ -43,7 +44,7 @@ in hs.symantic-parser // { ]; buildInputs = [ #hs.ghcid - #hs.ormolu + pkgs.ormolu #hs.hlint #pkgs.nixpkgs-fmt ]; diff --git a/flake.lock b/flake.lock index 19b7a80..27a0952 100644 --- a/flake.lock +++ b/flake.lock @@ -17,8 +17,8 @@ }, "nixpkgs": { "locked": { - "narHash": "sha256-0rr9cOiNhJnQ7DgjZouhNFo8dKnTiw+/Vee+EQuN5sY=", - "path": "/nix/store/bxgglm21wj8pxmza3m87rkdwwm8gz54k-nixpkgs-patched", + "narHash": "sha256-XAXD5xcPEId0B+EBm37/+vuLes/uIE7fPQf6ek3fqUU=", + "path": "/nix/store/ib1v3n4kfzaj0p9ixf2wlmg6msp7dlyr-nixpkgs-patched", "type": "path" }, "original": { diff --git a/src/Symantic/Parser.hs b/src/Symantic/Parser.hs index e959bc8..4428eff 100644 --- a/src/Symantic/Parser.hs +++ b/src/Symantic/Parser.hs @@ -6,7 +6,7 @@ module Symantic.Parser ) where import Data.Either (Either(..)) -import Data.Function ((.)) +import Data.Function (($)) import Data.Ord (Ord) import Language.Haskell.TH (CodeQ) import Text.Show (Show) @@ -26,4 +26,6 @@ runParser :: forall inp a. InstrReadable (InputToken inp) Gen => Parser inp a -> CodeQ (inp -> Either (ParsingError inp) a) -runParser = generateCode . machine +runParser p = TH.Code $ do + mach <- TH.runIO $ machine p + TH.examineCode $ generateCode mach diff --git a/src/Symantic/Parser/Grammar.hs b/src/Symantic/Parser/Grammar.hs index d95c7c6..a32bb4e 100644 --- a/src/Symantic/Parser/Grammar.hs +++ b/src/Symantic/Parser/Grammar.hs @@ -9,6 +9,7 @@ module Symantic.Parser.Grammar , module Symantic.Parser.Grammar.Write , module Symantic.Parser.Grammar.View , Letable(..) + , Letsable(..) ) where import Symantic.Parser.Grammar.Combinators import Symantic.Parser.Grammar.View @@ -28,6 +29,7 @@ type Grammar tok repr = , Alternable repr , Satisfiable tok repr , Letable TH.Name repr + , Letsable TH.Name repr , Selectable repr , Matchable repr , Foldable repr @@ -46,7 +48,8 @@ grammar = optimizeGrammar . observeSharing -- | An usual pipeline to show 'Comb'inators: -- 'observeSharing' then 'optimizeGrammar' then 'viewGrammar' then 'show'. showGrammar :: + ShowLetName showName TH.Name => ObserveSharing TH.Name (OptimizeGrammar (ViewGrammar showName)) a -> String -showGrammar = show . viewGrammar . optimizeGrammar . observeSharing +showGrammar = show . viewGrammar . grammar diff --git a/src/Symantic/Parser/Grammar/Combinators.hs b/src/Symantic/Parser/Grammar/Combinators.hs index 0cbb20b..ffbdede 100644 --- a/src/Symantic/Parser/Grammar/Combinators.hs +++ b/src/Symantic/Parser/Grammar/Combinators.hs @@ -211,10 +211,12 @@ class Foldable repr where Applicable repr => Alternable repr => repr a -> repr (a -> a) -> repr a - chainPre op p = go <*> p - where go = (H..) <$> op <*> go <|> pure H.id - chainPost p op = p <**> go - where go = (H..) <$> op <*> go <|> pure H.id + chainPre op p = go <*> p where go = (H..) <$> op <*> go <|> pure H.id + chainPost p op = p <**> go where go = (H..) <$> op <*> go <|> pure H.id + {- + chainPre op p = flip (foldr ($)) <$> many op <*> p + chainPost p op = foldl' (flip ($)) <$> p <*> many op + -} {- conditional :: Selectable repr => [(TermGrammar (a -> Bool), repr b)] -> repr a -> repr b -> repr b diff --git a/src/Symantic/Parser/Grammar/ObserveSharing.hs b/src/Symantic/Parser/Grammar/ObserveSharing.hs index 33648cd..76c6415 100644 --- a/src/Symantic/Parser/Grammar/ObserveSharing.hs +++ b/src/Symantic/Parser/Grammar/ObserveSharing.hs @@ -5,7 +5,6 @@ module Symantic.Parser.Grammar.ObserveSharing ) where import Control.Monad (mapM) -import Data.Eq (Eq(..)) import Data.Function (($), (.)) import Data.Hashable (Hashable, hashWithSalt) import Text.Show (Show(..)) @@ -20,54 +19,40 @@ import qualified Symantic.Univariant.Trans as Sym -- | Like 'Letable.observeSharing' -- but type-binding @(letName)@ to 'TH.Name' -- to avoid the trouble to always set it. -observeSharing :: ObserveSharing TH.Name repr a -> repr a -observeSharing = Letable.observeSharing +observeSharing :: + Letsable TH.Name repr => + ObserveSharing TH.Name repr a -> + repr a +observeSharing os = lets defs body + where (body, defs) = Letable.observeSharing os -- | Needed by 'observeSharing'. instance Hashable TH.Name where hashWithSalt s = hashWithSalt s . show +instance MakeLetName TH.Name where + makeLetName _ = TH.qNewName "name" -- Combinators semantics for the 'ObserveSharing' interpreter. instance - ( Letable letName repr - , MakeLetName letName - , Eq letName - , Hashable letName - , Show letName + ( Letable TH.Name repr , Satisfiable tok repr - ) => Satisfiable tok (ObserveSharing letName repr) + ) => Satisfiable tok (ObserveSharing TH.Name repr) instance - ( Letable letName repr - , MakeLetName letName - , Eq letName - , Hashable letName - , Show letName + ( Letable TH.Name repr , Alternable repr - ) => Alternable (ObserveSharing letName repr) + ) => Alternable (ObserveSharing TH.Name repr) instance - ( Letable letName repr - , MakeLetName letName - , Eq letName - , Hashable letName - , Show letName + ( Letable TH.Name repr , Applicable repr - ) => Applicable (ObserveSharing letName repr) + ) => Applicable (ObserveSharing TH.Name repr) instance - ( Letable letName repr - , MakeLetName letName - , Eq letName - , Hashable letName - , Show letName + ( Letable TH.Name repr , Selectable repr - ) => Selectable (ObserveSharing letName repr) + ) => Selectable (ObserveSharing TH.Name repr) instance - ( Letable letName repr - , MakeLetName letName - , Eq letName - , Hashable letName - , Show letName + ( Letable TH.Name repr , Matchable repr - ) => Matchable (ObserveSharing letName repr) where + ) => Matchable (ObserveSharing TH.Name repr) where -- Here the default definition does not fit -- since there is no lift* for the type of 'conditional' -- and its default definition does not handles 'bs' @@ -79,40 +64,32 @@ instance Functor.<*> mapM unObserveSharing bs Functor.<*> unObserveSharing b instance - ( Letable letName repr - , MakeLetName letName - , Eq letName - , Hashable letName - , Show letName + ( Letable TH.Name repr , Foldable repr {- TODO: the following constraints are for the current Foldable, - they will have to be removed when Foldable will have Sym.lift2 as defaults -} , Applicable repr , Alternable repr - ) => Foldable (ObserveSharing letName repr) + ) => Foldable (ObserveSharing TH.Name repr) instance - ( Letable letName repr - , MakeLetName letName - , Eq letName - , Hashable letName - , Show letName + ( Letable TH.Name repr , Lookable repr - ) => Lookable (ObserveSharing letName repr) + ) => Lookable (ObserveSharing TH.Name repr) --- Combinators semantics for the 'CleanDefs' interpreter. -instance Applicable repr => Applicable (CleanDefs letName repr) -instance Alternable repr => Alternable (CleanDefs letName repr) -instance Satisfiable tok repr => Satisfiable tok (CleanDefs letName repr) -instance Selectable repr => Selectable (CleanDefs letName repr) -instance Matchable repr => Matchable (CleanDefs letName repr) where - conditional a cs bs b = CleanDefs $ +-- Combinators semantics for the 'FinalizeSharing' interpreter. +instance Applicable repr => Applicable (FinalizeSharing TH.Name repr) +instance Alternable repr => Alternable (FinalizeSharing TH.Name repr) +instance Satisfiable tok repr => Satisfiable tok (FinalizeSharing TH.Name repr) +instance Selectable repr => Selectable (FinalizeSharing TH.Name repr) +instance Matchable repr => Matchable (FinalizeSharing TH.Name repr) where + conditional a cs bs b = FinalizeSharing $ conditional - Functor.<$> unCleanDefs a + Functor.<$> unFinalizeSharing a Functor.<*> Functor.pure cs - Functor.<*> mapM unCleanDefs bs - Functor.<*> unCleanDefs b -instance Lookable repr => Lookable (CleanDefs letName repr) -instance Foldable repr => Foldable (CleanDefs letName repr) where + Functor.<*> mapM unFinalizeSharing bs + Functor.<*> unFinalizeSharing b +instance Lookable repr => Lookable (FinalizeSharing TH.Name repr) +instance Foldable repr => Foldable (FinalizeSharing TH.Name repr) where chainPre = Sym.lift2 chainPre chainPost = Sym.lift2 chainPost diff --git a/src/Symantic/Parser/Grammar/Optimize.hs b/src/Symantic/Parser/Grammar/Optimize.hs index e362bd4..fce15cb 100644 --- a/src/Symantic/Parser/Grammar/Optimize.hs +++ b/src/Symantic/Parser/Grammar/Optimize.hs @@ -14,7 +14,6 @@ import Data.Maybe (Maybe(..)) import qualified Data.Functor as Functor import qualified Data.Foldable as Foldable import qualified Data.List as List -import qualified Language.Haskell.TH.Syntax as TH import Data.Kind (Constraint, Type) import Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..)) @@ -24,7 +23,7 @@ import Symantic.Univariant.Letable import Symantic.Univariant.Trans import qualified Symantic.Parser.Haskell as H -{- Uncomment to trace optimizations +{- import Data.Function (($), flip) import Debug.Trace (trace) @@ -137,16 +136,18 @@ instance -- & trace "App Failure Weakening Law" Comb (Pure f) <*> Comb (Pure x) = pure (f H..@ x) -- & trace "Homomorphism Law" + {- Comb (Pure f) <*> Comb (g :<$>: p) = -- This is basically a shortcut, - -- it can be caught by the Composition Law - -- and Homomorphism Law. + -- it can be caught by one Composition Law + -- and two Homomorphism Law. (H..) H..@ f H..@ g <$> p -- & trace "Functor Composition Law" - u <*> Comb (v :<*>: w) = (((H..) <$> u) <*> v) <*> w - -- & trace "Composition Law" + -} u <*> Comb (Pure x) = H.flip H..@ (H.$) H..@ x <$> u -- & trace "Interchange Law" + u <*> Comb (v :<*>: w) = (((H..) <$> u) <*> v) <*> w + -- & trace "Composition Law" Comb (u :*>: v) <*> w = u *> (v <*> w) -- & trace "Reassociation Law 1" u <*> Comb (v :<*: w) = (u <*> v) <* w @@ -154,7 +155,7 @@ instance u <*> Comb (v :$>: x) = (u <*> pure x) <* v -- & trace "Reassociation Law 3" p <*> Comb (NegLook q) = - (p <*> pure H.unit) <* negLook (q) + (p <*> pure H.unit) <* negLook q -- & trace "Absorption Law" x <*> y = SomeComb (x :<*>: y) @@ -249,7 +250,7 @@ instance where code = [|| case $$(H.code lr) of Left x -> x ||] Right value -> r <*> pure (trans H.ValueCode{..}) where code = [|| case $$(H.code lr) of Right x -> x ||] - -- & trace "Branch Pure Left/Right Law" $ + -- & trace "Branch Pure Left/Right Law" branch b (Comb (Pure (trans -> l))) (Comb (Pure (trans -> r))) = trans H.ValueCode{..} <$> b -- & trace "Branch Generalised Identity Law" @@ -288,7 +289,10 @@ data instance Comb Matchable repr a where Comb Matchable repr b instance Matchable repr => Trans (Comb Matchable repr) repr where trans = \case - Conditional a ps bs b -> conditional (trans a) ps (trans Functor.<$> bs) (trans b) + Conditional a ps bs b -> + conditional (trans a) + (H.optimizeTerm Functor.<$> ps) + (trans Functor.<$> bs) (trans b) instance ( Applicable repr , Alternable repr @@ -384,7 +388,7 @@ data instance Comb (Satisfiable tok) repr a where Comb (Satisfiable tok) repr tok instance Satisfiable tok repr => Trans (Comb (Satisfiable tok) repr) repr where trans = \case - Satisfy es p -> satisfy es p + Satisfy es p -> satisfy es (H.optimizeTerm p) Item -> item instance (Satisfiable tok repr, Typeable tok) => @@ -394,16 +398,30 @@ instance -- Letable data instance Comb (Letable letName) repr a where - Def :: letName -> SomeComb repr a -> Comb (Letable letName) repr a + Shareable :: letName -> SomeComb repr a -> Comb (Letable letName) repr a Ref :: Bool -> letName -> Comb (Letable letName) repr a -instance Letable letName repr => Trans (Comb (Letable letName) repr) repr where +instance + Letable letName repr => + Trans (Comb (Letable letName) repr) repr where trans = \case - Def n v -> def n (trans v) + Shareable n x -> shareable n (trans x) Ref isRec n -> ref isRec n instance (Letable letName repr, Typeable letName) => Letable letName (SomeComb repr) where - def n = SomeComb . Def n + shareable n = SomeComb . Shareable n ref isRec = SomeComb . Ref isRec -instance MakeLetName TH.Name where - makeLetName _ = TH.qNewName "name" + +-- Letsable +data instance Comb (Letsable letName) repr a where + Lets :: LetBindings letName (SomeComb repr) -> + SomeComb repr a -> Comb (Letsable letName) repr a +instance + Letsable letName repr => + Trans (Comb (Letsable letName) repr) repr where + trans = \case + Lets defs x -> lets ((\(SomeLet sub) -> SomeLet (trans sub)) Functor.<$> defs) (trans x) +instance + (Letsable letName repr, Typeable letName) => + Letsable letName (SomeComb repr) where + lets defs = SomeComb . Lets defs diff --git a/src/Symantic/Parser/Grammar/View.hs b/src/Symantic/Parser/Grammar/View.hs index 3451eac..0012df2 100644 --- a/src/Symantic/Parser/Grammar/View.hs +++ b/src/Symantic/Parser/Grammar/View.hs @@ -1,74 +1,86 @@ module Symantic.Parser.Grammar.View where import Data.Bool (Bool) -import Data.Function (($), (.), id) +import Data.Function (($), (.), id, on) +import Data.Ord (Ord(..)) import Data.Semigroup (Semigroup(..)) -import Data.String (String, IsString(..)) +import Data.String (String) +import Data.Tuple (fst) import Text.Show (Show(..)) import qualified Control.Applicative as Fct -import qualified Data.Tree as Tree +import qualified Data.Functor as Functor +import qualified Data.HashMap.Strict as HM import qualified Data.List as List +import qualified Data.Tree as Tree import Symantic.Univariant.Letable import Symantic.Parser.Grammar.Combinators -- * Type 'ViewGrammar' newtype ViewGrammar (showName::Bool) a = ViewGrammar { unViewGrammar :: - Tree.Tree String } + Tree.Tree (String, String) } viewGrammar :: ViewGrammar sN a -> ViewGrammar sN a viewGrammar = id instance Show (ViewGrammar sN a) where - show = drawTree . unViewGrammar + show = List.unlines . draw . unViewGrammar where - drawTree :: Tree.Tree String -> String - drawTree = List.unlines . draw - draw :: Tree.Tree String -> [String] - draw (Tree.Node x ts0) = List.lines x <> drawSubTrees ts0 - where - drawSubTrees [] = [] - drawSubTrees [t] = shift "` " " " (draw t) - drawSubTrees (t:ts) = shift "+ " "| " (draw t) <> drawSubTrees ts - shift first other = List.zipWith (<>) (first : List.repeat other) -instance IsString (ViewGrammar sN a) where - fromString s = ViewGrammar $ Tree.Node (fromString s) [] + draw :: Tree.Tree (String, String) -> [String] + draw (Tree.Node (x, n) ts0) = + (List.zipWith (<>) (List.lines x) (n : List.repeat "")) <> + (drawTrees ts0) + drawTrees [] = [] + drawTrees [t] = shift "` " " " (draw t) + drawTrees (t:ts) = shift "+ " "| " (draw t) <> drawTrees ts + shift ind0 ind = List.zipWith (<>) (ind0 : List.repeat ind) instance ShowLetName sN letName => Letable letName (ViewGrammar sN) where - def name x = ViewGrammar $ - Tree.Node ("def "<>showLetName @sN name) [unViewGrammar x] - ref rec name = ViewGrammar $ + shareable name x = ViewGrammar $ + Tree.Node ("shareable", " "<>showLetName @sN name) [unViewGrammar x] + ref isRec name = ViewGrammar $ Tree.Node - ( (if rec then "rec " else "ref ") - <> showLetName @sN name + ( if isRec then "rec" else "ref" + , " "<>showLetName @sN name ) [] +instance + ShowLetName sN letName => + Letsable letName (ViewGrammar sN) where + lets defs x = ViewGrammar $ + Tree.Node ("lets", "") $ + (<> [unViewGrammar x]) $ + List.sortBy (compare `on` (((fst Functor.<$>) Functor.<$>) . Tree.levels)) $ + HM.foldrWithKey' + (\name (SomeLet val) -> + (Tree.Node ("let", " "<>showLetName @sN name) [unViewGrammar val] :)) + [] defs instance Applicable (ViewGrammar sN) where - _f <$> x = ViewGrammar $ Tree.Node "<$>" [unViewGrammar x] - pure a = ViewGrammar $ Tree.Node ("pure "<>showsPrec 10 a "") [] - x <*> y = ViewGrammar $ Tree.Node "<*>" [unViewGrammar x, unViewGrammar y] - x <* y = ViewGrammar $ Tree.Node "<*" [unViewGrammar x, unViewGrammar y] - x *> y = ViewGrammar $ Tree.Node "*>" [unViewGrammar x, unViewGrammar y] + _f <$> x = ViewGrammar $ Tree.Node ("<$>", "") [unViewGrammar x] + pure a = ViewGrammar $ Tree.Node ("pure "<>showsPrec 10 a "", "") [] + x <*> y = ViewGrammar $ Tree.Node ("<*>", "") [unViewGrammar x, unViewGrammar y] + x <* y = ViewGrammar $ Tree.Node ("<*", "") [unViewGrammar x, unViewGrammar y] + x *> y = ViewGrammar $ Tree.Node ("*>", "") [unViewGrammar x, unViewGrammar y] instance Alternable (ViewGrammar sN) where - empty = ViewGrammar $ Tree.Node "empty" [] - x <|> y = ViewGrammar $ Tree.Node "<|>" [unViewGrammar x, unViewGrammar y] - try x = ViewGrammar $ Tree.Node "try" [unViewGrammar x] + empty = ViewGrammar $ Tree.Node ("empty", "") [] + x <|> y = ViewGrammar $ Tree.Node ("<|>", "") [unViewGrammar x, unViewGrammar y] + try x = ViewGrammar $ Tree.Node ("try", "") [unViewGrammar x] instance Satisfiable tok (ViewGrammar sN) where - satisfy _es _p = ViewGrammar $ Tree.Node "satisfy" [] + satisfy _es _p = ViewGrammar $ Tree.Node ("satisfy", "") [] instance Selectable (ViewGrammar sN) where - branch lr l r = ViewGrammar $ Tree.Node "branch" + branch lr l r = ViewGrammar $ Tree.Node ("branch", "") [ unViewGrammar lr, unViewGrammar l, unViewGrammar r ] instance Matchable (ViewGrammar sN) where - conditional a _ps bs b = ViewGrammar $ Tree.Node "conditional" + conditional a _ps bs b = ViewGrammar $ Tree.Node ("conditional", "") [ unViewGrammar a - , Tree.Node "bs" (unViewGrammar Fct.<$> bs) + , Tree.Node ("branches", "") (unViewGrammar Fct.<$> bs) , unViewGrammar b ] instance Lookable (ViewGrammar sN) where - look x = ViewGrammar $ Tree.Node "look" [unViewGrammar x] - negLook x = ViewGrammar $ Tree.Node "negLook" [unViewGrammar x] - eof = ViewGrammar $ Tree.Node "eof" [] + look x = ViewGrammar $ Tree.Node ("look", "") [unViewGrammar x] + negLook x = ViewGrammar $ Tree.Node ("negLook", "") [unViewGrammar x] + eof = ViewGrammar $ Tree.Node ("eof", "") [] instance Foldable (ViewGrammar sN) where - chainPre f x = ViewGrammar $ Tree.Node "chainPre" [unViewGrammar f, unViewGrammar x] - chainPost x f = ViewGrammar $ Tree.Node "chainPost" [unViewGrammar x, unViewGrammar f] + chainPre f x = ViewGrammar $ Tree.Node ("chainPre", "") [unViewGrammar f, unViewGrammar x] + chainPost x f = ViewGrammar $ Tree.Node ("chainPost", "") [unViewGrammar x, unViewGrammar f] diff --git a/src/Symantic/Parser/Grammar/Write.hs b/src/Symantic/Parser/Grammar/Write.hs index 81bb490..e9eab38 100644 --- a/src/Symantic/Parser/Grammar/Write.hs +++ b/src/Symantic/Parser/Grammar/Write.hs @@ -9,6 +9,7 @@ import Data.Monoid (Monoid(..)) import Data.Semigroup (Semigroup(..)) import Data.String (IsString(..)) import qualified Data.Functor as Pre +import qualified Data.HashMap.Strict as HM import qualified Data.List as List import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB @@ -18,7 +19,8 @@ import Symantic.Parser.Grammar.Combinators import Symantic.Parser.Grammar.Fixity -- * Type 'WriteGrammar' -newtype WriteGrammar (showName::Bool) a = WriteGrammar { unWriteGrammar :: WriteGrammarInh -> Maybe TLB.Builder } +newtype WriteGrammar (showName::Bool) a = WriteGrammar { unWriteGrammar :: + WriteGrammarInh -> Maybe TLB.Builder } instance IsString (WriteGrammar sN a) where fromString s = WriteGrammar $ \_inh -> @@ -41,7 +43,9 @@ emptyWriteGrammarInh = WriteGrammarInh } writeGrammar :: WriteGrammar sN a -> TL.Text -writeGrammar (WriteGrammar r) = TLB.toLazyText $ fromMaybe "" $ r emptyWriteGrammarInh +writeGrammar (WriteGrammar go) = + TLB.toLazyText $ fromMaybe "" $ + go emptyWriteGrammarInh pairWriteGrammarInh :: Semigroup s => IsString s => @@ -55,9 +59,9 @@ pairWriteGrammarInh inh op s = instance ShowLetName sN letName => Letable letName (WriteGrammar sN) where - def name x = WriteGrammar $ \inh -> + shareable name x = WriteGrammar $ \inh -> pairWriteGrammarInh inh op $ - Just "def " + Just "shareable " <> Just (fromString (showLetName @sN name)) <> unWriteGrammar x inh where @@ -68,6 +72,20 @@ instance Just (fromString (showLetName @sN name)) where op = infixN 9 +instance + ShowLetName sN letName => + Letsable letName (WriteGrammar sN) where + lets defs x = WriteGrammar $ \inh -> + pairWriteGrammarInh inh op $ + Just "let " + <> HM.foldMapWithKey + (\name (SomeLet val) -> + Just (fromString (showLetName @sN name)) + <> unWriteGrammar val inh) + defs + <> unWriteGrammar x inh + where + op = infixN 9 instance Applicable (WriteGrammar sN) where pure _ = WriteGrammar $ return Nothing -- pure _ = "pure" diff --git a/src/Symantic/Parser/Haskell/Optimize.hs b/src/Symantic/Parser/Haskell/Optimize.hs index 0d5c4df..d6022b0 100644 --- a/src/Symantic/Parser/Haskell/Optimize.hs +++ b/src/Symantic/Parser/Haskell/Optimize.hs @@ -112,8 +112,8 @@ instance Trans (Term Identity) Identity where (:$) -> ($) -} instance Trans (Term TH.CodeQ) TH.CodeQ where - -- Superfluous pattern-matches are only - -- out of a cosmetic concerns when reading *.dump-splices, + -- Superfluous pattern-matches are only here + -- for cosmetic concerns when reading *.dump-splices, -- not for optimizing, which is done in 'optimizeTerm'. trans = \case Cons :@ x :@ y -> [|| $$(trans x) : $$(trans y) ||] diff --git a/src/Symantic/Parser/Machine.hs b/src/Symantic/Parser/Machine.hs index 26f92b0..814f4d4 100644 --- a/src/Symantic/Parser/Machine.hs +++ b/src/Symantic/Parser/Machine.hs @@ -9,6 +9,7 @@ module Symantic.Parser.Machine ) where import Data.Function ((.)) import Data.Ord (Ord) +import System.IO (IO) import Text.Show (Show) import qualified Language.Haskell.TH.Syntax as TH @@ -36,5 +37,5 @@ machine :: forall inp repr a. Grammar (InputToken inp) (Program repr inp) => Machine (InputToken inp) repr => ParserRepr repr inp a -> - repr inp '[] a + IO (repr inp '[] a) machine = optimizeMachine . grammar @(InputToken inp) diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs index a350b55..c059fc2 100644 --- a/src/Symantic/Parser/Machine/Generate.hs +++ b/src/Symantic/Parser/Machine/Generate.hs @@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE StandaloneDeriving #-} -- For Show (ParsingError inp) {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE UnboxedTuples #-} -- For nextInput {-# LANGUAGE UndecidableInstances #-} -- For Show (ParsingError inp) module Symantic.Parser.Machine.Generate where @@ -8,23 +9,27 @@ module Symantic.Parser.Machine.Generate where import Control.Monad (Monad(..)) import Data.Bool (Bool) import Data.Char (Char) -import Data.Either (Either(..)) -import Data.Function (($), (.)) -import Data.Functor ((<$>)) +import Data.Either (Either(..), either) +import Data.Function (($), (.), id, const, on) +import Data.Functor (Functor, (<$>), (<$)) +import Data.Foldable (foldMap') import Data.Int (Int) -import Data.List (minimum) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) import Data.Maybe (Maybe(..)) -import Data.Monoid (Monoid(..)) import Data.Ord (Ord(..), Ordering(..)) import Data.Semigroup (Semigroup(..)) import Data.Set (Set) import Data.String (String) -import Language.Haskell.TH (CodeQ, Code(..)) -import Prelude ((+), (-)) -import Text.Show (Show(..)) +import Data.Traversable (Traversable(..)) +import Data.Tuple (fst) import GHC.TypeLits (symbolVal) +import Language.Haskell.TH (CodeQ) +import Prelude ((+), (-), error) +import Text.Show (Show(..)) +-- import qualified Control.Monad.Trans.State.Strict as MT +import qualified Data.HashMap.Strict as HM +import qualified Data.List as List import qualified Data.List.NonEmpty as NE import qualified Data.Map.Internal as Map_ import qualified Data.Map.Strict as Map @@ -32,13 +37,15 @@ import qualified Data.Set as Set import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH +import Symantic.Univariant.Letable import Symantic.Univariant.Trans import Symantic.Parser.Grammar.Combinators (ErrorItem(..)) import Symantic.Parser.Machine.Input import Symantic.Parser.Machine.Instructions import qualified Symantic.Parser.Haskell as H -import Debug.Trace (trace) +--import Debug.Trace +trace = const id genCode :: TermInstr a -> CodeQ a genCode = trans @@ -46,61 +53,15 @@ genCode = trans -- * Type 'Gen' -- | Generate the 'CodeQ' parsing the input. data Gen inp vs a = Gen - { minHorizon :: Map TH.Name Horizon -> Horizon - -- ^ Synthetized (bottom-up) minimal input length - -- required by the parser to not fail. - -- This requires a 'minHorizonByName' - -- containing the minimal 'Horizon's of all the 'TH.Name's - -- this parser 'call's, 'jump's or 'refJoin's to. - , exceptions :: Map TH.Name (Map ErrorLabel ()) -> Map ErrorLabel () + { genAnalysisByLet :: LetMapFix (CallTrace -> GenAnalysis) + -- ^ 'genAnalysis' for each 'defLet' and 'defJoin' of the 'Machine'. + , genAnalysis :: LetMapTo (CallTrace -> GenAnalysis) + -- ^ Synthetized (bottom-up) static genAnalysis of the 'Machine'. , unGen :: GenCtx inp vs a -> CodeQ (Either (ParsingError inp) a) } --- ** Type 'ParsingError' -data ParsingError inp - = ParsingErrorStandard - { parsingErrorOffset :: Offset - -- | Note that if an 'ErrorItemHorizon' greater than 1 - -- is amongst the 'parsingErrorExpecting' - -- then this is only the 'InputToken' - -- at the begining of the expected 'Horizon'. - , parsingErrorUnexpected :: Maybe (InputToken inp) - , parsingErrorExpecting :: Set (ErrorItem (InputToken inp)) - } -deriving instance Show (InputToken inp) => Show (ParsingError inp) - --- ** Type 'ErrorLabel' -type ErrorLabel = String - --- ** Type 'Offset' -type Offset = Int - --- ** Type 'Horizon' --- | Synthetized minimal input length --- required for a successful parsing. --- Used with 'checkedHorizon' to factorize input length checks, --- instead of checking the input length --- one 'InputToken' at a time at each 'read'. -type Horizon = Offset - --- ** Type 'Cont' -type Cont inp v a = - {-farthestInput-}Cursor inp -> - {-farthestExpecting-}[ErrorItem (InputToken inp)] -> - v -> - Cursor inp -> - Either (ParsingError inp) a - -{- --- *** Type 'FarthestError' -data FarthestError inp = FarthestError - { farthestInput :: Cursor inp - , farthestExpecting :: [ErrorItem (InputToken inp)] - } --} - -- | @('generateCode' input mach)@ generates @TemplateHaskell@ code -- parsing the given 'input' according to the given 'Machine'. generateCode :: @@ -131,6 +92,7 @@ generateCode k = [|| \(input :: inp) -> { valueStack = ValueStackEmpty , catchStackByLabel = Map.empty , defaultCatch = [||finalRaise||] + , callStack = [] , retCode = [||finalRet||] , input = [||init||] , nextInput = [||readNext||] @@ -139,11 +101,104 @@ generateCode k = [|| \(input :: inp) -> , farthestInput = [||init||] , farthestExpecting = [|| [] ||] , checkedHorizon = 0 - , minHorizonByName = Map.empty - , exceptionsByName = Map.empty + , horizonStack = [] + , finalGenAnalysisByLet = runGenAnalysis (genAnalysisByLet k) }) ||] +-- ** Type 'ParsingError' +data ParsingError inp + = ParsingErrorStandard + { parsingErrorOffset :: Offset + -- | Note that if an 'ErrorItemHorizon' greater than 1 + -- is amongst the 'parsingErrorExpecting' + -- then this is only the 'InputToken' + -- at the begining of the expected 'Horizon'. + , parsingErrorUnexpected :: Maybe (InputToken inp) + , parsingErrorExpecting :: Set (ErrorItem (InputToken inp)) + } +deriving instance Show (InputToken inp) => Show (ParsingError inp) + +-- ** Type 'ErrorLabel' +type ErrorLabel = String + +-- * Type 'GenAnalysis' +data GenAnalysis = GenAnalysis + { minReads :: Either ErrorLabel Horizon + , mayRaise :: Map ErrorLabel () + } deriving (Show) + +-- | Tie the knot between mutually recursive 'TH.Name's +-- introduced by 'defLet' and 'defJoin'. +-- and provide the empty initial 'CallTrace' stack +runGenAnalysis :: + LetMapFix (CallTrace -> GenAnalysis) -> + LetMap GenAnalysis +runGenAnalysis ga = (($ []) <$>) $ polyfix ga + +-- | Poly-variadic fixpoint combinator. +-- Used to express mutual recursion and to transparently introduce memoization. +-- Used to "tie the knot" between observed sharing ('defLet', 'call', 'jump') +-- and join points ('defJoin', 'refJoin'). +-- All mutually dependent functions are restricted to the same polymorphic type @(a)@. +-- See http://okmij.org/ftp/Computation/fixed-point-combinators.html#Poly-variadic +polyfix :: Functor f => f (f a -> a) -> f a +polyfix fs = fix $ \finals -> ($ finals) <$> fs + +fix :: (a -> a) -> a +fix f = final where final = f final + +type LetMap = HM.HashMap TH.Name +type LetMapTo a = LetMap a -> a +type LetMapFix a = LetMap (LetMap a -> a) + +-- | Call trace stack updated by 'call' and 'refJoin'. +-- Used to avoid infinite loops when tying the knot with 'polyfix'. +type CallTrace = [TH.Name] + +-- ** Type 'Offset' +type Offset = Int +-- ** Type 'Horizon' +-- | Minimal input length required for a successful parsing. +type Horizon = Offset + +-- seqGenAnalysis = +-- altGenAnalysis = List.foldl' (\acc x -> either Left (\h -> Right (either (const h) (min h) acc)) x) +seqGenAnalysis :: NonEmpty GenAnalysis -> GenAnalysis +seqGenAnalysis aas@(a:|as) = GenAnalysis + { minReads = List.foldl' (\acc x -> + acc >>= \r -> (r +) <$> minReads x + ) (minReads a) as + , mayRaise = sconcat (mayRaise <$> aas) + } +altGenAnalysis :: NonEmpty GenAnalysis -> GenAnalysis +altGenAnalysis aas@(a:|as) = GenAnalysis + { minReads = List.foldl' (\acc x -> + either + (\l -> either (const (Left l)) Right) + (\r -> either (const (Right r)) (Right . min r)) + acc (minReads x) + ) (minReads a) as + , mayRaise = sconcat (mayRaise <$> aas) + } + + +-- ** Type 'Cont' +type Cont inp v a = + {-farthestInput-}Cursor inp -> + {-farthestExpecting-}[ErrorItem (InputToken inp)] -> + v -> + Cursor inp -> + Either (ParsingError inp) a + +{- +-- *** Type 'FarthestError' +data FarthestError inp = FarthestError + { farthestInput :: Cursor inp + , farthestExpecting :: [ErrorItem (InputToken inp)] + } +-} + -- ** Type 'GenCtx' -- | This is an inherited (top-down) context -- only present at compile-time, to build TemplateHaskell splices. @@ -157,6 +212,8 @@ data GenCtx inp vs a = -- | Default 'Catcher' defined at the begining of the generated 'CodeQ', -- hence a constant within the 'Gen'eration. , defaultCatch :: forall b. CodeQ (Catcher inp b) + -- | Used by 'checkToken' to get 'GenAnalysis' from 'genAnalysis'. + , callStack :: [TH.Name] , retCode :: CodeQ (Cont inp a a) , input :: CodeQ (Cursor inp) , moreInput :: CodeQ (Cursor inp -> Bool) @@ -164,16 +221,17 @@ data GenCtx inp vs a = , farthestInput :: CodeQ (Cursor inp) , farthestExpecting :: CodeQ [ErrorItem (InputToken inp)] -- | Remaining horizon already checked. + -- Use to factorize 'input' length checks, + -- instead of checking the 'input' length + -- one 'InputToken' at a time at each 'read'. -- Updated by 'checkHorizon' -- and reset elsewhere when needed. , checkedHorizon :: Horizon - -- | Minimal horizon for each 'defLet' or 'defJoin'. - -- This can be done as an inherited attribute because - -- 'OverserveSharing' introduces 'def' as an ancestor node - -- of all the 'ref's pointing to it. - -- Same for 'defJoin' and its 'refJoin's. - , minHorizonByName :: Map TH.Name Horizon - , exceptionsByName :: Map TH.Name (Map ErrorLabel ()) + -- | Used by 'pushInput' and 'loadInput' + -- to restore the 'Horizon' at the restored 'input'. + , horizonStack :: [Horizon] + -- | Output of 'runGenAnalysis'. + , finalGenAnalysisByLet :: LetMap GenAnalysis } -- ** Type 'ValueStack' @@ -186,32 +244,32 @@ data ValueStack vs where instance InstrValuable Gen where pushValue x k = k - { unGen = \ctx -> unGen k ctx + { unGen = \ctx -> trace "unGen.pushValue" $ unGen k ctx { valueStack = ValueStackCons x (valueStack ctx) } } popValue k = k - { unGen = \ctx -> unGen k ctx + { unGen = \ctx -> trace "unGen.popValue" $ unGen k ctx { valueStack = valueStackTail (valueStack ctx) } } lift2Value f k = k - { unGen = \ctx -> unGen k ctx + { unGen = \ctx -> trace "unGen.lift2Value" $ unGen k ctx { valueStack = - let ValueStackCons y (ValueStackCons x xs) = valueStack ctx in - ValueStackCons (f H.:@ x H.:@ y) xs + let ValueStackCons y (ValueStackCons x vs) = valueStack ctx in + ValueStackCons (f H.:@ x H.:@ y) vs } } swapValue k = k - { unGen = \ctx -> unGen k ctx + { unGen = \ctx -> trace "unGen.swapValue" $ unGen k ctx { valueStack = - let ValueStackCons y (ValueStackCons x xs) = valueStack ctx in - ValueStackCons x (ValueStackCons y xs) + let ValueStackCons y (ValueStackCons x vs) = valueStack ctx in + ValueStackCons x (ValueStackCons y vs) } } instance InstrBranchable Gen where caseBranch kx ky = Gen - { minHorizon = \hs -> minHorizon kx hs `min` minHorizon ky hs - , exceptions = \hs -> exceptions kx hs <> exceptions ky hs - , unGen = \ctx -> + { genAnalysisByLet = genAnalysisByLet kx <> genAnalysisByLet ky + , genAnalysis = \final ct -> altGenAnalysis $ genAnalysis kx final ct :| [genAnalysis ky final ct] + , unGen = \ctx -> trace "unGen.caseBranch" $ let ValueStackCons v vs = valueStack ctx in [|| case $$(genCode v) of @@ -220,39 +278,45 @@ instance InstrBranchable Gen where ||] } choicesBranch fs ks kd = Gen - { minHorizon = \hs -> minimum $ - minHorizon kd hs : - (($ hs) . minHorizon <$> ks) - , exceptions = \hs -> mconcat $ - exceptions kd hs : - (($ hs) . exceptions <$> ks) - , unGen = \ctx -> + { genAnalysisByLet = sconcat $ genAnalysisByLet kd :| (genAnalysisByLet <$> ks) + , genAnalysis = \final ct -> altGenAnalysis $ (\k -> genAnalysis k final ct) <$> (kd:|ks) + , unGen = \ctx -> trace "unGen.choicesBranch" $ let ValueStackCons v vs = valueStack ctx in go ctx{valueStack = vs} v fs ks } where go ctx x (f:fs') (k:ks') = [|| - if $$(genCode (f H.:@ x)) - then $$(unGen k ctx) - else $$(go ctx x fs' ks') + if $$(genCode (H.optimizeTerm (f H.:@ x))) + then + let _ = "choicesBranch.then" in + $$(trace "unGen.choicesBranch.k" $ unGen k ctx) + else + let _ = "choicesBranch.else" in + $$(go ctx x fs' ks') ||] go ctx _ _ _ = unGen kd ctx instance InstrExceptionable Gen where raiseException lbl failExp = Gen - { minHorizon = \_hs -> 0 - , exceptions = \_hs -> Map.singleton (symbolVal lbl) () - , unGen = \ctx@GenCtx{} -> [|| + { genAnalysisByLet = HM.empty + , genAnalysis = \_final _ct -> GenAnalysis + { minReads = Left (symbolVal lbl) + , mayRaise = Map.singleton (symbolVal lbl) () + } + , unGen = \ctx@GenCtx{} -> trace ("unGen.raiseException: "<>symbolVal lbl) $ [|| let (# farInp, farExp #) = case $$compareOffset $$(farthestInput ctx) $$(input ctx) of LT -> (# $$(input ctx), failExp #) EQ -> (# $$(farthestInput ctx), $$(farthestExpecting ctx) <> failExp #) GT -> (# $$(farthestInput ctx), $$(farthestExpecting ctx) #) in - $$(NE.head (Map.findWithDefault (NE.singleton (defaultCatch ctx)) (symbolVal lbl) (catchStackByLabel ctx))) + $$(NE.head $ Map.findWithDefault + (NE.singleton (defaultCatch ctx)) + (symbolVal lbl) + (catchStackByLabel ctx)) $$(input ctx) farInp farExp ||] } popException lbl k = k - { unGen = \ctx -> + { unGen = \ctx -> trace ("unGen.popException: "<>symbolVal lbl) $ unGen k ctx{catchStackByLabel = Map.update (\case _r0:|(r1:rs) -> Just (r1:|rs) _ -> Nothing @@ -260,27 +324,42 @@ instance InstrExceptionable Gen where } } catchException lbl ok ko = Gen - { minHorizon = \hs -> minHorizon ok hs `min` minHorizon ko hs - , exceptions = \hs -> exceptions ok hs <> exceptions ko hs - , unGen = \ctx@GenCtx{} -> [|| - let _ = $$(TH.liftTyped ("catchException lbl="<>symbolVal lbl)) in - $$(unGen ok ctx - { catchStackByLabel = Map.insertWith (<>) (symbolVal lbl) - (NE.singleton ([|| \ !failInp !farInp !farExp -> - $$(unGen ko ctx - -- PushValue the input as it was when entering the catchFail. - { valueStack = ValueStackCons (H.Term (input ctx)) (valueStack ctx) + { genAnalysisByLet = genAnalysisByLet ok <> genAnalysisByLet ko + , genAnalysis = \final ct -> + let ga = altGenAnalysis $ genAnalysis ok final ct :| [ genAnalysis ko final ct ] in + ga { mayRaise = Map.delete (symbolVal lbl) (mayRaise ga) } + , unGen = \ctx@GenCtx{} -> trace ("unGen.catchException: "<>symbolVal lbl) $ [|| + let _ = $$(liftTypedString ("catchException lbl="<>symbolVal lbl)) in + let catchHandler !failInp !farInp !farExp = + let _ = $$(liftTypedString ("catchException.ko lbl="<>symbolVal lbl)) in + $$(trace ("unGen.catchException.ko: "<>symbolVal lbl) $ unGen ko ctx + -- Push 'input' and 'checkedHorizon' + -- as they were when entering 'catchException'. + { valueStack = + ValueStackCons (H.Term (input ctx)) $ + valueStack ctx + , horizonStack = + checkedHorizon ctx : horizonStack ctx -- Note that 'catchStackByLabel' is reset. -- Move the input to the failing position. , input = [||failInp||] + -- The 'checkedHorizon' at the 'raiseException's + -- are not known here. + -- Nor whether 'failInp' is after + -- 'checkedHorizon' 'ctx' or not. + , checkedHorizon = 0 -- Set the farthestInput to the farthest computed by 'fail' , farthestInput = [||farInp||] , farthestExpecting = [||farExp||] }) - ||])) (catchStackByLabel ctx) + in + $$(trace ("unGen.catchException.ok: "<>symbolVal lbl) $ unGen ok ctx + { catchStackByLabel = Map.insertWith (<>) (symbolVal lbl) + (NE.singleton [||catchHandler||]) (catchStackByLabel ctx) } ) ||] } + -- ** Type 'Catcher' type Catcher inp a = {-failureInput-}Cursor inp -> @@ -288,41 +367,65 @@ type Catcher inp a = {-farthestExpecting-}[ErrorItem (InputToken inp)] -> Either (ParsingError inp) a instance InstrInputable Gen where + pushInput k = k + { unGen = \ctx -> + trace "unGen.pushInput" $ + unGen k ctx + { valueStack = H.Term (input ctx) `ValueStackCons` valueStack ctx + , horizonStack = checkedHorizon ctx : horizonStack ctx + } + } loadInput k = k { unGen = \ctx -> - let ValueStackCons input vs = valueStack ctx in - unGen k ctx - { valueStack = vs - , input = genCode input - , checkedHorizon = 0 + trace "unGen.loadInput" $ + let ValueStackCons input vs = valueStack ctx in + let (h, hs) = case horizonStack ctx of + [] -> (0, []) + x:xs -> (x, xs) in + unGen k ctx + { valueStack = vs + , horizonStack = hs + , input = genCode input + , checkedHorizon = h + } + , genAnalysis = \final ct -> GenAnalysis + { minReads = 0 <$ minReads (genAnalysis k final ct) + , mayRaise = mayRaise (genAnalysis k final ct) } } - pushInput k = k - { unGen = \ctx -> - unGen k ctx{valueStack = ValueStackCons (H.Term (input ctx)) (valueStack ctx)} +instance InstrCallable Gen where + defLet defs k = k + { unGen = \ctx@GenCtx{} -> + trace ("unGen.defLet: defs="<>show (HM.keys defs)) $ + TH.unsafeCodeCoerce $ do + decls <- traverse (makeDecl ctx) $ + List.sortBy (compare `on` fst) $ + HM.toList defs + body <- TH.unTypeQ (TH.examineCode (trace "unGen.defLet.body" $ unGen k ctx)) + return (TH.LetE decls body) + , genAnalysisByLet = + foldMap' (\(SomeLet sub) -> genAnalysisByLet sub) defs <> + ((\(SomeLet sub) -> genAnalysis sub) <$> defs) <> + genAnalysisByLet k } -instance InstrLetable Gen where - defLet (LetName n) sub k = k - { unGen = \ctx@GenCtx{} -> Code $ TH.unsafeTExpCoerce $ do - -- 'sub' is recursively 'call'able within 'sub', - -- but its maximal 'minHorizon' is not known yet. - let minHorizonByNameButSub = Map.insert n 0 (minHorizonByName ctx) - let raiseLabelsByNameButSub = Map.insert n Map.empty (exceptionsByName ctx) + where + makeDecl ctx (n, SomeLet sub) = do body <- TH.unTypeQ $ TH.examineCode $ [|| -- buildRec in Parsley -- Called by 'call' or 'jump'. \ !ok{-from generateSuspend or retCode-} !inp !koByLabel{- 'catchStackByLabel' from the 'call'-site -} -> - $$(unGen sub ctx + $$(trace ("unGen.defLet.sub: "<>show n) $ unGen sub ctx { valueStack = ValueStackEmpty -- Build a 'catchStackByLabel' from the one available at the 'call'-site. - -- Note that all the 'exceptions' of the 'sub'routine may not be available, + -- Note that all the 'mayRaise' of the 'sub'routine may not be available, -- hence 'Map.findWithDefault' is used instead of 'Map.!'. , catchStackByLabel = Map.mapWithKey (\lbl () -> NE.singleton [||Map.findWithDefault $$(defaultCatch ctx) lbl koByLabel||]) - (exceptions sub raiseLabelsByNameButSub) + (trace ("mayRaise: "<>show n) $ + mayRaise (finalGenAnalysisByLet ctx HM.! n)) , input = [||inp||] - , retCode = [||ok||] + , retCode = trace ("unGen.defLet.sub.retCode: "<>show n) [||ok||] -- These are passed by the caller via 'ok' or 'ko' -- , farthestInput = @@ -334,62 +437,71 @@ instance InstrLetable Gen where -- by taking the minimum of the checked horizons -- before all the 'call's and 'jump's to this 'defLet'. , checkedHorizon = 0 - , minHorizonByName = minHorizonByNameButSub - , exceptionsByName = raiseLabelsByNameButSub }) ||] let decl = TH.FunD n [TH.Clause [] (TH.NormalB body) []] - expr <- TH.unTypeQ (TH.examineCode (unGen k ctx - { minHorizonByName = - -- 'sub' is 'call'able within 'k'. - Map.insert n - (minHorizon sub minHorizonByNameButSub) - (minHorizonByName ctx) - , exceptionsByName = - Map.insert n - (exceptions sub raiseLabelsByNameButSub) - (exceptionsByName ctx) - })) - return (TH.LetE [decl] expr) - } + return decl jump (LetName n) = Gen - { minHorizon = (Map.! n) - , exceptions = (Map.! n) - , unGen = \ctx -> [|| + { genAnalysisByLet = HM.empty + , genAnalysis = \final ct -> + if n`List.elem`ct + then GenAnalysis + { minReads = Right 0 + , mayRaise = Map.empty + } + else (final HM.! n) (n:ct) + , unGen = \ctx -> trace ("unGen.jump: "<>show n) $ [|| let _ = "jump" in - $$(Code (TH.unsafeTExpCoerce (return (TH.VarE n)))) + $$(TH.unsafeCodeCoerce (return (TH.VarE n))) {-ok-}$$(retCode ctx) $$(input ctx) $$(liftTypedRaiseByLabel $ catchStackByLabel ctx -- Pass only the labels raised by the 'defLet'. `Map.intersection` - (exceptionsByName ctx Map.! n) - ) + (mayRaise $ finalGenAnalysisByLet ctx HM.! n) + ) ||] } call (LetName n) k = k - { minHorizon = (Map.! n) - , exceptions = (Map.! n) - , unGen = \ctx -> let ks = (Map.keys (catchStackByLabel ctx)) in [|| - let _ = $$(TH.liftTyped $ "call exceptionsByName("<>show n<>")="<>show (Map.keys (Map.findWithDefault Map.empty n (exceptionsByName ctx))) <> " catchStackByLabel(ctx)="<> show ks) in - $$(Code (TH.unsafeTExpCoerce (return (TH.VarE n)))) - {-ok-}$$(generateSuspend k ctx) + { genAnalysis = \final ct -> + if n`List.elem`ct + then GenAnalysis + { minReads = Right 0 + , mayRaise = Map.empty + } + else seqGenAnalysis $ + (final HM.! n) (n:ct) :| + [ genAnalysis k final ct ] + , unGen = trace ("unGen.call: "<>show n) $ \ctx -> + -- let ks = (Map.keys (catchStackByLabel ctx)) in + [|| + -- let _ = $$(liftTypedString $ "call exceptByLet("<>show n<>")="<>show (Map.keys (Map.findWithDefault Map.empty n (exceptByLet ctx))) <> " catchStackByLabel(ctx)="<> show ks) in + $$(TH.unsafeCodeCoerce (return (TH.VarE n))) + {-ok-}$$(generateSuspend k ctx{callStack = n : callStack ctx}) $$(input ctx) $$(liftTypedRaiseByLabel $ catchStackByLabel ctx -- Pass only the labels raised by the 'defLet'. `Map.intersection` - (exceptionsByName ctx Map.! n) + (mayRaise $ finalGenAnalysisByLet ctx HM.! n) ) ||] } ret = Gen - { minHorizon = \_hs -> 0 - , exceptions = \_hs -> Map.empty - , unGen = \ctx -> unGen (generateResume (retCode ctx)) ctx + { genAnalysisByLet = HM.empty + , genAnalysis = \_final _ct -> GenAnalysis + { minReads = Right 0 + , mayRaise = Map.empty + } + , unGen = \ctx -> trace "unGen.ret" $ unGen (trace "unGen.ret.generateResume" $ generateResume (trace "unGen.ret.retCode" $ retCode ctx)) ctx } +-- | Like 'TH.liftString' but on 'TH.Code'. +-- Useful to get a 'TH.StringL' instead of a 'TH.ListE'. +liftTypedString :: String -> TH.Code TH.Q a +liftTypedString = TH.unsafeCodeCoerce . TH.liftString + -- | Like 'TH.liftTyped' but adjusted to work on 'catchStackByLabel' -- which already contains 'CodeQ' terms. -- Moreover, only the 'Catcher' at the top of the stack @@ -403,16 +515,16 @@ liftTypedRaiseByLabel (Map_.Bin s k (h:|_hs) l r) = -- | Generate a 'retCode' 'Cont'inuation to be called with 'generateResume'. -- Used when 'call' 'ret'urns. --- The return 'v'alue is 'pushValue'ed on the 'valueStack'. +-- The return 'v'alue is 'pushValue'-ed on the 'valueStack'. generateSuspend :: {-k-}Gen inp (v ': vs) a -> GenCtx inp vs a -> CodeQ (Cont inp v a) generateSuspend k ctx = [|| - let _ = $$(TH.liftTyped $ "suspend raiseException=" <> show (exceptionsByName ctx)) in + let _ = $$(liftTypedString $ "suspend") in \farInp farExp v !inp -> - $$(unGen k ctx - { valueStack = ValueStackCons (H.Term [||v||]) (valueStack ctx) + $$(trace "unGen.generateSuspend" $ unGen k ctx + { valueStack = ValueStackCons (trace "unGen.generateSuspend.value" $ H.Term [||v||]) (valueStack ctx) , input = [||inp||] , farthestInput = [||farInp||] , farthestExpecting = [||farExp||] @@ -427,58 +539,67 @@ generateResume :: CodeQ (Cont inp v a) -> Gen inp (v ': vs) a generateResume k = Gen - { minHorizon = \_hs -> 0 - , exceptions = \_hs -> Map.empty - , unGen = \ctx -> [|| + { genAnalysisByLet = HM.empty + , genAnalysis = \_final _ct -> GenAnalysis + { minReads = Right 0 + , mayRaise = Map.empty + } + , unGen = \ctx -> trace "unGen.generateResume" $ [|| let _ = "resume" in $$k $$(farthestInput ctx) $$(farthestExpecting ctx) - (let _ = "resume.genCode" in $$(genCode (valueStackHead (valueStack ctx)))) + (let _ = "resume.genCode" in $$(trace "unGen.generateResume.genCode" $ genCode $ H.optimizeTerm $ + valueStackHead $ valueStack ctx)) $$(input ctx) ||] } instance InstrJoinable Gen where - defJoin (LetName n) joined k = k - { unGen = \ctx -> Code $ TH.unsafeTExpCoerce $ do - body <- TH.unTypeQ $ TH.examineCode $ [|| - -- Called by 'generateResume'. - \farInp farExp v !inp -> - $$(unGen joined ctx - { valueStack = ValueStackCons (H.Term [||v||]) (valueStack ctx) - , input = [||inp||] - , farthestInput = [||farInp||] - , farthestExpecting = [||farExp||] - , checkedHorizon = 0 - {- FIXME: - , catchStackByLabel = Map.mapWithKey - (\lbl () -> NE.singleton [||koByLabel Map.! lbl||]) - (exceptions joined raiseLabelsByNameButSub) - -} - }) - ||] - let decl = TH.FunD n [TH.Clause [] (TH.NormalB body) []] - expr <- TH.unTypeQ (TH.examineCode (unGen k ctx - { minHorizonByName = - -- 'joined' is 'refJoin'able within 'k'. - Map.insert n - -- By definition (in 'joinNext') - -- 'joined' is not recursively 'refJoin'able within 'joined', - -- hence no need to prevent against recursivity - -- as has to be done in 'defLet'. - (minHorizon joined (minHorizonByName ctx)) - (minHorizonByName ctx) - , exceptionsByName = - Map.insert n - (exceptions joined (exceptionsByName ctx)) - (exceptionsByName ctx) - })) - return (TH.LetE [decl] expr) + defJoin (LetName n) sub k = k + { unGen = + \ctx -> + trace ("unGen.defJoin: "<>show n) $ + TH.unsafeCodeCoerce $ do + next <- TH.unTypeQ $ TH.examineCode $ [|| + -- Called by 'generateResume'. + \farInp farExp v !inp -> + $$(trace ("unGen.defJoin.next: "<>show n) $ unGen sub ctx + { valueStack = ValueStackCons (H.Term [||v||]) (valueStack ctx) + , input = [||inp||] + , farthestInput = [||farInp||] + , farthestExpecting = [||farExp||] + , checkedHorizon = 0 + {- FIXME: + , catchStackByLabel = Map.mapWithKey + (\lbl () -> NE.singleton [||koByLabel Map.! lbl||]) + (mayRaise sub raiseLabelsByLetButSub) + -} + }) + ||] + let decl = TH.FunD n [TH.Clause [] (TH.NormalB next) []] + expr <- TH.unTypeQ (TH.examineCode (trace ("unGen.defJoin.expr: "<>show n) $ unGen k ctx)) + return (TH.LetE [decl] expr) + , genAnalysisByLet = + (genAnalysisByLet sub <>) $ + HM.insert n (genAnalysis sub) $ + genAnalysisByLet k } - refJoin (LetName n) = (generateResume (Code (TH.unsafeTExpCoerce (return (TH.VarE n))))) - { minHorizon = (Map.! n) - , exceptions = (Map.! n) + refJoin (LetName n) = Gen + { unGen = \ctx -> + trace ("unGen.refJoin: "<>show n) $ + unGen (generateResume + (TH.unsafeCodeCoerce (return (TH.VarE n)))) ctx + , genAnalysisByLet = HM.empty + , genAnalysis = \final ct -> + if n`List.elem`ct -- FIXME: useless + then GenAnalysis + { minReads = Right 0 + , mayRaise = Map.empty + } + else HM.findWithDefault + (error (show (n,ct,HM.keys final))) + n final (n:ct) } instance InstrReadable Char Gen where read farExp p = checkHorizon . checkToken farExp p @@ -488,19 +609,29 @@ checkHorizon :: {-ok-}Gen inp vs a -> Gen inp vs a checkHorizon ok = ok - { minHorizon = \hs -> 1 + minHorizon ok hs - , exceptions = \hs -> Map.insert "fail" () $ exceptions ok hs + { genAnalysis = \final ct -> seqGenAnalysis $ + GenAnalysis { minReads = Right 1 + , mayRaise = Map.singleton "fail" () + } :| + [ genAnalysis ok final ct ] , unGen = \ctx0@GenCtx{} -> - let raiseByLbl = - NE.head (Map.findWithDefault (NE.singleton (defaultCatch ctx0)) "fail" (catchStackByLabel ctx0)) in + trace "unGen.checkHorizon" $ + let raiseFail = + NE.head (Map.findWithDefault + (NE.singleton (defaultCatch ctx0)) + "fail" (catchStackByLabel ctx0)) in [|| - -- Factorize failure code - let readFail = $$(raiseByLbl) in + -- Factorize generated code for raising the "fail". + let readFail = $$(raiseFail) in $$( - let ctx = ctx0{catchStackByLabel = Map.adjust (\(_r:|rs) -> [||readFail||] :| rs) "fail" (catchStackByLabel ctx0)} in + let ctx = ctx0{catchStackByLabel = + Map.adjust (\(_r:|rs) -> [||readFail||] :| rs) + "fail" (catchStackByLabel ctx0)} in if checkedHorizon ctx >= 1 then unGen ok ctx0{checkedHorizon = checkedHorizon ctx - 1} - else let minHoriz = minHorizon ok (minHorizonByName ctx) in + else let minHoriz = + either (\err -> 0) id $ + minReads $ finalGenAnalysis ctx ok in [|| if $$(moreInput ctx) $$(if minHoriz > 0 @@ -515,6 +646,14 @@ checkHorizon ok = ok ||] } +finalGenAnalysis :: GenCtx inp vs a -> Gen inp cs a -> GenAnalysis +finalGenAnalysis ctx k = + --(\f -> f (error "callTrace")) $ + (\f -> f (callStack ctx)) $ + genAnalysis k $ + ((\f _ct -> f) <$>) $ + finalGenAnalysisByLet ctx + checkToken :: Ord (InputToken inp) => TH.Lift (InputToken inp) => @@ -523,8 +662,7 @@ checkToken :: {-ok-}Gen inp (InputToken inp ': vs) a -> Gen inp vs a checkToken farExp p ok = ok - { exceptions = \hs -> Map.insert "fail" () $ exceptions ok hs - , unGen = \ctx -> [|| + { unGen = \ctx -> trace "unGen.read" $ [|| let !(# c, cs #) = $$(nextInput ctx) $$(input ctx) in if $$(genCode p) c then $$(unGen ok ctx diff --git a/src/Symantic/Parser/Machine/Instructions.hs b/src/Symantic/Parser/Machine/Instructions.hs index df00e09..5ee80b5 100644 --- a/src/Symantic/Parser/Machine/Instructions.hs +++ b/src/Symantic/Parser/Machine/Instructions.hs @@ -29,7 +29,7 @@ type Machine tok repr = , InstrExceptionable repr , InstrInputable repr , InstrJoinable repr - , InstrLetable repr + , InstrCallable repr , InstrValuable repr , InstrReadable tok repr ) @@ -47,17 +47,25 @@ newtype LetName a = LetName { unLetName :: TH.Name } -- ** Class 'InstrValuable' class InstrValuable (repr::ReprInstr) where + -- | @('pushValue' x k)@ pushes @(x)@ on the 'valueStack' + -- and continues with the next 'Instr'uction @(k)@. pushValue :: TermInstr v -> repr inp (v ': vs) a -> repr inp vs a + -- | @('popValue' k)@ pushes @(x)@ on the 'valueStack'. popValue :: repr inp vs a -> repr inp (v ': vs) a + -- | @('lift2Value' f k)@ pops two values from the 'valueStack', + -- and pushes the result of @(f)@ applied to them. lift2Value :: TermInstr (x -> y -> z) -> repr inp (z ': vs) a -> repr inp (y ': x ': vs) a + -- | @('swapValue' k)@ pops two values on the 'valueStack', + -- pushes the first popped-out, then the second, + -- and continues with the next 'Instr'uction @(k)@. swapValue :: repr inp (x ': y ': vs) a -> repr inp (y ': x ': vs) a @@ -97,7 +105,7 @@ class InstrExceptionable (repr::ReprInstr) where repr inp vs a -- | @('catchException' lbl l r)@ tries the @(l)@ 'Instr'uction -- in a new failure scope such that if @(l)@ raises a failure, it is caught, - -- then the input is pushed as it was before trying @(l)@ on the 'valueStack', + -- then the input (and its 'Horizon') is pushed as it was before trying @(l)@ on the 'valueStack', -- and the control flow goes on with the @(r)@ 'Instr'uction. catchException :: KnownSymbol lbl => @@ -128,13 +136,13 @@ class InstrBranchable (repr::ReprInstr) where repr inp (Bool ': vs) a ifBranch ok ko = choicesBranch [H.id] [ok] ko --- ** Class 'InstrLetable' -class InstrLetable (repr::ReprInstr) where +-- ** Class 'InstrCallable' +class InstrCallable (repr::ReprInstr) where -- | @('defLet' n v k)@ binds the 'LetName' @(n)@ to the 'Instr'uction's @(v)@, -- 'Call's @(n)@ and -- continues with the next 'Instr'uction @(k)@. defLet :: - LetName v -> repr inp '[] v -> + LetBindings TH.Name (repr inp '[]) -> repr inp vs a -> repr inp vs a -- | @('call' n k)@ pass the control-flow to the 'DefLet' named @(n)@, @@ -162,16 +170,16 @@ class InstrJoinable (repr::ReprInstr) where -- ** Class 'InstrInputable' class InstrInputable (repr::ReprInstr) where - -- | @('loadInput' k)@ removes the input from the 'valueStack' - -- and continues with the next 'Instr'uction @(k)@ using that input. - loadInput :: - repr inp vs a -> - repr inp (Cursor inp ': vs) a -- | @('pushInput' k)@ pushes the input @(inp)@ on the 'valueStack' -- and continues with the next 'Instr'uction @(k)@. pushInput :: repr inp (Cursor inp ': vs) a -> repr inp vs a + -- | @('loadInput' k)@ removes the input from the 'valueStack' + -- and continues with the next 'Instr'uction @(k)@ using that input. + loadInput :: + repr inp vs a -> + repr inp (Cursor inp ': vs) a -- ** Class 'InstrReadable' class InstrReadable (tok::Type) (repr::ReprInstr) where diff --git a/src/Symantic/Parser/Machine/Optimize.hs b/src/Symantic/Parser/Machine/Optimize.hs index d577009..2b8a6f0 100644 --- a/src/Symantic/Parser/Machine/Optimize.hs +++ b/src/Symantic/Parser/Machine/Optimize.hs @@ -17,6 +17,7 @@ import Data.Proxy (Proxy(..)) import GHC.TypeLits (KnownSymbol) import Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..)) import qualified Data.Functor as Functor +import qualified Language.Haskell.TH as TH import Symantic.Parser.Grammar import Symantic.Parser.Machine.Input @@ -72,25 +73,17 @@ unSomeInstr (SomeInstr (i::Instr i repr inp vs a)) = -- InstrValuable data instance Instr InstrValuable repr inp vs a where - -- | @('PushValue' x k)@ pushes @(x)@ on the 'valueStack' - -- and continues with the next 'Instr'uction @(k)@. PushValue :: TermInstr v -> SomeInstr repr inp (v ': vs) a -> Instr InstrValuable repr inp vs a - -- | @('PopValue' k)@ pushes @(x)@ on the 'valueStack'. PopValue :: SomeInstr repr inp vs a -> Instr InstrValuable repr inp (v ': vs) a - -- | @('Lift2Value' f k)@ pops two values from the 'valueStack', - -- and pushes the result of @(f)@ applied to them. Lift2Value :: TermInstr (x -> y -> z) -> SomeInstr repr inp (z : vs) a -> Instr InstrValuable repr inp (y : x : vs) a - -- | @('SwapValue' k)@ pops two values on the 'valueStack', - -- pushes the first popped-out, then the second, - -- and continues with the next 'Instr'uction @(k)@. SwapValue :: SomeInstr repr inp (x ': y ': vs) a -> Instr InstrValuable repr inp (y ': x ': vs) a @@ -154,30 +147,29 @@ instance InstrBranchable repr => InstrBranchable (SomeInstr repr) where caseBranch l = SomeInstr . CaseBranch l choicesBranch ps bs = SomeInstr . ChoicesBranch ps bs --- InstrLetable -data instance Instr InstrLetable repr inp vs a where +-- InstrCallable +data instance Instr InstrCallable repr inp vs a where DefLet :: - LetName v -> - SomeInstr repr inp '[] v -> + LetBindings TH.Name (SomeInstr repr inp '[]) -> SomeInstr repr inp vs a -> - Instr InstrLetable repr inp vs a + Instr InstrCallable repr inp vs a Call :: LetName v -> SomeInstr repr inp (v ': vs) a -> - Instr InstrLetable repr inp vs a + Instr InstrCallable repr inp vs a Ret :: - Instr InstrLetable repr inp '[a] a + Instr InstrCallable repr inp '[a] a Jump :: LetName a -> - Instr InstrLetable repr inp '[] a -instance InstrLetable repr => Trans (Instr InstrLetable repr inp vs) (repr inp vs) where + Instr InstrCallable repr inp '[] a +instance InstrCallable repr => Trans (Instr InstrCallable repr inp vs) (repr inp vs) where trans = \case - DefLet n sub k -> defLet n (trans sub) (trans k) + DefLet subs k -> defLet ((\(SomeLet sub) -> SomeLet (trans sub)) Functor.<$> subs) (trans k) Jump n -> jump n Call n k -> call n (trans k) Ret -> ret -instance InstrLetable repr => InstrLetable (SomeInstr repr) where - defLet n sub = SomeInstr . DefLet n sub +instance InstrCallable repr => InstrCallable (SomeInstr repr) where + defLet subs = SomeInstr . DefLet subs jump = SomeInstr . Jump call n = SomeInstr . Call n ret = SomeInstr Ret @@ -202,19 +194,19 @@ instance InstrJoinable repr => InstrJoinable (SomeInstr repr) where -- InstrInputable data instance Instr InstrInputable repr inp vs a where - LoadInput :: - SomeInstr repr inp vs a -> - Instr InstrInputable repr inp (Cursor inp : vs) a PushInput :: SomeInstr repr inp (Cursor inp ': vs) a -> Instr InstrInputable repr inp vs a + LoadInput :: + SomeInstr repr inp vs a -> + Instr InstrInputable repr inp (Cursor inp ': vs) a instance InstrInputable repr => Trans (Instr InstrInputable repr inp vs) (repr inp vs) where trans = \case - LoadInput k -> loadInput (trans k) PushInput k -> pushInput (trans k) + LoadInput k -> loadInput (trans k) instance InstrInputable repr => InstrInputable (SomeInstr repr) where - loadInput = SomeInstr . LoadInput pushInput = SomeInstr . PushInput + loadInput = SomeInstr . LoadInput -- InstrReadable data instance Instr (InstrReadable tok) repr inp vs a where diff --git a/src/Symantic/Parser/Machine/Program.hs b/src/Symantic/Parser/Machine/Program.hs index 5da7e84..ac7adb1 100644 --- a/src/Symantic/Parser/Machine/Program.hs +++ b/src/Symantic/Parser/Machine/Program.hs @@ -7,15 +7,17 @@ -- those generated (eg. by using 'joinNext'). module Symantic.Parser.Machine.Program where +import Control.Monad (Monad(..), (<=<), (=<<), liftM, liftM2, sequence) import Data.Bool (Bool(..)) -import Data.Ord (Ord) import Data.Function (($), (.)) -import Type.Reflection (Typeable) +import Data.Ord (Ord) import Data.Proxy (Proxy(..)) -import System.IO.Unsafe (unsafePerformIO) +import System.IO (IO) +import Type.Reflection (Typeable) import qualified Data.Functor as Functor +import qualified Data.HashMap.Strict as HM +import qualified Data.Traversable as Traversable import qualified Language.Haskell.TH as TH -import qualified Language.Haskell.TH.Syntax as TH import qualified Symantic.Parser.Haskell as H import Symantic.Parser.Grammar @@ -34,25 +36,26 @@ data Program repr inp a = Program { unProgram :: -- This is the next instruction SomeInstr repr inp (a ': vs) ret -> -- This is the current instruction - SomeInstr repr inp vs ret } + -- IO is needed for 'TH.qNewName'. + IO (SomeInstr repr inp vs ret) + } -- | Build an interpreter of the 'Program' of the given 'Machine'. optimizeMachine :: forall inp repr a. Machine (InputToken inp) repr => Program repr inp a -> - repr inp '[] a -optimizeMachine (Program f) = trans (f @'[] ret) + IO (repr inp '[] a) +optimizeMachine (Program f) = trans Functor.<$> f @'[] ret instance InstrValuable repr => Applicable (Program repr inp) where - pure x = Program (pushValue (trans x)) - Program f <*> Program x = Program (f . x . applyValue) - liftA2 f (Program x) (Program y) = - Program (x . y . lift2Value (trans f)) - Program x *> Program y = Program (x . popValue . y) - Program x <* Program y = Program (x . y . popValue) + pure x = Program $ return . pushValue (trans x) + Program f <*> Program x = Program $ (f <=< x) . applyValue + liftA2 f (Program x) (Program y) = Program $ (x <=< y) . lift2Value (trans f) + Program x *> Program y = Program (x <=< return . popValue <=< y) + Program x <* Program y = Program (x <=< y <=< return . popValue) instance ( Cursorable (Cursor inp) , InstrBranchable repr @@ -61,17 +64,17 @@ instance , InstrJoinable repr , InstrValuable repr ) => Alternable (Program repr inp) where - empty = Program $ \_next -> fail [] + empty = Program $ \_next -> return $ fail [] Program l <|> Program r = joinNext $ Program $ \next -> - catchException (Proxy @"fail") + liftM2 (catchException (Proxy @"fail")) (l (popException (Proxy @"fail") next)) - (failIfConsumed (r next)) + (failIfConsumed Functor.<$> r next) try (Program x) = Program $ \next -> - catchException (Proxy @"fail") + liftM2 (catchException (Proxy @"fail")) (x (popException (Proxy @"fail") next)) -- On exception, reset the input, -- and propagate the failure. - (loadInput (fail [])) + (return $ loadInput (fail [])) -- | If no input has been consumed by the failing alternative -- then continue with the given continuation. @@ -83,8 +86,11 @@ failIfConsumed :: InstrInputable repr => InstrValuable repr => SomeInstr repr inp vs ret -> - SomeInstr repr inp (Cursor inp : vs) ret -failIfConsumed k = pushInput (lift2Value (H.Term sameOffset) (ifBranch k (fail []))) + SomeInstr repr inp (Cursor inp ': vs) ret +failIfConsumed k = + pushInput $ + lift2Value (H.Term sameOffset) $ + ifBranch k (fail []) -- | @('joinNext' m)@ factorize the next 'Instr'uction -- to be able to reuse it multiple times without duplication. @@ -109,38 +115,39 @@ joinNext (Program m) = Program $ \case -- then it's useless to introduce a join-node. next@(Instr Ret{}) -> m next -- Introduce a join-node. - next -> defJoin joinName next (m (refJoin joinName)) - where joinName = LetName $ unsafePerformIO $ TH.qNewName "join" + next -> do + !joinName <- TH.newName "join" + defJoin (LetName joinName) next + Functor.<$> m (refJoin (LetName joinName)) + instance InstrExceptionable repr => Throwable (Program repr inp) where type ThrowableLabel (Program repr inp) lbl = () - throw lbl = Program $ \_next -> raiseException lbl [] + throw lbl = Program $ \_next -> return $ raiseException lbl [] instance ( tok ~ InputToken inp , InstrReadable tok repr , Typeable tok ) => Satisfiable tok (Program repr inp) where - satisfy es p = Program $ read es (trans p) + satisfy es p = Program $ return . read es (trans p) instance ( InstrBranchable repr , InstrJoinable repr , InstrValuable repr ) => Selectable (Program repr inp) where branch (Program lr) (Program l) (Program r) = joinNext $ Program $ \next -> - lr (caseBranch + lr =<< liftM2 caseBranch (l (swapValue (applyValue next))) - (r (swapValue (applyValue next)))) + (r (swapValue (applyValue next))) instance ( InstrBranchable repr , InstrJoinable repr ) => Matchable (Program repr inp) where - conditional (Program a) ps bs (Program d) = joinNext $ Program $ \next -> - a (choicesBranch - (trans Functor.<$> ps) - ((\(Program b) -> b next) Functor.<$> bs) - (d next)) + conditional (Program a) ps bs (Program d) = joinNext $ Program $ \next -> do + bs' <- Control.Monad.sequence $ (\(Program b) -> b next) Functor.<$> bs + a =<< liftM (choicesBranch (trans Functor.<$> ps) bs') (d next) instance ( Ord (InputToken inp) , Cursorable (Cursor inp) @@ -153,12 +160,12 @@ instance , InstrValuable repr ) => Lookable (Program repr inp) where look (Program x) = Program $ \next -> - pushInput (x (swapValue (loadInput next))) + liftM pushInput (x (swapValue (loadInput next))) eof = negLook (satisfy [{-discarded by negLook-}] (H.lam1 (\_x -> H.bool True))) -- This sets a better failure message - <|> (Program $ \_k -> fail [ErrorItemEnd]) + <|> (Program $ \_next -> return $ fail [ErrorItemEnd]) negLook (Program x) = Program $ \next -> - catchException (Proxy @"fail") + liftM2 (catchException (Proxy @"fail")) -- On x success, discard the result, -- and replace this 'CatchException''s failure handler -- by a failure whose 'farthestExpecting' is negated, @@ -171,23 +178,30 @@ instance -- the grammar might be blamed on something in x -- that, if corrected, still makes x succeed and -- (negLook x) fail. - (pushInput (x + (liftM pushInput (x (popValue (popException (Proxy @"fail") (loadInput (fail [])))))) -- On x failure, reset the input, -- and go on with the next 'Instr'uctions. - (loadInput (pushValue H.unit next)) + (return $ loadInput $ pushValue H.unit next) instance - InstrLetable repr => + InstrCallable repr => Letable TH.Name (Program repr inp) where - def n (Program v) = Program $ \next -> - defLet (LetName n) (v ret) (call (LetName n) next) + shareable n (Program sub) = Program $ \next -> do + sub' <- sub ret + return $ defLet (HM.singleton n (SomeLet sub')) (call (LetName n) next) ref _isRec n = Program $ \case -- Returning just after a 'call' is useless: -- using 'jump' lets the 'ret' of the 'defLet' -- directly return where it would in two 'ret's. - Instr Ret{} -> jump (LetName n) - next -> call (LetName n) next + Instr Ret{} -> return $ jump (LetName n) + next -> return $ call (LetName n) next +instance + InstrCallable repr => + Letsable TH.Name (Program repr inp) where + lets defs (Program x) = Program $ \next -> do + defs' <- Traversable.traverse (\(SomeLet (Program val)) -> liftM SomeLet (val ret)) defs + liftM (defLet defs') (x next) instance ( Cursorable (Cursor inp) , InstrBranchable repr diff --git a/src/Symantic/Parser/Machine/View.hs b/src/Symantic/Parser/Machine/View.hs index 297e056..d0d6a22 100644 --- a/src/Symantic/Parser/Machine/View.hs +++ b/src/Symantic/Parser/Machine/View.hs @@ -1,25 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} -- For ShowLetName module Symantic.Parser.Machine.View where import Data.Bool (Bool(..)) -import Data.Function (($), (.), id) +import Data.Either (Either(..)) +import Data.Function (($), (.), id, on) import Data.Functor ((<$>)) import Data.Kind (Type) +import Data.Ord (Ord(..)) import Data.Semigroup (Semigroup(..)) -import Data.String (String, IsString(..)) +import Data.String (String) +import Data.Tuple (fst) import GHC.TypeLits (symbolVal) import Text.Show (Show(..)) -import qualified Data.Tree as Tree +import qualified Data.HashMap.Strict as HM import qualified Data.List as List +import qualified Data.Map.Strict as Map +import qualified Data.Tree as Tree import qualified Language.Haskell.TH.Syntax as TH +import Prelude (error) import Symantic.Parser.Grammar.ObserveSharing (ShowLetName(..)) import Symantic.Parser.Machine.Instructions +import Symantic.Univariant.Letable (SomeLet(..)) +import Symantic.Parser.Machine.Generate -- * Type 'ViewMachine' -newtype ViewMachine (showName::Bool) inp (vs:: [Type]) a - = ViewMachine { unViewMachine :: - Tree.Forest String -> Tree.Forest String } +data ViewMachine (showName::Bool) inp (vs:: [Type]) a + = ViewMachine + { viewGen :: Gen inp vs a + -- ^ Provide 'GenAnalysis', which next important for debugging + -- and improving golden tests, see 'viewInstrCmd'. + , unViewMachine :: + CallTrace -> + LetMap GenAnalysis -> -- Output of 'runGenAnalysis'. + Tree.Forest (String, String) -> + Tree.Forest (String, String) + } viewMachine :: ViewMachine sN inp vs a -> @@ -27,67 +44,162 @@ viewMachine :: viewMachine = id -- | Helper to view a command. -viewInstrCmd :: String -> Tree.Forest String -> Tree.Tree String -viewInstrCmd n = Tree.Node n +viewInstrCmd :: + Either TH.Name (Gen inp vs a) -> + CallTrace -> + LetMap GenAnalysis -> + (String, String) -> Tree.Forest (String, String) -> Tree.Tree (String, String) +viewInstrCmd gen ct lm (n, no) = Tree.Node $ (n + <> "\nminReads="<>showsPrec 11 (minReads ga) "" + <> "\nmayRaise="<>showsPrec 11 (Map.keys (mayRaise ga)) "" + , no) + where + ga = case gen of + Right r -> (\f -> f ct) $ genAnalysis r $ (\f _ct -> f) <$> lm + Left l -> HM.findWithDefault (error (show (l, HM.keys lm))) l lm + -- | Helper to view an argument. -viewInstrArg :: String -> Tree.Forest String -> Tree.Tree String -viewInstrArg n = Tree.Node ("<"<>n<>">") +viewInstrArg :: String -> Tree.Forest (String, String) -> Tree.Tree (String, String) +viewInstrArg n = Tree.Node $ ("<"<>n<>">", "") instance Show (ViewMachine sN inp vs a) where - show = drawTree . Tree.Node "" . ($ []) . unViewMachine + show vm = List.unlines $ drawTrees $ + unViewMachine vm [] (runGenAnalysis (genAnalysisByLet (viewGen vm))) [] where - drawTree :: Tree.Tree String -> String - drawTree = List.unlines . draw - draw :: Tree.Tree String -> [String] - draw (Tree.Node x ts0) = List.lines x <> drawSubTrees ts0 - where - drawSubTrees [] = [] - drawSubTrees [t] = shift "" " " (draw t) - drawSubTrees (t:ts) = shift "" "| " (draw t) <> drawSubTrees ts - shift first other = List.zipWith (<>) (first : List.repeat other) -instance IsString (ViewMachine sN inp vs a) where - fromString s = ViewMachine $ \is -> Tree.Node (fromString s) [] : is + draw :: Tree.Tree (String, String) -> [String] + draw (Tree.Node (x, n) ts0) = + shift "" " " (List.zipWith (<>) (List.lines x) (n : List.repeat "")) <> + shift "| " "| " (drawTrees ts0) + drawTrees [] = [] + drawTrees [t] = draw t + drawTrees (t:ts) = draw t <> drawTrees ts + shift ind0 ind = List.zipWith (<>) (ind0 : List.repeat ind) instance InstrValuable (ViewMachine sN) where - pushValue a k = ViewMachine $ \is -> viewInstrCmd ("pushValue "<>showsPrec 10 a "") [] : unViewMachine k is - popValue k = ViewMachine $ \is -> viewInstrCmd "popValue" [] : unViewMachine k is - lift2Value f k = ViewMachine $ \is -> viewInstrCmd ("lift2Value "<>showsPrec 10 f "") [] : unViewMachine k is - swapValue k = ViewMachine $ \is -> viewInstrCmd "swapValue" [] : unViewMachine k is + pushValue a k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("pushValue "<>showsPrec 10 a "", "") [] : + unViewMachine k ct lm next + , viewGen = gen + } where gen = pushValue a (viewGen k) + popValue k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("popValue", "") [] : + unViewMachine k ct lm next + , viewGen = gen + } where gen = popValue (viewGen k) + lift2Value f k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("lift2Value "<>showsPrec 10 f "", "") [] : + unViewMachine k ct lm next + , viewGen = gen + } where gen = lift2Value f (viewGen k) + swapValue k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("swapValue", "") [] : + unViewMachine k ct lm next + , viewGen = gen + } where gen = swapValue (viewGen k) instance InstrExceptionable (ViewMachine sN) where - raiseException lbl _err = ViewMachine $ \is -> viewInstrCmd ("raiseException "<> show (symbolVal lbl)) [] : is - popException lbl k = ViewMachine $ \is -> viewInstrCmd ("popException "<> show (symbolVal lbl)) [] : unViewMachine k is - catchException lbl t h = ViewMachine $ \is -> viewInstrCmd ("catchException "<> show (symbolVal lbl)) - [ viewInstrArg "try" (unViewMachine t []) - , viewInstrArg "handler" (unViewMachine h []) - ] : is + raiseException lbl err = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("raiseException "<>show (symbolVal lbl), "") [] : next + , viewGen = gen + } where gen = raiseException lbl err + popException lbl k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("popException "<>show (symbolVal lbl), "") [] : + unViewMachine k ct lm next + , viewGen = gen + } where gen = popException lbl (viewGen k) + catchException lbl ok ko = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("catchException "<>show (symbolVal lbl), "") + [ viewInstrArg "ok" (unViewMachine ok ct lm []) + , viewInstrArg "ko" (unViewMachine ko ct lm []) + ] : next + , viewGen = gen + } where gen = catchException lbl (viewGen ok) (viewGen ko) instance InstrBranchable (ViewMachine sN) where - caseBranch l r = ViewMachine $ \is -> viewInstrCmd "case" - [ viewInstrArg "left" (unViewMachine l []) - , viewInstrArg "right" (unViewMachine r []) - ] : is - choicesBranch ps bs d = ViewMachine $ \is -> - viewInstrCmd ("choicesBranch "<>show ps) ( - (viewInstrArg "branch" . ($ []) . unViewMachine <$> bs) <> - [ viewInstrArg "default" (unViewMachine d []) ] - ) : is + caseBranch l r = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("case", "") + [ viewInstrArg "left" (unViewMachine l ct lm []) + , viewInstrArg "right" (unViewMachine r ct lm []) + ] : next + , viewGen = gen + } where gen = caseBranch (viewGen l) (viewGen r) + choicesBranch ps bs d = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("choicesBranch "<>show ps, "") ( + ((\b -> viewInstrArg "branch" $ unViewMachine b ct lm []) <$> bs) <> + [ viewInstrArg "default" (unViewMachine d ct lm []) ] + ) : next + , viewGen = gen + } where gen = choicesBranch ps (viewGen <$> bs) (viewGen d) instance ShowLetName sN TH.Name => - InstrLetable (ViewMachine sN) where - defLet (LetName n) sub k = ViewMachine $ \is -> - Tree.Node (showLetName @sN n<>":") (unViewMachine sub []) - : unViewMachine k is - jump (LetName n) = ViewMachine $ \is -> viewInstrCmd ("jump "<>showLetName @sN n) [] : is - call (LetName n) k = ViewMachine $ \is -> viewInstrCmd ("call "<>showLetName @sN n) [] : unViewMachine k is - ret = ViewMachine $ \is -> viewInstrCmd "ret" [] : is + InstrCallable (ViewMachine sN) where + defLet defs k = ViewMachine + { unViewMachine = \ct lm next -> + (<> unViewMachine k ct lm next) $ + List.sortBy (compare `on` (((fst <$>) <$>) . Tree.levels)) $ + ((\(n, SomeLet sub) -> + viewInstrCmd (Left n) ct lm + ("let", " "<>showLetName @sN n) + (unViewMachine sub ct lm [])) + <$> HM.toList defs) + , viewGen = gen + } where gen = defLet ((\(SomeLet x) -> SomeLet (viewGen x)) <$> defs) (viewGen k) + jump ln@(LetName n) = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("jump", " "<>showLetName @sN n) [] : next + , viewGen = gen + } where gen = jump ln + call ln@(LetName n) k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("call", " "<>showLetName @sN n) [] : + unViewMachine k (n:ct) lm next + , viewGen = gen + } where gen = call ln (viewGen k) + ret = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("ret", "") [] : next + , viewGen = gen + } where gen = ret instance ShowLetName sN TH.Name => InstrJoinable (ViewMachine sN) where - defJoin (LetName n) j k = ViewMachine $ \is -> - Tree.Node (showLetName @sN n<>":") (unViewMachine j []) - : unViewMachine k is - refJoin (LetName n) = ViewMachine $ \is -> viewInstrCmd ("refJoin "<>showLetName @sN n) [] : is + defJoin ln@(LetName n) j k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Left n) ct lm + ("join", " "<>showLetName @sN n) + (unViewMachine j ct lm []) : + unViewMachine k (n:ct) lm next + , viewGen = gen + } where gen = defJoin ln (viewGen j) (viewGen k) + refJoin ln@(LetName n) = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("refJoin", " "<>showLetName @sN n) [] : next + , viewGen = gen + } where gen = refJoin ln instance InstrInputable (ViewMachine sN) where - loadInput k = ViewMachine $ \is -> viewInstrCmd "loadInput" [] : unViewMachine k is - pushInput k = ViewMachine $ \is -> viewInstrCmd "pushInput" [] : unViewMachine k is -instance InstrReadable tok (ViewMachine sN) where - read _es p k = ViewMachine $ \is -> viewInstrCmd ("read "<>showsPrec 10 p "") [] : unViewMachine k is + pushInput k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("pushInput", "") [] : + unViewMachine k ct lm next + , viewGen = gen + } where gen = pushInput (viewGen k) + loadInput k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("loadInput", "") [] : + unViewMachine k ct lm next + , viewGen = gen + } where gen = loadInput (viewGen k) +instance InstrReadable tok Gen => InstrReadable tok (ViewMachine sN) where + read es p k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("read "<>showsPrec 10 p "", "") [] : + unViewMachine k ct lm next + , viewGen = gen + } where gen = read es p (viewGen k) diff --git a/src/Symantic/Univariant/Letable.hs b/src/Symantic/Univariant/Letable.hs index b0955ce..a972a6e 100644 --- a/src/Symantic/Univariant/Letable.hs +++ b/src/Symantic/Univariant/Letable.hs @@ -31,6 +31,7 @@ import Text.Show (Show(..)) import qualified Control.Monad.Trans.Class as MT import qualified Control.Monad.Trans.Reader as MT import qualified Control.Monad.Trans.State as MT +import qualified Control.Monad.Trans.Writer as MT import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS @@ -40,22 +41,23 @@ import Symantic.Univariant.Trans -- * Class 'Letable' -- | This class is not for end-users like usual symantic operators, --- here 'def' and 'ref' are introduced by 'observeSharing'. +-- here 'shareable' and 'ref' are introduced by 'observeSharing'. class Letable letName repr where - -- | @('def' letName x)@ let-binds @(letName)@ to be equal to @(x)@. - def :: letName -> repr a -> repr a -- | @('ref' isRec letName)@ is a reference to @(letName)@. -- @(isRec)@ is 'True' iif. this 'ref'erence is recursive, -- ie. is reachable within its 'def'inition. ref :: Bool -> letName -> repr a - default def :: - Liftable1 repr => Letable letName (Output repr) => - letName -> repr a -> repr a default ref :: Liftable repr => Letable letName (Output repr) => Bool -> letName -> repr a - def n = lift1 (def n) - ref r n = lift (ref r n) + ref isRec n = lift (ref isRec n) + + -- | @('shareable' letName x)@ let-binds @(letName)@ to be equal to @(x)@. + shareable :: letName -> repr a -> repr a + default shareable :: + Liftable1 repr => Letable letName (Output repr) => + letName -> repr a -> repr a + shareable n = lift1 (shareable n) -- * Class 'MakeLetName' class MakeLetName letName where @@ -106,7 +108,7 @@ instance Show SharingName where newtype ObserveSharing letName repr a = ObserveSharing { unObserveSharing :: MT.ReaderT (HashSet SharingName) (MT.State (ObserveSharingState letName)) - (CleanDefs letName repr a) } + (FinalizeSharing letName repr a) } -- | Interpreter detecting some (Haskell embedded) @let@ definitions used at -- least once and/or recursively, in order to replace them @@ -114,24 +116,49 @@ newtype ObserveSharing letName repr a = ObserveSharing { unObserveSharing :: -- See [Type-safe observable sharing in Haskell](https://doi.org/10.1145/1596638.1596653) -- -- Beware not to apply 'observeSharing' more than once on the same term --- otherwise some 'def' introduced by the first call would be removed by the second call. +-- otherwise some 'shareable' introduced by the first call +-- would be removed by the second call. observeSharing :: Eq letName => Hashable letName => Show letName => ObserveSharing letName repr a -> - repr a -observeSharing (ObserveSharing m) = do - let (a, st) = MT.runReaderT m mempty `MT.runState` + WithSharing letName repr a +observeSharing (ObserveSharing m) = + let (fs, st) = MT.runReaderT m mempty `MT.runState` ObserveSharingState { oss_refs = HM.empty , oss_recs = HS.empty - } + } in let refs = HS.fromList $ (`foldMap` oss_refs st) $ (\(letName, refCount) -> - if refCount > 0 then [letName] else []) + if refCount > 0 then [letName] else []) in --trace (show refs) $ - unCleanDefs a refs + MT.runWriter $ + (`MT.runReaderT` refs) $ + unFinalizeSharing fs + +-- ** Type 'SomeLet' +data SomeLet repr = forall a. SomeLet (repr a) + +-- ** Type 'WithSharing' +type WithSharing letName repr a = + (repr a, HM.HashMap letName (SomeLet repr)) +{- +-- * Type 'WithSharing' +data WithSharing letName repr a = WithSharing + { lets :: HM.HashMap letName (SomeLet repr) + , body :: repr a + } +mapWithSharing :: + (forall v. repr v -> repr v) -> + WithSharing letName repr a -> + WithSharing letName repr a +mapWithSharing f ws = WithSharing + { lets = (\(SomeLet repr) -> SomeLet (f repr)) <$> lets ws + , body = f (body ws) + } +-} -- ** Type 'ObserveSharingState' data ObserveSharingState letName = ObserveSharingState @@ -170,17 +197,17 @@ observeSharingNode (ObserveSharing m) = ObserveSharing $ do else do MT.lift $ MT.put st{ oss_refs = preds } if isNothing before - then MT.local (HS.insert nodeName) (def letName <$> m) + then MT.local (HS.insert nodeName) (shareable letName <$> m) else return $ ref False letName -type instance Output (ObserveSharing letName repr) = CleanDefs letName repr +type instance Output (ObserveSharing letName repr) = FinalizeSharing letName repr instance ( Letable letName repr , MakeLetName letName , Eq letName , Hashable letName , Show letName - ) => Trans (CleanDefs letName repr) (ObserveSharing letName repr) where + ) => Trans (FinalizeSharing letName repr) (ObserveSharing letName repr) where trans = observeSharingNode . ObserveSharing . return instance ( Letable letName repr @@ -188,7 +215,7 @@ instance , Eq letName , Hashable letName , Show letName - ) => Trans1 (CleanDefs letName repr) (ObserveSharing letName repr) where + ) => Trans1 (FinalizeSharing letName repr) (ObserveSharing letName repr) where trans1 f x = observeSharingNode $ ObserveSharing $ f <$> unObserveSharing x instance @@ -197,7 +224,7 @@ instance , Eq letName , Hashable letName , Show letName - ) => Trans2 (CleanDefs letName repr) (ObserveSharing letName repr) where + ) => Trans2 (FinalizeSharing letName repr) (ObserveSharing letName repr) where trans2 f x y = observeSharingNode $ ObserveSharing $ f <$> unObserveSharing x <*> unObserveSharing y @@ -207,49 +234,97 @@ instance , Eq letName , Hashable letName , Show letName - ) => Trans3 (CleanDefs letName repr) (ObserveSharing letName repr) where + ) => Trans3 (FinalizeSharing letName repr) (ObserveSharing letName repr) where trans3 f x y z = observeSharingNode $ ObserveSharing $ f <$> unObserveSharing x <*> unObserveSharing y <*> unObserveSharing z +instance Letable letName (ObserveSharing letName repr) where + shareable = error "[BUG]: observeSharing MUST NOT be applied twice" + ref = error "[BUG]: observeSharing MUST NOT be applied twice" +instance Letsable letName (ObserveSharing letName repr) where + lets = error "[BUG]: observeSharing MUST NOT be applied twice" + +-- * Type 'FinalizeSharing' +-- | Remove 'shareable' when non-recursive or unused +-- or replace it by 'ref', moving 'def' a top. +newtype FinalizeSharing letName repr a = FinalizeSharing { unFinalizeSharing :: + MT.ReaderT (HS.HashSet letName) + (MT.Writer (LetBindings letName repr)) + (repr a) } + +-- ** Type 'LetBindings' +type LetBindings letName repr = HM.HashMap letName (SomeLet repr) + +type instance Output (FinalizeSharing _letName repr) = repr +instance + ( Eq letName + , Hashable letName + ) => Trans repr (FinalizeSharing letName repr) where + trans = FinalizeSharing . pure +instance + ( Eq letName + , Hashable letName + ) => Trans1 repr (FinalizeSharing letName repr) where + trans1 f x = FinalizeSharing $ f <$> unFinalizeSharing x +instance + ( Eq letName + , Hashable letName + ) => Trans2 repr (FinalizeSharing letName repr) where + trans2 f x y = FinalizeSharing $ + f <$> unFinalizeSharing x + <*> unFinalizeSharing y +instance + ( Eq letName + , Hashable letName + ) => Trans3 repr (FinalizeSharing letName repr) where + trans3 f x y z = FinalizeSharing $ + f <$> unFinalizeSharing x + <*> unFinalizeSharing y + <*> unFinalizeSharing z instance ( Letable letName repr - , MakeLetName letName , Eq letName , Hashable letName , Show letName - ) => Letable letName (ObserveSharing letName repr) where - def = error "[BUG]: observeSharing MUST NOT be applied twice" - ref = error "[BUG]: observeSharing MUST NOT be applied twice" + ) => Letable letName (FinalizeSharing letName repr) where + shareable name x = FinalizeSharing $ do + refs <- MT.ask + if name `HS.member` refs + -- This 'shareable' is 'ref'erenced, move it into the result, + -- to put it in scope even when some 'ref' to it exists outside of 'x' + -- (which can happen when a sub-expression is shared), + -- and replace it by a 'ref'. + then do + let (repr, defs) = MT.runWriter $ MT.runReaderT (unFinalizeSharing x) refs + MT.lift $ MT.tell $ HM.insert name (SomeLet repr) defs + return $ ref False name + -- Remove 'shareable'. + else + unFinalizeSharing x --- * Type 'CleanDefs' --- | Remove 'def' when non-recursive or unused. -newtype CleanDefs letName repr a = CleanDefs { unCleanDefs :: - HS.HashSet letName -> repr a } - -type instance Output (CleanDefs _letName repr) = repr -instance Trans repr (CleanDefs letName repr) where - trans = CleanDefs . pure -instance Trans1 repr (CleanDefs letName repr) where - trans1 f x = CleanDefs $ f <$> unCleanDefs x -instance Trans2 repr (CleanDefs letName repr) where - trans2 f x y = CleanDefs $ - f <$> unCleanDefs x - <*> unCleanDefs y -instance Trans3 repr (CleanDefs letName repr) where - trans3 f x y z = CleanDefs $ - f <$> unCleanDefs x - <*> unCleanDefs y - <*> unCleanDefs z +-- * Class 'Letsable' +class Letsable letName repr where + -- | @('lets' defs x)@ let-binds @(defs)@ in @(x)@. + lets :: LetBindings letName repr -> repr a -> repr a + default lets :: + Trans repr (Output repr) => + Liftable1 repr => Letsable letName (Output repr) => + LetBindings letName repr -> repr a -> repr a + lets defs = lift1 (lets ((\(SomeLet val) -> SomeLet (trans val)) <$> defs)) +{- +-- | Not used but can be written nonetheless. instance - ( Letable letName repr + ( Letsable letName repr , Eq letName , Hashable letName , Show letName - ) => Letable letName (CleanDefs letName repr) where - def name x = CleanDefs $ \refs -> - if name `HS.member` refs - then -- Perserve 'def' - def name $ unCleanDefs x refs - else -- Remove 'def' - unCleanDefs x refs + ) => Letsable letName (FinalizeSharing letName repr) where + lets defs x = FinalizeSharing $ do + ds <- traverse (\(SomeLet v) -> do + r <- unFinalizeSharing v + return (SomeLet r) + ) defs + MT.lift $ MT.tell ds + unFinalizeSharing x +-} diff --git a/symantic-parser.cabal b/symantic-parser.cabal index 55dc46b..943337d 100644 --- a/symantic-parser.cabal +++ b/symantic-parser.cabal @@ -31,7 +31,7 @@ extra-source-files: flake.lock flake.nix shell.nix - test/Golden/**/*.txt + --test/Golden/**/*.txt extra-tmp-files: build-type: Custom tested-with: GHC==9.0.1 @@ -55,6 +55,8 @@ common boilerplate default-extensions: NoImplicitPrelude ghc-options: + -- -dynamic-too + ---static -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates @@ -87,6 +89,7 @@ library Symantic.Parser.Haskell.View Symantic.Parser.Machine Symantic.Parser.Machine.Generate + --Symantic.Parser.Machine.Horizon Symantic.Parser.Machine.Input Symantic.Parser.Machine.Instructions Symantic.Parser.Machine.Optimize @@ -147,16 +150,20 @@ test-suite symantic-parser-test -- autogen-modules: -- Paths_symantic_parser ghc-options: + ghc-prof-options: + -fexternal-interpreter build-depends: symantic-parser, base >= 4.10 && < 5, bytestring >= 0.10, + --ghc-bignum, -- Needed for exported Data.Map.Internal containers >= 0.5.10.1, deepseq >= 1.4, directory >= 1.3, filepath >= 1.4, hashable >= 1.2.6, + --pretty >= 1.1, process >= 1.6, strict >= 0.4, tasty >= 0.11, diff --git a/test/Golden/Grammar.hs b/test/Golden/Grammar.hs index 5ed73a9..339458c 100644 --- a/test/Golden/Grammar.hs +++ b/test/Golden/Grammar.hs @@ -26,13 +26,13 @@ goldens = testGroup "Grammar" $ goldenVsStringDiff ("G"<>show g) goldenDiff grammarFile $ do resetTHNameCounter return $ fromString $ show $ - P.viewGrammar @'True $ - P.observeSharing gram + P.viewGrammar @'False gram , testGroup "OptimizeGrammar" $ (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \(Grammar.G gram) g -> let grammarFile = "test/Golden/Grammar/OptimizeGrammar/G"<>show g<>".expected.txt" in goldenVsStringDiff ("G"<>show g) goldenDiff grammarFile $ do resetTHNameCounter - return $ fromString $ - P.showGrammar @'True gram + return $ fromString $ show $ + P.viewGrammar @'False $ + P.optimizeGrammar gram ] diff --git a/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt index 0dbd765..9540500 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt @@ -1,3 +1,4 @@ -<*> -+ pure (\u1 -> 'a') -` satisfy +lets +` <*> + + pure (\u1 -> 'a') + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt index 7e96757..a4a657e 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt @@ -1,7 +1,8 @@ -<|> -+ <*> -| + pure (\u1 -> 'a') -| ` satisfy -` <*> - + pure (\u1 -> 'b') - ` satisfy +lets +` <|> + + <*> + | + pure (\u1 -> 'a') + | ` satisfy + ` <*> + + pure (\u1 -> 'b') + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt index 033eb10..280b6a4 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt @@ -1,12 +1,14 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` def -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) -` satisfy +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1 Term)) + | ` ref + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt index 3e17f2b..23964e2 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt @@ -1,12 +1,14 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` def -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) -` eof +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1 Term)) + | ` ref + ` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt index 9e1c6e1..8e1b3c3 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt @@ -1,58 +1,63 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u2)) -| ` def name_1 -| ` <*> -| + pure (\u1 -> Term) -| ` def name_4 -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | ` satisfy -| | ` rec name_4 -| ` pure (\u1 -> u1) -` def name_2 - ` <*> - + pure (\u1 -> u1 Term) - ` def name_3 - ` <|> - + <*> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) - | | | ` conditional - | | | + look - | | | | ` satisfy - | | | + bs - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | ` <*> - | | | | + <*> - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) - | | | | | | | ` satisfy - | | | | | | ` ref name_1 - | | | | | ` rec name_2 - | | | | ` satisfy - | | | ` empty - | | ` ref name_1 - | ` rec name_3 - ` pure (\u1 -> u1) +lets ++ let +| ` <*> +| + pure (\u1 -> Term) +| ` ref ++ let +| ` <*> +| + pure (\u1 -> u1 Term) +| ` ref ++ let +| ` <|> +| + <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u1 : u3 u4)))) +| | | | ` conditional +| | | | + look +| | | | | ` satisfy +| | | | + branches +| | | | | + <*> +| | | | | | + pure (\u1 -> Term) +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + pure (\u1 -> Term) +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + pure (\u1 -> Term) +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + pure (\u1 -> Term) +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + pure (\u1 -> Term) +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + pure (\u1 -> Term) +| | | | | | ` satisfy +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term u3)))) +| | | | | | | | ` satisfy +| | | | | | | ` ref +| | | | | | ` rec +| | | | | ` satisfy +| | | | ` empty +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u2)) + | ` ref + ` ref diff --git a/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt index b4f6e01..d402742 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt @@ -1,479 +1,410 @@ -<*> -+ <*> -| + <*> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) -| | | | ` def -| | | | ` <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) -| | | | | | ` def -| | | | | | ` pure Term -| | | | | ` def -| | | | | ` <|> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> Term)) -| | | | | | | | | ` def -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | ` satisfy -| | | | | | | | | ` ref -| | | | | | | | ` def -| | | | | | | | ` <|> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | ` ref -| | | | | | | | | ` rec -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | | | | | | | | ` try -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> '/' : ('/' : Term))) -| | | | | | | | | | | | ` satisfy -| | | | | | | | | | | ` satisfy -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | ` satisfy -| | | | | | | | | | ` rec -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` rec -| | | | | ` pure (\u1 -> u1) -| | | | ` ref -| | | ` ref -| | ` def -| | ` <|> -| | + <*> -| | | + <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10)))))))))) -| | | | | | | | | | | ` try -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | ` try -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : u9)))))))))))))))) -| | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` pure Term -| | | | | | | | | | | ` def -| | | | | | | | | | | ` negLook -| | | | | | | | | | | ` satisfy -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | ` try -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` def -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` rec -| | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` def -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> '(')) -| | | | | | | | | ` satisfy -| | | | | | | | ` ref -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | | | | | | ` def -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> Term) -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | ` def -| | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> ',')) -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` <|> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | | ` satisfy -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` ref -| | | | | ` def -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> ')')) -| | | | | | ` satisfy -| | | | | ` ref -| | | | ` def -| | | | ` <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5))))))) -| | | | | | | | | | ` satisfy -| | | | | | | | | ` ref -| | | | | | | | ` ref -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> '0') -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> '1') -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) -| | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) -| | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> Term) -| | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2))) -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` def -| | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` rec -| | | | | | | | | | ` <|> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | | | | | | ` try -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` rec -| | | | | | | | | | ` ref -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | | ` try -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) -| | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` <|> -| | | | | | | | | + try -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11)))))))))))) -| | | | | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> Term)) -| | | | | | | | | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) -| | | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <|> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` rec -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` ref -| | | | | | | | | | ` def -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> ';')) -| | | | | | | | | | | ` satisfy -| | | | | | | | | | ` ref -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` rec -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` ref -| | | | | ` satisfy -| | | | ` ref -| | | ` rec -| | ` pure (\u1 -> u1) -| ` ref -` eof +lets ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u2)) +| | ` ref +| ` <|> +| + <*> +| | + pure (\u1 -> Term) +| | ` ref +| ` ref ++ let +| ` <*> +| + <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | ` ref +| | | ` ref +| | ` ref +| ` ref ++ let +| ` <*> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5))))))) +| | | | | | | ` satisfy +| | | | | | ` ref +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) +| | | | | | ` satisfy +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> '(')) +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> ')')) +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> ',')) +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> ';')) +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> Term)) +| | ` ref +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u2)) +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u2)) +| | ` try +| | ` <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | ` satisfy +| | | | ` ref +| | | ` ref +| | ` ref +| ` ref ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u2)) +| | | ` <|> +| | | + <*> +| | | | + pure (\u1 -> '0') +| | | | ` satisfy +| | | ` <*> +| | | + pure (\u1 -> '1') +| | | ` satisfy +| | ` ref +| ` <|> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) +| | | | | ` satisfy +| | | | ` <|> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | | ` satisfy +| | | | | ` ref +| | | | ` <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u3))) +| | | | | | ` satisfy +| | | | | ` satisfy +| | | | ` ref +| | | ` satisfy +| | ` ref +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u2)) +| | ` ref +| ` <|> +| + <*> +| | + pure (\u1 -> Term) +| | ` <|> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> u2))) +| | | | | ` ref +| | | | ` <|> +| | | | + <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) +| | | | | | | | ` rec +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` ref +| ` ref ++ let +| ` <|> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | ` ref +| | | | ` ref +| | | ` rec +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10)))))))))) +| | | | | | | | | | ` try +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : Term))))))))))))))) +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | ` satisfy +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` satisfy +| | | | | | | | | ` ref +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` <|> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> Term))) +| | | | | | | | ` satisfy +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) +| | | | | ` satisfy +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | ` <|> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u2)) +| | | | | ` try +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> 'i' : ('f' : Term))) +| | | | | | ` satisfy +| | | | | ` satisfy +| | | | ` ref +| | | ` <|> +| | | + <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) +| | | | | | | ` try +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'w' : ('h' : ('i' : ('l' : ('e' : Term))))))))) +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` satisfy +| | | | | | | | | ` satisfy +| | | | | | | | ` satisfy +| | | | | | | ` satisfy +| | | | | | ` ref +| | | | | ` ref +| | | | ` rec +| | | ` <|> +| | | + try +| | | | ` <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + <*> +| | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11)))))))))))) +| | | | | | | | | | | | | | | ` <|> +| | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> Term)) +| | | | | | | | | | | | | | | | | ` try +| | | | | | | | | | | | | | | | | ` <*> +| | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | + <*> +| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> 'v' : ('a' : ('r' : Term))))) +| | | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | | ` satisfy +| | | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | | ` ref +| | | | | | | | | | | | | ` ref +| | | | | | | | | | | | ` ref +| | | | | | | | | | | ` ref +| | | | | | | | | | ` satisfy +| | | | | | | | | ` ref +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` ref +| | | | ` ref +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` ref +| ` ref ++ let +| ` pure (\u1 -> (\u2 -> u2)) ++ let +| ` pure Term ++ let +| ` pure Term ++ let +| ` satisfy +` <*> + + <*> + | + <*> + | | + <*> + | | | + <*> + | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) + | | | | ` ref + | | | ` ref + | | ` ref + | ` ref + ` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt index 2450553..d4daa2b 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt @@ -1,10 +1,12 @@ -<*> -+ pure (\u1 -> u1 Term) -` def name_401 - ` <|> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) - | | ` satisfy - | ` rec name_401 - ` pure (\u1 -> u1) +lets +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <|> + | + <*> + | | + pure (\u1 -> 'a') + | | ` satisfy + | ` <*> + | + pure (\u1 -> 'b') + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt index 8088504..b0e13cb 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt @@ -1,22 +1,16 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1 : u2 Term)) -| ` def name_416 -| ` try -| ` <*> -| + <*> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | | | ` satisfy -| | | ` satisfy -| | ` satisfy -| ` satisfy -` def name_415 - ` <|> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) - | | ` ref name_416 - | ` rec name_415 - ` pure (\u1 -> u1) +lets +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <|> + | + <*> + | | + pure (\u1 -> 'a') + | | ` satisfy + | ` <|> + | + <*> + | | + pure (\u1 -> 'b') + | | ` satisfy + | ` <*> + | + pure (\u1 -> 'c') + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G17.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G17.expected.txt deleted file mode 100644 index 2d0bb4a..0000000 --- a/test/Golden/Grammar/OptimizeGrammar/G17.expected.txt +++ /dev/null @@ -1,24 +0,0 @@ -<*> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) -| | ` def name_462 -| | ` try -| | ` <*> -| | + <*> -| | | + <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | | | | ` satisfy -| | | | ` satisfy -| | | ` satisfy -| | ` satisfy -| ` def name_461 -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | | ` ref name_462 -| | ` rec name_461 -| ` pure (\u1 -> u1) -` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G18.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G18.expected.txt deleted file mode 100644 index 5167dd7..0000000 --- a/test/Golden/Grammar/OptimizeGrammar/G18.expected.txt +++ /dev/null @@ -1,11 +0,0 @@ -<|> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) -| | ` satisfy -| ` satisfy -` <*> - + <*> - | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | ` satisfy - ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G19.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G19.expected.txt deleted file mode 100644 index 17ce3a3..0000000 --- a/test/Golden/Grammar/OptimizeGrammar/G19.expected.txt +++ /dev/null @@ -1,13 +0,0 @@ -<|> -+ try -| ` <*> -| + <*> -| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) -| | ` satisfy -| ` satisfy -` try - ` <*> - + <*> - | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | ` satisfy - ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt index 4460a7d..34cae6e 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt @@ -1,8 +1,9 @@ -try -` <*> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : ('b' : ('c' : Term))))) - | | ` satisfy - | ` satisfy - ` satisfy +lets +` try + ` <*> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : ('b' : ('c' : Term))))) + | | ` satisfy + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G20.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G20.expected.txt deleted file mode 100644 index 52b9fa5..0000000 --- a/test/Golden/Grammar/OptimizeGrammar/G20.expected.txt +++ /dev/null @@ -1,12 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` def name_583 -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) -| | | ` satisfy -| | ` rec name_583 -| ` pure (\u1 -> u1) -` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G21.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G21.expected.txt deleted file mode 100644 index 37fb719..0000000 --- a/test/Golden/Grammar/OptimizeGrammar/G21.expected.txt +++ /dev/null @@ -1 +0,0 @@ -eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G22.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G22.expected.txt deleted file mode 100644 index 7e96757..0000000 --- a/test/Golden/Grammar/OptimizeGrammar/G22.expected.txt +++ /dev/null @@ -1,7 +0,0 @@ -<|> -+ <*> -| + pure (\u1 -> 'a') -| ` satisfy -` <*> - + pure (\u1 -> 'b') - ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G23.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G23.expected.txt deleted file mode 100644 index 52bba00..0000000 --- a/test/Golden/Grammar/OptimizeGrammar/G23.expected.txt +++ /dev/null @@ -1,12 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` def name_613 -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) -| | | ` satisfy -| | ` rec name_613 -| ` pure (\u1 -> u1) -` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G24.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G24.expected.txt deleted file mode 100644 index 109452f..0000000 --- a/test/Golden/Grammar/OptimizeGrammar/G24.expected.txt +++ /dev/null @@ -1,12 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` def name_635 -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | | ` satisfy -| | ` rec name_635 -| ` pure (\u1 -> u1) -` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G25.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G25.expected.txt deleted file mode 100644 index 5f17659..0000000 --- a/test/Golden/Grammar/OptimizeGrammar/G25.expected.txt +++ /dev/null @@ -1,58 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u2)) -| ` def name_651 -| ` <*> -| + pure (\u1 -> Term) -| ` def name_652 -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | ` satisfy -| | ` rec name_652 -| ` pure (\u1 -> u1) -` def name_650 - ` <*> - + pure (\u1 -> u1 Term) - ` def name_649 - ` <|> - + <*> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) - | | | ` conditional - | | | + look - | | | | ` satisfy - | | | + bs - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | + <*> - | | | | | + pure (\u1 -> (\u2 -> cons Term)) - | | | | | ` satisfy - | | | | ` <*> - | | | | + <*> - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) - | | | | | | | ` satisfy - | | | | | | ` ref name_651 - | | | | | ` rec name_650 - | | | | ` satisfy - | | | ` empty - | | ` ref name_651 - | ` rec name_649 - ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt index d32bfda..80ca96c 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt @@ -1,10 +1,12 @@ -<*> -+ pure (\u1 -> u1 Term) -` def - ` <|> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) - | | ` satisfy - | ` rec - ` pure (\u1 -> u1) +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` <*> + + pure (\u1 -> u1 Term) + ` ref diff --git a/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt index b6b25c7..3b441ab 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt @@ -1,22 +1,25 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1 : u2 Term)) -| ` def -| ` try -| ` <*> -| + <*> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | | | ` satisfy -| | | ` satisfy -| | ` satisfy -| ` satisfy -` def - ` <|> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) - | | ` ref - | ` rec - ` pure (\u1 -> u1) +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` try +| ` <*> +| + <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | | | ` satisfy +| | | ` satisfy +| | ` satisfy +| ` satisfy +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1 : u2 Term)) + | ` ref + ` ref diff --git a/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt index bcaeec5..a5dd2cc 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt @@ -1,24 +1,27 @@ -<*> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) -| | ` def -| | ` try -| | ` <*> -| | + <*> -| | | + <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | | | | ` satisfy -| | | | ` satisfy -| | | ` satisfy -| | ` satisfy -| ` def -| ` <|> +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` try +| ` <*> | + <*> | | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | | ` ref -| | ` rec -| ` pure (\u1 -> u1) -` eof +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) +| | | | ` satisfy +| | | ` satisfy +| | ` satisfy +| ` satisfy +` <*> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) + | | ` ref + | ` ref + ` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt index 5167dd7..ecb0f34 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt @@ -1,11 +1,12 @@ -<|> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) -| | ` satisfy -| ` satisfy -` <*> +lets +` <|> + <*> - | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | + <*> + | | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) + | | ` satisfy | ` satisfy - ` satisfy + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt index 17ce3a3..0ed842c 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt @@ -1,13 +1,14 @@ -<|> -+ try -| ` <*> -| + <*> -| | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) -| | ` satisfy -| ` satisfy -` try - ` <*> - + <*> - | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | ` satisfy - ` satisfy +lets +` <|> + + try + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) + | | ` satisfy + | ` satisfy + ` try + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt index 8218cf0..fcb2d3d 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt @@ -1,12 +1,14 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1 Term)) -| ` def -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) -| | | ` satisfy -| | ` rec -| ` pure (\u1 -> u1) -` eof +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1 Term)) + | ` ref + ` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt index 37fb719..9c1ae43 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt @@ -1 +1,2 @@ -eof +lets +` eof diff --git a/test/Golden/Grammar/ViewGrammar/G1.expected.txt b/test/Golden/Grammar/ViewGrammar/G1.expected.txt index b4ac9ea..a78e743 100644 --- a/test/Golden/Grammar/ViewGrammar/G1.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G1.expected.txt @@ -1,5 +1,6 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` pure 'a' -` satisfy +lets +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'a' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G10.expected.txt b/test/Golden/Grammar/ViewGrammar/G10.expected.txt index 79525bf..75fe8d3 100644 --- a/test/Golden/Grammar/ViewGrammar/G10.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G10.expected.txt @@ -1,11 +1,12 @@ -<|> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> u1)) -| | ` pure 'a' -| ` satisfy -` <*> +lets +` <|> + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` pure 'b' - ` satisfy + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'a' + | ` satisfy + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'b' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G11.expected.txt b/test/Golden/Grammar/ViewGrammar/G11.expected.txt index da95145..529efb2 100644 --- a/test/Golden/Grammar/ViewGrammar/G11.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G11.expected.txt @@ -1,24 +1,26 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> -| + def -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + pure cons -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` pure 'a' -| | | | ` satisfy -| | | ` rec -| | ` pure (\u1 -> u1) -| ` pure Term +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'a' +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) ` <*> + <*> | + pure (\u1 -> (\u2 -> u1)) - | ` pure 'b' - ` satisfy + | ` <*> + | + ref + | ` pure Term + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'b' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G12.expected.txt b/test/Golden/Grammar/ViewGrammar/G12.expected.txt index 6bed0a7..8f94a46 100644 --- a/test/Golden/Grammar/ViewGrammar/G12.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G12.expected.txt @@ -1,16 +1,18 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> -| + def -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + pure cons -| | | | ` satisfy -| | | ` rec -| | ` pure (\u1 -> u1) -| ` pure Term -` eof +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + pure cons +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <*> + | + ref + | ` pure Term + ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G13.expected.txt b/test/Golden/Grammar/ViewGrammar/G13.expected.txt index bcb2e13..42938c4 100644 --- a/test/Golden/Grammar/ViewGrammar/G13.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G13.expected.txt @@ -1,100 +1,105 @@ -<*> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> u1)) -| | ` pure (\u1 -> u1) -| ` def name_1 -| ` <*> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure (\u1 -> u1) -| | ` <*> -| | + <*> -| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | ` pure Term -| | ` def name_4 -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | ` satisfy -| | | ` rec name_4 -| | ` pure (\u1 -> u1) -| ` pure Term -` def name_2 - ` <*> - + def name_3 - | ` <|> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) - | | | ` <*> - | | | + pure cons - | | | ` <*> - | | | + <*> - | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | ` conditional - | | | | + look - | | | | | ` satisfy - | | | | + bs - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | ` <*> - | | | | | + <*> - | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | ` <*> - | | | | | | + <*> - | | | | | | | + <*> - | | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | | ` pure (\u1 -> u1) - | | | | | | | ` <*> - | | | | | | | + <*> - | | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | | ` satisfy - | | | | | | | ` ref name_1 - | | | | | | ` <*> - | | | | | | + pure Term - | | | | | | ` rec name_2 - | | | | | ` <*> - | | | | | + <*> - | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | ` pure ']' - | | | | | ` satisfy - | | | | ` empty - | | | ` ref name_1 - | | ` rec name_3 - | ` pure (\u1 -> u1) - ` pure Term +lets ++ let +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` <*> +| | + <*> +| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | ` pure Term +| | ` ref +| ` pure Term ++ let +| ` <*> +| + ref +| ` pure Term ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | ` pure (\u1 -> (\u2 -> u1)) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` conditional +| | | | + look +| | | | | ` satisfy +| | | | + branches +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure Term +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure Term +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure Term +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure Term +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure Term +| | | | | | ` satisfy +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure Term +| | | | | | ` satisfy +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` satisfy +| | | | | | | ` ref +| | | | | | ` <*> +| | | | | | + pure Term +| | | | | | ` rec +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` pure ']' +| | | | | ` satisfy +| | | | ` empty +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) +` <*> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure (\u1 -> u1) + | ` ref + ` ref diff --git a/test/Golden/Grammar/ViewGrammar/G14.expected.txt b/test/Golden/Grammar/ViewGrammar/G14.expected.txt index 2acd52f..ccdeb1c 100644 --- a/test/Golden/Grammar/ViewGrammar/G14.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G14.expected.txt @@ -1,12 +1,102 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) +lets ++ let | ` <*> | + <*> | | + <*> | | | + pure (\u1 -> (\u2 -> u1)) | | | ` pure (\u1 -> u1) -| | ` def +| | ` ref +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` <*> +| | + <*> +| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | ` pure Term +| | ` ref +| ` pure Term ++ let +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` ref +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` <*> +| | + <*> +| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | ` ref +| | ` ref +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure (\u1 -> u1) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure '[' +| | | | ` satisfy +| | | ` ref +| | ` <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure (\u1 -> u1) +| | | ` ref +| | ` <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure (\u1 -> u1) +| | | ` <*> +| | | + <*> +| | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | ` pure Term +| | | ` ref +| | ` pure Term +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure ']' +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure (\u1 -> u1) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure '{' +| | | | ` satisfy +| | | ` ref | | ` <*> | | + <*> | | | + <*> @@ -15,979 +105,738 @@ | | | ` <*> | | | + <*> | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | ` def -| | | | ` pure Term -| | | ` def -| | | ` <|> -| | | + <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | ` <|> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` def -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` satisfy -| | | | | | | ` ref -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | ` pure Term -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` ref -| | | | | | | | ` rec -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` pure Term -| | | | | ` <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` try -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure cons -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure '/' -| | | | | | | | ` satisfy -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure cons -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure '/' -| | | | | | | | ` satisfy -| | | | | | | ` pure Term -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | ` ref -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` satisfy -| | | | | | | | ` rec -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` ref -| | | | | ` ref -| | | | ` rec -| | | ` pure (\u1 -> u1) +| | | | ` ref +| | | ` ref | | ` ref | ` <*> | + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure (\u1 -> u1) +| | + pure (\u1 -> (\u2 -> u1)) | | ` <*> | | + <*> -| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | ` ref -| | ` def -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | ` <*> -| | | | + <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | ` pure (\u1 -> u1) -| | | | | ` <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` try -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | ` try -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'f' -| | | | | | | | | | ` satisfy -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'u' -| | | | | | | | | | ` satisfy -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'n' -| | | | | | | | | | ` satisfy -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'c' -| | | | | | | | | | ` satisfy -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 't' -| | | | | | | | | | ` satisfy -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'i' -| | | | | | | | | | ` satisfy -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'o' -| | | | | | | | | | ` satisfy -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure cons -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure 'n' -| | | | | | | | | | ` satisfy -| | | | | | | | | ` def -| | | | | | | | | ` pure Term -| | | | | | | | ` def -| | | | | | | | ` negLook -| | | | | | | | ` satisfy -| | | | | | | ` ref -| | | | | | ` def -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` try -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` satisfy -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | ` ref -| | | | | | | | ` def -| | | | | | | | ` <|> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` satisfy -| | | | | | | | | ` rec -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` ref -| | | | | | ` ref -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` def -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure '(' -| | | | | | | | ` satisfy -| | | | | | | ` ref -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure (\u1 -> u1) -| | | | | | | ` def -| | | | | | | ` <|> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure Term -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | ` def -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | ` ref -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure Term -| | | | | | | | | | ` def -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure '[' -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` satisfy -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <|> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` rec -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` pure Term -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure ']' -| | | | | | | | | | | ` satisfy -| | | | | | | | | | ` ref -| | | | | | | | | ` ref -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <|> -| | | | | | | | | + <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` def -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure ',' -| | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` <|> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure Term -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` pure ':' -| | | | | | | | | ` satisfy -| | | | | | | | ` ref -| | | | | | | ` ref -| | | | | | ` ref -| | | | | ` def -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure ')' -| | | | | | ` satisfy -| | | | | ` ref -| | | | ` def -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` pure '{' -| | | | | | | ` satisfy -| | | | | | ` ref -| | | | | ` <*> -| | | | | + <*> -| | | | | | + <*> -| | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | ` pure (\u1 -> u1) -| | | | | | ` <*> -| | | | | | + <*> -| | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | ` ref -| | | | | | ` def -| | | | | | ` <|> -| | | | | | + <*> -| | | | | | | + <*> -| | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | ` <|> -| | | | | | | | + <|> -| | | | | | | | | + <|> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'i' -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'f' -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` def -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | + <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure '0' -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure '1' -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure '\'' -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure '\\' -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure '\'' -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | + ref -| | | | | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` def -| | | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | | | | | | | | | | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | | ` pure '!' -| | | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` rec -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure 'e' -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure 'l' -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure 's' -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure 'e' -| | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` rec -| | | | | | | | | | | ` ref -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` try -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'w' -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'h' -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'i' -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'l' -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure 'e' -| | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` ref -| | | | | | | | | | ` rec -| | | | | | | | | ` try -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure Term -| | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | ` try -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'v' -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'a' -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure cons -| | | | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | | ` pure 'r' -| | | | | | | | | | | | | | | | | ` satisfy -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` def -| | | | | | | | | | | | | ` <|> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + ref -| | | | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | | ` rec -| | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | ` pure '=' -| | | | | | | | | | | | ` satisfy -| | | | | | | | | | | ` ref -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` ref -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | ` <*> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | | | | | | | | | | ` ref -| | | | | | | | | | | ` def -| | | | | | | | | | | ` <|> -| | | | | | | | | | | + <*> -| | | | | | | | | | | | + <*> -| | | | | | | | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + ref -| | | | | | | | | | | | | ` <*> -| | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | + <*> -| | | | | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | | | | | ` ref -| | | | | | | | | | | | | ` ref -| | | | | | | | | | | | ` rec -| | | | | | | | | | | ` pure (\u1 -> u1) -| | | | | | | | | | ` ref -| | | | | | | | | ` def -| | | | | | | | | ` <*> -| | | | | | | | | + <*> -| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | ` <*> -| | | | | | | | | | + <*> -| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | ` pure ';' -| | | | | | | | | | ` satisfy -| | | | | | | | | ` ref -| | | | | | | | ` <*> -| | | | | | | | + <*> -| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | | | | ` ref -| | | | | | | | ` ref -| | | | | | | ` rec -| | | | | | ` pure (\u1 -> u1) -| | | | | ` ref -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` <*> -| | | | | + <*> -| | | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | | ` pure '}' -| | | | | ` satisfy -| | | | ` ref -| | | ` rec -| | ` pure (\u1 -> u1) +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure '}' +| | ` satisfy | ` ref -` eof ++ let +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` ref +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure Term +| | ` ref +| ` ref ++ let +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` try +| | ` <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure (\u1 -> u1) +| | | ` satisfy +| | ` <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure (\u1 -> u1) +| | | ` <*> +| | | + <*> +| | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | ` ref +| | | ` ref +| | ` ref +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure '(' +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure ')' +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure ',' +| | ` satisfy +| ` ref ++ let +| ` <*> +| + <*> +| | + pure (\u1 -> (\u2 -> u1)) +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure ';' +| | ` satisfy +| ` ref ++ let +| ` <*> +| + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| ` pure (\u1 -> (\u2 -> u1)) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | ` pure (\u1 -> (\u2 -> u1)) +| | | ` <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` pure (\u1 -> u1) +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` try +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 'f' +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 'u' +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 'n' +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 'c' +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 't' +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 'i' +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 'o' +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 'n' +| | | | | | | | ` satisfy +| | | | | | | ` pure Term +| | | | | | ` ref +| | | | | ` ref +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` ref +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` ref +| | | | | ` <|> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure Term +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure ':' +| | | | | | | | ` satisfy +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | ` pure (\u1 -> (\u2 -> u1)) +| | | ` <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` pure '!' +| | | | | ` satisfy +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | ` pure (\u1 -> (\u2 -> u1)) +| | | ` <|> +| | | + <|> +| | | | + <|> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` try +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 'i' +| | | | | | | | ` satisfy +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure cons +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure 'f' +| | | | | | | | ` satisfy +| | | | | | | ` pure Term +| | | | | | ` ref +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` try +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure cons +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure 'w' +| | | | | | | | | ` satisfy +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure cons +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure 'h' +| | | | | | | | | ` satisfy +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure cons +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure 'i' +| | | | | | | | | ` satisfy +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure cons +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure 'l' +| | | | | | | | | ` satisfy +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure cons +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure 'e' +| | | | | | | | | ` satisfy +| | | | | | | | ` pure Term +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` rec +| | | | ` try +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure (\u1 -> u1) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` <|> +| | | | | | | | + <*> +| | | | | | | | | + <*> +| | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | ` pure Term +| | | | | | | | | ` <*> +| | | | | | | | | + <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | | | ` try +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure cons +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | ` pure 'v' +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure cons +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | ` pure 'a' +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` <*> +| | | | | | | | | | + <*> +| | | | | | | | | | | + pure cons +| | | | | | | | | | | ` <*> +| | | | | | | | | | | + <*> +| | | | | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | ` pure 'r' +| | | | | | | | | | | ` satisfy +| | | | | | | | | | ` pure Term +| | | | | | | | | ` ref +| | | | | | | | ` ref +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` ref +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + <*> +| | | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | | ` pure (\u1 -> u1) +| | | | | | | | ` <*> +| | | | | | | | + <*> +| | | | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | ` ref +| | | | | | | | ` ref +| | | | | | | ` ref +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` <*> +| | | | | | | + <*> +| | | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | | ` pure '=' +| | | | | | | ` satisfy +| | | | | | ` ref +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` ref +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` ref +| | | | ` ref +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | ` pure (\u1 -> (\u2 -> u1)) +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | ` pure (\u1 -> (\u2 -> u1)) +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | | ` pure (\u1 -> (\u2 -> u1)) +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + ref +| | | ` <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` ref +| | | ` rec +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + ref +| | | ` <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + ref +| | | ` <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + ref +| | | ` <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` ref +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure Term +| | ` <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure (\u1 -> u1) +| | | ` ref +| | ` <*> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure (\u1 -> u1) +| | | ` <*> +| | | + <*> +| | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | ` ref +| | | ` ref +| | ` ref +| ` ref ++ let +| ` <|> +| + <|> +| | + <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` <|> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` pure '0' +| | | | | ` satisfy +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure '1' +| | | | ` satisfy +| | | ` ref +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure '\'' +| | | | ` satisfy +| | | ` <|> +| | | + <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` pure (\u1 -> u1) +| | | | | ` satisfy +| | | | ` ref +| | | ` <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure '\\' +| | | | ` satisfy +| | | ` <*> +| | | + <*> +| | | | + <*> +| | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | ` pure (\u1 -> u1) +| | | | ` satisfy +| | | ` ref +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure '\'' +| | | ` satisfy +| | ` ref +| ` <*> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure (\u1 -> u1) +| | ` ref +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure Term +| | ` <|> +| | + <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` <*> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` pure (\u1 -> u1) +| | | | | ` ref +| | | | ` <|> +| | | | + <*> +| | | | | + <*> +| | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | ` pure Term +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` rec +| | | | | ` <*> +| | | | | + <*> +| | | | | | + <*> +| | | | | | | + pure (\u1 -> (\u2 -> u1)) +| | | | | | | ` pure (\u1 -> u1) +| | | | | | ` <*> +| | | | | | + <*> +| | | | | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | ` ref +| | | | | | ` ref +| | | | | ` ref +| | | | ` ref +| | | ` ref +| | ` ref +| ` ref ++ let +| ` pure Term ++ let +| ` pure Term ++ let +| ` satisfy +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <*> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure (\u1 -> u1) + | | ` ref + | ` <*> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure (\u1 -> u1) + | | ` <*> + | | + <*> + | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) + | | | ` ref + | | ` ref + | ` ref + ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G15.expected.txt b/test/Golden/Grammar/ViewGrammar/G15.expected.txt index f3aba12..be638a9 100644 --- a/test/Golden/Grammar/ViewGrammar/G15.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G15.expected.txt @@ -1,16 +1,20 @@ -<*> -+ def name_32 -| ` <|> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | ` <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'a' -| | | ` satisfy -| | ` rec name_32 -| ` pure (\u1 -> u1) -` pure Term +lets +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <|> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'c' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G16.expected.txt b/test/Golden/Grammar/ViewGrammar/G16.expected.txt index e627081..a2dbb63 100644 --- a/test/Golden/Grammar/ViewGrammar/G16.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G16.expected.txt @@ -1,50 +1,26 @@ -<*> -+ <*> -| + pure cons -| ` def name_47 -| ` try -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' -| | ` satisfy -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'b' -| | ` satisfy -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'c' -| | ` satisfy -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'd' -| | ` satisfy -| ` pure Term +lets ` <*> - + def name_46 + + <*> + | + pure (\u1 -> (\u2 -> u1)) | ` <|> - | + <*> + | + <|> | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) - | | | ` <*> - | | | + pure cons - | | | ` ref name_47 - | | ` rec name_46 - | ` pure (\u1 -> u1) - ` pure Term + | | | + <*> + | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | ` pure 'a' + | | | ` satisfy + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'b' + | | ` satisfy + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'c' + | ` satisfy + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'd' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G17.expected.txt b/test/Golden/Grammar/ViewGrammar/G17.expected.txt deleted file mode 100644 index bc14d25..0000000 --- a/test/Golden/Grammar/ViewGrammar/G17.expected.txt +++ /dev/null @@ -1,54 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> -| + <*> -| | + pure cons -| | ` def name_92 -| | ` try -| | ` <*> -| | + <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'a' -| | | ` satisfy -| | ` <*> -| | + <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'b' -| | | ` satisfy -| | ` <*> -| | + <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'c' -| | | ` satisfy -| | ` <*> -| | + <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'd' -| | | ` satisfy -| | ` pure Term -| ` <*> -| + def name_93 -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + pure cons -| | | | ` ref name_92 -| | | ` rec name_93 -| | ` pure (\u1 -> u1) -| ` pure Term -` eof diff --git a/test/Golden/Grammar/ViewGrammar/G18.expected.txt b/test/Golden/Grammar/ViewGrammar/G18.expected.txt deleted file mode 100644 index 277a90d..0000000 --- a/test/Golden/Grammar/ViewGrammar/G18.expected.txt +++ /dev/null @@ -1,35 +0,0 @@ -<|> -+ <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' -| | ` satisfy -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' -| | ` satisfy -| ` pure Term -` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` satisfy - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' - | ` satisfy - ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G19.expected.txt b/test/Golden/Grammar/ViewGrammar/G19.expected.txt deleted file mode 100644 index 76c8c9d..0000000 --- a/test/Golden/Grammar/ViewGrammar/G19.expected.txt +++ /dev/null @@ -1,37 +0,0 @@ -<|> -+ try -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' -| | ` satisfy -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' -| | ` satisfy -| ` pure Term -` try - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` satisfy - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' - | ` satisfy - ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G2.expected.txt b/test/Golden/Grammar/ViewGrammar/G2.expected.txt index 5b58cc9..a6a1662 100644 --- a/test/Golden/Grammar/ViewGrammar/G2.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G2.expected.txt @@ -1,19 +1,12 @@ -try -` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` satisfy +lets +` try ` <*> + <*> | + pure cons | ` <*> | + <*> | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' + | | ` pure 'a' | ` satisfy ` <*> + <*> @@ -21,6 +14,14 @@ try | ` <*> | + <*> | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'c' + | | ` pure 'b' | ` satisfy - ` pure Term + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'c' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G20.expected.txt b/test/Golden/Grammar/ViewGrammar/G20.expected.txt deleted file mode 100644 index 02f4801..0000000 --- a/test/Golden/Grammar/ViewGrammar/G20.expected.txt +++ /dev/null @@ -1,20 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> -| + def name_214 -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + pure cons -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` pure 'r' -| | | | ` satisfy -| | | ` rec name_214 -| | ` pure (\u1 -> u1) -| ` pure Term -` eof diff --git a/test/Golden/Grammar/ViewGrammar/G21.expected.txt b/test/Golden/Grammar/ViewGrammar/G21.expected.txt deleted file mode 100644 index 37fb719..0000000 --- a/test/Golden/Grammar/ViewGrammar/G21.expected.txt +++ /dev/null @@ -1 +0,0 @@ -eof diff --git a/test/Golden/Grammar/ViewGrammar/G22.expected.txt b/test/Golden/Grammar/ViewGrammar/G22.expected.txt deleted file mode 100644 index 79525bf..0000000 --- a/test/Golden/Grammar/ViewGrammar/G22.expected.txt +++ /dev/null @@ -1,11 +0,0 @@ -<|> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> u1)) -| | ` pure 'a' -| ` satisfy -` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` pure 'b' - ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G23.expected.txt b/test/Golden/Grammar/ViewGrammar/G23.expected.txt deleted file mode 100644 index 9314083..0000000 --- a/test/Golden/Grammar/ViewGrammar/G23.expected.txt +++ /dev/null @@ -1,24 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> -| + def name_244 -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + pure cons -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` pure 'a' -| | | | ` satisfy -| | | ` rec name_244 -| | ` pure (\u1 -> u1) -| ` pure Term -` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` pure 'b' - ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G24.expected.txt b/test/Golden/Grammar/ViewGrammar/G24.expected.txt deleted file mode 100644 index 5794e39..0000000 --- a/test/Golden/Grammar/ViewGrammar/G24.expected.txt +++ /dev/null @@ -1,16 +0,0 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> -| + def name_266 -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + pure cons -| | | | ` satisfy -| | | ` rec name_266 -| | ` pure (\u1 -> u1) -| ` pure Term -` eof diff --git a/test/Golden/Grammar/ViewGrammar/G25.expected.txt b/test/Golden/Grammar/ViewGrammar/G25.expected.txt deleted file mode 100644 index 0bcd98d..0000000 --- a/test/Golden/Grammar/ViewGrammar/G25.expected.txt +++ /dev/null @@ -1,100 +0,0 @@ -<*> -+ <*> -| + <*> -| | + pure (\u1 -> (\u2 -> u1)) -| | ` pure (\u1 -> u1) -| ` def name_282 -| ` <*> -| + <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure (\u1 -> u1) -| | ` <*> -| | + <*> -| | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) -| | | ` pure Term -| | ` def name_283 -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) -| | | | | ` pure (\u1 -> (\u2 -> u1)) -| | | | ` satisfy -| | | ` rec name_283 -| | ` pure (\u1 -> u1) -| ` pure Term -` def name_281 - ` <*> - + def name_280 - | ` <|> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) - | | | ` <*> - | | | + pure cons - | | | ` <*> - | | | + <*> - | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | ` conditional - | | | | + look - | | | | | ` satisfy - | | | | + bs - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | + <*> - | | | | | | + <*> - | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | ` pure Term - | | | | | | ` satisfy - | | | | | ` <*> - | | | | | + <*> - | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | ` <*> - | | | | | | + <*> - | | | | | | | + <*> - | | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | | ` pure (\u1 -> u1) - | | | | | | | ` <*> - | | | | | | | + <*> - | | | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | | | ` satisfy - | | | | | | | ` ref name_282 - | | | | | | ` <*> - | | | | | | + pure Term - | | | | | | ` rec name_281 - | | | | | ` <*> - | | | | | + <*> - | | | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | | | ` pure ']' - | | | | | ` satisfy - | | | | ` empty - | | | ` ref name_282 - | | ` rec name_280 - | ` pure (\u1 -> u1) - ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G3.expected.txt b/test/Golden/Grammar/ViewGrammar/G3.expected.txt index 0154489..03c867e 100644 --- a/test/Golden/Grammar/ViewGrammar/G3.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G3.expected.txt @@ -1,5 +1,5 @@ -<*> -+ def +lets ++ let | ` <|> | + <*> | | + <*> @@ -13,4 +13,6 @@ | | | ` satisfy | | ` rec | ` pure (\u1 -> u1) -` pure Term +` <*> + + ref + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G4.expected.txt b/test/Golden/Grammar/ViewGrammar/G4.expected.txt index abeef3c..61ee02d 100644 --- a/test/Golden/Grammar/ViewGrammar/G4.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G4.expected.txt @@ -1,15 +1,31 @@ -<*> -+ <*> -| + pure cons -| ` def -| ` try +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + pure cons +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` try +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy | ` <*> | + <*> | | + pure cons | | ` <*> | | + <*> | | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' +| | | ` pure 'b' | | ` satisfy | ` <*> | + <*> @@ -17,7 +33,7 @@ | | ` <*> | | + <*> | | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'b' +| | | ` pure 'c' | | ` satisfy | ` <*> | + <*> @@ -25,26 +41,13 @@ | | ` <*> | | + <*> | | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'c' +| | | ` pure 'd' | | ` satisfy -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'd' -| | ` satisfy -| ` pure Term +| ` pure Term ` <*> - + def - | ` <|> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) - | | | ` <*> - | | | + pure cons - | | | ` ref - | | ` rec - | ` pure (\u1 -> u1) - ` pure Term + + <*> + | + pure cons + | ` ref + ` <*> + + ref + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G5.expected.txt b/test/Golden/Grammar/ViewGrammar/G5.expected.txt index b6b1666..b346292 100644 --- a/test/Golden/Grammar/ViewGrammar/G5.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G5.expected.txt @@ -1,54 +1,57 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> +lets ++ let +| ` <|> | + <*> -| | + pure cons -| | ` def -| | ` try -| | ` <*> -| | + <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'a' -| | | ` satisfy -| | ` <*> -| | + <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'b' -| | | ` satisfy -| | ` <*> -| | + <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'c' -| | | ` satisfy -| | ` <*> -| | + <*> -| | | + pure cons -| | | ` <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> u1)) -| | | | ` pure 'd' -| | | ` satisfy -| | ` pure Term +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + pure cons +| | | ` ref +| | ` rec +| ` pure (\u1 -> u1) ++ let +| ` try | ` <*> -| + def -| | ` <|> +| + <*> +| | + pure cons +| | ` <*> | | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + pure cons -| | | | ` ref -| | | ` rec -| | ` pure (\u1 -> u1) -| ` pure Term -` eof +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'a' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'b' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'c' +| | ` satisfy +| ` <*> +| + <*> +| | + pure cons +| | ` <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> u1)) +| | | ` pure 'd' +| | ` satisfy +| ` pure Term +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <*> + | + <*> + | | + pure cons + | | ` ref + | ` <*> + | + ref + | ` pure Term + ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G6.expected.txt b/test/Golden/Grammar/ViewGrammar/G6.expected.txt index 277a90d..a0b4294 100644 --- a/test/Golden/Grammar/ViewGrammar/G6.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G6.expected.txt @@ -1,35 +1,36 @@ -<|> -+ <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' -| | ` satisfy -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' -| | ` satisfy -| ` pure Term -` <*> +lets +` <|> + <*> - | + pure cons + | + <*> + | | + pure cons + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy | ` <*> | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` satisfy + | | + pure cons + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy + | ` pure Term ` <*> + <*> | + pure cons | ` <*> | + <*> | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' + | | ` pure 'a' | ` satisfy - ` pure Term + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G7.expected.txt b/test/Golden/Grammar/ViewGrammar/G7.expected.txt index 76c8c9d..ec4f52b 100644 --- a/test/Golden/Grammar/ViewGrammar/G7.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G7.expected.txt @@ -1,37 +1,38 @@ -<|> -+ try -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' -| | ` satisfy -| ` <*> -| + <*> -| | + pure cons -| | ` <*> -| | + <*> -| | | + pure (\u1 -> (\u2 -> u1)) -| | | ` pure 'a' -| | ` satisfy -| ` pure Term -` try - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` satisfy +lets +` <|> + + try + | ` <*> + | + <*> + | | + pure cons + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy + | ` <*> + | + <*> + | | + pure cons + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy + | ` pure Term + ` try ` <*> + <*> | + pure cons | ` <*> | + <*> | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' + | | ` pure 'a' | ` satisfy - ` pure Term + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G8.expected.txt b/test/Golden/Grammar/ViewGrammar/G8.expected.txt index 025f7a8..b666342 100644 --- a/test/Golden/Grammar/ViewGrammar/G8.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G8.expected.txt @@ -1,20 +1,22 @@ -<*> -+ <*> -| + pure (\u1 -> (\u2 -> u1)) -| ` <*> -| + def -| | ` <|> -| | + <*> -| | | + <*> -| | | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) -| | | | ` <*> -| | | | + pure cons -| | | | ` <*> -| | | | + <*> -| | | | | + pure (\u1 -> (\u2 -> u1)) -| | | | | ` pure 'r' -| | | | ` satisfy -| | | ` rec -| | ` pure (\u1 -> u1) -| ` pure Term -` eof +lets ++ let +| ` <|> +| + <*> +| | + <*> +| | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | ` <*> +| | | + pure cons +| | | ` <*> +| | | + <*> +| | | | + pure (\u1 -> (\u2 -> u1)) +| | | | ` pure 'r' +| | | ` satisfy +| | ` rec +| ` pure (\u1 -> u1) +` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <*> + | + ref + | ` pure Term + ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G9.expected.txt b/test/Golden/Grammar/ViewGrammar/G9.expected.txt index 37fb719..9c1ae43 100644 --- a/test/Golden/Grammar/ViewGrammar/G9.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G9.expected.txt @@ -1 +1,2 @@ -eof +lets +` eof diff --git a/test/Golden/Machine.hs b/test/Golden/Machine.hs index d5fc55e..cd0d10e 100644 --- a/test/Golden/Machine.hs +++ b/test/Golden/Machine.hs @@ -22,5 +22,7 @@ goldens = testGroup "Machine" $ (\f -> List.zipWith f Machine.machines [1::Int ..]) $ \(Machine.M mach) g -> let machineFile = "test/Golden/Machine/G"<>show g<>".expected.txt" in goldenVsStringDiff ("G"<>show g) goldenDiff machineFile $ do + resetTHNameCounter + m <- mach return $ fromString $ show $ - P.viewMachine @'False mach + P.viewMachine @'False m diff --git a/test/Golden/Machine/G1.expected.txt b/test/Golden/Machine/G1.expected.txt index dc8fb40..3fd4e12 100644 --- a/test/Golden/Machine/G1.expected.txt +++ b/test/Golden/Machine/G1.expected.txt @@ -1,4 +1,18 @@ -pushValue (\u1 -> 'a') +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 1) + mayRaise=["fail"] +pushValue 'a' + minReads=(Right 1) + mayRaise=["fail"] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 1) + mayRaise=["fail"] read ('a' ==) + minReads=(Right 1) + mayRaise=["fail"] lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret + minReads=(Right 0) + mayRaise=[] diff --git a/test/Golden/Machine/G10.expected.txt b/test/Golden/Machine/G10.expected.txt index fc64d34..c77ce0c 100644 --- a/test/Golden/Machine/G10.expected.txt +++ b/test/Golden/Machine/G10.expected.txt @@ -1,18 +1,58 @@ catchException "fail" - - | pushValue (\u1 -> 'a') - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | ret - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | pushValue (\u1 -> 'b') - | read ('b' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | ret - - raiseException "fail" + minReads=(Right 1) + mayRaise=[] +| +| | pushValue (\u1 -> (\u2 -> u1)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | pushValue 'a' +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | read ('a' ==) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | popException "fail" +| | minReads=(Right 0) +| | mayRaise=[] +| | ret +| | minReads=(Right 0) +| | mayRaise=[] +| +| | pushInput +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | | +| | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue 'b' +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | read ('b' ==) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | ret +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Machine/G11.expected.txt b/test/Golden/Machine/G11.expected.txt index 4618809..9c6d792 100644 --- a/test/Golden/Machine/G11.expected.txt +++ b/test/Golden/Machine/G11.expected.txt @@ -1,25 +1,103 @@ -pushValue (\u1 -> (\u2 -> u1 Term)) -: +let + minReads=(Right 0) + mayRaise=[] | catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) -| | read ('a' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue 'a' +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | read ('a' ==) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 1) + mayRaise=["fail"] call + minReads=(Right 1) + mayRaise=["fail"] +pushValue Term + minReads=(Right 1) + mayRaise=["fail"] lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 1) + mayRaise=["fail"] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 1) + mayRaise=["fail"] +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 1) + mayRaise=["fail"] +pushValue 'b' + minReads=(Right 1) + mayRaise=["fail"] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 1) + mayRaise=["fail"] read ('b' ==) + minReads=(Right 1) + mayRaise=["fail"] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret + minReads=(Right 0) + mayRaise=[] diff --git a/test/Golden/Machine/G12.expected.txt b/test/Golden/Machine/G12.expected.txt index 3e2e572..8975a09 100644 --- a/test/Golden/Machine/G12.expected.txt +++ b/test/Golden/Machine/G12.expected.txt @@ -1,48 +1,136 @@ -pushValue (\u1 -> (\u2 -> u1 Term)) -: +let + minReads=(Right 0) + mayRaise=[] | catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | read Term -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | read Term +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 0) + mayRaise=[] call + minReads=(Right 0) + mayRaise=[] +pushValue Term + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) -: + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] +join + minReads=(Right 0) + mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret +| minReads=(Right 0) +| mayRaise=[] catchException "fail" - - | catchException "fail" - | - | | pushInput - | | read (\u1 -> Term) - | | popValue - | | popException "fail" - | | loadInput - | | raiseException "fail" - | - | loadInput - | pushValue Term - | popException "fail" - | refJoin - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | raiseException "fail" - - raiseException "fail" + minReads=(Right 0) + mayRaise=[] +| +| | catchException "fail" +| | minReads=(Right 0) +| | mayRaise=[] +| | | +| | | | pushInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | read (\u1 -> Term) +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popValue +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | loadInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | loadInput +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | pushValue Term +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | refJoin +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| +| | pushInput +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Machine/G13.expected.txt b/test/Golden/Machine/G13.expected.txt index 6b8ef1b..ed39490 100644 --- a/test/Golden/Machine/G13.expected.txt +++ b/test/Golden/Machine/G13.expected.txt @@ -1,104 +1,406 @@ -pushValue (\u1 -> (\u2 -> u2)) -: -| pushValue (\u1 -> Term) -| : -| | catchException "fail" -| | -| | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | read Term -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | call -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | popException "fail" -| | | ret -| | -| | pushInput -| | lift2Value Term -| | choicesBranch [(\u1 -> u1)] -| | -| | | pushValue (\u1 -> u1) -| | | ret -| | -| | raiseException "fail" +let + minReads=(Right 0) + mayRaise=[] | call +| minReads=(Right 0) +| mayRaise=[] +| pushValue Term +| minReads=(Right 0) +| mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret -call -lift2Value (\u1 -> (\u2 -> u1 u2)) -: -| pushValue (\u1 -> u1 Term) -| : -| | catchException "fail" -| | -| | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) -| | | : -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | popException "fail" -| | | | ret -| | | pushInput -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | swapValue -| | | loadInput -| | | choicesBranch [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)] -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | read (']' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin -| | | -| | | raiseException "fail" -| | -| | pushInput -| | lift2Value Term -| | choicesBranch [(\u1 -> u1)] -| | -| | | pushValue (\u1 -> u1) -| | | ret -| | -| | raiseException "fail" +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | read Term +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | join +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | call +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | call +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | ret +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | pushInput +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | read ((\u1 -> (\u2 -> u1)) Term) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | swapValue +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | loadInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)] +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | pushValue Term +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | refJoin +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | pushValue Term +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | refJoin +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | pushValue Term +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | refJoin +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | pushValue Term +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | refJoin +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | pushValue Term +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | refJoin +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | pushValue Term +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | refJoin +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 2) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 2) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 2) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 2) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 2) +| | | | | mayRaise=["fail"] +| | | | | read ((\u1 -> (\u2 -> u1)) Term) +| | | | | minReads=(Right 2) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | call +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | pushValue Term +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | call +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | pushValue ']' +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | read (']' ==) +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | refJoin +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 0) +| mayRaise=[] +| pushValue (\u1 -> u1) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| minReads=(Right 0) +| mayRaise=[] +| pushValue Term +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | call +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| pushValue Term +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret +| minReads=(Right 0) +| mayRaise=[] +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 0) + mayRaise=[] +pushValue (\u1 -> u1) + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] +call + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] call + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret + minReads=(Right 0) + mayRaise=[] diff --git a/test/Golden/Machine/G14.expected.txt b/test/Golden/Machine/G14.expected.txt index 921d9e7..abf6e2a 100644 --- a/test/Golden/Machine/G14.expected.txt +++ b/test/Golden/Machine/G14.expected.txt @@ -1,938 +1,3327 @@ -pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) -: -| pushValue (\u1 -> (\u2 -> (\u3 -> u3))) -| : -| | pushValue Term +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | read Term +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | catchException "fail" +| | | minReads=(Right 18) +| | | mayRaise=[] +| | | | +| | | | | pushValue cons +| | | | | minReads=(Right 18) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 18) +| | | | | mayRaise=["fail"] +| | | | | pushValue 'f' +| | | | | minReads=(Right 18) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 18) +| | | | | mayRaise=["fail"] +| | | | | read ('f' ==) +| | | | | minReads=(Right 18) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 17) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 17) +| | | | | mayRaise=["fail"] +| | | | | pushValue cons +| | | | | minReads=(Right 17) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 17) +| | | | | mayRaise=["fail"] +| | | | | pushValue 'u' +| | | | | minReads=(Right 17) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 17) +| | | | | mayRaise=["fail"] +| | | | | read ('u' ==) +| | | | | minReads=(Right 17) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 16) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 16) +| | | | | mayRaise=["fail"] +| | | | | pushValue cons +| | | | | minReads=(Right 16) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 16) +| | | | | mayRaise=["fail"] +| | | | | pushValue 'n' +| | | | | minReads=(Right 16) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 16) +| | | | | mayRaise=["fail"] +| | | | | read ('n' ==) +| | | | | minReads=(Right 16) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 15) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 15) +| | | | | mayRaise=["fail"] +| | | | | pushValue cons +| | | | | minReads=(Right 15) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 15) +| | | | | mayRaise=["fail"] +| | | | | pushValue 'c' +| | | | | minReads=(Right 15) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 15) +| | | | | mayRaise=["fail"] +| | | | | read ('c' ==) +| | | | | minReads=(Right 15) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 14) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 14) +| | | | | mayRaise=["fail"] +| | | | | pushValue cons +| | | | | minReads=(Right 14) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 14) +| | | | | mayRaise=["fail"] +| | | | | pushValue 't' +| | | | | minReads=(Right 14) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 14) +| | | | | mayRaise=["fail"] +| | | | | read ('t' ==) +| | | | | minReads=(Right 14) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 13) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 13) +| | | | | mayRaise=["fail"] +| | | | | pushValue cons +| | | | | minReads=(Right 13) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 13) +| | | | | mayRaise=["fail"] +| | | | | pushValue 'i' +| | | | | minReads=(Right 13) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 13) +| | | | | mayRaise=["fail"] +| | | | | read ('i' ==) +| | | | | minReads=(Right 13) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 12) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 12) +| | | | | mayRaise=["fail"] +| | | | | pushValue cons +| | | | | minReads=(Right 12) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 12) +| | | | | mayRaise=["fail"] +| | | | | pushValue 'o' +| | | | | minReads=(Right 12) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 12) +| | | | | mayRaise=["fail"] +| | | | | read ('o' ==) +| | | | | minReads=(Right 12) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 11) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 11) +| | | | | mayRaise=["fail"] +| | | | | pushValue cons +| | | | | minReads=(Right 11) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 11) +| | | | | mayRaise=["fail"] +| | | | | pushValue 'n' +| | | | | minReads=(Right 11) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 11) +| | | | | mayRaise=["fail"] +| | | | | read ('n' ==) +| | | | | minReads=(Right 11) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | pushValue Term +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | popException "fail" +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | call +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | call +| | | | | minReads=(Right 10) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 8) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 8) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 8) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 8) +| | | | | mayRaise=["fail"] +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 8) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 8) +| | | | | mayRaise=["fail"] +| | | | | call +| | | | | minReads=(Right 8) +| | | | | mayRaise=["fail"] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 6) +| | | | | mayRaise=[] +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 6) +| | | | | mayRaise=[] +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 6) +| | | | | mayRaise=[] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 6) +| | | | | mayRaise=[] +| | | | | call +| | | | | minReads=(Right 6) +| | | | | mayRaise=[] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 2) +| | | | | mayRaise=[] +| | | | | join +| | | | | minReads=(Right 6) +| | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 6) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 6) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 6) +| | | | | | mayRaise=["fail"] +| | | | | | call +| | | | | | minReads=(Right 6) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 4) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 4) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 4) +| | | | | | mayRaise=["fail"] +| | | | | | call +| | | | | | minReads=(Right 4) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | call +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | popException "fail" +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | ret +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | catchException "fail" +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | | +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue Term +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue (\u1 -> u1) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue ':' +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | read (':' ==) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | call +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | call +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | popException "fail" +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | refJoin +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | +| | | | | | | pushInput +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value Term +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=["fail"] +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=["fail"] +| | | | | | | | +| | | | | | | | | call +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | | refJoin +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | +| | | | | | | | | raiseException "fail" +| | | | | | | | | minReads=(Left "fail") +| | | | | | | | | mayRaise=["fail"] +| | | | +| | | | | loadInput +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | join +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | call +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | ret +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | catchException "fail" +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | | +| | | | | join +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | | popException "fail" +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | refJoin +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | catchException "fail" +| | | | | minReads=(Right 2) +| | | | | mayRaise=[] +| | | | | | +| | | | | | | join +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | | popException "fail" +| | | | | | | | minReads=(Right 0) +| | | | | | | | mayRaise=[] +| | | | | | | | refJoin +| | | | | | | | minReads=(Right 0) +| | | | | | | | mayRaise=[] +| | | | | | | catchException "fail" +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=[] +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | minReads=(Right 2) +| | | | | | | | | mayRaise=[] +| | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | minReads=(Right 2) +| | | | | | | | | mayRaise=[] +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | minReads=(Right 2) +| | | | | | | | | mayRaise=[] +| | | | | | | | | catchException "fail" +| | | | | | | | | minReads=(Right 2) +| | | | | | | | | mayRaise=[] +| | | | | | | | | | +| | | | | | | | | | | pushValue cons +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue 'i' +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | read ('i' ==) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue cons +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue 'f' +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | read ('f' ==) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue Term +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | popException "fail" +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | call +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | popException "fail" +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | refJoin +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | +| | | | | | | | | | | loadInput +| | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | +| | | | | | | | | pushInput +| | | | | | | | | minReads=(Right 11) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | lift2Value Term +| | | | | | | | | minReads=(Right 11) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | minReads=(Right 11) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | +| | | | | | | | | | | | | pushValue cons +| | | | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue 'w' +| | | | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | read ('w' ==) +| | | | | | | | | | | | | minReads=(Right 11) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 10) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 10) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue cons +| | | | | | | | | | | | | minReads=(Right 10) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | minReads=(Right 10) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue 'h' +| | | | | | | | | | | | | minReads=(Right 10) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 10) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | read ('h' ==) +| | | | | | | | | | | | | minReads=(Right 10) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 9) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 9) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue cons +| | | | | | | | | | | | | minReads=(Right 9) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | minReads=(Right 9) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue 'i' +| | | | | | | | | | | | | minReads=(Right 9) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 9) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | read ('i' ==) +| | | | | | | | | | | | | minReads=(Right 9) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue cons +| | | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue 'l' +| | | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | read ('l' ==) +| | | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 7) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 7) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue cons +| | | | | | | | | | | | | minReads=(Right 7) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | minReads=(Right 7) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue 'e' +| | | | | | | | | | | | | minReads=(Right 7) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 7) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | read ('e' ==) +| | | | | | | | | | | | | minReads=(Right 7) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | pushValue Term +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | call +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | call +| | | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | call +| | | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | +| | | | | | | | | | | | | loadInput +| | | | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | +| | | | | | | pushInput +| | | | | | | minReads=(Right 8) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value Term +| | | | | | | minReads=(Right 8) +| | | | | | | mayRaise=["fail"] +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | minReads=(Right 8) +| | | | | | | mayRaise=["fail"] +| | | | | | | | +| | | | | | | | | catchException "fail" +| | | | | | | | | minReads=(Right 8) +| | | | | | | | | mayRaise=[] +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | join +| | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 8) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 6) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | pushValue '=' +| | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | read ('=' ==) +| | | | | | | | | | | | minReads=(Right 4) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | call +| | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | refJoin +| | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | pushValue Term +| | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | pushValue cons +| | | | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | pushValue 'v' +| | | | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | read ('v' ==) +| | | | | | | | | | | | | | | minReads=(Right 3) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | pushValue cons +| | | | | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | pushValue 'a' +| | | | | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | read ('a' ==) +| | | | | | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | pushValue cons +| | | | | | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | pushValue 'r' +| | | | | | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | read ('r' ==) +| | | | | | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | pushValue Term +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | loadInput +| | | | | | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | +| | | | | | | | | | | | | pushInput +| | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | lift2Value Term +| | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | call +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | | +| | | | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | +| | | | | | | | | | | loadInput +| | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | +| | | | | | | | | raiseException "fail" +| | | | | | | | | minReads=(Left "fail") +| | | | | | | | | mayRaise=["fail"] +| | | | +| | | | | pushInput +| | | | | minReads=(Right 4) +| | | | | mayRaise=["fail"] +| | | | | lift2Value Term +| | | | | minReads=(Right 4) +| | | | | mayRaise=["fail"] +| | | | | choicesBranch [(\u1 -> u1)] +| | | | | minReads=(Right 4) +| | | | | mayRaise=["fail"] +| | | | | | +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | call +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | call +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | refJoin +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | +| | | | | | | raiseException "fail" +| | | | | | | minReads=(Left "fail") +| | | | | | | mayRaise=["fail"] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue '!' +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | read ('!' ==) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | pushValue Term +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | jump +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 0) + mayRaise=[] +| pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) +| minReads=(Right 0) +| mayRaise=[] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 0) + mayRaise=[] +| pushValue Term +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 0) + mayRaise=[] +| pushValue Term +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 1) + mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> u1) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| call +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 0) +| mayRaise=[] +| pushValue (\u1 -> u1) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| minReads=(Right 0) +| mayRaise=[] +| pushValue Term +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| call +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| pushValue Term +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 1) + mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> u1) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| read Term +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| call +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 1) + mayRaise=["fail"] +| read Term +| minReads=(Right 1) +| mayRaise=["fail"] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 2) + mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue '(' +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=["fail"] +| read ('(' ==) +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| call +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 2) + mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue ')' +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=["fail"] +| read (')' ==) +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| call +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 2) + mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue ',' +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=["fail"] +| read (',' ==) +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| call +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 2) + mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue ';' +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=["fail"] +| read (';' ==) +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| call +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 2) + mayRaise=[] +| catchException "fail" +| minReads=(Right 2) +| mayRaise=[] +| | +| | | join +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | ret +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | catchException "fail" +| | | minReads=(Right 2) +| | | mayRaise=[] +| | | | +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 2) +| | | | | mayRaise=[] +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 2) +| | | | | mayRaise=[] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 2) +| | | | | mayRaise=[] +| | | | | join +| | | | | minReads=(Right 1) +| | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | call +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | popException "fail" +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | refJoin +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | catchException "fail" +| | | | | minReads=(Right 1) +| | | | | mayRaise=[] +| | | | | | +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue '0' +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | read ('0' ==) +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | popException "fail" +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | refJoin +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | +| | | | | | | pushInput +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value Term +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=["fail"] +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | minReads=(Right 1) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | pushValue '1' +| | | | | | | | | minReads=(Right 1) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | minReads=(Right 1) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | read ('1' ==) +| | | | | | | | | minReads=(Right 1) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | | refJoin +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | +| | | | | | | | | raiseException "fail" +| | | | | | | | | minReads=(Left "fail") +| | | | | | | | | mayRaise=["fail"] +| | | | +| | | | | pushInput +| | | | | minReads=(Right 4) +| | | | | mayRaise=["fail"] +| | | | | lift2Value Term +| | | | | minReads=(Right 4) +| | | | | mayRaise=["fail"] +| | | | | choicesBranch [(\u1 -> u1)] +| | | | | minReads=(Right 4) +| | | | | mayRaise=["fail"] +| | | | | | +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue (\u1 -> u1) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | pushValue '\'' +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | read ('\'' ==) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 3) +| | | | | | | mayRaise=[] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 3) +| | | | | | | mayRaise=[] +| | | | | | | join +| | | | | | | minReads=(Right 2) +| | | | | | | mayRaise=["fail"] +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | minReads=(Right 2) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | minReads=(Right 2) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | minReads=(Right 2) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | minReads=(Right 2) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | pushValue '\'' +| | | | | | | | minReads=(Right 2) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | minReads=(Right 2) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | read ('\'' ==) +| | | | | | | | minReads=(Right 2) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | minReads=(Right 1) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | minReads=(Right 1) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | call +| | | | | | | | minReads=(Right 1) +| | | | | | | | mayRaise=["fail"] +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | minReads=(Right 0) +| | | | | | | | mayRaise=[] +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | minReads=(Right 0) +| | | | | | | | mayRaise=[] +| | | | | | | | refJoin +| | | | | | | | minReads=(Right 0) +| | | | | | | | mayRaise=[] +| | | | | | | catchException "fail" +| | | | | | | minReads=(Right 1) +| | | | | | | mayRaise=[] +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | minReads=(Right 1) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | minReads=(Right 1) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | minReads=(Right 1) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | read Term +| | | | | | | | | minReads=(Right 1) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | | call +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | | popException "fail" +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | | refJoin +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | +| | | | | | | | | pushInput +| | | | | | | | | minReads=(Right 2) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | lift2Value Term +| | | | | | | | | minReads=(Right 2) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | minReads=(Right 2) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue '\\' +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | read ('\\' ==) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | read Term +| | | | | | | | | | | minReads=(Right 1) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | call +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | refJoin +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | +| | | | | | | raiseException "fail" +| | | | | | | minReads=(Left "fail") +| | | | | | | mayRaise=["fail"] +| | +| | | pushInput +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | minReads=(Right 2) +| | | | | mayRaise=[] +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 2) +| | | | | mayRaise=[] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 2) +| | | | | mayRaise=[] +| | | | | call +| | | | | minReads=(Right 2) +| | | | | mayRaise=[] +| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | join +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | ret +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | catchException "fail" +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | | +| | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=[] +| | | | | | | pushValue Term +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=[] +| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=[] +| | | | | | | join +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=[] +| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | minReads=(Right 0) +| | | | | | | | mayRaise=[] +| | | | | | | | popException "fail" +| | | | | | | | minReads=(Right 0) +| | | | | | | | mayRaise=[] +| | | | | | | | refJoin +| | | | | | | | minReads=(Right 0) +| | | | | | | | mayRaise=[] +| | | | | | | catchException "fail" +| | | | | | | minReads=(Right 4) +| | | | | | | mayRaise=[] +| | | | | | | | +| | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | minReads=(Right 4) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | minReads=(Right 4) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | minReads=(Right 4) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | minReads=(Right 4) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | call +| | | | | | | | | minReads=(Right 4) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | minReads=(Right 2) +| | | | | | | | | mayRaise=[] +| | | | | | | | | join +| | | | | | | | | minReads=(Right 2) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | call +| | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | mayRaise=[] +| | | | | | | | | | popException "fail" +| | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | mayRaise=[] +| | | | | | | | | | refJoin +| | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | mayRaise=[] +| | | | | | | | | catchException "fail" +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | | | +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue Term +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | call +| | | | | | | | | | | minReads=(Right 2) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue (\u1 -> u1) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | call +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | call +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | call +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | popException "fail" +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | refJoin +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | +| | | | | | | | | | | pushInput +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | lift2Value Term +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | +| | | | | | | | | | | | | call +| | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | refJoin +| | | | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | +| | | | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | +| | | | | | | | | pushInput +| | | | | | | | | minReads=(Right 5) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | lift2Value Term +| | | | | | | | | minReads=(Right 5) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | | | minReads=(Right 5) +| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | +| | | | | | | | | | | call +| | | | | | | | | | | minReads=(Right 5) +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | refJoin +| | | | | | | | | | | minReads=(Right 0) +| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | +| | | | | | | | | | | raiseException "fail" +| | | | | | | | | | | minReads=(Left "fail") +| | | | | | | | | | | mayRaise=["fail"] +| | | | | | +| | | | | | | pushInput +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=["fail"] +| | | | | | | lift2Value Term +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=["fail"] +| | | | | | | choicesBranch [(\u1 -> u1)] +| | | | | | | minReads=(Right 0) +| | | | | | | mayRaise=["fail"] +| | | | | | | | +| | | | | | | | | call +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | | refJoin +| | | | | | | | | minReads=(Right 0) +| | | | | | | | | mayRaise=[] +| | | | | | | | +| | | | | | | | | raiseException "fail" +| | | | | | | | | minReads=(Left "fail") +| | | | | | | | | mayRaise=["fail"] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 2) + mayRaise=[] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[] +| pushValue (\u1 -> u1) +| minReads=(Right 2) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=[] +| call +| minReads=(Right 2) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| join +| minReads=(Right 0) +| mayRaise=[] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] | | ret +| | minReads=(Right 0) +| | mayRaise=[] +| catchException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 5) +| | | mayRaise=["fail"] +| | | pushValue Term +| | | minReads=(Right 5) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 5) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 5) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | refJoin +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | call +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | refJoin +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 2) + mayRaise=[] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[] +| pushValue (\u1 -> u1) +| minReads=(Right 2) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=[] | call +| minReads=(Right 2) +| mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) -| : -| | catchException "fail" -| | -| | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | : -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | popException "fail" -| | | | ret -| | | catchException "fail" -| | | -| | | | pushValue (\u1 -> (\u2 -> Term)) -| | | | : -| | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | read Term -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | ret -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | catchException "fail" -| | | | | -| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | popException "fail" -| | | | | | ret -| | | | | -| | | | | pushInput -| | | | | lift2Value Term -| | | | | choicesBranch [(\u1 -> u1)] -| | | | | -| | | | | | pushValue (\u1 -> u1) -| | | | | | ret -| | | | | -| | | | | raiseException "fail" -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | popException "fail" -| | | | refJoin -| | | -| | | pushInput -| | | lift2Value Term -| | | choicesBranch [(\u1 -> u1)] -| | | -| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | catchException "fail" -| | | | -| | | | | pushValue (\u1 -> (\u2 -> '/' : ('/' : Term))) -| | | | | read ('/' ==) -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | read ('/' ==) -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | popException "fail" -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | : -| | | | | | catchException "fail" -| | | | | | -| | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | read Term -| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | call -| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | popException "fail" -| | | | | | | ret -| | | | | | -| | | | | | pushInput -| | | | | | lift2Value Term -| | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | -| | | | | | | pushValue (\u1 -> u1) -| | | | | | | ret -| | | | | | -| | | | | | raiseException "fail" -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | refJoin -| | | | -| | | | loadInput -| | | | raiseException "fail" -| | | -| | | raiseException "fail" -| | -| | pushInput -| | lift2Value Term -| | choicesBranch [(\u1 -> u1)] -| | -| | | pushValue (\u1 -> u1) -| | | ret -| | -| | raiseException "fail" +| minReads=(Right 0) +| mayRaise=[] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 0) +| mayRaise=[] +| pushValue (\u1 -> u1) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| minReads=(Right 0) +| mayRaise=[] | call +| minReads=(Right 0) +| mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | call +| minReads=(Right 0) +| mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| call +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 2) + mayRaise=[] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[] +| pushValue (\u1 -> u1) +| minReads=(Right 2) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=[] +| catchException "fail" +| minReads=(Right 2) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | read Term +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> u1) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | popException "fail" +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | call +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | loadInput +| | | minReads=(Left "fail") +| | | mayRaise=["fail"] +| | | raiseException "fail" +| | | minReads=(Left "fail") +| | | mayRaise=["fail"] +let + minReads=(Right 4) + mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 4) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 4) +| mayRaise=["fail"] +| pushValue (\u1 -> u1) +| minReads=(Right 4) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 4) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 4) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 4) +| mayRaise=["fail"] +| pushValue '{' +| minReads=(Right 4) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 4) +| mayRaise=["fail"] +| read ('{' ==) +| minReads=(Right 4) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 3) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 3) +| mayRaise=["fail"] +| call +| minReads=(Right 3) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> u1) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| minReads=(Right 1) +| mayRaise=["fail"] +| call +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| call +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| call +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue '}' +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| read ('}' ==) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| call +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 5) + mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 5) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 5) +| mayRaise=["fail"] +| pushValue (\u1 -> u1) +| minReads=(Right 5) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 5) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 5) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 5) +| mayRaise=["fail"] +| pushValue '[' +| minReads=(Right 5) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 5) +| mayRaise=["fail"] +| read ('[' ==) +| minReads=(Right 5) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 4) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 4) +| mayRaise=["fail"] +| call +| minReads=(Right 4) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=["fail"] +| pushValue (\u1 -> u1) +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=["fail"] +| call +| minReads=(Right 2) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> u1) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue Term +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| call +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue Term +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue ']' +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| read (']' ==) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| call +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 1) + mayRaise=["fail"] +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 1) + mayRaise=["fail"] +pushValue (\u1 -> u1) + minReads=(Right 1) + mayRaise=["fail"] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 1) + mayRaise=["fail"] call + minReads=(Right 1) + mayRaise=["fail"] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 0) + mayRaise=[] +pushValue (\u1 -> u1) + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] +pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) + minReads=(Right 0) + mayRaise=[] call + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) -: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10)))))))))) -| | catchException "fail" -| | -| | | pushValue (\u1 -> (\u2 -> u2)) -| | | catchException "fail" -| | | -| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> 'f' : ('u' : ('n' : ('c' : ('t' : ('i' : ('o' : ('n' : u9)))))))))))))))) -| | | | read ('f' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | read ('u' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | read ('n' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | read ('c' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | read ('t' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | read ('i' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | read ('o' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | read ('n' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | pushValue Term -| | | | | ret -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | popException "fail" -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | catchException "fail" -| | | | | -| | | | | | pushInput -| | | | | | read Term -| | | | | | popValue -| | | | | | popException "fail" -| | | | | | loadInput -| | | | | | raiseException "fail" -| | | | | -| | | | | loadInput -| | | | | pushValue Term -| | | | | ret -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | popException "fail" -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | catchException "fail" -| | | | | -| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | read Term -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | : -| | | | | | | catchException "fail" -| | | | | | | -| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | read Term -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | popException "fail" -| | | | | | | | ret -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift2Value Term -| | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | -| | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | ret -| | | | | | | -| | | | | | | raiseException "fail" -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | popException "fail" -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | ret -| | | | | -| | | | | loadInput -| | | | | raiseException "fail" -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | pushValue (\u1 -> (\u2 -> '(')) -| | | | | read ('(' ==) -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | ret -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | catchException "fail" -| | | | | -| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | : -| | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | call -| | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | : -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | ret -| | | | | | | catchException "fail" -| | | | | | | -| | | | | | | | pushValue (\u1 -> Term) -| | | | | | | | : -| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term)))))) -| | | | | | | | | read ('[' ==) -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | : -| | | | | | | | | | read Term -| | | | | | | | | | ret -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | : -| | | | | | | | | | catchException "fail" -| | | | | | | | | | -| | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | | | | call -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | popException "fail" -| | | | | | | | | | | ret -| | | | | | | | | | -| | | | | | | | | | pushInput -| | | | | | | | | | lift2Value Term -| | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | -| | | | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | | | ret -| | | | | | | | | | -| | | | | | | | | | raiseException "fail" -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | read (']' ==) -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | ret -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | popException "fail" -| | | | | | | | refJoin -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift2Value Term -| | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | -| | | | | | | | call -| | | | | | | | refJoin -| | | | | | | -| | | | | | | raiseException "fail" -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | : -| | | | | | | catchException "fail" -| | | | | | | -| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | : -| | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | ret -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | : -| | | | | | | | | pushValue (\u1 -> (\u2 -> ',')) -| | | | | | | | | read (',' ==) -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | ret -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | call -| | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | popException "fail" -| | | | | | | | ret -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift2Value Term -| | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | -| | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | ret -| | | | | | | -| | | | | | | raiseException "fail" -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | popException "fail" -| | | | | | ret -| | | | | -| | | | | pushInput -| | | | | lift2Value Term -| | | | | choicesBranch [(\u1 -> u1)] -| | | | | -| | | | | | jump -| | | | | -| | | | | raiseException "fail" -| | | | call -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | : -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | : -| | | | | | pushValue (\u1 -> (\u2 -> ')')) -| | | | | | read (')' ==) -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | ret -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | : -| | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5))))))) -| | | | | | read ('{' ==) -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | : -| | | | | | | catchException "fail" -| | | | | | | -| | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | | | | | | : -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | call -| | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | popException "fail" -| | | | | | | | | ret -| | | | | | | | catchException "fail" -| | | | | | | | -| | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5))))) -| | | | | | | | | catchException "fail" -| | | | | | | | | -| | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | catchException "fail" -| | | | | | | | | | -| | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3)))) -| | | | | | | | | | | read ('i' ==) -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | read ('f' ==) -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | popException "fail" -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | popException "fail" -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | : -| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | | | : -| | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> '0') -| | | | | | | | | | | | | | | read ('0' ==) -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> '1') -| | | | | | | | | | | | | | | read ('1' ==) -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2)))) -| | | | | | | | | | | | | | | read ('\'' ==) -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | read ('\'' ==) -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | | read Term -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u3))) -| | | | | | | | | | | | | | | | read ('\\' ==) -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | read Term -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushValue (\u1 -> Term) -| | | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u2))) -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term)))) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | : -| | | | | | | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | : -| | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5))))) -| | | | | | | | | | | | | | read ('!' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | ret -| | | | | | | | | | | | | -| | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | | | | | | ret -| | | | | | | | | | | | | -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | ret -| | | | | | | | | | | call -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | : -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | refJoin -| | | | | | | | | | | catchException "fail" -| | | | | | | | | | | -| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> 'e' : ('l' : ('s' : ('e' : u5)))))))) -| | | | | | | | | | | | | | read ('e' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | read ('l' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | read ('s' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | read ('e' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | -| | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | loadInput -| | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | -| | | | | | | | | | | pushInput -| | | | | | | | | | | lift2Value Term -| | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | -| | | | | | | | | | | | call -| | | | | | | | | | | | refJoin -| | | | | | | | | | | -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | -| | | | | | | | | | loadInput -| | | | | | | | | | raiseException "fail" -| | | | | | | | | -| | | | | | | | | loadInput -| | | | | | | | | raiseException "fail" -| | | | | | | | -| | | | | | | | pushInput -| | | | | | | | lift2Value Term -| | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | -| | | | | | | | | catchException "fail" -| | | | | | | | | -| | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4)))) -| | | | | | | | | | catchException "fail" -| | | | | | | | | | -| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | catchException "fail" -| | | | | | | | | | | -| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> 'w' : ('h' : ('i' : ('l' : ('e' : u6)))))))))) -| | | | | | | | | | | | read ('w' ==) -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | read ('h' ==) -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | read ('i' ==) -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | read ('l' ==) -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | read ('e' ==) -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | call -| | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | refJoin -| | | | | | | | | | | -| | | | | | | | | | | loadInput -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | -| | | | | | | | | | loadInput -| | | | | | | | | | raiseException "fail" -| | | | | | | | | -| | | | | | | | | pushInput -| | | | | | | | | lift2Value Term -| | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | -| | | | | | | | | | catchException "fail" -| | | | | | | | | | -| | | | | | | | | | | catchException "fail" -| | | | | | | | | | | -| | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11)))))))))))) -| | | | | | | | | | | | : -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | : -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | read ('=' ==) -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | : -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5)))))) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | pushInput -| | | | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | | | | | | | | ret -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | : -| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> ';')) -| | | | | | | | | | | | | | read (';' ==) -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | call -| | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | ret -| | | | | | | | | | | | | call -| | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | refJoin -| | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> Term)) -| | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u2)) -| | | | | | | | | | | | | | catchException "fail" -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'v' : ('a' : ('r' : u4)))))) -| | | | | | | | | | | | | | | read ('v' ==) -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | read ('a' ==) -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | read ('r' ==) -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | call -| | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | | | | | popException "fail" -| | | | | | | | | | | | | | | refJoin -| | | | | | | | | | | | | | -| | | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | -| | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | -| | | | | | | | | | | | pushInput -| | | | | | | | | | | | lift2Value Term -| | | | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | | | -| | | | | | | | | | | | | call -| | | | | | | | | | | | | refJoin -| | | | | | | | | | | | -| | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | -| | | | | | | | | | | loadInput -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | -| | | | | | | | | | pushInput -| | | | | | | | | | lift2Value Term -| | | | | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | | | | -| | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) -| | | | | | | | | | | call -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | call -| | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | | | | | | refJoin -| | | | | | | | | | -| | | | | | | | | | raiseException "fail" -| | | | | | | | | -| | | | | | | | | raiseException "fail" -| | | | | | | | -| | | | | | | | raiseException "fail" -| | | | | | | -| | | | | | | pushInput -| | | | | | | lift2Value Term -| | | | | | | choicesBranch [(\u1 -> u1)] -| | | | | | | -| | | | | | | | pushValue (\u1 -> u1) -| | | | | | | | ret -| | | | | | | -| | | | | | | raiseException "fail" -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | read ('}' ==) -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | call -| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | | ret -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | popException "fail" -| | | | | ret -| | | | catchException "fail" -| | | | -| | | | | pushValue (\u1 -> (\u2 -> (\u3 -> Term))) -| | | | | read (':' ==) -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | call -| | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | | popException "fail" -| | | | | refJoin -| | | | -| | | | pushInput -| | | | lift2Value Term -| | | | choicesBranch [(\u1 -> u1)] -| | | | -| | | | | call -| | | | | refJoin -| | | | -| | | | raiseException "fail" -| | | -| | | loadInput -| | | raiseException "fail" -| | -| | loadInput -| | raiseException "fail" -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" + minReads=(Right 0) + mayRaise=[] call + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] call + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) -: + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] +join + minReads=(Right 0) + mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret +| minReads=(Right 0) +| mayRaise=[] catchException "fail" - - | catchException "fail" - | - | | pushInput - | | read (\u1 -> Term) - | | popValue - | | popException "fail" - | | loadInput - | | raiseException "fail" - | - | loadInput - | pushValue Term - | popException "fail" - | refJoin - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | raiseException "fail" - - raiseException "fail" + minReads=(Right 0) + mayRaise=[] +| +| | catchException "fail" +| | minReads=(Right 0) +| | mayRaise=[] +| | | +| | | | pushInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | read (\u1 -> Term) +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popValue +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | loadInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | loadInput +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | pushValue Term +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | refJoin +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| +| | pushInput +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Machine/G15.expected.txt b/test/Golden/Machine/G15.expected.txt index f215fc0..39e4984 100644 --- a/test/Golden/Machine/G15.expected.txt +++ b/test/Golden/Machine/G15.expected.txt @@ -1,23 +1,88 @@ -pushValue (\u1 -> u1 Term) -name_770: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) -| | read ('a' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call name_770 -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" -call name_770 -lift2Value (\u1 -> (\u2 -> u1 u2)) -ret +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 2) + mayRaise=[] +join + minReads=(Right 1) + mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue 'c' +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| read ('c' ==) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +catchException "fail" + minReads=(Right 1) + mayRaise=[] +| +| | pushValue (\u1 -> (\u2 -> u1)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | pushValue 'a' +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | read ('a' ==) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | popException "fail" +| | minReads=(Right 0) +| | mayRaise=[] +| | refJoin +| | minReads=(Right 0) +| | mayRaise=[] +| +| | pushInput +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | | +| | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue 'b' +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | read ('b' ==) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | refJoin +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Machine/G16.expected.txt b/test/Golden/Machine/G16.expected.txt index 5551214..b54fad7 100644 --- a/test/Golden/Machine/G16.expected.txt +++ b/test/Golden/Machine/G16.expected.txt @@ -1,42 +1,134 @@ -pushValue (\u1 -> (\u2 -> u1 : u2 Term)) -name_785: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | read ('a' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('b' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('c' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('d' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| loadInput -| raiseException "fail" -call name_785 -lift2Value (\u1 -> (\u2 -> u1 u2)) -name_784: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | call name_785 -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call name_784 -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" -call name_784 -lift2Value (\u1 -> (\u2 -> u1 u2)) -ret +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 2) + mayRaise=[] +join + minReads=(Right 1) + mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 1) +| mayRaise=["fail"] +| pushValue 'd' +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=["fail"] +| read ('d' ==) +| minReads=(Right 1) +| mayRaise=["fail"] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +catchException "fail" + minReads=(Right 1) + mayRaise=[] +| +| | join +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | refJoin +| | | minReads=(Right 0) +| | | mayRaise=[] +| | catchException "fail" +| | minReads=(Right 1) +| | mayRaise=[] +| | | +| | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue 'a' +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | read ('a' ==) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | refJoin +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | +| | | | pushInput +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value Term +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | choicesBranch [(\u1 -> u1)] +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | | +| | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | pushValue 'b' +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | read ('b' ==) +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | refJoin +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | +| | | | | | raiseException "fail" +| | | | | | minReads=(Left "fail") +| | | | | | mayRaise=["fail"] +| +| | pushInput +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | | +| | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue 'c' +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | read ('c' ==) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | refJoin +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Machine/G17.expected.txt b/test/Golden/Machine/G17.expected.txt deleted file mode 100644 index d396465..0000000 --- a/test/Golden/Machine/G17.expected.txt +++ /dev/null @@ -1,67 +0,0 @@ -pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) -name_830: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | read ('a' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('b' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('c' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('d' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| loadInput -| raiseException "fail" -call name_830 -lift2Value (\u1 -> (\u2 -> u1 u2)) -name_831: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | call name_830 -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call name_831 -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" -call name_831 -lift2Value (\u1 -> (\u2 -> u1 u2)) -join_879: -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| ret -catchException "fail" - - | catchException "fail" - | - | | pushInput - | | read (\u1 -> Term) - | | popValue - | | popException "fail" - | | loadInput - | | raiseException "fail" - | - | loadInput - | pushValue Term - | popException "fail" - | refJoin join_879 - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | raiseException "fail" - - raiseException "fail" diff --git a/test/Golden/Machine/G18.expected.txt b/test/Golden/Machine/G18.expected.txt deleted file mode 100644 index eac5644..0000000 --- a/test/Golden/Machine/G18.expected.txt +++ /dev/null @@ -1,22 +0,0 @@ -catchException "fail" - - | pushValue (\u1 -> (\u2 -> 'a' : ('a' : Term))) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | ret - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | pushValue (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('b' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | ret - - raiseException "fail" diff --git a/test/Golden/Machine/G19.expected.txt b/test/Golden/Machine/G19.expected.txt deleted file mode 100644 index abe13b0..0000000 --- a/test/Golden/Machine/G19.expected.txt +++ /dev/null @@ -1,34 +0,0 @@ -catchException "fail" - - | catchException "fail" - | - | | pushValue (\u1 -> (\u2 -> 'a' : ('a' : Term))) - | | read ('a' ==) - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | read ('a' ==) - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | popException "fail" - | | popException "fail" - | | ret - | - | loadInput - | raiseException "fail" - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | catchException "fail" - | - | | pushValue (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | | read ('a' ==) - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | read ('b' ==) - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | popException "fail" - | | ret - | - | loadInput - | raiseException "fail" - - raiseException "fail" diff --git a/test/Golden/Machine/G2.expected.txt b/test/Golden/Machine/G2.expected.txt index 28a0ccc..264b0aa 100644 --- a/test/Golden/Machine/G2.expected.txt +++ b/test/Golden/Machine/G2.expected.txt @@ -1,14 +1,92 @@ catchException "fail" - - | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : ('b' : ('c' : Term))))) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('b' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('c' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | ret - - loadInput - raiseException "fail" + minReads=(Right 3) + mayRaise=[] +| +| | pushValue cons +| | minReads=(Right 3) +| | mayRaise=["fail"] +| | pushValue (\u1 -> (\u2 -> u1)) +| | minReads=(Right 3) +| | mayRaise=["fail"] +| | pushValue 'a' +| | minReads=(Right 3) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 3) +| | mayRaise=["fail"] +| | read ('a' ==) +| | minReads=(Right 3) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | pushValue cons +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | pushValue (\u1 -> (\u2 -> u1)) +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | pushValue 'b' +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | read ('b' ==) +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | pushValue cons +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | pushValue (\u1 -> (\u2 -> u1)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | pushValue 'c' +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | read ('c' ==) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | pushValue Term +| | minReads=(Right 0) +| | mayRaise=[] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | popException "fail" +| | minReads=(Right 0) +| | mayRaise=[] +| | ret +| | minReads=(Right 0) +| | mayRaise=[] +| +| | loadInput +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | raiseException "fail" +| | minReads=(Left "fail") +| | mayRaise=["fail"] diff --git a/test/Golden/Machine/G20.expected.txt b/test/Golden/Machine/G20.expected.txt deleted file mode 100644 index 42e1f06..0000000 --- a/test/Golden/Machine/G20.expected.txt +++ /dev/null @@ -1,48 +0,0 @@ -pushValue (\u1 -> (\u2 -> u1 Term)) -name_953: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) -| | read ('r' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call name_953 -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" -call name_953 -lift2Value (\u1 -> (\u2 -> u1 u2)) -join_879: -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| ret -catchException "fail" - - | catchException "fail" - | - | | pushInput - | | read (\u1 -> Term) - | | popValue - | | popException "fail" - | | loadInput - | | raiseException "fail" - | - | loadInput - | pushValue Term - | popException "fail" - | refJoin join_879 - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | raiseException "fail" - - raiseException "fail" diff --git a/test/Golden/Machine/G21.expected.txt b/test/Golden/Machine/G21.expected.txt deleted file mode 100644 index be75595..0000000 --- a/test/Golden/Machine/G21.expected.txt +++ /dev/null @@ -1,23 +0,0 @@ -catchException "fail" - - | catchException "fail" - | - | | pushInput - | | read (\u1 -> Term) - | | popValue - | | popException "fail" - | | loadInput - | | raiseException "fail" - | - | loadInput - | pushValue Term - | popException "fail" - | ret - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | raiseException "fail" - - raiseException "fail" diff --git a/test/Golden/Machine/G22.expected.txt b/test/Golden/Machine/G22.expected.txt deleted file mode 100644 index fc64d34..0000000 --- a/test/Golden/Machine/G22.expected.txt +++ /dev/null @@ -1,18 +0,0 @@ -catchException "fail" - - | pushValue (\u1 -> 'a') - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | ret - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | pushValue (\u1 -> 'b') - | read ('b' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | ret - - raiseException "fail" diff --git a/test/Golden/Machine/G23.expected.txt b/test/Golden/Machine/G23.expected.txt deleted file mode 100644 index 134ded7..0000000 --- a/test/Golden/Machine/G23.expected.txt +++ /dev/null @@ -1,25 +0,0 @@ -pushValue (\u1 -> (\u2 -> u1 Term)) -name_983: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) -| | read ('a' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call name_983 -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" -call name_983 -lift2Value (\u1 -> (\u2 -> u1 u2)) -read ('b' ==) -lift2Value (\u1 -> (\u2 -> u1 u2)) -ret diff --git a/test/Golden/Machine/G24.expected.txt b/test/Golden/Machine/G24.expected.txt deleted file mode 100644 index d167b18..0000000 --- a/test/Golden/Machine/G24.expected.txt +++ /dev/null @@ -1,48 +0,0 @@ -pushValue (\u1 -> (\u2 -> u1 Term)) -name_1005: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | read Term -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call name_1005 -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" -call name_1005 -lift2Value (\u1 -> (\u2 -> u1 u2)) -join_879: -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| ret -catchException "fail" - - | catchException "fail" - | - | | pushInput - | | read (\u1 -> Term) - | | popValue - | | popException "fail" - | | loadInput - | | raiseException "fail" - | - | loadInput - | pushValue Term - | popException "fail" - | refJoin join_879 - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | raiseException "fail" - - raiseException "fail" diff --git a/test/Golden/Machine/G25.expected.txt b/test/Golden/Machine/G25.expected.txt deleted file mode 100644 index 9ee1494..0000000 --- a/test/Golden/Machine/G25.expected.txt +++ /dev/null @@ -1,104 +0,0 @@ -pushValue (\u1 -> (\u2 -> u2)) -name_1021: -| pushValue (\u1 -> Term) -| name_1022: -| | catchException "fail" -| | -| | | pushValue (\u1 -> (\u2 -> (\u3 -> u2 u3))) -| | | read Term -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | call name_1022 -| | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | popException "fail" -| | | ret -| | -| | pushInput -| | lift2Value Term -| | choicesBranch [(\u1 -> u1)] -| | -| | | pushValue (\u1 -> u1) -| | | ret -| | -| | raiseException "fail" -| call name_1022 -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| ret -call name_1021 -lift2Value (\u1 -> (\u2 -> u1 u2)) -name_1020: -| pushValue (\u1 -> u1 Term) -| name_1019: -| | catchException "fail" -| | -| | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4))))) -| | | join_879: -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call name_1021 -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call name_1019 -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | popException "fail" -| | | | ret -| | | pushInput -| | | read ((\u1 -> (\u2 -> u1)) Term) -| | | swapValue -| | | loadInput -| | | choicesBranch [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)] -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin join_879 -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin join_879 -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin join_879 -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin join_879 -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin join_879 -| | | -| | | | pushValue (\u1 -> (\u2 -> cons Term)) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin join_879 -| | | -| | | | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3)))))) -| | | | read ((\u1 -> (\u2 -> u1)) Term) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call name_1021 -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | call name_1020 -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | read (']' ==) -| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | | | refJoin join_879 -| | | -| | | raiseException "fail" -| | -| | pushInput -| | lift2Value Term -| | choicesBranch [(\u1 -> u1)] -| | -| | | pushValue (\u1 -> u1) -| | | ret -| | -| | raiseException "fail" -| call name_1019 -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| ret -call name_1020 -lift2Value (\u1 -> (\u2 -> u1 u2)) -ret diff --git a/test/Golden/Machine/G3.expected.txt b/test/Golden/Machine/G3.expected.txt index eec290a..06c7e61 100644 --- a/test/Golden/Machine/G3.expected.txt +++ b/test/Golden/Machine/G3.expected.txt @@ -1,23 +1,79 @@ -pushValue (\u1 -> u1 Term) -: +let + minReads=(Right 0) + mayRaise=[] | catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3))) -| | read ('a' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue 'a' +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | read ('a' ==) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] call + minReads=(Right 0) + mayRaise=[] +pushValue Term + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret + minReads=(Right 0) + mayRaise=[] diff --git a/test/Golden/Machine/G4.expected.txt b/test/Golden/Machine/G4.expected.txt index 911b2b9..60a5be0 100644 --- a/test/Golden/Machine/G4.expected.txt +++ b/test/Golden/Machine/G4.expected.txt @@ -1,42 +1,198 @@ -pushValue (\u1 -> (\u2 -> u1 : u2 Term)) -: +let + minReads=(Right 0) + mayRaise=[] | catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | read ('a' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('b' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('c' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('d' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| loadInput -| raiseException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 4) +| | | mayRaise=[] +| | | pushValue cons +| | | minReads=(Right 4) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 4) + mayRaise=[] +| catchException "fail" +| minReads=(Right 4) +| mayRaise=[] +| | +| | | pushValue cons +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue 'a' +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | read ('a' ==) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | pushValue 'b' +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | read ('b' ==) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | pushValue 'c' +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | read ('c' ==) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue 'd' +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | read ('d' ==) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | pushValue Term +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | loadInput +| | | minReads=(Left "fail") +| | | mayRaise=["fail"] +| | | raiseException "fail" +| | | minReads=(Left "fail") +| | | mayRaise=["fail"] +pushValue cons + minReads=(Right 4) + mayRaise=[] call + minReads=(Right 4) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) -: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | call -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" + minReads=(Right 0) + mayRaise=[] call + minReads=(Right 0) + mayRaise=[] +pushValue Term + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret + minReads=(Right 0) + mayRaise=[] diff --git a/test/Golden/Machine/G5.expected.txt b/test/Golden/Machine/G5.expected.txt index 714a023..7200161 100644 --- a/test/Golden/Machine/G5.expected.txt +++ b/test/Golden/Machine/G5.expected.txt @@ -1,67 +1,267 @@ -pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) -: +let + minReads=(Right 0) + mayRaise=[] | catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> (\u4 -> 'a' : ('b' : ('c' : ('d' : Term))))))) -| | read ('a' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('b' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('c' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | read ('d' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| loadInput -| raiseException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 4) +| | | mayRaise=[] +| | | pushValue cons +| | | minReads=(Right 4) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 4) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +let + minReads=(Right 4) + mayRaise=[] +| catchException "fail" +| minReads=(Right 4) +| mayRaise=[] +| | +| | | pushValue cons +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | pushValue 'a' +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | read ('a' ==) +| | | minReads=(Right 4) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | pushValue 'b' +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | read ('b' ==) +| | | minReads=(Right 3) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | pushValue 'c' +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | read ('c' ==) +| | | minReads=(Right 2) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue 'd' +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | read ('d' ==) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | pushValue Term +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | loadInput +| | | minReads=(Left "fail") +| | | mayRaise=["fail"] +| | | raiseException "fail" +| | | minReads=(Left "fail") +| | | mayRaise=["fail"] +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 4) + mayRaise=[] +pushValue cons + minReads=(Right 4) + mayRaise=[] call + minReads=(Right 4) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) -: -| catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3))) -| | call -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" + minReads=(Right 0) + mayRaise=[] call + minReads=(Right 0) + mayRaise=[] +pushValue Term + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) -: + minReads=(Right 0) + mayRaise=[] +join + minReads=(Right 0) + mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret +| minReads=(Right 0) +| mayRaise=[] catchException "fail" - - | catchException "fail" - | - | | pushInput - | | read (\u1 -> Term) - | | popValue - | | popException "fail" - | | loadInput - | | raiseException "fail" - | - | loadInput - | pushValue Term - | popException "fail" - | refJoin - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | raiseException "fail" - - raiseException "fail" + minReads=(Right 0) + mayRaise=[] +| +| | catchException "fail" +| | minReads=(Right 0) +| | mayRaise=[] +| | | +| | | | pushInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | read (\u1 -> Term) +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popValue +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | loadInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | loadInput +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | pushValue Term +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | refJoin +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| +| | pushInput +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Machine/G6.expected.txt b/test/Golden/Machine/G6.expected.txt index eac5644..b3555a9 100644 --- a/test/Golden/Machine/G6.expected.txt +++ b/test/Golden/Machine/G6.expected.txt @@ -1,22 +1,130 @@ catchException "fail" - - | pushValue (\u1 -> (\u2 -> 'a' : ('a' : Term))) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | popException "fail" - | ret - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | pushValue (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | read ('a' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | read ('b' ==) - | lift2Value (\u1 -> (\u2 -> u1 u2)) - | ret - - raiseException "fail" + minReads=(Right 2) + mayRaise=[] +| +| | pushValue cons +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | pushValue (\u1 -> (\u2 -> u1)) +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | pushValue 'a' +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | read ('a' ==) +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | pushValue cons +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | pushValue (\u1 -> (\u2 -> u1)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | pushValue 'a' +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | read ('a' ==) +| | minReads=(Right 1) +| | mayRaise=["fail"] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | pushValue Term +| | minReads=(Right 0) +| | mayRaise=[] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] +| | popException "fail" +| | minReads=(Right 0) +| | mayRaise=[] +| | ret +| | minReads=(Right 0) +| | mayRaise=[] +| +| | pushInput +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | | +| | | | pushValue cons +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | pushValue 'a' +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | read ('a' ==) +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue cons +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue 'b' +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | read ('b' ==) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | pushValue Term +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | ret +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Machine/G7.expected.txt b/test/Golden/Machine/G7.expected.txt index abe13b0..8414a00 100644 --- a/test/Golden/Machine/G7.expected.txt +++ b/test/Golden/Machine/G7.expected.txt @@ -1,34 +1,158 @@ catchException "fail" - - | catchException "fail" - | - | | pushValue (\u1 -> (\u2 -> 'a' : ('a' : Term))) - | | read ('a' ==) - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | read ('a' ==) - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | popException "fail" - | | popException "fail" - | | ret - | - | loadInput - | raiseException "fail" - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | catchException "fail" - | - | | pushValue (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | | read ('a' ==) - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | read ('b' ==) - | | lift2Value (\u1 -> (\u2 -> u1 u2)) - | | popException "fail" - | | ret - | - | loadInput - | raiseException "fail" - - raiseException "fail" + minReads=(Right 2) + mayRaise=[] +| +| | catchException "fail" +| | minReads=(Right 2) +| | mayRaise=[] +| | | +| | | | pushValue cons +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | pushValue 'a' +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | read ('a' ==) +| | | | minReads=(Right 2) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue cons +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | pushValue 'a' +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | read ('a' ==) +| | | | minReads=(Right 1) +| | | | mayRaise=["fail"] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | pushValue Term +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | ret +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | +| | | | loadInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| +| | pushInput +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Right 2) +| | mayRaise=["fail"] +| | | +| | | | catchException "fail" +| | | | minReads=(Right 2) +| | | | mayRaise=[] +| | | | | +| | | | | | pushValue cons +| | | | | | minReads=(Right 2) +| | | | | | mayRaise=["fail"] +| | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | minReads=(Right 2) +| | | | | | mayRaise=["fail"] +| | | | | | pushValue 'a' +| | | | | | minReads=(Right 2) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 2) +| | | | | | mayRaise=["fail"] +| | | | | | read ('a' ==) +| | | | | | minReads=(Right 2) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | pushValue cons +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | pushValue (\u1 -> (\u2 -> u1)) +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | pushValue 'b' +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | read ('b' ==) +| | | | | | minReads=(Right 1) +| | | | | | mayRaise=["fail"] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | pushValue Term +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | popException "fail" +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | | ret +| | | | | | minReads=(Right 0) +| | | | | | mayRaise=[] +| | | | | +| | | | | | loadInput +| | | | | | minReads=(Left "fail") +| | | | | | mayRaise=["fail"] +| | | | | | raiseException "fail" +| | | | | | minReads=(Left "fail") +| | | | | | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Machine/G8.expected.txt b/test/Golden/Machine/G8.expected.txt index 499c666..4386c99 100644 --- a/test/Golden/Machine/G8.expected.txt +++ b/test/Golden/Machine/G8.expected.txt @@ -1,48 +1,148 @@ -pushValue (\u1 -> (\u2 -> u1 Term)) -: +let + minReads=(Right 0) + mayRaise=[] | catchException "fail" -| -| | pushValue (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3))) -| | read ('r' ==) -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | call -| | lift2Value (\u1 -> (\u2 -> u1 u2)) -| | popException "fail" -| | ret -| -| pushInput -| lift2Value Term -| choicesBranch [(\u1 -> u1)] -| -| | pushValue (\u1 -> u1) -| | ret -| -| raiseException "fail" +| minReads=(Right 0) +| mayRaise=[] +| | +| | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue cons +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue (\u1 -> (\u2 -> u1)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | pushValue 'r' +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | read ('r' ==) +| | | minReads=(Right 1) +| | | mayRaise=["fail"] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | call +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | popException "fail" +| | | minReads=(Right 0) +| | | mayRaise=[] +| | | ret +| | | minReads=(Right 0) +| | | mayRaise=[] +| | +| | | pushInput +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | lift2Value Term +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | choicesBranch [(\u1 -> u1)] +| | | minReads=(Right 0) +| | | mayRaise=["fail"] +| | | | +| | | | | pushValue (\u1 -> u1) +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | | ret +| | | | | minReads=(Right 0) +| | | | | mayRaise=[] +| | | | +| | | | | raiseException "fail" +| | | | | minReads=(Left "fail") +| | | | | mayRaise=["fail"] +pushValue (\u1 -> (\u2 -> u1)) + minReads=(Right 0) + mayRaise=[] call + minReads=(Right 0) + mayRaise=[] +pushValue Term + minReads=(Right 0) + mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) -: + minReads=(Right 0) + mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] +join + minReads=(Right 0) + mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret +| minReads=(Right 0) +| mayRaise=[] catchException "fail" - - | catchException "fail" - | - | | pushInput - | | read (\u1 -> Term) - | | popValue - | | popException "fail" - | | loadInput - | | raiseException "fail" - | - | loadInput - | pushValue Term - | popException "fail" - | refJoin - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | raiseException "fail" - - raiseException "fail" + minReads=(Right 0) + mayRaise=[] +| +| | catchException "fail" +| | minReads=(Right 0) +| | mayRaise=[] +| | | +| | | | pushInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | read (\u1 -> Term) +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popValue +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | loadInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | loadInput +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | pushValue Term +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | refJoin +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| +| | pushInput +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Machine/G9.expected.txt b/test/Golden/Machine/G9.expected.txt index be75595..eb3aa61 100644 --- a/test/Golden/Machine/G9.expected.txt +++ b/test/Golden/Machine/G9.expected.txt @@ -1,23 +1,57 @@ catchException "fail" - - | catchException "fail" - | - | | pushInput - | | read (\u1 -> Term) - | | popValue - | | popException "fail" - | | loadInput - | | raiseException "fail" - | - | loadInput - | pushValue Term - | popException "fail" - | ret - - pushInput - lift2Value Term - choicesBranch [(\u1 -> u1)] - - | raiseException "fail" - - raiseException "fail" + minReads=(Right 0) + mayRaise=[] +| +| | catchException "fail" +| | minReads=(Right 0) +| | mayRaise=[] +| | | +| | | | pushInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | read (\u1 -> Term) +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popValue +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | popException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | loadInput +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | loadInput +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | pushValue Term +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | popException "fail" +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| | | | ret +| | | | minReads=(Right 0) +| | | | mayRaise=[] +| +| | pushInput +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | lift2Value Term +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | choicesBranch [(\u1 -> u1)] +| | minReads=(Left "fail") +| | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] +| | | +| | | | raiseException "fail" +| | | | minReads=(Left "fail") +| | | | mayRaise=["fail"] diff --git a/test/Golden/Parser.hs b/test/Golden/Parser.hs index 43ac71b..97db1d7 100644 --- a/test/Golden/Parser.hs +++ b/test/Golden/Parser.hs @@ -12,15 +12,16 @@ import Data.Int (Int) import Data.Semigroup (Semigroup(..)) import Data.String (IsString(..)) import Data.Text.IO (readFile) +import System.FilePath ((<.>), (), dropExtensions, takeBaseName) +import System.IO.Unsafe (unsafePerformIO) +import System.IO (print) import Test.Tasty import Test.Tasty.Golden import Text.Show (Show(..)) -import System.IO.Unsafe (unsafePerformIO) -import System.FilePath ((<.>), (), dropExtensions, takeBaseName) +import qualified Control.Exception as IO import qualified Data.List as List -import qualified System.IO.Error as IO import qualified System.Directory as IO -import qualified Control.Exception as IO +import qualified System.IO.Error as IO import Golden.Utils import Parser @@ -28,6 +29,7 @@ import Parser goldens :: TestTree goldens = testGroup "Parser" $ (\f -> List.zipWith f parsers [1::Int ..]) $ \(P p) g -> + -- Collect the existing files: test/Golden/Parser/G*.input.txt let parserDir = "test/Golden/Parser/G"<>show g in let inputs = ((parserDir ) <$>) $ diff --git a/test/Golden/Parser/G1/P1.expected.txt b/test/Golden/Parser/G1/P1.expected.txt deleted file mode 100644 index 7559ead..0000000 --- a/test/Golden/Parser/G1/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -'a' \ No newline at end of file diff --git a/test/Golden/Parser/G1/P1.input.txt b/test/Golden/Parser/G1/P1.input.txt deleted file mode 100644 index 2e65efe..0000000 --- a/test/Golden/Parser/G1/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -a \ No newline at end of file diff --git a/test/Golden/Parser/G10/P1.expected.txt b/test/Golden/Parser/G10/P1.expected.txt deleted file mode 100644 index c8bf1ae..0000000 --- a/test/Golden/Parser/G10/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorUnexpected = Just 'c', parsingErrorExpecting = fromList [ErrorItemToken 'a',ErrorItemToken 'b']} \ No newline at end of file diff --git a/test/Golden/Parser/G10/P1.input.txt b/test/Golden/Parser/G10/P1.input.txt deleted file mode 100644 index 3410062..0000000 --- a/test/Golden/Parser/G10/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -c \ No newline at end of file diff --git a/test/Golden/Parser/G11/P1.expected.txt b/test/Golden/Parser/G11/P1.expected.txt deleted file mode 100644 index e3e1f97..0000000 --- a/test/Golden/Parser/G11/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -ParsingErrorStandard {parsingErrorOffset = 4, parsingErrorUnexpected = Just 'c', parsingErrorExpecting = fromList [ErrorItemToken 'a',ErrorItemToken 'b']} \ No newline at end of file diff --git a/test/Golden/Parser/G11/P1.input.txt b/test/Golden/Parser/G11/P1.input.txt deleted file mode 100644 index d9a79c8..0000000 --- a/test/Golden/Parser/G11/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -aaaac \ No newline at end of file diff --git a/test/Golden/Parser/G12/P1.expected.txt b/test/Golden/Parser/G12/P1.expected.txt deleted file mode 100644 index 5ec0128..0000000 --- a/test/Golden/Parser/G12/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -"baacbccbaa" \ No newline at end of file diff --git a/test/Golden/Parser/G12/P1.input.txt b/test/Golden/Parser/G12/P1.input.txt deleted file mode 100644 index 1c1f7a0..0000000 --- a/test/Golden/Parser/G12/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -baacbccbaa \ No newline at end of file diff --git a/test/Golden/Parser/G2/P1.expected.txt b/test/Golden/Parser/G2/P1.expected.txt deleted file mode 100644 index 4f44a21..0000000 --- a/test/Golden/Parser/G2/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -"abc" \ No newline at end of file diff --git a/test/Golden/Parser/G2/P1.input.txt b/test/Golden/Parser/G2/P1.input.txt deleted file mode 100644 index f2ba8f8..0000000 --- a/test/Golden/Parser/G2/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -abc \ No newline at end of file diff --git a/test/Golden/Parser/G2/P2.expected.txt b/test/Golden/Parser/G2/P2.expected.txt deleted file mode 100644 index 712fbf1..0000000 --- a/test/Golden/Parser/G2/P2.expected.txt +++ /dev/null @@ -1 +0,0 @@ -ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [ErrorItemHorizon 3]} \ No newline at end of file diff --git a/test/Golden/Parser/G2/P2.input.txt b/test/Golden/Parser/G2/P2.input.txt deleted file mode 100644 index 9ae9e86..0000000 --- a/test/Golden/Parser/G2/P2.input.txt +++ /dev/null @@ -1 +0,0 @@ -ab \ No newline at end of file diff --git a/test/Golden/Parser/G3/P1.expected.txt b/test/Golden/Parser/G3/P1.expected.txt deleted file mode 100644 index 92302fa..0000000 --- a/test/Golden/Parser/G3/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -"aaaaa" \ No newline at end of file diff --git a/test/Golden/Parser/G3/P1.input.txt b/test/Golden/Parser/G3/P1.input.txt deleted file mode 100644 index e4a7dd9..0000000 --- a/test/Golden/Parser/G3/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -aaaaa \ No newline at end of file diff --git a/test/Golden/Parser/G4/P1.expected.txt b/test/Golden/Parser/G4/P1.expected.txt deleted file mode 100644 index 7a343d4..0000000 --- a/test/Golden/Parser/G4/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -["abcd","abcd","abcd"] \ No newline at end of file diff --git a/test/Golden/Parser/G4/P1.input.txt b/test/Golden/Parser/G4/P1.input.txt deleted file mode 100644 index 5ec8a28..0000000 --- a/test/Golden/Parser/G4/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -abcdabcdabcd \ No newline at end of file diff --git a/test/Golden/Parser/G5/P1.expected.txt b/test/Golden/Parser/G5/P1.expected.txt deleted file mode 100644 index 137f65a..0000000 --- a/test/Golden/Parser/G5/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [ErrorItemHorizon 4]} \ No newline at end of file diff --git a/test/Golden/Parser/G5/P1.input.txt b/test/Golden/Parser/G5/P1.input.txt deleted file mode 100644 index f2ba8f8..0000000 --- a/test/Golden/Parser/G5/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -abc \ No newline at end of file diff --git a/test/Golden/Parser/G5/P2.expected.txt b/test/Golden/Parser/G5/P2.expected.txt deleted file mode 100644 index 73d9ebc..0000000 --- a/test/Golden/Parser/G5/P2.expected.txt +++ /dev/null @@ -1 +0,0 @@ -ParsingErrorStandard {parsingErrorOffset = 4, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [ErrorItemHorizon 4,ErrorItemEnd]} \ No newline at end of file diff --git a/test/Golden/Parser/G5/P2.input.txt b/test/Golden/Parser/G5/P2.input.txt deleted file mode 100644 index a9420db..0000000 --- a/test/Golden/Parser/G5/P2.input.txt +++ /dev/null @@ -1 +0,0 @@ -abcdabc \ No newline at end of file diff --git a/test/Golden/Parser/G6/P1.expected.txt b/test/Golden/Parser/G6/P1.expected.txt deleted file mode 100644 index e33eadf..0000000 --- a/test/Golden/Parser/G6/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -ParsingErrorStandard {parsingErrorOffset = 1, parsingErrorUnexpected = Just 'b', parsingErrorExpecting = fromList [ErrorItemToken 'a']} \ No newline at end of file diff --git a/test/Golden/Parser/G6/P1.input.txt b/test/Golden/Parser/G6/P1.input.txt deleted file mode 100644 index 9ae9e86..0000000 --- a/test/Golden/Parser/G6/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -ab \ No newline at end of file diff --git a/test/Golden/Parser/G7/P1.expected.txt b/test/Golden/Parser/G7/P1.expected.txt deleted file mode 100644 index b90f7e1..0000000 --- a/test/Golden/Parser/G7/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -"ab" \ No newline at end of file diff --git a/test/Golden/Parser/G7/P1.input.txt b/test/Golden/Parser/G7/P1.input.txt deleted file mode 100644 index 9ae9e86..0000000 --- a/test/Golden/Parser/G7/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -ab \ No newline at end of file diff --git a/test/Golden/Parser/G7/P2.expected.txt b/test/Golden/Parser/G7/P2.expected.txt deleted file mode 100644 index 742e221..0000000 --- a/test/Golden/Parser/G7/P2.expected.txt +++ /dev/null @@ -1 +0,0 @@ -"aa" \ No newline at end of file diff --git a/test/Golden/Parser/G7/P2.input.txt b/test/Golden/Parser/G7/P2.input.txt deleted file mode 100644 index 7ec9a4b..0000000 --- a/test/Golden/Parser/G7/P2.input.txt +++ /dev/null @@ -1 +0,0 @@ -aa \ No newline at end of file diff --git a/test/Golden/Parser/G8/P1.expected.txt b/test/Golden/Parser/G8/P1.expected.txt deleted file mode 100644 index 206b5f4..0000000 --- a/test/Golden/Parser/G8/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -ParsingErrorStandard {parsingErrorOffset = 3, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [ErrorItemToken 'r',ErrorItemEnd]} \ No newline at end of file diff --git a/test/Golden/Parser/G8/P1.input.txt b/test/Golden/Parser/G8/P1.input.txt deleted file mode 100644 index 6aabf50..0000000 --- a/test/Golden/Parser/G8/P1.input.txt +++ /dev/null @@ -1 +0,0 @@ -rrra \ No newline at end of file diff --git a/test/Golden/Parser/G9/P1.expected.txt b/test/Golden/Parser/G9/P1.expected.txt deleted file mode 100644 index dd626a0..0000000 --- a/test/Golden/Parser/G9/P1.expected.txt +++ /dev/null @@ -1 +0,0 @@ -() \ No newline at end of file diff --git a/test/Golden/Parser/G9/P1.input.txt b/test/Golden/Parser/G9/P1.input.txt deleted file mode 100644 index e69de29..0000000 diff --git a/test/Golden/Parser/G9/P2.expected.txt b/test/Golden/Parser/G9/P2.expected.txt deleted file mode 100644 index b25166b..0000000 --- a/test/Golden/Parser/G9/P2.expected.txt +++ /dev/null @@ -1 +0,0 @@ -ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [ErrorItemEnd]} \ No newline at end of file diff --git a/test/Golden/Parser/G9/P2.input.txt b/test/Golden/Parser/G9/P2.input.txt deleted file mode 100644 index 2e65efe..0000000 --- a/test/Golden/Parser/G9/P2.input.txt +++ /dev/null @@ -1 +0,0 @@ -a \ No newline at end of file diff --git a/test/Golden/Parser/left-right.txt b/test/Golden/Parser/left-right.txt deleted file mode 100644 index 7ec9a4b..0000000 --- a/test/Golden/Parser/left-right.txt +++ /dev/null @@ -1 +0,0 @@ -aa \ No newline at end of file diff --git a/test/Golden/Splice.hs b/test/Golden/Splice.hs index 4e29ac4..aa142a6 100644 --- a/test/Golden/Splice.hs +++ b/test/Golden/Splice.hs @@ -1,34 +1,61 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TypeApplications #-} module Golden.Splice where +import Data.Either (Either(..)) import Data.Function (($)) import Data.Functor ((<$>)) import Data.Int (Int) +import Data.Text (Text) import Data.Semigroup (Semigroup(..)) -import System.FilePath ((), (<.>), (-<.>)) -import System.IO (writeFile) +import System.FilePath ((), (<.>)) +import System.IO (IO) import Test.Tasty import Text.Show (Show(..)) import qualified Data.List as List +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH +import Symantic.Parser (ParsingError, optimizeMachine, generateCode) -import Build_symantic_parser +--import Build_symantic_parser import Golden.Splice.Utils import qualified Grammar goldens :: TestTree goldens = testGroup "Splice" $ - (<$> [1::Int .. List.length Grammar.grammars]) $ \g -> + {-[ let spliceFile = "test/Golden/Splice/""G"<>show g<.>"hs" in withResource (writeFile (rootDirspliceFile) $ List.unlines - [ "module Splice where" + [ "module Golden.Splice.G"<>show g<>" where" , "import Data.Text (Text)" , "import qualified Symantic.Parser as P" + , "import qualified Data.IORef as IORef" + , "import qualified Language.Haskell.TH.Syntax as TH" , "import qualified Grammar" , "" - , "splice = $$(P.runParser @Text Grammar.g"<>show g<>")" + , "splice = $$(TH.Code (do" + -- This is for 'TH.Name's to match with the ones in + -- 'viewGrammar' and 'viewMachine', which ease debugging. + , " TH.qRunIO (IORef.writeIORef TH.counter 0)" + , " TH.examineCode (P.runParser @Text Grammar.g"<>show g<>")" + , " ))" ]) (\() -> do rmFile (rootDirspliceFile) rmFile (rootDirspliceFile-<.>"hi") - rmFile (rootDirspliceFile-<.>"o")) + rmFile (rootDirspliceFile-<.>"o") + rmFile (rootDirspliceFile-<.>"p_hi") + rmFile (rootDirspliceFile-<.>"p_o")) (\_io -> testSplice spliceFile) + | g <- [1::Int .. List.length Grammar.grammars] + ]-} + [ coverSplice splice $ "test/Golden/Splice/""G"<>show g<.>"expected"<.>"txt" + | (g, S splice) <- List.zip [1::Int ..] splices + ] + +data S inp = forall a. S (IO (TH.TExp (inp -> Either (ParsingError inp) a))) +splices :: [S Text] +splices = (<$> Grammar.grammars) $ \(Grammar.G g) -> S $ TH.runQ $ do + mach <- TH.qRunIO $ optimizeMachine g + TH.examineCode $ generateCode mach diff --git a/test/Golden/Splice/G1.expected.txt b/test/Golden/Splice/G1.expected.txt index 463f9b3..0541d7d 100644 --- a/test/Golden/Splice/G1.expected.txt +++ b/test/Golden/Splice/G1.expected.txt @@ -1,55 +1,116 @@ -test/Golden/Splice/G1.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g1 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let readFail = finalRaise - in - if readMore init then - let !(# c, cs #) = readNext init - in - if ('a' ==) c then - let _ = "resume" - in - (((finalRet init) []) - (let _ = "resume.genCode" in ((\ x -> \ x -> x x) (\ x -> 'a')) c)) - cs - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((finalRaise init) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemHorizon 1] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) - GT -> (# init, [] #) - in ((finalRaise init) farInp) farExp +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let + in let readFail_24 = finalRaise_18 + in if readMore_2 init_1 + then + let !(# + c_25, + cs_26 + #) = readNext_3 init_1 + in if ('a' GHC.Classes.==) c_25 + then + let _ = "resume" + in finalRet_13 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' + ) + cs_26 + else + let _ = "checkToken.else" + in let (# + farInp_27, + farExp_28 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in finalRaise_18 init_1 farInp_27 farExp_28 + else + let _ = "checkHorizon.else" + in let (# + farInp_29, + farExp_30 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in finalRaise_18 init_1 farInp_29 farExp_30 diff --git a/test/Golden/Splice/G10.expected.txt b/test/Golden/Splice/G10.expected.txt index e759055..cdc019a 100644 --- a/test/Golden/Splice/G10.expected.txt +++ b/test/Golden/Splice/G10.expected.txt @@ -1,104 +1,217 @@ -test/Golden/Splice/G10.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g10 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - init) - failInp) then - let readFail = finalRaise - in - if readMore failInp then - let !(# c, cs #) = readNext failInp - in - if ('b' ==) c then - let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in ((\ x -> \ x -> x x) (\ x -> 'b')) c)) - cs +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let + in let _ = "catchException lbl=fail" + in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_28 + _ + ) + ( Data.Text.Internal.Text + _ + j_29 + _ + ) -> i_28 GHC.Classes.== j_29 + ) + init_1 + failInp_25 + then + let _ = "choicesBranch.then" + in let readFail_30 = finalRaise_18 + in if readMore_2 failInp_25 + then + let !(# + c_31, + cs_32 + #) = readNext_3 failInp_25 + in if ('b' GHC.Classes.==) c_31 + then + let _ = "resume" + in finalRet_13 + farInp_26 + farExp_27 + ( let _ = "resume.genCode" + in 'b' + ) + cs_32 + else + let _ = "checkToken.else" + in let (# + farInp_33, + farExp_34 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 failInp_25 farInp_33 farExp_34 + else + let _ = "checkHorizon.else" + in let (# + farInp_35, + farExp_36 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 failInp_25 farInp_35 farExp_36 + else + let _ = "choicesBranch.else" + in let (# + farInp_37, + farExp_38 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 failInp_25 farInp_37 farExp_38 + in let readFail_39 = catchHandler_24 + in if readMore_2 init_1 + then + let !(# + c_40, + cs_41 + #) = readNext_3 init_1 + in if ('a' GHC.Classes.==) c_40 + then + let _ = "resume" + in finalRet_13 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' + ) + cs_41 + else + let _ = "checkToken.else" + in let (# + farInp_42, + farExp_43 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_39 init_1 farInp_42 farExp_43 else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) failInp - of - LT -> (# failInp, [P.ErrorItemToken 'b'] #) - EQ -> (# farInp, (farExp <> [P.ErrorItemToken 'b']) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) failInp of - LT -> (# failInp, [P.ErrorItemHorizon 1] #) - EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 1]) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - else - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) failInp of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - in - if readMore init then - let !(# c, cs #) = readNext init - in - if ('a' ==) c then - let _ = "resume" - in - (((finalRet init) []) - (let _ = "resume.genCode" in ((\ x -> \ x -> x x) (\ x -> 'a')) c)) - cs - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemHorizon 1] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp + let _ = "checkHorizon.else" + in let (# + farInp_44, + farExp_45 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_39 init_1 farInp_44 farExp_45 diff --git a/test/Golden/Splice/G11.expected.txt b/test/Golden/Splice/G11.expected.txt index 7747a10..4b1b0ef 100644 --- a/test/Golden/Splice/G11.expected.txt +++ b/test/Golden/Splice/G11.expected.txt @@ -1,148 +1,238 @@ -test/Golden/Splice/G11.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g11 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) (let _ = "resume.genCode" in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if ('a' ==) c then - let - _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x -> \ x -> \ x -> ('a' : x x))) - c)) - v)) - inp)) - cs) - (((((Data.Map.Internal.Bin 1) "fail") readFail) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip) - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp in - let - _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let readFail = finalRaise - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if ('b' ==) c then - let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) (\ x -> \ x -> x [])) v)) - c)) - cs - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [P.ErrorItemToken 'b'] #) - EQ -> (# farInp, (farExp <> [P.ErrorItemToken 'b']) #) - GT -> (# farInp, farExp #) - in ((finalRaise inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 1]) #) - GT -> (# farInp, farExp #) - in ((finalRaise inp) farInp) farExp)) - init) - Data.Map.Internal.Tip +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + let _ = "catchException lbl=fail" + in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_32 + _ + ) + ( Data.Text.Internal.Text + _ + j_33 + _ + ) -> i_32 GHC.Classes.== j_33 + ) + inp_26 + failInp_29 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_25 + farInp_30 + farExp_31 + ( let _ = "resume.genCode" + in \x_34 -> x_34 + ) + failInp_29 + else + let _ = "choicesBranch.else" + in let (# + farInp_35, + farExp_36 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + GHC.Types.LT -> + (# + failInp_29, + [] + #) + GHC.Types.EQ -> + (# + farInp_30, + farExp_31 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_30, + farExp_31 + #) + in finalRaise_18 failInp_29 farInp_35 farExp_36 + in let readFail_37 = catchHandler_28 + in if readMore_2 inp_26 + then + let !(# + c_38, + cs_39 + #) = readNext_3 inp_26 + in if ('a' GHC.Classes.==) c_38 + then + name_24 + ( let _ = "suspend" + in \farInp_40 farExp_41 v_42 (!inp_43) -> + let _ = "resume" + in ok_25 + farInp_40 + farExp_41 + ( let _ = "resume.genCode" + in \x_44 -> 'a' GHC.Types.: v_42 x_44 + ) + inp_43 + ) + cs_39 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_45, + farExp_46 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_37 inp_26 farInp_45 farExp_46 + else + let _ = "checkHorizon.else" + in let (# + farInp_47, + farExp_48 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_37 inp_26 farInp_47 farExp_48 + in name_24 + ( let _ = "suspend" + in \farInp_49 farExp_50 v_51 (!inp_52) -> + let readFail_53 = finalRaise_18 + in if readMore_2 inp_52 + then + let !(# + c_54, + cs_55 + #) = readNext_3 inp_52 + in if ('b' GHC.Classes.==) c_54 + then + let _ = "resume" + in finalRet_13 + farInp_49 + farExp_50 + ( let _ = "resume.genCode" + in v_51 GHC.Types . [] + ) + cs_55 + else + let _ = "checkToken.else" + in let (# + farInp_56, + farExp_57 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + GHC.Types.LT -> + (# + inp_52, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + farInp_49, + farExp_50 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + farInp_49, + farExp_50 + #) + in finalRaise_18 inp_52 farInp_56 farExp_57 + else + let _ = "checkHorizon.else" + in let (# + farInp_58, + farExp_59 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + GHC.Types.LT -> + (# + inp_52, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_49, + farExp_50 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_49, + farExp_50 + #) + in finalRaise_18 inp_52 farInp_58 farExp_59 + ) + init_1 + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G12.expected.txt b/test/Golden/Splice/G12.expected.txt index 5338d87..7f660ac 100644 --- a/test/Golden/Splice/G12.expected.txt +++ b/test/Golden/Splice/G12.expected.txt @@ -1,202 +1,330 @@ -test/Golden/Splice/G12.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g12 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) (let _ = "resume.genCode" in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if (\ t - -> (('a' == t) - || (('b' == t) || (('c' == t) || (('d' == t) || False))))) - c then - let - _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x -> \ x -> \ x -> (x : x x))) - c)) - v)) - inp)) - cs) - (((((Data.Map.Internal.Bin 1) "fail") readFail) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip) - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemLabel "oneOf"] #) - EQ -> (# init, ([] <> [P.ErrorItemLabel "oneOf"]) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp in - let - _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let - join - = \ farInp farExp v !inp - -> let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) (\ x -> \ x -> x [])) v)) - v)) - inp in - let _ = "catchException lbl=fail" in - let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> let _ = "resume" - in (((join farInp) farExp) (let _ = "resume.genCode" in ())) inp - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if (\ x -> True) c then - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - failInp - of - LT -> (# failInp, [P.ErrorItemEnd] #) - EQ - -> (# farInp, - (farExp <> [P.ErrorItemEnd]) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - else - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp) - inp) - farInp) - farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 1]) #) - GT -> (# farInp, farExp #) - in ((readFail inp) farInp) farExp)) - init) - Data.Map.Internal.Tip +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + let _ = "catchException lbl=fail" + in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_32 + _ + ) + ( Data.Text.Internal.Text + _ + j_33 + _ + ) -> i_32 GHC.Classes.== j_33 + ) + inp_26 + failInp_29 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_25 + farInp_30 + farExp_31 + ( let _ = "resume.genCode" + in \x_34 -> x_34 + ) + failInp_29 + else + let _ = "choicesBranch.else" + in let (# + farInp_35, + farExp_36 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + GHC.Types.LT -> + (# + failInp_29, + [] + #) + GHC.Types.EQ -> + (# + farInp_30, + farExp_31 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_30, + farExp_31 + #) + in finalRaise_18 failInp_29 farInp_35 farExp_36 + in let readFail_37 = catchHandler_28 + in if readMore_2 inp_26 + then + let !(# + c_38, + cs_39 + #) = readNext_3 inp_26 + in if (\t_40 -> ('a' GHC.Classes.== t_40) GHC.Classes.|| (('b' GHC.Classes.== t_40) GHC.Classes.|| (('c' GHC.Classes.== t_40) GHC.Classes.|| (('d' GHC.Classes.== t_40) GHC.Classes.|| GHC.Types.False)))) c_38 + then + name_24 + ( let _ = "suspend" + in \farInp_41 farExp_42 v_43 (!inp_44) -> + let _ = "resume" + in ok_25 + farInp_41 + farExp_42 + ( let _ = "resume.genCode" + in \x_45 -> c_38 GHC.Types.: v_43 x_45 + ) + inp_44 + ) + cs_39 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_46, + farExp_47 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_37 inp_26 farInp_46 farExp_47 + else + let _ = "checkHorizon.else" + in let (# + farInp_48, + farExp_49 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_37 inp_26 farInp_48 farExp_49 + in name_24 + ( let _ = "suspend" + in \farInp_50 farExp_51 v_52 (!inp_53) -> + let join_54 = \farInp_55 farExp_56 v_57 (!inp_58) -> + let _ = "resume" + in finalRet_13 + farInp_55 + farExp_56 + ( let _ = "resume.genCode" + in v_52 GHC.Types . [] + ) + inp_58 + in let _ = "catchException lbl=fail" + in let catchHandler_59 (!failInp_60) (!farInp_61) (!farExp_62) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_63 + _ + ) + ( Data.Text.Internal.Text + _ + j_64 + _ + ) -> i_63 GHC.Classes.== j_64 + ) + inp_53 + failInp_60 + then + let _ = "choicesBranch.then" + in let (# + farInp_65, + farExp_66 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_61 failInp_60 of + GHC.Types.LT -> + (# + failInp_60, + [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.EQ -> + (# + farInp_61, + farExp_62 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.GT -> + (# + farInp_61, + farExp_62 + #) + in finalRaise_18 failInp_60 farInp_65 farExp_66 + else + let _ = "choicesBranch.else" + in let (# + farInp_67, + farExp_68 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_61 failInp_60 of + GHC.Types.LT -> + (# + failInp_60, + [] + #) + GHC.Types.EQ -> + (# + farInp_61, + farExp_62 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_61, + farExp_62 + #) + in finalRaise_18 failInp_60 farInp_67 farExp_68 + in let _ = "catchException lbl=fail" + in let catchHandler_69 (!failInp_70) (!farInp_71) (!farExp_72) = + let _ = "catchException.ko lbl=fail" + in let _ = "resume" + in join_54 + farInp_71 + farExp_72 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_53 + in let readFail_73 = catchHandler_69 + in if readMore_2 inp_53 + then + let !(# + c_74, + cs_75 + #) = readNext_3 inp_53 + in if (\x_76 -> GHC.Types.True) c_74 + then + let (# + farInp_77, + farExp_78 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_50 inp_53 of + GHC.Types.LT -> + (# + inp_53, + [] + #) + GHC.Types.EQ -> + (# + farInp_50, + farExp_51 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_50, + farExp_51 + #) + in catchHandler_59 inp_53 farInp_77 farExp_78 + else + let _ = "checkToken.else" + in let (# + farInp_79, + farExp_80 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_50 inp_53 of + GHC.Types.LT -> + (# + inp_53, + [] + #) + GHC.Types.EQ -> + (# + farInp_50, + farExp_51 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_50, + farExp_51 + #) + in readFail_73 inp_53 farInp_79 farExp_80 + else + let _ = "checkHorizon.else" + in let (# + farInp_81, + farExp_82 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_50 inp_53 of + GHC.Types.LT -> + (# + inp_53, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_50, + farExp_51 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_50, + farExp_51 + #) + in readFail_73 inp_53 farInp_81 farExp_82 + ) + init_1 + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G13.expected.txt b/test/Golden/Splice/G13.expected.txt index 98bb7a1..c4b9be8 100644 --- a/test/Golden/Splice/G13.expected.txt +++ b/test/Golden/Splice/G13.expected.txt @@ -1,1245 +1,904 @@ -test/Golden/Splice/G13.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g13 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let - name - = \ !ok !inp !koByLabel - -> let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" in \ x -> x)) - failInp +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + name_28 + ( let _ = "suspend" + in \farInp_29 farExp_30 v_31 (!inp_32) -> + let _ = "resume" + in ok_25 + farInp_29 + farExp_30 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_32 + ) + inp_26 + Data.Map.Internal.Tip + name_28 = \(!ok_33) (!inp_34) (!koByLabel_35) -> + let _ = "catchException lbl=fail" + in let catchHandler_36 (!failInp_37) (!farInp_38) (!farExp_39) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_40 + _ + ) + ( Data.Text.Internal.Text + _ + j_41 + _ + ) -> i_40 GHC.Classes.== j_41 + ) + inp_34 + failInp_37 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_33 + farInp_38 + farExp_39 + ( let _ = "resume.genCode" + in \x_42 -> x_42 + ) + failInp_37 + else + let _ = "choicesBranch.else" + in let (# + farInp_43, + farExp_44 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + GHC.Types.LT -> + (# + failInp_37, + [] + #) + GHC.Types.EQ -> + (# + farInp_38, + farExp_39 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_38, + farExp_39 + #) + in finalRaise_18 failInp_37 farInp_43 farExp_44 + in let readFail_45 = catchHandler_36 + in if readMore_2 inp_34 + then + let !(# + c_46, + cs_47 + #) = readNext_3 inp_34 + in if (\c_48 -> GHC.Classes.not (('<' GHC.Classes.== c_48) GHC.Classes.|| (('>' GHC.Classes.== c_48) GHC.Classes.|| (('+' GHC.Classes.== c_48) GHC.Classes.|| (('-' GHC.Classes.== c_48) GHC.Classes.|| (('[' GHC.Classes.== c_48) GHC.Classes.|| ((']' GHC.Classes.== c_48) GHC.Classes.|| ((',' GHC.Classes.== c_48) GHC.Classes.|| (('.' GHC.Classes.== c_48) GHC.Classes.|| (('$' GHC.Classes.== c_48) GHC.Classes.|| GHC.Types.False)))))))))) c_46 + then + name_28 + ( let _ = "suspend" + in \farInp_49 farExp_50 v_51 (!inp_52) -> + let _ = "resume" + in ok_33 + farInp_49 + farExp_50 + ( let _ = "resume.genCode" + in \x_53 -> v_51 x_53 + ) + inp_52 + ) + cs_47 + Data.Map.Internal.Tip else - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault - finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if (\ c - -> not - (('<' == c) - || - (('>' == c) - || - (('+' == c) - || - (('-' == c) - || - (('[' == c) - || - ((']' == c) - || - ((',' == c) - || - (('.' == c) - || - (('$' - == c) - || - False)))))))))) - c then - let - _ = "call exceptionsByName(name_4)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList []),(name_4,fromList [])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x -> \ x -> \ x -> x x)) - c)) - v)) - inp)) - cs) - (((((Data.Map.Internal.Bin 1) "fail") readFail) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip) - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) init) - inp - of - LT - -> (# inp, - [P.ErrorItemToken '<', - P.ErrorItemToken '>', - P.ErrorItemToken '+', - P.ErrorItemToken '-', - P.ErrorItemToken '[', - P.ErrorItemToken ']', - P.ErrorItemToken ',', - P.ErrorItemToken '.', - P.ErrorItemToken '$'] #) - EQ - -> (# init, - ([] - <> - [P.ErrorItemToken '<', - P.ErrorItemToken '>', - P.ErrorItemToken '+', - P.ErrorItemToken '-', - P.ErrorItemToken '[', - P.ErrorItemToken ']', - P.ErrorItemToken ',', - P.ErrorItemToken '.', - P.ErrorItemToken '$']) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp in - let - _ = "call exceptionsByName(name_4)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList []),(name_4,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in ((\ x -> \ x -> x x) (\ x -> ())) v)) - inp)) - inp) - Data.Map.Internal.Tip in - let - _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=[]" - in - ((name - (let _ = "suspend raiseException=fromList [(name_1,fromList [])]" - in - \ farInp farExp v !inp - -> let - name - = \ !ok !inp !koByLabel - -> let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - join - = \ farInp farExp v !inp - -> let - _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList [])]" - in - \ farInp farExp v !inp - -> let - _ = "call exceptionsByName(name_3)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList [])]" - in - \ farInp - farExp - v - !inp - -> let _ = "resume" - in - (((ok farInp) - farExp) - (let - _ = "resume.genCode" - in - ((\ x - -> \ x - -> x x) - (((\ x - -> \ x - -> x x) - (((\ x - -> \ x - -> x x) - (\ x - -> \ x - -> \ x - -> \ x - -> (x x) - (x x))) - v)) - v)) - v)) - inp)) - inp) - (((((Data.Map.Internal.Bin - 1) - "fail") - (\ !failInp - !farInp - !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ - i - _) - (Data.Text.Internal.Text _ - j - _) - -> (i == - j)) - inp) - failInp) then - let - _ = "resume" - in - (((ok - farInp) - farExp) - (let - _ = "resume.genCode" - in - \ x - -> x)) - failInp - else - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - failInp - of - LT - -> (# failInp, - [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault - finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp)) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip))) - inp) - (((((Data.Map.Internal.Bin 1) "fail") - (\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ - i - _) - (Data.Text.Internal.Text _ - j - _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) - (let - _ = "resume.genCode" - in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - failInp - of - LT - -> (# failInp, - [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault - finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp)) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip) in - let - readFail - = \ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ - -> (# farInp, - (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault - finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if ((\ x -> \ x -> x) True) c then - if ('>' == c) then - let readFail = readFail - in - if readMore - ((P.shiftRightText 666) - inp) then - let !(# c, cs #) = readNext inp - in - if ((\ x -> \ x -> x) True) - c then - let _ = "resume" - in - (((join farInp) farExp) - (let - _ = "resume.genCode" - in - ((\ x - -> \ x -> x x) - (\ x - -> \ x - -> (Grammar.Brainfuck.RightPointer - :))) - c)) - cs - else - let - _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT -> (# inp, [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - ((readFail inp) farInp) - farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [P.ErrorItemHorizon - 667] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemHorizon - 667]) #) - GT - -> (# farInp, farExp #) - in ((readFail inp) farInp) farExp - else - if ('<' == c) then - let readFail = readFail - in - if readMore - ((P.shiftRightText 666) - inp) then - let - !(# c, cs #) = readNext inp - in - if ((\ x -> \ x -> x) True) - c then - let _ = "resume" - in - (((join farInp) - farExp) - (let - _ = "resume.genCode" - in - ((\ x - -> \ x - -> x x) - (\ x - -> \ x - -> (Grammar.Brainfuck.LeftPointer - :))) - c)) - cs - else - let - _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - ((readFail inp) - farInp) - farExp - else - let - _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [P.ErrorItemHorizon - 667] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemHorizon - 667]) #) - GT - -> (# farInp, - farExp #) - in - ((readFail inp) farInp) - farExp - else - if ('+' == c) then - let readFail = readFail - in - if readMore - ((P.shiftRightText 666) - inp) then - let - !(# c, cs #) - = readNext inp - in - if ((\ x -> \ x -> x) - True) - c then - let _ = "resume" - in - (((join farInp) - farExp) - (let - _ = "resume.genCode" - in - ((\ x - -> \ x - -> x x) - (\ x - -> \ x - -> (Grammar.Brainfuck.Increment - :))) - c)) - cs - else - let - _ = "checkToken.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - ((readFail inp) - farInp) - farExp - else - let - _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [P.ErrorItemHorizon - 667] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemHorizon - 667]) #) - GT - -> (# farInp, - farExp #) - in - ((readFail inp) farInp) - farExp - else - if ('-' == c) then - let readFail = readFail - in - if readMore - ((P.shiftRightText - 666) - inp) then - let - !(# c, cs #) - = readNext inp - in - if ((\ x - -> \ x -> x) - True) - c then - let - _ = "resume" - in - (((join - farInp) - farExp) - (let - _ = "resume.genCode" - in - ((\ x - -> \ x - -> x x) - (\ x - -> \ x - -> (Grammar.Brainfuck.Decrement - :))) - c)) - cs - else - let - _ = "checkToken.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - ((readFail - inp) - farInp) - farExp - else - let - _ = "checkHorizon.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [P.ErrorItemHorizon - 667] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemHorizon - 667]) #) - GT - -> (# farInp, - farExp #) - in - ((readFail inp) - farInp) - farExp - else - if ('.' == c) then - let readFail = readFail - in - if readMore - ((P.shiftRightText - 666) - inp) then - let - !(# c, cs #) - = readNext - inp - in - if ((\ x - -> \ x - -> x) - True) - c then - let - _ = "resume" - in - (((join - farInp) - farExp) - (let - _ = "resume.genCode" - in - ((\ x - -> \ x - -> x x) - (\ x - -> \ x - -> (Grammar.Brainfuck.Output - :))) - c)) - cs - else - let - _ = "checkToken.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - ((readFail - inp) - farInp) - farExp - else - let - _ = "checkHorizon.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [P.ErrorItemHorizon - 667] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemHorizon - 667]) #) - GT - -> (# farInp, - farExp #) - in - ((readFail inp) - farInp) - farExp - else - if (',' == c) then - let - readFail - = readFail - in - if readMore - ((P.shiftRightText - 666) - inp) then - let - !(# c, - cs #) - = readNext - inp - in - if ((\ x - -> \ x - -> x) - True) - c then - let - _ = "resume" - in - (((join - farInp) - farExp) - (let - _ = "resume.genCode" - in - ((\ x - -> \ x - -> x x) - (\ x - -> \ x - -> (Grammar.Brainfuck.Input - :))) - c)) - cs - else - let - _ = "checkToken.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - ((readFail - inp) - farInp) - farExp - else - let - _ = "checkHorizon.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [P.ErrorItemHorizon - 667] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemHorizon - 667]) #) - GT - -> (# farInp, - farExp #) - in - ((readFail - inp) - farInp) - farExp - else - if ('[' == c) then - let - readFail - = readFail - in - if readMore - ((P.shiftRightText - 666) - inp) then - let - !(# c, - cs #) - = readNext - inp - in - if ((\ x - -> \ x - -> x) - True) - c then - let - _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList []),(join_46,fromList [])]" - in - \ farInp - farExp - v - !inp - -> let - _ = "call exceptionsByName(name_2)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList []),(join_46,fromList [])]" - in - \ farInp - farExp - v - !inp - -> let - readFail - = readFail - in - if readMore - ((P.shiftRightText - 666) - inp) then - let - !(# c, - cs #) - = readNext - inp - in - if (']' - ==) - c then - let - _ = "resume" - in - (((join - farInp) - farExp) - (let - _ = "resume.genCode" - in - ((\ x - -> \ x - -> x x) - (((\ x - -> \ x - -> x x) - (((\ x - -> \ x - -> x x) - (((\ x - -> \ x - -> x x) - (\ x - -> \ x - -> \ x - -> \ x - -> \ x - -> (Grammar.Brainfuck.Loop - x - :))) - c)) - v)) - v)) - c)) - cs - else - let - _ = "checkToken.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [P.ErrorItemToken - ']'] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemToken - ']']) #) - GT - -> (# farInp, - farExp #) - in - ((readFail - inp) - farInp) - farExp - else - let - _ = "checkHorizon.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [P.ErrorItemHorizon - 667] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemHorizon - 667]) #) - GT - -> (# farInp, - farExp #) - in - ((readFail - inp) - farInp) - farExp)) - inp) - (((((Data.Map.Internal.Bin - 1) - "fail") - readFail) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip))) - cs) - (((((Data.Map.Internal.Bin - 1) - "fail") - readFail) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip) - else - let - _ = "checkToken.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - ((readFail - inp) - farInp) - farExp - else - let - _ = "checkHorizon.else" in - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [P.ErrorItemHorizon - 667] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemHorizon - 667]) #) - GT - -> (# farInp, - farExp #) - in - ((readFail - inp) - farInp) - farExp - else - let - (# farInp, - farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - inp - of - LT - -> (# inp, - [] #) - EQ - -> (# farInp, - (farExp - <> - []) #) - GT - -> (# farInp, - farExp #) - in - ((readFail - inp) - farInp) - farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` P.offset) - farInp) - inp - of - LT -> (# inp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - inp - of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ - -> (# farInp, - (farExp - <> [P.ErrorItemHorizon 1]) #) - GT -> (# farInp, farExp #) - in ((readFail inp) farInp) farExp in - let - _ = "call exceptionsByName(name_3)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList []),(name_3,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in ((\ x -> \ x -> x x) (\ x -> x [])) v)) - inp)) - inp) - Data.Map.Internal.Tip in - let - _ = "call exceptionsByName(name_2)=[] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList []),(name_2,fromList [])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) (\ x -> \ x -> x)) v)) - v)) - inp)) - inp) - Data.Map.Internal.Tip)) - init) - Data.Map.Internal.Tip + let _ = "checkToken.else" + in let (# + farInp_54, + farExp_55 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_34 of + GHC.Types.LT -> + (# + inp_34, + [ Symantic.Parser.Grammar.Combinators.ErrorItemToken '<', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '>', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '+', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '-', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '[', + Symantic.Parser.Grammar.Combinators.ErrorItemToken ']', + Symantic.Parser.Grammar.Combinators.ErrorItemToken ',', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '.', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '$' + ] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] + GHC.Base.<> [ Symantic.Parser.Grammar.Combinators.ErrorItemToken '<', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '>', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '+', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '-', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '[', + Symantic.Parser.Grammar.Combinators.ErrorItemToken ']', + Symantic.Parser.Grammar.Combinators.ErrorItemToken ',', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '.', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '$' + ] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_45 inp_34 farInp_54 farExp_55 + else + let _ = "checkHorizon.else" + in let (# + farInp_56, + farExp_57 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_34 of + GHC.Types.LT -> + (# + inp_34, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_45 inp_34 farInp_56 farExp_57 + name_58 = \(!ok_59) (!inp_60) (!koByLabel_61) -> + let _ = "catchException lbl=fail" + in let catchHandler_62 (!failInp_63) (!farInp_64) (!farExp_65) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_66 + _ + ) + ( Data.Text.Internal.Text + _ + j_67 + _ + ) -> i_66 GHC.Classes.== j_67 + ) + inp_60 + failInp_63 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_59 + farInp_64 + farExp_65 + ( let _ = "resume.genCode" + in \x_68 -> x_68 + ) + failInp_63 + else + let _ = "choicesBranch.else" + in let (# + farInp_69, + farExp_70 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_64 failInp_63 of + GHC.Types.LT -> + (# + failInp_63, + [] + #) + GHC.Types.EQ -> + (# + farInp_64, + farExp_65 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_64, + farExp_65 + #) + in finalRaise_18 failInp_63 farInp_69 farExp_70 + in let join_71 = \farInp_72 farExp_73 v_74 (!inp_75) -> + name_24 + ( let _ = "suspend" + in \farInp_76 farExp_77 v_78 (!inp_79) -> + name_58 + ( let _ = "suspend" + in \farInp_80 farExp_81 v_82 (!inp_83) -> + let _ = "resume" + in ok_59 + farInp_80 + farExp_81 + ( let _ = "resume.genCode" + in \x_84 -> v_74 GHC.Types.: v_82 x_84 + ) + inp_83 + ) + inp_79 + Data.Map.Internal.Tip + ) + inp_75 + Data.Map.Internal.Tip + in let readFail_85 = catchHandler_62 + in if readMore_2 inp_60 + then + let !(# + c_86, + cs_87 + #) = readNext_3 inp_60 + in if (\x_88 -> \x_89 -> x_88) GHC.Types.True c_86 + then + if '>' GHC.Classes.== c_86 + then + let _ = "choicesBranch.then" + in let readFail_90 = readFail_85 + in if readMore_2 inp_60 + then + let !(# + c_91, + cs_92 + #) = readNext_3 inp_60 + in if (\x_93 -> \x_94 -> x_93) GHC.Types.True c_91 + then + let _ = "resume" + in join_71 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in Grammar.Brainfuck.RightPointer + ) + cs_92 + else + let _ = "checkToken.else" + in let (# + farInp_95, + farExp_96 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_90 inp_60 farInp_95 farExp_96 + else + let _ = "checkHorizon.else" + in let (# + farInp_97, + farExp_98 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_90 inp_60 farInp_97 farExp_98 + else + let _ = "choicesBranch.else" + in if '<' GHC.Classes.== c_86 + then + let _ = "choicesBranch.then" + in let readFail_99 = readFail_85 + in if readMore_2 inp_60 + then + let !(# + c_100, + cs_101 + #) = readNext_3 inp_60 + in if (\x_102 -> \x_103 -> x_102) GHC.Types.True c_100 + then + let _ = "resume" + in join_71 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in Grammar.Brainfuck.LeftPointer + ) + cs_101 + else + let _ = "checkToken.else" + in let (# + farInp_104, + farExp_105 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_99 inp_60 farInp_104 farExp_105 + else + let _ = "checkHorizon.else" + in let (# + farInp_106, + farExp_107 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_99 inp_60 farInp_106 farExp_107 + else + let _ = "choicesBranch.else" + in if '+' GHC.Classes.== c_86 + then + let _ = "choicesBranch.then" + in let readFail_108 = readFail_85 + in if readMore_2 inp_60 + then + let !(# + c_109, + cs_110 + #) = readNext_3 inp_60 + in if (\x_111 -> \x_112 -> x_111) GHC.Types.True c_109 + then + let _ = "resume" + in join_71 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Increment + ) + cs_110 + else + let _ = "checkToken.else" + in let (# + farInp_113, + farExp_114 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_108 inp_60 farInp_113 farExp_114 + else + let _ = "checkHorizon.else" + in let (# + farInp_115, + farExp_116 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_108 inp_60 farInp_115 farExp_116 + else + let _ = "choicesBranch.else" + in if '-' GHC.Classes.== c_86 + then + let _ = "choicesBranch.then" + in let readFail_117 = readFail_85 + in if readMore_2 inp_60 + then + let !(# + c_118, + cs_119 + #) = readNext_3 inp_60 + in if (\x_120 -> \x_121 -> x_120) GHC.Types.True c_118 + then + let _ = "resume" + in join_71 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Decrement + ) + cs_119 + else + let _ = "checkToken.else" + in let (# + farInp_122, + farExp_123 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_117 inp_60 farInp_122 farExp_123 + else + let _ = "checkHorizon.else" + in let (# + farInp_124, + farExp_125 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_117 inp_60 farInp_124 farExp_125 + else + let _ = "choicesBranch.else" + in if '.' GHC.Classes.== c_86 + then + let _ = "choicesBranch.then" + in let readFail_126 = readFail_85 + in if readMore_2 inp_60 + then + let !(# + c_127, + cs_128 + #) = readNext_3 inp_60 + in if (\x_129 -> \x_130 -> x_129) GHC.Types.True c_127 + then + let _ = "resume" + in join_71 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Output + ) + cs_128 + else + let _ = "checkToken.else" + in let (# + farInp_131, + farExp_132 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_126 inp_60 farInp_131 farExp_132 + else + let _ = "checkHorizon.else" + in let (# + farInp_133, + farExp_134 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_126 inp_60 farInp_133 farExp_134 + else + let _ = "choicesBranch.else" + in if ',' GHC.Classes.== c_86 + then + let _ = "choicesBranch.then" + in let readFail_135 = readFail_85 + in if readMore_2 inp_60 + then + let !(# + c_136, + cs_137 + #) = readNext_3 inp_60 + in if (\x_138 -> \x_139 -> x_138) GHC.Types.True c_136 + then + let _ = "resume" + in join_71 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Input + ) + cs_137 + else + let _ = "checkToken.else" + in let (# + farInp_140, + farExp_141 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_135 inp_60 farInp_140 farExp_141 + else + let _ = "checkHorizon.else" + in let (# + farInp_142, + farExp_143 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_135 inp_60 farInp_142 farExp_143 + else + let _ = "choicesBranch.else" + in if '[' GHC.Classes.== c_86 + then + let _ = "choicesBranch.then" + in let readFail_144 = readFail_85 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_60) + then + let !(# + c_145, + cs_146 + #) = readNext_3 inp_60 + in if (\x_147 -> \x_148 -> x_147) GHC.Types.True c_145 + then + name_24 + ( let _ = "suspend" + in \farInp_149 farExp_150 v_151 (!inp_152) -> + name_153 + ( let _ = "suspend" + in \farInp_154 farExp_155 v_156 (!inp_157) -> + let readFail_158 = readFail_144 + in if readMore_2 inp_157 + then + let !(# + c_159, + cs_160 + #) = readNext_3 inp_157 + in if (']' GHC.Classes.==) c_159 + then + let _ = "resume" + in join_71 + farInp_154 + farExp_155 + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Loop v_156 + ) + cs_160 + else + let _ = "checkToken.else" + in let (# + farInp_161, + farExp_162 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_154 inp_157 of + GHC.Types.LT -> + (# + inp_157, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] + #) + GHC.Types.EQ -> + (# + farInp_154, + farExp_155 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] + #) + GHC.Types.GT -> + (# + farInp_154, + farExp_155 + #) + in readFail_158 inp_157 farInp_161 farExp_162 + else + let _ = "checkHorizon.else" + in let (# + farInp_163, + farExp_164 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_154 inp_157 of + GHC.Types.LT -> + (# + inp_157, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_154, + farExp_155 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_154, + farExp_155 + #) + in readFail_158 inp_157 farInp_163 farExp_164 + ) + inp_152 + Data.Map.Internal.Tip + ) + cs_146 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_165, + farExp_166 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_144 inp_60 farInp_165 farExp_166 + else + let _ = "checkHorizon.else" + in let (# + farInp_167, + farExp_168 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_144 inp_60 farInp_167 farExp_168 + else + let _ = "choicesBranch.else" + in let (# + farInp_169, + farExp_170 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_85 inp_60 farInp_169 farExp_170 + else + let _ = "checkToken.else" + in let (# + farInp_171, + farExp_172 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_85 inp_60 farInp_171 farExp_172 + else + let _ = "checkHorizon.else" + in let (# + farInp_173, + farExp_174 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + GHC.Types.LT -> + (# + inp_60, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_85 inp_60 farInp_173 farExp_174 + name_153 = \(!ok_175) (!inp_176) (!koByLabel_177) -> + name_58 + ( let _ = "suspend" + in \farInp_178 farExp_179 v_180 (!inp_181) -> + let _ = "resume" + in ok_175 + farInp_178 + farExp_179 + ( let _ = "resume.genCode" + in v_180 GHC.Types . [] + ) + inp_181 + ) + inp_176 + Data.Map.Internal.Tip + in name_24 + ( let _ = "suspend" + in \farInp_182 farExp_183 v_184 (!inp_185) -> + name_153 + ( let _ = "suspend" + in \farInp_186 farExp_187 v_188 (!inp_189) -> + let _ = "resume" + in finalRet_13 + farInp_186 + farExp_187 + ( let _ = "resume.genCode" + in v_188 + ) + inp_189 + ) + inp_185 + Data.Map.Internal.Tip + ) + init_1 + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G14.expected.txt b/test/Golden/Splice/G14.expected.txt index 7570682..cba7284 100644 --- a/test/Golden/Splice/G14.expected.txt +++ b/test/Golden/Splice/G14.expected.txt @@ -1,14 +1,4186 @@ - -test/Golden/Splice/G14.hs:0:0: error: - • Exception when trying to run compile-time code: - Map.!: given key is not an element in the map -CallStack (from HasCallStack): - error, called at libraries/containers/containers/src/Data/Map/Internal.hs:0:0 in containers-0.6.4.1:Data.Map.Internal - Code: (P.runParser @Text Grammar.g14) - • In the Template Haskell splice $$(P.runParser @Text Grammar.g14) - In the expression: $$(P.runParser @Text Grammar.g14) - In an equation for ‘splice’: - splice = $$(P.runParser @Text Grammar.g14) - | -6 | splice = $$(P.runParser @Text Grammar.g14) - | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + let _ = "catchException lbl=fail" + in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_32 + _ + ) + ( Data.Text.Internal.Text + _ + j_33 + _ + ) -> i_32 GHC.Classes.== j_33 + ) + inp_26 + failInp_29 + then + let _ = "choicesBranch.then" + in name_34 + ( let _ = "suspend" + in \farInp_35 farExp_36 v_37 (!inp_38) -> + let join_39 = \farInp_40 farExp_41 v_42 (!inp_43) -> + let _ = "resume" + in ok_25 + farInp_40 + farExp_41 + ( let _ = "resume.genCode" + in v_42 + ) + inp_43 + in let _ = "catchException lbl=fail" + in let catchHandler_44 (!failInp_45) (!farInp_46) (!farExp_47) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_48 + _ + ) + ( Data.Text.Internal.Text + _ + j_49 + _ + ) -> i_48 GHC.Classes.== j_49 + ) + inp_38 + failInp_45 + then + let _ = "choicesBranch.then" + in name_50 + ( let _ = "suspend" + in \farInp_51 farExp_52 v_53 (!inp_54) -> + let _ = "resume" + in join_39 + farInp_51 + farExp_52 + ( let _ = "resume.genCode" + in v_53 + ) + inp_54 + ) + failInp_45 + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp_55, + farExp_56 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_46 failInp_45 of + GHC.Types.LT -> + (# + failInp_45, + [] + #) + GHC.Types.EQ -> + (# + farInp_46, + farExp_47 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_46, + farExp_47 + #) + in finalRaise_18 failInp_45 farInp_55 farExp_56 + in let join_57 = \farInp_58 farExp_59 v_60 (!inp_61) -> + let _ = "resume" + in join_39 + farInp_58 + farExp_59 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_61 + in let _ = "catchException lbl=fail" + in let catchHandler_62 (!failInp_63) (!farInp_64) (!farExp_65) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_66 + _ + ) + ( Data.Text.Internal.Text + _ + j_67 + _ + ) -> i_66 GHC.Classes.== j_67 + ) + inp_38 + failInp_63 + then + let _ = "choicesBranch.then" + in name_68 + ( let _ = "suspend" + in \farInp_69 farExp_70 v_71 (!inp_72) -> + let _ = "resume" + in join_57 + farInp_69 + farExp_70 + ( let _ = "resume.genCode" + in v_71 + ) + inp_72 + ) + failInp_63 + (Data.Map.Internal.Bin 1 "fail" catchHandler_44 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "choicesBranch.else" + in let (# + farInp_73, + farExp_74 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_64 failInp_63 of + GHC.Types.LT -> + (# + failInp_63, + [] + #) + GHC.Types.EQ -> + (# + farInp_64, + farExp_65 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_64, + farExp_65 + #) + in catchHandler_44 failInp_63 farInp_73 farExp_74 + in name_75 + ( let _ = "suspend" + in \farInp_76 farExp_77 v_78 (!inp_79) -> + let join_80 = \farInp_81 farExp_82 v_83 (!inp_84) -> + name_85 + ( let _ = "suspend" + in \farInp_86 farExp_87 v_88 (!inp_89) -> + let _ = "resume" + in join_57 + farInp_86 + farExp_87 + ( let _ = "resume.genCode" + in v_83 + ) + inp_89 + ) + inp_84 + (Data.Map.Internal.Bin 1 "fail" catchHandler_62 Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let _ = "catchException lbl=fail" + in let catchHandler_90 (!failInp_91) (!farInp_92) (!farExp_93) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_94 + _ + ) + ( Data.Text.Internal.Text + _ + j_95 + _ + ) -> i_94 GHC.Classes.== j_95 + ) + inp_79 + failInp_91 + then + let _ = "choicesBranch.then" + in name_50 + ( let _ = "suspend" + in \farInp_96 farExp_97 v_98 (!inp_99) -> + let _ = "resume" + in join_80 + farInp_96 + farExp_97 + ( let _ = "resume.genCode" + in v_98 + ) + inp_99 + ) + failInp_91 + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp_100, + farExp_101 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_92 failInp_91 of + GHC.Types.LT -> + (# + failInp_91, + [] + #) + GHC.Types.EQ -> + (# + farInp_92, + farExp_93 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_92, + farExp_93 + #) + in catchHandler_62 failInp_91 farInp_100 farExp_101 + in name_102 + ( let _ = "suspend" + in \farInp_103 farExp_104 v_105 (!inp_106) -> + name_50 + ( let _ = "suspend" + in \farInp_107 farExp_108 v_109 (!inp_110) -> + name_111 + ( let _ = "suspend" + in \farInp_112 farExp_113 v_114 (!inp_115) -> + name_50 + ( let _ = "suspend" + in \farInp_116 farExp_117 v_118 (!inp_119) -> + let _ = "resume" + in join_80 + farInp_116 + farExp_117 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_119 + ) + inp_115 + Data.Map.Internal.Tip + ) + inp_110 + Data.Map.Internal.Tip + ) + inp_106 + Data.Map.Internal.Tip + ) + inp_79 + Data.Map.Internal.Tip + ) + inp_38 + (Data.Map.Internal.Bin 1 "fail" catchHandler_62 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + failInp_29 + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp_120, + farExp_121 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + GHC.Types.LT -> + (# + failInp_29, + [] + #) + GHC.Types.EQ -> + (# + farInp_30, + farExp_31 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_30, + farExp_31 + #) + in finalRaise_18 failInp_29 farInp_120 farExp_121 + in let join_122 = \farInp_123 farExp_124 v_125 (!inp_126) -> + let _ = "resume" + in ok_25 + farInp_123 + farExp_124 + ( let _ = "resume.genCode" + in v_125 + ) + inp_126 + in let _ = "catchException lbl=fail" + in let catchHandler_127 (!failInp_128) (!farInp_129) (!farExp_130) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_131 + _ + ) + ( Data.Text.Internal.Text + _ + j_132 + _ + ) -> i_131 GHC.Classes.== j_132 + ) + inp_26 + failInp_128 + then + let _ = "choicesBranch.then" + in let readFail_133 = catchHandler_28 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 failInp_128) + then + let !(# + c_134, + cs_135 + #) = readNext_3 failInp_128 + in if ('\'' GHC.Classes.==) c_134 + then + let join_136 = \farInp_137 farExp_138 v_139 (!inp_140) -> + let readFail_141 = readFail_133 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_140) + then + let !(# + c_142, + cs_143 + #) = readNext_3 inp_140 + in if ('\'' GHC.Classes.==) c_142 + then + name_144 + ( let _ = "suspend" + in \farInp_145 farExp_146 v_147 (!inp_148) -> + let _ = "resume" + in join_122 + farInp_145 + farExp_146 + ( let _ = "resume.genCode" + in v_139 + ) + inp_148 + ) + cs_143 + (Data.Map.Internal.Bin 1 "fail" readFail_141 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_149, + farExp_150 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_137 inp_140 of + GHC.Types.LT -> + (# + inp_140, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + #) + GHC.Types.EQ -> + (# + farInp_137, + farExp_138 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + #) + GHC.Types.GT -> + (# + farInp_137, + farExp_138 + #) + in readFail_141 inp_140 farInp_149 farExp_150 + else + let _ = "checkHorizon.else" + in let (# + farInp_151, + farExp_152 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_137 inp_140 of + GHC.Types.LT -> + (# + inp_140, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp_137, + farExp_138 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp_137, + farExp_138 + #) + in readFail_141 inp_140 farInp_151 farExp_152 + in let _ = "catchException lbl=fail" + in let catchHandler_153 (!failInp_154) (!farInp_155) (!farExp_156) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_157 + _ + ) + ( Data.Text.Internal.Text + _ + j_158 + _ + ) -> i_157 GHC.Classes.== j_158 + ) + cs_135 + failInp_154 + then + let _ = "choicesBranch.then" + in let readFail_159 = readFail_133 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 failInp_154) + then + let !(# + c_160, + cs_161 + #) = readNext_3 failInp_154 + in if ('\\' GHC.Classes.==) c_160 + then + let readFail_162 = readFail_159 + in let !(# + c_163, + cs_164 + #) = readNext_3 cs_161 + in if (\t_165 -> ('0' GHC.Classes.== t_165) GHC.Classes.|| (('t' GHC.Classes.== t_165) GHC.Classes.|| (('n' GHC.Classes.== t_165) GHC.Classes.|| (('v' GHC.Classes.== t_165) GHC.Classes.|| (('f' GHC.Classes.== t_165) GHC.Classes.|| (('r' GHC.Classes.== t_165) GHC.Classes.|| GHC.Types.False)))))) c_163 + then + name_50 + ( let _ = "suspend" + in \farInp_166 farExp_167 v_168 (!inp_169) -> + let _ = "resume" + in join_136 + farInp_166 + farExp_167 + ( let _ = "resume.genCode" + in v_168 + ) + inp_169 + ) + cs_164 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_170, + farExp_171 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_155 cs_161 of + GHC.Types.LT -> + (# + cs_161, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.EQ -> + (# + farInp_155, + farExp_156 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.GT -> + (# + farInp_155, + farExp_156 + #) + in readFail_159 cs_161 farInp_170 farExp_171 + else + let _ = "checkToken.else" + in let (# + farInp_172, + farExp_173 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_155 failInp_154 of + GHC.Types.LT -> + (# + failInp_154, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\\'] + #) + GHC.Types.EQ -> + (# + farInp_155, + farExp_156 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\\'] + #) + GHC.Types.GT -> + (# + farInp_155, + farExp_156 + #) + in readFail_159 failInp_154 farInp_172 farExp_173 + else + let _ = "checkHorizon.else" + in let (# + farInp_174, + farExp_175 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_155 failInp_154 of + GHC.Types.LT -> + (# + failInp_154, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + farInp_155, + farExp_156 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + farInp_155, + farExp_156 + #) + in readFail_159 failInp_154 farInp_174 farExp_175 + else + let _ = "choicesBranch.else" + in let (# + farInp_176, + farExp_177 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_155 failInp_154 of + GHC.Types.LT -> + (# + failInp_154, + [] + #) + GHC.Types.EQ -> + (# + farInp_155, + farExp_156 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_155, + farExp_156 + #) + in readFail_133 failInp_154 farInp_176 farExp_177 + in let readFail_178 = catchHandler_153 + in let !(# + c_179, + cs_180 + #) = readNext_3 cs_135 + in if Grammar.Nandlang.nandStringLetter c_179 + then + name_50 + ( let _ = "suspend" + in \farInp_181 farExp_182 v_183 (!inp_184) -> + let _ = "resume" + in join_136 + farInp_181 + farExp_182 + ( let _ = "resume.genCode" + in v_183 + ) + inp_184 + ) + cs_180 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_185, + farExp_186 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_129 cs_135 of + GHC.Types.LT -> + (# + cs_135, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "Char"] + #) + GHC.Types.EQ -> + (# + farInp_129, + farExp_130 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "Char"] + #) + GHC.Types.GT -> + (# + farInp_129, + farExp_130 + #) + in catchHandler_153 cs_135 farInp_185 farExp_186 + else + let _ = "checkToken.else" + in let (# + farInp_187, + farExp_188 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_129 failInp_128 of + GHC.Types.LT -> + (# + failInp_128, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + #) + GHC.Types.EQ -> + (# + farInp_129, + farExp_130 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + #) + GHC.Types.GT -> + (# + farInp_129, + farExp_130 + #) + in readFail_133 failInp_128 farInp_187 farExp_188 + else + let _ = "checkHorizon.else" + in let (# + farInp_189, + farExp_190 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_129 failInp_128 of + GHC.Types.LT -> + (# + failInp_128, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + farInp_129, + farExp_130 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + farInp_129, + farExp_130 + #) + in readFail_133 failInp_128 farInp_189 farExp_190 + else + let _ = "choicesBranch.else" + in let (# + farInp_191, + farExp_192 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_129 failInp_128 of + GHC.Types.LT -> + (# + failInp_128, + [] + #) + GHC.Types.EQ -> + (# + farInp_129, + farExp_130 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_129, + farExp_130 + #) + in catchHandler_28 failInp_128 farInp_191 farExp_192 + in let join_193 = \farInp_194 farExp_195 v_196 (!inp_197) -> + name_144 + ( let _ = "suspend" + in \farInp_198 farExp_199 v_200 (!inp_201) -> + let _ = "resume" + in join_122 + farInp_198 + farExp_199 + ( let _ = "resume.genCode" + in v_200 + ) + inp_201 + ) + inp_197 + (Data.Map.Internal.Bin 1 "fail" catchHandler_127 Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let _ = "catchException lbl=fail" + in let catchHandler_202 (!failInp_203) (!farInp_204) (!farExp_205) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_206 + _ + ) + ( Data.Text.Internal.Text + _ + j_207 + _ + ) -> i_206 GHC.Classes.== j_207 + ) + inp_26 + failInp_203 + then + let _ = "choicesBranch.then" + in let readFail_208 = catchHandler_127 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_203) + then + let !(# + c_209, + cs_210 + #) = readNext_3 failInp_203 + in if ('1' GHC.Classes.==) c_209 + then + let _ = "resume" + in join_193 + farInp_204 + farExp_205 + ( let _ = "resume.genCode" + in '1' + ) + cs_210 + else + let _ = "checkToken.else" + in let (# + farInp_211, + farExp_212 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_204 failInp_203 of + GHC.Types.LT -> + (# + failInp_203, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '1'] + #) + GHC.Types.EQ -> + (# + farInp_204, + farExp_205 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '1'] + #) + GHC.Types.GT -> + (# + farInp_204, + farExp_205 + #) + in readFail_208 failInp_203 farInp_211 farExp_212 + else + let _ = "checkHorizon.else" + in let (# + farInp_213, + farExp_214 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_204 failInp_203 of + GHC.Types.LT -> + (# + failInp_203, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp_204, + farExp_205 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp_204, + farExp_205 + #) + in readFail_208 failInp_203 farInp_213 farExp_214 + else + let _ = "choicesBranch.else" + in let (# + farInp_215, + farExp_216 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_204 failInp_203 of + GHC.Types.LT -> + (# + failInp_203, + [] + #) + GHC.Types.EQ -> + (# + farInp_204, + farExp_205 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_204, + farExp_205 + #) + in catchHandler_127 failInp_203 farInp_215 farExp_216 + in let readFail_217 = catchHandler_202 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_26) + then + let !(# + c_218, + cs_219 + #) = readNext_3 inp_26 + in if ('0' GHC.Classes.==) c_218 + then + let _ = "resume" + in join_193 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in '0' + ) + cs_219 + else + let _ = "checkToken.else" + in let (# + farInp_220, + farExp_221 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '0'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '0'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_217 inp_26 farInp_220 farExp_221 + else + let _ = "checkHorizon.else" + in let (# + farInp_222, + farExp_223 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_217 inp_26 farInp_222 farExp_223 + name_224 = \(!ok_225) (!inp_226) (!koByLabel_227) -> + let _ = "catchException lbl=fail" + in let catchHandler_228 (!failInp_229) (!farInp_230) (!farExp_231) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_232 + _ + ) + ( Data.Text.Internal.Text + _ + j_233 + _ + ) -> i_232 GHC.Classes.== j_233 + ) + inp_226 + failInp_229 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_225 + farInp_230 + farExp_231 + ( let _ = "resume.genCode" + in \x_234 -> x_234 + ) + failInp_229 + else + let _ = "choicesBranch.else" + in let (# + farInp_235, + farExp_236 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_230 failInp_229 of + GHC.Types.LT -> + (# + failInp_229, + [] + #) + GHC.Types.EQ -> + (# + farInp_230, + farExp_231 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_230, + farExp_231 + #) + in finalRaise_18 failInp_229 farInp_235 farExp_236 + in name_237 + ( let _ = "suspend" + in \farInp_238 farExp_239 v_240 (!inp_241) -> + name_242 + ( let _ = "suspend" + in \farInp_243 farExp_244 v_245 (!inp_246) -> + name_102 + ( let _ = "suspend" + in \farInp_247 farExp_248 v_249 (!inp_250) -> + name_224 + ( let _ = "suspend" + in \farInp_251 farExp_252 v_253 (!inp_254) -> + let _ = "resume" + in ok_225 + farInp_251 + farExp_252 + ( let _ = "resume.genCode" + in \x_255 -> v_240 v_249 (v_253 x_255) + ) + inp_254 + ) + inp_250 + Data.Map.Internal.Tip + ) + inp_246 + Data.Map.Internal.Tip + ) + inp_241 + (Data.Map.Internal.Bin 1 "fail" catchHandler_228 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp_226 + Data.Map.Internal.Tip + name_256 = \(!ok_257) (!inp_258) (!koByLabel_259) -> + let _ = "catchException lbl=fail" + in let catchHandler_260 (!failInp_261) (!farInp_262) (!farExp_263) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_264 + _ + ) + ( Data.Text.Internal.Text + _ + j_265 + _ + ) -> i_264 GHC.Classes.== j_265 + ) + inp_258 + failInp_261 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_257 + farInp_262 + farExp_263 + ( let _ = "resume.genCode" + in \x_266 -> x_266 + ) + failInp_261 + else + let _ = "choicesBranch.else" + in let (# + farInp_267, + farExp_268 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_262 failInp_261 of + GHC.Types.LT -> + (# + failInp_261, + [] + #) + GHC.Types.EQ -> + (# + farInp_262, + farExp_263 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_262, + farExp_263 + #) + in finalRaise_18 failInp_261 farInp_267 farExp_268 + in name_237 + ( let _ = "suspend" + in \farInp_269 farExp_270 v_271 (!inp_272) -> + name_242 + ( let _ = "suspend" + in \farInp_273 farExp_274 v_275 (!inp_276) -> + name_277 + ( let _ = "suspend" + in \farInp_278 farExp_279 v_280 (!inp_281) -> + name_256 + ( let _ = "suspend" + in \farInp_282 farExp_283 v_284 (!inp_285) -> + let _ = "resume" + in ok_257 + farInp_282 + farExp_283 + ( let _ = "resume.genCode" + in \x_286 -> v_271 v_280 (v_284 x_286) + ) + inp_285 + ) + inp_281 + Data.Map.Internal.Tip + ) + inp_276 + Data.Map.Internal.Tip + ) + inp_272 + (Data.Map.Internal.Bin 1 "fail" catchHandler_260 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp_258 + Data.Map.Internal.Tip + name_287 = \(!ok_288) (!inp_289) (!koByLabel_290) -> + let _ = "catchException lbl=fail" + in let catchHandler_291 (!failInp_292) (!farInp_293) (!farExp_294) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_295 + _ + ) + ( Data.Text.Internal.Text + _ + j_296 + _ + ) -> i_295 GHC.Classes.== j_296 + ) + inp_289 + failInp_292 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_288 + farInp_293 + farExp_294 + ( let _ = "resume.genCode" + in \x_297 -> x_297 + ) + failInp_292 + else + let _ = "choicesBranch.else" + in let (# + farInp_298, + farExp_299 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_293 failInp_292 of + GHC.Types.LT -> + (# + failInp_292, + [] + #) + GHC.Types.EQ -> + (# + farInp_293, + farExp_294 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_293, + farExp_294 + #) + in finalRaise_18 failInp_292 farInp_298 farExp_299 + in let join_300 = \farInp_301 farExp_302 v_303 (!inp_304) -> + name_287 + ( let _ = "suspend" + in \farInp_305 farExp_306 v_307 (!inp_308) -> + let _ = "resume" + in ok_288 + farInp_305 + farExp_306 + ( let _ = "resume.genCode" + in \x_309 -> v_307 x_309 + ) + inp_308 + ) + inp_304 + Data.Map.Internal.Tip + in let _ = "catchException lbl=fail" + in let catchHandler_310 (!failInp_311) (!farInp_312) (!farExp_313) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_314 + _ + ) + ( Data.Text.Internal.Text + _ + j_315 + _ + ) -> i_314 GHC.Classes.== j_315 + ) + inp_289 + failInp_311 + then + let _ = "choicesBranch.then" + in name_102 + ( let _ = "suspend" + in \farInp_316 farExp_317 v_318 (!inp_319) -> + name_320 + ( let _ = "suspend" + in \farInp_321 farExp_322 v_323 (!inp_324) -> + let _ = "resume" + in join_300 + farInp_321 + farExp_322 + ( let _ = "resume.genCode" + in v_318 + ) + inp_324 + ) + inp_319 + (Data.Map.Internal.Bin 1 "fail" catchHandler_291 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + failInp_311 + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp_325, + farExp_326 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_312 failInp_311 of + GHC.Types.LT -> + (# + failInp_311, + [] + #) + GHC.Types.EQ -> + (# + farInp_312, + farExp_313 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_312, + farExp_313 + #) + in catchHandler_291 failInp_311 farInp_325 farExp_326 + in let join_327 = \farInp_328 farExp_329 v_330 (!inp_331) -> + let _ = "resume" + in join_300 + farInp_328 + farExp_329 + ( let _ = "resume.genCode" + in v_330 + ) + inp_331 + in let _ = "catchException lbl=fail" + in let catchHandler_332 (!failInp_333) (!farInp_334) (!farExp_335) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_336 + _ + ) + ( Data.Text.Internal.Text + _ + j_337 + _ + ) -> i_336 GHC.Classes.== j_337 + ) + inp_289 + failInp_333 + then + let _ = "choicesBranch.then" + in let _ = "catchException lbl=fail" + in let catchHandler_338 (!failInp_339) (!farInp_340) (!farExp_341) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_342, + farExp_343 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_340 failInp_333 of + GHC.Types.LT -> + (# + failInp_333, + [] + #) + GHC.Types.EQ -> + (# + farInp_340, + farExp_341 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_340, + farExp_341 + #) + in catchHandler_310 failInp_333 farInp_342 farExp_343 + in let join_344 = \farInp_345 farExp_346 v_347 (!inp_348) -> + name_277 + ( let _ = "suspend" + in \farInp_349 farExp_350 v_351 (!inp_352) -> + name_50 + ( let _ = "suspend" + in \farInp_353 farExp_354 v_355 (!inp_356) -> + name_256 + ( let _ = "suspend" + in \farInp_357 farExp_358 v_359 (!inp_360) -> + name_50 + ( let _ = "suspend" + in \farInp_361 farExp_362 v_363 (!inp_364) -> + let readFail_365 = catchHandler_338 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_364) + then + let !(# + c_366, + cs_367 + #) = readNext_3 inp_364 + in if ('=' GHC.Classes.==) c_366 + then + name_144 + ( let _ = "suspend" + in \farInp_368 farExp_369 v_370 (!inp_371) -> + name_102 + ( let _ = "suspend" + in \farInp_372 farExp_373 v_374 (!inp_375) -> + name_50 + ( let _ = "suspend" + in \farInp_376 farExp_377 v_378 (!inp_379) -> + name_224 + ( let _ = "suspend" + in \farInp_380 farExp_381 v_382 (!inp_383) -> + name_50 + ( let _ = "suspend" + in \farInp_384 farExp_385 v_386 (!inp_387) -> + name_320 + ( let _ = "suspend" + in \farInp_388 farExp_389 v_390 (!inp_391) -> + let _ = "resume" + in join_327 + farInp_388 + farExp_389 + ( let _ = "resume.genCode" + in v_386 + ) + inp_391 + ) + inp_387 + (Data.Map.Internal.Bin 1 "fail" readFail_365 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp_383 + Data.Map.Internal.Tip + ) + inp_379 + Data.Map.Internal.Tip + ) + inp_375 + Data.Map.Internal.Tip + ) + inp_371 + Data.Map.Internal.Tip + ) + cs_367 + (Data.Map.Internal.Bin 1 "fail" readFail_365 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_392, + farExp_393 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_361 inp_364 of + GHC.Types.LT -> + (# + inp_364, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '='] + #) + GHC.Types.EQ -> + (# + farInp_361, + farExp_362 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '='] + #) + GHC.Types.GT -> + (# + farInp_361, + farExp_362 + #) + in readFail_365 inp_364 farInp_392 farExp_393 + else + let _ = "checkHorizon.else" + in let (# + farInp_394, + farExp_395 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_361 inp_364 of + GHC.Types.LT -> + (# + inp_364, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + farInp_361, + farExp_362 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + farInp_361, + farExp_362 + #) + in readFail_365 inp_364 farInp_394 farExp_395 + ) + inp_360 + Data.Map.Internal.Tip + ) + inp_356 + Data.Map.Internal.Tip + ) + inp_352 + Data.Map.Internal.Tip + ) + inp_348 + Data.Map.Internal.Tip + in let _ = "catchException lbl=fail" + in let catchHandler_396 (!failInp_397) (!farInp_398) (!farExp_399) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_400 + _ + ) + ( Data.Text.Internal.Text + _ + j_401 + _ + ) -> i_400 GHC.Classes.== j_401 + ) + failInp_333 + failInp_397 + then + let _ = "choicesBranch.then" + in name_50 + ( let _ = "suspend" + in \farInp_402 farExp_403 v_404 (!inp_405) -> + let _ = "resume" + in join_344 + farInp_402 + farExp_403 + ( let _ = "resume.genCode" + in v_404 + ) + inp_405 + ) + failInp_397 + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp_406, + farExp_407 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_398 failInp_397 of + GHC.Types.LT -> + (# + failInp_397, + [] + #) + GHC.Types.EQ -> + (# + farInp_398, + farExp_399 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_398, + farExp_399 + #) + in catchHandler_338 failInp_397 farInp_406 farExp_407 + in let _ = "catchException lbl=fail" + in let catchHandler_408 (!failInp_409) (!farInp_410) (!farExp_411) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_412, + farExp_413 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_410 failInp_333 of + GHC.Types.LT -> + (# + failInp_333, + [] + #) + GHC.Types.EQ -> + (# + farInp_410, + farExp_411 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_410, + farExp_411 + #) + in catchHandler_396 failInp_333 farInp_412 farExp_413 + in let readFail_414 = catchHandler_408 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 10 failInp_333) + then + let !(# + c_415, + cs_416 + #) = readNext_3 failInp_333 + in if ('v' GHC.Classes.==) c_415 + then + let readFail_417 = readFail_414 + in let !(# + c_418, + cs_419 + #) = readNext_3 cs_416 + in if ('a' GHC.Classes.==) c_418 + then + let readFail_420 = readFail_414 + in let !(# + c_421, + cs_422 + #) = readNext_3 cs_419 + in if ('r' GHC.Classes.==) c_421 + then + name_423 + ( let _ = "suspend" + in \farInp_424 farExp_425 v_426 (!inp_427) -> + let _ = "resume" + in join_344 + farInp_424 + farExp_425 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_427 + ) + cs_422 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_428, + farExp_429 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 cs_419 of + GHC.Types.LT -> + (# + cs_419, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] + #) + GHC.Types.EQ -> + (# + farInp_334, + farExp_335 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] + #) + GHC.Types.GT -> + (# + farInp_334, + farExp_335 + #) + in readFail_414 cs_419 farInp_428 farExp_429 + else + let _ = "checkToken.else" + in let (# + farInp_430, + farExp_431 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 cs_416 of + GHC.Types.LT -> + (# + cs_416, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + farInp_334, + farExp_335 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + farInp_334, + farExp_335 + #) + in readFail_414 cs_416 farInp_430 farExp_431 + else + let _ = "checkToken.else" + in let (# + farInp_432, + farExp_433 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 failInp_333 of + GHC.Types.LT -> + (# + failInp_333, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'v'] + #) + GHC.Types.EQ -> + (# + farInp_334, + farExp_335 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'v'] + #) + GHC.Types.GT -> + (# + farInp_334, + farExp_335 + #) + in readFail_414 failInp_333 farInp_432 farExp_433 + else + let _ = "checkHorizon.else" + in let (# + farInp_434, + farExp_435 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 failInp_333 of + GHC.Types.LT -> + (# + failInp_333, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + #) + GHC.Types.EQ -> + (# + farInp_334, + farExp_335 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + #) + GHC.Types.GT -> + (# + farInp_334, + farExp_335 + #) + in readFail_414 failInp_333 farInp_434 farExp_435 + else + let _ = "choicesBranch.else" + in let (# + farInp_436, + farExp_437 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 failInp_333 of + GHC.Types.LT -> + (# + failInp_333, + [] + #) + GHC.Types.EQ -> + (# + farInp_334, + farExp_335 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_334, + farExp_335 + #) + in catchHandler_310 failInp_333 farInp_436 farExp_437 + in let join_438 = \farInp_439 farExp_440 v_441 (!inp_442) -> + let _ = "resume" + in join_327 + farInp_439 + farExp_440 + ( let _ = "resume.genCode" + in v_441 + ) + inp_442 + in let _ = "catchException lbl=fail" + in let catchHandler_443 (!failInp_444) (!farInp_445) (!farExp_446) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_447 + _ + ) + ( Data.Text.Internal.Text + _ + j_448 + _ + ) -> i_447 GHC.Classes.== j_448 + ) + inp_289 + failInp_444 + then + let _ = "choicesBranch.then" + in let _ = "catchException lbl=fail" + in let catchHandler_449 (!failInp_450) (!farInp_451) (!farExp_452) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_453, + farExp_454 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_451 failInp_444 of + GHC.Types.LT -> + (# + failInp_444, + [] + #) + GHC.Types.EQ -> + (# + farInp_451, + farExp_452 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_451, + farExp_452 + #) + in catchHandler_332 failInp_444 farInp_453 farExp_454 + in let readFail_455 = catchHandler_449 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 10 failInp_444) + then + let !(# + c_456, + cs_457 + #) = readNext_3 failInp_444 + in if ('w' GHC.Classes.==) c_456 + then + let readFail_458 = readFail_455 + in let !(# + c_459, + cs_460 + #) = readNext_3 cs_457 + in if ('h' GHC.Classes.==) c_459 + then + let readFail_461 = readFail_455 + in let !(# + c_462, + cs_463 + #) = readNext_3 cs_460 + in if ('i' GHC.Classes.==) c_462 + then + let readFail_464 = readFail_455 + in let !(# + c_465, + cs_466 + #) = readNext_3 cs_463 + in if ('l' GHC.Classes.==) c_465 + then + let readFail_467 = readFail_455 + in let !(# + c_468, + cs_469 + #) = readNext_3 cs_466 + in if ('e' GHC.Classes.==) c_468 + then + name_423 + ( let _ = "suspend" + in \farInp_470 farExp_471 v_472 (!inp_473) -> + name_102 + ( let _ = "suspend" + in \farInp_474 farExp_475 v_476 (!inp_477) -> + name_478 + ( let _ = "suspend" + in \farInp_479 farExp_480 v_481 (!inp_482) -> + let _ = "resume" + in join_438 + farInp_479 + farExp_480 + ( let _ = "resume.genCode" + in v_481 + ) + inp_482 + ) + inp_477 + (Data.Map.Internal.Bin 1 "fail" catchHandler_332 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp_473 + Data.Map.Internal.Tip + ) + cs_469 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_483, + farExp_484 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 cs_466 of + GHC.Types.LT -> + (# + cs_466, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'e'] + #) + GHC.Types.EQ -> + (# + farInp_445, + farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'e'] + #) + GHC.Types.GT -> + (# + farInp_445, + farExp_446 + #) + in readFail_455 cs_466 farInp_483 farExp_484 + else + let _ = "checkToken.else" + in let (# + farInp_485, + farExp_486 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 cs_463 of + GHC.Types.LT -> + (# + cs_463, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'l'] + #) + GHC.Types.EQ -> + (# + farInp_445, + farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'l'] + #) + GHC.Types.GT -> + (# + farInp_445, + farExp_446 + #) + in readFail_455 cs_463 farInp_485 farExp_486 + else + let _ = "checkToken.else" + in let (# + farInp_487, + farExp_488 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 cs_460 of + GHC.Types.LT -> + (# + cs_460, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.EQ -> + (# + farInp_445, + farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.GT -> + (# + farInp_445, + farExp_446 + #) + in readFail_455 cs_460 farInp_487 farExp_488 + else + let _ = "checkToken.else" + in let (# + farInp_489, + farExp_490 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 cs_457 of + GHC.Types.LT -> + (# + cs_457, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'h'] + #) + GHC.Types.EQ -> + (# + farInp_445, + farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'h'] + #) + GHC.Types.GT -> + (# + farInp_445, + farExp_446 + #) + in readFail_455 cs_457 farInp_489 farExp_490 + else + let _ = "checkToken.else" + in let (# + farInp_491, + farExp_492 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 failInp_444 of + GHC.Types.LT -> + (# + failInp_444, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'w'] + #) + GHC.Types.EQ -> + (# + farInp_445, + farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'w'] + #) + GHC.Types.GT -> + (# + farInp_445, + farExp_446 + #) + in readFail_455 failInp_444 farInp_491 farExp_492 + else + let _ = "checkHorizon.else" + in let (# + farInp_493, + farExp_494 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 failInp_444 of + GHC.Types.LT -> + (# + failInp_444, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + #) + GHC.Types.EQ -> + (# + farInp_445, + farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + #) + GHC.Types.GT -> + (# + farInp_445, + farExp_446 + #) + in readFail_455 failInp_444 farInp_493 farExp_494 + else + let _ = "choicesBranch.else" + in let (# + farInp_495, + farExp_496 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 failInp_444 of + GHC.Types.LT -> + (# + failInp_444, + [] + #) + GHC.Types.EQ -> + (# + farInp_445, + farExp_446 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_445, + farExp_446 + #) + in catchHandler_332 failInp_444 farInp_495 farExp_496 + in let _ = "catchException lbl=fail" + in let catchHandler_497 (!failInp_498) (!farInp_499) (!farExp_500) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_501, + farExp_502 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_499 inp_289 of + GHC.Types.LT -> + (# + inp_289, + [] + #) + GHC.Types.EQ -> + (# + farInp_499, + farExp_500 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_499, + farExp_500 + #) + in catchHandler_443 inp_289 farInp_501 farExp_502 + in let readFail_503 = catchHandler_497 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_289) + then + let !(# + c_504, + cs_505 + #) = readNext_3 inp_289 + in if ('i' GHC.Classes.==) c_504 + then + let readFail_506 = readFail_503 + in let !(# + c_507, + cs_508 + #) = readNext_3 cs_505 + in if ('f' GHC.Classes.==) c_507 + then + name_423 + ( let _ = "suspend" + in \farInp_509 farExp_510 v_511 (!inp_512) -> + let _ = "resume" + in join_438 + farInp_509 + farExp_510 + ( let _ = "resume.genCode" + in v_511 + ) + inp_512 + ) + cs_508 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_513, + farExp_514 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_505 of + GHC.Types.LT -> + (# + cs_505, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_503 cs_505 farInp_513 farExp_514 + else + let _ = "checkToken.else" + in let (# + farInp_515, + farExp_516 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_289 of + GHC.Types.LT -> + (# + inp_289, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_503 inp_289 farInp_515 farExp_516 + else + let _ = "checkHorizon.else" + in let (# + farInp_517, + farExp_518 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_289 of + GHC.Types.LT -> + (# + inp_289, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_503 inp_289 farInp_517 farExp_518 + name_85 = \(!ok_519) (!inp_520) (!koByLabel_521) -> + let readFail_522 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_521 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_520) + then + let !(# + c_523, + cs_524 + #) = readNext_3 inp_520 + in if (')' GHC.Classes.==) c_523 + then + name_144 + ( let _ = "suspend" + in \farInp_525 farExp_526 v_527 (!inp_528) -> + let _ = "resume" + in ok_519 + farInp_525 + farExp_526 + ( let _ = "resume.genCode" + in ')' + ) + inp_528 + ) + cs_524 + (Data.Map.Internal.Bin 1 "fail" readFail_522 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_529, + farExp_530 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_520 of + GHC.Types.LT -> + (# + inp_520, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ')'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ')'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_522 inp_520 farInp_529 farExp_530 + else + let _ = "checkHorizon.else" + in let (# + farInp_531, + farExp_532 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_520 of + GHC.Types.LT -> + (# + inp_520, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_522 inp_520 farInp_531 farExp_532 + name_68 = \(!ok_533) (!inp_534) (!koByLabel_535) -> + let readFail_536 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_535 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 4 inp_534) + then + let !(# + c_537, + cs_538 + #) = readNext_3 inp_534 + in if ('[' GHC.Classes.==) c_537 + then + name_144 + ( let _ = "suspend" + in \farInp_539 farExp_540 v_541 (!inp_542) -> + name_543 + ( let _ = "suspend" + in \farInp_544 farExp_545 v_546 (!inp_547) -> + name_548 + ( let _ = "suspend" + in \farInp_549 farExp_550 v_551 (!inp_552) -> + let readFail_553 = readFail_536 + in if readMore_2 inp_552 + then + let !(# + c_554, + cs_555 + #) = readNext_3 inp_552 + in if (']' GHC.Classes.==) c_554 + then + name_144 + ( let _ = "suspend" + in \farInp_556 farExp_557 v_558 (!inp_559) -> + let _ = "resume" + in ok_533 + farInp_556 + farExp_557 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_559 + ) + cs_555 + (Data.Map.Internal.Bin 1 "fail" readFail_553 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_560, + farExp_561 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_549 inp_552 of + GHC.Types.LT -> + (# + inp_552, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] + #) + GHC.Types.EQ -> + (# + farInp_549, + farExp_550 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] + #) + GHC.Types.GT -> + (# + farInp_549, + farExp_550 + #) + in readFail_553 inp_552 farInp_560 farExp_561 + else + let _ = "checkHorizon.else" + in let (# + farInp_562, + farExp_563 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_549 inp_552 of + GHC.Types.LT -> + (# + inp_552, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_549, + farExp_550 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_549, + farExp_550 + #) + in readFail_553 inp_552 farInp_562 farExp_563 + ) + inp_547 + Data.Map.Internal.Tip + ) + inp_542 + (Data.Map.Internal.Bin 1 "fail" readFail_536 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + cs_538 + (Data.Map.Internal.Bin 1 "fail" readFail_536 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_564, + farExp_565 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_534 of + GHC.Types.LT -> + (# + inp_534, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '['] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '['] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_536 inp_534 farInp_564 farExp_565 + else + let _ = "checkHorizon.else" + in let (# + farInp_566, + farExp_567 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_534 of + GHC.Types.LT -> + (# + inp_534, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 5] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 5] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_536 inp_534 farInp_566 farExp_567 + name_75 = \(!ok_568) (!inp_569) (!koByLabel_570) -> + let readFail_571 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_570 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_569) + then + let !(# + c_572, + cs_573 + #) = readNext_3 inp_569 + in if ('(' GHC.Classes.==) c_572 + then + name_144 + ( let _ = "suspend" + in \farInp_574 farExp_575 v_576 (!inp_577) -> + let _ = "resume" + in ok_568 + farInp_574 + farExp_575 + ( let _ = "resume.genCode" + in '(' + ) + inp_577 + ) + cs_573 + (Data.Map.Internal.Bin 1 "fail" readFail_571 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_578, + farExp_579 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_569 of + GHC.Types.LT -> + (# + inp_569, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '('] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '('] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_571 inp_569 farInp_578 farExp_579 + else + let _ = "checkHorizon.else" + in let (# + farInp_580, + farExp_581 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_569 of + GHC.Types.LT -> + (# + inp_569, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_571 inp_569 farInp_580 farExp_581 + name_548 = \(!ok_582) (!inp_583) (!koByLabel_584) -> + let _ = "catchException lbl=fail" + in let catchHandler_585 (!failInp_586) (!farInp_587) (!farExp_588) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_589 + _ + ) + ( Data.Text.Internal.Text + _ + j_590 + _ + ) -> i_589 GHC.Classes.== j_590 + ) + inp_583 + failInp_586 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_582 + farInp_587 + farExp_588 + ( let _ = "resume.genCode" + in \x_591 -> x_591 + ) + failInp_586 + else + let _ = "choicesBranch.else" + in let (# + farInp_592, + farExp_593 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_587 failInp_586 of + GHC.Types.LT -> + (# + failInp_586, + [] + #) + GHC.Types.EQ -> + (# + farInp_587, + farExp_588 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_587, + farExp_588 + #) + in finalRaise_18 failInp_586 farInp_592 farExp_593 + in name_543 + ( let _ = "suspend" + in \farInp_594 farExp_595 v_596 (!inp_597) -> + name_548 + ( let _ = "suspend" + in \farInp_598 farExp_599 v_600 (!inp_601) -> + let _ = "resume" + in ok_582 + farInp_598 + farExp_599 + ( let _ = "resume.genCode" + in \x_602 -> v_600 x_602 + ) + inp_601 + ) + inp_597 + Data.Map.Internal.Tip + ) + inp_583 + (Data.Map.Internal.Bin 1 "fail" catchHandler_585 Data.Map.Internal.Tip Data.Map.Internal.Tip) + name_237 = \(!ok_603) (!inp_604) (!koByLabel_605) -> + let _ = "resume" + in ok_603 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in \x_606 -> \x_607 -> x_607 + ) + inp_604 + name_50 = \(!ok_608) (!inp_609) (!koByLabel_610) -> + let _ = "resume" + in ok_608 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_609 + name_611 = \(!ok_612) (!inp_613) (!koByLabel_614) -> + let _ = "catchException lbl=fail" + in let catchHandler_615 (!failInp_616) (!farInp_617) (!farExp_618) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_619 + _ + ) + ( Data.Text.Internal.Text + _ + j_620 + _ + ) -> i_619 GHC.Classes.== j_620 + ) + inp_613 + failInp_616 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_612 + farInp_617 + farExp_618 + ( let _ = "resume.genCode" + in \x_621 -> x_621 + ) + failInp_616 + else + let _ = "choicesBranch.else" + in let (# + farInp_622, + farExp_623 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_617 failInp_616 of + GHC.Types.LT -> + (# + failInp_616, + [] + #) + GHC.Types.EQ -> + (# + farInp_617, + farExp_618 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_617, + farExp_618 + #) + in finalRaise_18 failInp_616 farInp_622 farExp_623 + in let readFail_624 = catchHandler_615 + in if readMore_2 inp_613 + then + let !(# + c_625, + cs_626 + #) = readNext_3 inp_613 + in if Grammar.Nandlang.nandIdentLetter c_625 + then + name_611 + ( let _ = "suspend" + in \farInp_627 farExp_628 v_629 (!inp_630) -> + let _ = "resume" + in ok_612 + farInp_627 + farExp_628 + ( let _ = "resume.genCode" + in \x_631 -> v_629 x_631 + ) + inp_630 + ) + cs_626 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_632, + farExp_633 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_613 of + GHC.Types.LT -> + (# + inp_613, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identLetter"] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identLetter"] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_624 inp_613 farInp_632 farExp_633 + else + let _ = "checkHorizon.else" + in let (# + farInp_634, + farExp_635 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_613 of + GHC.Types.LT -> + (# + inp_613, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_624 inp_613 farInp_634 farExp_635 + name_636 = \(!ok_637) (!inp_638) (!koByLabel_639) -> + let _ = "catchException lbl=fail" + in let catchHandler_640 (!failInp_641) (!farInp_642) (!farExp_643) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_644 + _ + ) + ( Data.Text.Internal.Text + _ + j_645 + _ + ) -> i_644 GHC.Classes.== j_645 + ) + inp_638 + failInp_641 + then + let _ = "choicesBranch.then" + in let _ = "jump" + in name_50 ok_637 failInp_641 Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp_646, + farExp_647 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_642 failInp_641 of + GHC.Types.LT -> + (# + failInp_641, + [] + #) + GHC.Types.EQ -> + (# + farInp_642, + farExp_643 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_642, + farExp_643 + #) + in finalRaise_18 failInp_641 farInp_646 farExp_647 + in name_277 + ( let _ = "suspend" + in \farInp_648 farExp_649 v_650 (!inp_651) -> + name_50 + ( let _ = "suspend" + in \farInp_652 farExp_653 v_654 (!inp_655) -> + name_656 + ( let _ = "suspend" + in \farInp_657 farExp_658 v_659 (!inp_660) -> + name_50 + ( let _ = "suspend" + in \farInp_661 farExp_662 v_663 (!inp_664) -> + let _ = "resume" + in ok_637 + farInp_661 + farExp_662 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_664 + ) + inp_660 + Data.Map.Internal.Tip + ) + inp_655 + Data.Map.Internal.Tip + ) + inp_651 + Data.Map.Internal.Tip + ) + inp_638 + Data.Map.Internal.Tip + name_320 = \(!ok_665) (!inp_666) (!koByLabel_667) -> + let readFail_668 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_667 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_666) + then + let !(# + c_669, + cs_670 + #) = readNext_3 inp_666 + in if (';' GHC.Classes.==) c_669 + then + name_144 + ( let _ = "suspend" + in \farInp_671 farExp_672 v_673 (!inp_674) -> + let _ = "resume" + in ok_665 + farInp_671 + farExp_672 + ( let _ = "resume.genCode" + in ';' + ) + inp_674 + ) + cs_670 + (Data.Map.Internal.Bin 1 "fail" readFail_668 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_675, + farExp_676 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_666 of + GHC.Types.LT -> + (# + inp_666, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ';'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ';'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_668 inp_666 farInp_675 farExp_676 + else + let _ = "checkHorizon.else" + in let (# + farInp_677, + farExp_678 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_666 of + GHC.Types.LT -> + (# + inp_666, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_668 inp_666 farInp_677 farExp_678 + name_102 = \(!ok_679) (!inp_680) (!koByLabel_681) -> + name_24 + ( let _ = "suspend" + in \farInp_682 farExp_683 v_684 (!inp_685) -> + name_50 + ( let _ = "suspend" + in \farInp_686 farExp_687 v_688 (!inp_689) -> + name_690 + ( let _ = "suspend" + in \farInp_691 farExp_692 v_693 (!inp_694) -> + name_50 + ( let _ = "suspend" + in \farInp_695 farExp_696 v_697 (!inp_698) -> + let _ = "resume" + in ok_679 + farInp_695 + farExp_696 + ( let _ = "resume.genCode" + in v_697 + ) + inp_698 + ) + inp_694 + Data.Map.Internal.Tip + ) + inp_689 + Data.Map.Internal.Tip + ) + inp_685 + Data.Map.Internal.Tip + ) + inp_680 + Data.Map.Internal.Tip + name_699 = \(!ok_700) (!inp_701) (!koByLabel_702) -> + let _ = "catchException lbl=fail" + in let catchHandler_703 (!failInp_704) (!farInp_705) (!farExp_706) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_707 + _ + ) + ( Data.Text.Internal.Text + _ + j_708 + _ + ) -> i_707 GHC.Classes.== j_708 + ) + inp_701 + failInp_704 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_700 + farInp_705 + farExp_706 + ( let _ = "resume.genCode" + in \x_709 -> x_709 + ) + failInp_704 + else + let _ = "choicesBranch.else" + in let (# + farInp_710, + farExp_711 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_705 failInp_704 of + GHC.Types.LT -> + (# + failInp_704, + [] + #) + GHC.Types.EQ -> + (# + farInp_705, + farExp_706 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_705, + farExp_706 + #) + in finalRaise_18 failInp_704 farInp_710 farExp_711 + in let _ = "catchException lbl=fail" + in let catchHandler_712 (!failInp_713) (!farInp_714) (!farExp_715) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_716, + farExp_717 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_714 inp_701 of + GHC.Types.LT -> + (# + inp_701, + [] + #) + GHC.Types.EQ -> + (# + farInp_714, + farExp_715 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_714, + farExp_715 + #) + in catchHandler_703 inp_701 farInp_716 farExp_717 + in let readFail_718 = catchHandler_712 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 17 inp_701) + then + let !(# + c_719, + cs_720 + #) = readNext_3 inp_701 + in if ('f' GHC.Classes.==) c_719 + then + let readFail_721 = readFail_718 + in let !(# + c_722, + cs_723 + #) = readNext_3 cs_720 + in if ('u' GHC.Classes.==) c_722 + then + let readFail_724 = readFail_718 + in let !(# + c_725, + cs_726 + #) = readNext_3 cs_723 + in if ('n' GHC.Classes.==) c_725 + then + let readFail_727 = readFail_718 + in let !(# + c_728, + cs_729 + #) = readNext_3 cs_726 + in if ('c' GHC.Classes.==) c_728 + then + let readFail_730 = readFail_718 + in let !(# + c_731, + cs_732 + #) = readNext_3 cs_729 + in if ('t' GHC.Classes.==) c_731 + then + let readFail_733 = readFail_718 + in let !(# + c_734, + cs_735 + #) = readNext_3 cs_732 + in if ('i' GHC.Classes.==) c_734 + then + let readFail_736 = readFail_718 + in let !(# + c_737, + cs_738 + #) = readNext_3 cs_735 + in if ('o' GHC.Classes.==) c_737 + then + let readFail_739 = readFail_718 + in let !(# + c_740, + cs_741 + #) = readNext_3 cs_738 + in if ('n' GHC.Classes.==) c_740 + then + name_423 + ( let _ = "suspend" + in \farInp_742 farExp_743 v_744 (!inp_745) -> + name_34 + ( let _ = "suspend" + in \farInp_746 farExp_747 v_748 (!inp_749) -> + name_75 + ( let _ = "suspend" + in \farInp_750 farExp_751 v_752 (!inp_753) -> + name_636 + ( let _ = "suspend" + in \farInp_754 farExp_755 v_756 (!inp_757) -> + let join_758 = \farInp_759 farExp_760 v_761 (!inp_762) -> + name_85 + ( let _ = "suspend" + in \farInp_763 farExp_764 v_765 (!inp_766) -> + name_478 + ( let _ = "suspend" + in \farInp_767 farExp_768 v_769 (!inp_770) -> + name_699 + ( let _ = "suspend" + in \farInp_771 farExp_772 v_773 (!inp_774) -> + let _ = "resume" + in ok_700 + farInp_771 + farExp_772 + ( let _ = "resume.genCode" + in \x_775 -> v_773 x_775 + ) + inp_774 + ) + inp_770 + Data.Map.Internal.Tip + ) + inp_766 + (Data.Map.Internal.Bin 1 "fail" catchHandler_703 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp_762 + (Data.Map.Internal.Bin 1 "fail" catchHandler_703 Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let _ = "catchException lbl=fail" + in let catchHandler_776 (!failInp_777) (!farInp_778) (!farExp_779) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_780 + _ + ) + ( Data.Text.Internal.Text + _ + j_781 + _ + ) -> i_780 GHC.Classes.== j_781 + ) + inp_757 + failInp_777 + then + let _ = "choicesBranch.then" + in name_50 + ( let _ = "suspend" + in \farInp_782 farExp_783 v_784 (!inp_785) -> + let _ = "resume" + in join_758 + farInp_782 + farExp_783 + ( let _ = "resume.genCode" + in v_784 + ) + inp_785 + ) + failInp_777 + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp_786, + farExp_787 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_778 failInp_777 of + GHC.Types.LT -> + (# + failInp_777, + [] + #) + GHC.Types.EQ -> + (# + farInp_778, + farExp_779 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_778, + farExp_779 + #) + in catchHandler_703 failInp_777 farInp_786 farExp_787 + in let readFail_788 = catchHandler_776 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_757) + then + let !(# + c_789, + cs_790 + #) = readNext_3 inp_757 + in if (':' GHC.Classes.==) c_789 + then + name_144 + ( let _ = "suspend" + in \farInp_791 farExp_792 v_793 (!inp_794) -> + name_636 + ( let _ = "suspend" + in \farInp_795 farExp_796 v_797 (!inp_798) -> + let _ = "resume" + in join_758 + farInp_795 + farExp_796 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_798 + ) + inp_794 + Data.Map.Internal.Tip + ) + cs_790 + (Data.Map.Internal.Bin 1 "fail" readFail_788 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_799, + farExp_800 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_754 inp_757 of + GHC.Types.LT -> + (# + inp_757, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ':'] + #) + GHC.Types.EQ -> + (# + farInp_754, + farExp_755 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ':'] + #) + GHC.Types.GT -> + (# + farInp_754, + farExp_755 + #) + in readFail_788 inp_757 farInp_799 farExp_800 + else + let _ = "checkHorizon.else" + in let (# + farInp_801, + farExp_802 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_754 inp_757 of + GHC.Types.LT -> + (# + inp_757, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp_754, + farExp_755 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp_754, + farExp_755 + #) + in readFail_788 inp_757 farInp_801 farExp_802 + ) + inp_753 + Data.Map.Internal.Tip + ) + inp_749 + (Data.Map.Internal.Bin 1 "fail" catchHandler_703 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp_745 + Data.Map.Internal.Tip + ) + cs_741 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_803, + farExp_804 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_738 of + GHC.Types.LT -> + (# + cs_738, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_718 cs_738 farInp_803 farExp_804 + else + let _ = "checkToken.else" + in let (# + farInp_805, + farExp_806 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_735 of + GHC.Types.LT -> + (# + cs_735, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'o'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'o'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_718 cs_735 farInp_805 farExp_806 + else + let _ = "checkToken.else" + in let (# + farInp_807, + farExp_808 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_732 of + GHC.Types.LT -> + (# + cs_732, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_718 cs_732 farInp_807 farExp_808 + else + let _ = "checkToken.else" + in let (# + farInp_809, + farExp_810 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_729 of + GHC.Types.LT -> + (# + cs_729, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 't'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 't'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_718 cs_729 farInp_809 farExp_810 + else + let _ = "checkToken.else" + in let (# + farInp_811, + farExp_812 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_726 of + GHC.Types.LT -> + (# + cs_726, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_718 cs_726 farInp_811 farExp_812 + else + let _ = "checkToken.else" + in let (# + farInp_813, + farExp_814 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_723 of + GHC.Types.LT -> + (# + cs_723, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_718 cs_723 farInp_813 farExp_814 + else + let _ = "checkToken.else" + in let (# + farInp_815, + farExp_816 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_720 of + GHC.Types.LT -> + (# + cs_720, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'u'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'u'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_718 cs_720 farInp_815 farExp_816 + else + let _ = "checkToken.else" + in let (# + farInp_817, + farExp_818 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_701 of + GHC.Types.LT -> + (# + inp_701, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_718 inp_701 farInp_817 farExp_818 + else + let _ = "checkHorizon.else" + in let (# + farInp_819, + farExp_820 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_701 of + GHC.Types.LT -> + (# + inp_701, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 18] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 18] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_718 inp_701 farInp_819 farExp_820 + name_34 = \(!ok_821) (!inp_822) (!koByLabel_823) -> + let _ = "catchException lbl=fail" + in let catchHandler_824 (!failInp_825) (!farInp_826) (!farExp_827) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_828, + farExp_829 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_826 inp_822 of + GHC.Types.LT -> + (# + inp_822, + [] + #) + GHC.Types.EQ -> + (# + farInp_826, + farExp_827 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_826, + farExp_827 + #) + in finalRaise_18 inp_822 farInp_828 farExp_829 + in let readFail_830 = catchHandler_824 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_822) + then + let !(# + c_831, + cs_832 + #) = readNext_3 inp_822 + in if Grammar.Nandlang.nandIdentStart c_831 + then + name_50 + ( let _ = "suspend" + in \farInp_833 farExp_834 v_835 (!inp_836) -> + name_611 + ( let _ = "suspend" + in \farInp_837 farExp_838 v_839 (!inp_840) -> + name_50 + ( let _ = "suspend" + in \farInp_841 farExp_842 v_843 (!inp_844) -> + name_144 + ( let _ = "suspend" + in \farInp_845 farExp_846 v_847 (!inp_848) -> + let _ = "resume" + in ok_821 + farInp_845 + farExp_846 + ( let _ = "resume.genCode" + in v_847 + ) + inp_848 + ) + inp_844 + Data.Map.Internal.Tip + ) + inp_840 + Data.Map.Internal.Tip + ) + inp_836 + Data.Map.Internal.Tip + ) + cs_832 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_849, + farExp_850 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_822 of + GHC.Types.LT -> + (# + inp_822, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identStart"] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identStart"] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_830 inp_822 farInp_849 farExp_850 + else + let _ = "checkHorizon.else" + in let (# + farInp_851, + farExp_852 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_822 of + GHC.Types.LT -> + (# + inp_822, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_830 inp_822 farInp_851 farExp_852 + name_478 = \(!ok_853) (!inp_854) (!koByLabel_855) -> + let readFail_856 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_855 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_854) + then + let !(# + c_857, + cs_858 + #) = readNext_3 inp_854 + in if ('{' GHC.Classes.==) c_857 + then + name_144 + ( let _ = "suspend" + in \farInp_859 farExp_860 v_861 (!inp_862) -> + name_50 + ( let _ = "suspend" + in \farInp_863 farExp_864 v_865 (!inp_866) -> + name_287 + ( let _ = "suspend" + in \farInp_867 farExp_868 v_869 (!inp_870) -> + name_50 + ( let _ = "suspend" + in \farInp_871 farExp_872 v_873 (!inp_874) -> + let readFail_875 = readFail_856 + in if readMore_2 inp_874 + then + let !(# + c_876, + cs_877 + #) = readNext_3 inp_874 + in if ('}' GHC.Classes.==) c_876 + then + name_144 + ( let _ = "suspend" + in \farInp_878 farExp_879 v_880 (!inp_881) -> + let _ = "resume" + in ok_853 + farInp_878 + farExp_879 + ( let _ = "resume.genCode" + in v_873 + ) + inp_881 + ) + cs_877 + (Data.Map.Internal.Bin 1 "fail" readFail_875 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_882, + farExp_883 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_871 inp_874 of + GHC.Types.LT -> + (# + inp_874, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '}'] + #) + GHC.Types.EQ -> + (# + farInp_871, + farExp_872 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '}'] + #) + GHC.Types.GT -> + (# + farInp_871, + farExp_872 + #) + in readFail_875 inp_874 farInp_882 farExp_883 + else + let _ = "checkHorizon.else" + in let (# + farInp_884, + farExp_885 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_871 inp_874 of + GHC.Types.LT -> + (# + inp_874, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_871, + farExp_872 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_871, + farExp_872 + #) + in readFail_875 inp_874 farInp_884 farExp_885 + ) + inp_870 + Data.Map.Internal.Tip + ) + inp_866 + Data.Map.Internal.Tip + ) + inp_862 + Data.Map.Internal.Tip + ) + cs_858 + (Data.Map.Internal.Bin 1 "fail" readFail_856 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_886, + farExp_887 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_854 of + GHC.Types.LT -> + (# + inp_854, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '{'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '{'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_856 inp_854 farInp_886 farExp_887 + else + let _ = "checkHorizon.else" + in let (# + farInp_888, + farExp_889 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_854 of + GHC.Types.LT -> + (# + inp_854, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_856 inp_854 farInp_888 farExp_889 + name_656 = \(!ok_890) (!inp_891) (!koByLabel_892) -> + let _ = "catchException lbl=fail" + in let catchHandler_893 (!failInp_894) (!farInp_895) (!farExp_896) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_897 + _ + ) + ( Data.Text.Internal.Text + _ + j_898 + _ + ) -> i_897 GHC.Classes.== j_898 + ) + inp_891 + failInp_894 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_890 + farInp_895 + farExp_896 + ( let _ = "resume.genCode" + in \x_899 -> x_899 + ) + failInp_894 + else + let _ = "choicesBranch.else" + in let (# + farInp_900, + farExp_901 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_895 failInp_894 of + GHC.Types.LT -> + (# + failInp_894, + [] + #) + GHC.Types.EQ -> + (# + farInp_895, + farExp_896 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_895, + farExp_896 + #) + in finalRaise_18 failInp_894 farInp_900 farExp_901 + in name_237 + ( let _ = "suspend" + in \farInp_902 farExp_903 v_904 (!inp_905) -> + name_242 + ( let _ = "suspend" + in \farInp_906 farExp_907 v_908 (!inp_909) -> + name_277 + ( let _ = "suspend" + in \farInp_910 farExp_911 v_912 (!inp_913) -> + name_656 + ( let _ = "suspend" + in \farInp_914 farExp_915 v_916 (!inp_917) -> + let _ = "resume" + in ok_890 + farInp_914 + farExp_915 + ( let _ = "resume.genCode" + in \x_918 -> v_904 v_912 (v_916 x_918) + ) + inp_917 + ) + inp_913 + Data.Map.Internal.Tip + ) + inp_909 + Data.Map.Internal.Tip + ) + inp_905 + (Data.Map.Internal.Bin 1 "fail" catchHandler_893 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp_891 + Data.Map.Internal.Tip + name_423 = \(!ok_919) (!inp_920) (!koByLabel_921) -> + let _ = "resume" + in ok_919 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_920 + name_922 = \(!ok_923) (!inp_924) (!koByLabel_925) -> + let _ = "catchException lbl=fail" + in let catchHandler_926 (!failInp_927) (!farInp_928) (!farExp_929) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_930 + _ + ) + ( Data.Text.Internal.Text + _ + j_931 + _ + ) -> i_930 GHC.Classes.== j_931 + ) + inp_924 + failInp_927 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_923 + farInp_928 + farExp_929 + ( let _ = "resume.genCode" + in \x_932 -> x_932 + ) + failInp_927 + else + let _ = "choicesBranch.else" + in let (# + farInp_933, + farExp_934 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_928 failInp_927 of + GHC.Types.LT -> + (# + failInp_927, + [] + #) + GHC.Types.EQ -> + (# + farInp_928, + farExp_929 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_928, + farExp_929 + #) + in finalRaise_18 failInp_927 farInp_933 farExp_934 + in name_935 + ( let _ = "suspend" + in \farInp_936 farExp_937 v_938 (!inp_939) -> + name_922 + ( let _ = "suspend" + in \farInp_940 farExp_941 v_942 (!inp_943) -> + let _ = "resume" + in ok_923 + farInp_940 + farExp_941 + ( let _ = "resume.genCode" + in \x_944 -> v_942 x_944 + ) + inp_943 + ) + inp_939 + Data.Map.Internal.Tip + ) + inp_924 + (Data.Map.Internal.Bin 1 "fail" catchHandler_926 Data.Map.Internal.Tip Data.Map.Internal.Tip) + name_935 = \(!ok_945) (!inp_946) (!koByLabel_947) -> + let readFail_948 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_947 + in if readMore_2 inp_946 + then + let !(# + c_949, + cs_950 + #) = readNext_3 inp_946 + in if GHC.Unicode.isSpace c_949 + then + name_50 + ( let _ = "suspend" + in \farInp_951 farExp_952 v_953 (!inp_954) -> + let _ = "resume" + in ok_945 + farInp_951 + farExp_952 + ( let _ = "resume.genCode" + in v_953 + ) + inp_954 + ) + cs_950 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_955, + farExp_956 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_946 of + GHC.Types.LT -> + (# + inp_946, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "space"] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "space"] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_948 inp_946 farInp_955 farExp_956 + else + let _ = "checkHorizon.else" + in let (# + farInp_957, + farExp_958 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_946 of + GHC.Types.LT -> + (# + inp_946, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_948 inp_946 farInp_957 farExp_958 + name_690 = \(!ok_959) (!inp_960) (!koByLabel_961) -> + let _ = "catchException lbl=fail" + in let catchHandler_962 (!failInp_963) (!farInp_964) (!farExp_965) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_966 + _ + ) + ( Data.Text.Internal.Text + _ + j_967 + _ + ) -> i_966 GHC.Classes.== j_967 + ) + inp_960 + failInp_963 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_959 + farInp_964 + farExp_965 + ( let _ = "resume.genCode" + in \x_968 -> x_968 + ) + failInp_963 + else + let _ = "choicesBranch.else" + in let (# + farInp_969, + farExp_970 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_964 failInp_963 of + GHC.Types.LT -> + (# + failInp_963, + [] + #) + GHC.Types.EQ -> + (# + farInp_964, + farExp_965 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_964, + farExp_965 + #) + in finalRaise_18 failInp_963 farInp_969 farExp_970 + in let readFail_971 = catchHandler_962 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_960) + then + let !(# + c_972, + cs_973 + #) = readNext_3 inp_960 + in if ('!' GHC.Classes.==) c_972 + then + name_144 + ( let _ = "suspend" + in \farInp_974 farExp_975 v_976 (!inp_977) -> + name_24 + ( let _ = "suspend" + in \farInp_978 farExp_979 v_980 (!inp_981) -> + name_690 + ( let _ = "suspend" + in \farInp_982 farExp_983 v_984 (!inp_985) -> + let _ = "resume" + in ok_959 + farInp_982 + farExp_983 + ( let _ = "resume.genCode" + in \x_986 -> v_984 x_986 + ) + inp_985 + ) + inp_981 + Data.Map.Internal.Tip + ) + inp_977 + Data.Map.Internal.Tip + ) + cs_973 + (Data.Map.Internal.Bin 1 "fail" readFail_971 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_987, + farExp_988 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_960 of + GHC.Types.LT -> + (# + inp_960, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '!'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '!'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_971 inp_960 farInp_987 farExp_988 + else + let _ = "checkHorizon.else" + in let (# + farInp_989, + farExp_990 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_960 of + GHC.Types.LT -> + (# + inp_960, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_971 inp_960 farInp_989 farExp_990 + name_242 = \(!ok_991) (!inp_992) (!koByLabel_993) -> + let readFail_994 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_993 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_992) + then + let !(# + c_995, + cs_996 + #) = readNext_3 inp_992 + in if (',' GHC.Classes.==) c_995 + then + name_144 + ( let _ = "suspend" + in \farInp_997 farExp_998 v_999 (!inp_1000) -> + let _ = "resume" + in ok_991 + farInp_997 + farExp_998 + ( let _ = "resume.genCode" + in ',' + ) + inp_1000 + ) + cs_996 + (Data.Map.Internal.Bin 1 "fail" readFail_994 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp_1001, + farExp_1002 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_992 of + GHC.Types.LT -> + (# + inp_992, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ','] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ','] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_994 inp_992 farInp_1001 farExp_1002 + else + let _ = "checkHorizon.else" + in let (# + farInp_1003, + farExp_1004 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_992 of + GHC.Types.LT -> + (# + inp_992, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_994 inp_992 farInp_1003 farExp_1004 + name_277 = \(!ok_1005) (!inp_1006) (!koByLabel_1007) -> + name_34 + ( let _ = "suspend" + in \farInp_1008 farExp_1009 v_1010 (!inp_1011) -> + let join_1012 = \farInp_1013 farExp_1014 v_1015 (!inp_1016) -> + let _ = "resume" + in ok_1005 + farInp_1013 + farExp_1014 + ( let _ = "resume.genCode" + in v_1015 + ) + inp_1016 + in let _ = "catchException lbl=fail" + in let catchHandler_1017 (!failInp_1018) (!farInp_1019) (!farExp_1020) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_1021 + _ + ) + ( Data.Text.Internal.Text + _ + j_1022 + _ + ) -> i_1021 GHC.Classes.== j_1022 + ) + inp_1011 + failInp_1018 + then + let _ = "choicesBranch.then" + in name_50 + ( let _ = "suspend" + in \farInp_1023 farExp_1024 v_1025 (!inp_1026) -> + let _ = "resume" + in join_1012 + farInp_1023 + farExp_1024 + ( let _ = "resume.genCode" + in v_1025 + ) + inp_1026 + ) + failInp_1018 + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp_1027, + farExp_1028 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1019 failInp_1018 of + GHC.Types.LT -> + (# + failInp_1018, + [] + #) + GHC.Types.EQ -> + (# + farInp_1019, + farExp_1020 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_1019, + farExp_1020 + #) + in finalRaise_18 failInp_1018 farInp_1027 farExp_1028 + in name_68 + ( let _ = "suspend" + in \farInp_1029 farExp_1030 v_1031 (!inp_1032) -> + let _ = "resume" + in join_1012 + farInp_1029 + farExp_1030 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_1032 + ) + inp_1011 + (Data.Map.Internal.Bin 1 "fail" catchHandler_1017 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp_1006 + Data.Map.Internal.Tip + name_543 = \(!ok_1033) (!inp_1034) (!koByLabel_1035) -> + let readFail_1036 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_1035 + in if readMore_2 inp_1034 + then + let !(# + c_1037, + cs_1038 + #) = readNext_3 inp_1034 + in if (\t_1039 -> ('0' GHC.Classes.== t_1039) GHC.Classes.|| (('1' GHC.Classes.== t_1039) GHC.Classes.|| (('2' GHC.Classes.== t_1039) GHC.Classes.|| (('3' GHC.Classes.== t_1039) GHC.Classes.|| (('4' GHC.Classes.== t_1039) GHC.Classes.|| (('5' GHC.Classes.== t_1039) GHC.Classes.|| (('6' GHC.Classes.== t_1039) GHC.Classes.|| (('7' GHC.Classes.== t_1039) GHC.Classes.|| (('8' GHC.Classes.== t_1039) GHC.Classes.|| (('9' GHC.Classes.== t_1039) GHC.Classes.|| GHC.Types.False)))))))))) c_1037 + then + let _ = "resume" + in ok_1033 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in c_1037 + ) + cs_1038 + else + let _ = "checkToken.else" + in let (# + farInp_1040, + farExp_1041 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_1034 of + GHC.Types.LT -> + (# + inp_1034, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_1036 inp_1034 farInp_1040 farExp_1041 + else + let _ = "checkHorizon.else" + in let (# + farInp_1042, + farExp_1043 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_1034 of + GHC.Types.LT -> + (# + inp_1034, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_1036 inp_1034 farInp_1042 farExp_1043 + name_111 = \(!ok_1044) (!inp_1045) (!koByLabel_1046) -> + let _ = "catchException lbl=fail" + in let catchHandler_1047 (!failInp_1048) (!farInp_1049) (!farExp_1050) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_1051 + _ + ) + ( Data.Text.Internal.Text + _ + j_1052 + _ + ) -> i_1051 GHC.Classes.== j_1052 + ) + inp_1045 + failInp_1048 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_1044 + farInp_1049 + farExp_1050 + ( let _ = "resume.genCode" + in \x_1053 -> x_1053 + ) + failInp_1048 + else + let _ = "choicesBranch.else" + in let (# + farInp_1054, + farExp_1055 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1049 failInp_1048 of + GHC.Types.LT -> + (# + failInp_1048, + [] + #) + GHC.Types.EQ -> + (# + farInp_1049, + farExp_1050 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_1049, + farExp_1050 + #) + in finalRaise_18 failInp_1048 farInp_1054 farExp_1055 + in name_237 + ( let _ = "suspend" + in \farInp_1056 farExp_1057 v_1058 (!inp_1059) -> + name_242 + ( let _ = "suspend" + in \farInp_1060 farExp_1061 v_1062 (!inp_1063) -> + name_102 + ( let _ = "suspend" + in \farInp_1064 farExp_1065 v_1066 (!inp_1067) -> + name_111 + ( let _ = "suspend" + in \farInp_1068 farExp_1069 v_1070 (!inp_1071) -> + let _ = "resume" + in ok_1044 + farInp_1068 + farExp_1069 + ( let _ = "resume.genCode" + in \x_1072 -> v_1058 v_1066 (v_1070 x_1072) + ) + inp_1071 + ) + inp_1067 + Data.Map.Internal.Tip + ) + inp_1063 + Data.Map.Internal.Tip + ) + inp_1059 + (Data.Map.Internal.Bin 1 "fail" catchHandler_1047 Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp_1045 + Data.Map.Internal.Tip + name_144 = \(!ok_1073) (!inp_1074) (!koByLabel_1075) -> + name_935 + ( let _ = "suspend" + in \farInp_1076 farExp_1077 v_1078 (!inp_1079) -> + name_922 + ( let _ = "suspend" + in \farInp_1080 farExp_1081 v_1082 (!inp_1083) -> + let _ = "resume" + in ok_1073 + farInp_1080 + farExp_1081 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_1083 + ) + inp_1079 + Data.Map.Internal.Tip + ) + inp_1074 + (Data.Map.Internal.Bin 1 "fail" (Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_1075) Data.Map.Internal.Tip Data.Map.Internal.Tip) + in name_144 + ( let _ = "suspend" + in \farInp_1084 farExp_1085 v_1086 (!inp_1087) -> + name_50 + ( let _ = "suspend" + in \farInp_1088 farExp_1089 v_1090 (!inp_1091) -> + name_699 + ( let _ = "suspend" + in \farInp_1092 farExp_1093 v_1094 (!inp_1095) -> + name_50 + ( let _ = "suspend" + in \farInp_1096 farExp_1097 v_1098 (!inp_1099) -> + let join_1100 = \farInp_1101 farExp_1102 v_1103 (!inp_1104) -> + let _ = "resume" + in finalRet_13 + farInp_1101 + farExp_1102 + ( let _ = "resume.genCode" + in v_1098 + ) + inp_1104 + in let _ = "catchException lbl=fail" + in let catchHandler_1105 (!failInp_1106) (!farInp_1107) (!farExp_1108) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_1109 + _ + ) + ( Data.Text.Internal.Text + _ + j_1110 + _ + ) -> i_1109 GHC.Classes.== j_1110 + ) + inp_1099 + failInp_1106 + then + let _ = "choicesBranch.then" + in let (# + farInp_1111, + farExp_1112 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1107 failInp_1106 of + GHC.Types.LT -> + (# + failInp_1106, + [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.EQ -> + (# + farInp_1107, + farExp_1108 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.GT -> + (# + farInp_1107, + farExp_1108 + #) + in finalRaise_18 failInp_1106 farInp_1111 farExp_1112 + else + let _ = "choicesBranch.else" + in let (# + farInp_1113, + farExp_1114 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1107 failInp_1106 of + GHC.Types.LT -> + (# + failInp_1106, + [] + #) + GHC.Types.EQ -> + (# + farInp_1107, + farExp_1108 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_1107, + farExp_1108 + #) + in finalRaise_18 failInp_1106 farInp_1113 farExp_1114 + in let _ = "catchException lbl=fail" + in let catchHandler_1115 (!failInp_1116) (!farInp_1117) (!farExp_1118) = + let _ = "catchException.ko lbl=fail" + in let _ = "resume" + in join_1100 + farInp_1117 + farExp_1118 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_1099 + in let readFail_1119 = catchHandler_1115 + in if readMore_2 inp_1099 + then + let !(# + c_1120, + cs_1121 + #) = readNext_3 inp_1099 + in if (\x_1122 -> GHC.Types.True) c_1120 + then + let (# + farInp_1123, + farExp_1124 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1096 inp_1099 of + GHC.Types.LT -> + (# + inp_1099, + [] + #) + GHC.Types.EQ -> + (# + farInp_1096, + farExp_1097 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_1096, + farExp_1097 + #) + in catchHandler_1105 inp_1099 farInp_1123 farExp_1124 + else + let _ = "checkToken.else" + in let (# + farInp_1125, + farExp_1126 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1096 inp_1099 of + GHC.Types.LT -> + (# + inp_1099, + [] + #) + GHC.Types.EQ -> + (# + farInp_1096, + farExp_1097 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_1096, + farExp_1097 + #) + in readFail_1119 inp_1099 farInp_1125 farExp_1126 + else + let _ = "checkHorizon.else" + in let (# + farInp_1127, + farExp_1128 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1096 inp_1099 of + GHC.Types.LT -> + (# + inp_1099, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_1096, + farExp_1097 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_1096, + farExp_1097 + #) + in readFail_1119 inp_1099 farInp_1127 farExp_1128 + ) + inp_1095 + Data.Map.Internal.Tip + ) + inp_1091 + Data.Map.Internal.Tip + ) + inp_1087 + Data.Map.Internal.Tip + ) + init_1 + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G15.expected.txt b/test/Golden/Splice/G15.expected.txt new file mode 100644 index 0000000..057616d --- /dev/null +++ b/test/Golden/Splice/G15.expected.txt @@ -0,0 +1,279 @@ +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let + in let join_24 = \farInp_25 farExp_26 v_27 (!inp_28) -> + let readFail_29 = finalRaise_18 + in if readMore_2 inp_28 + then + let !(# + c_30, + cs_31 + #) = readNext_3 inp_28 + in if ('c' GHC.Classes.==) c_30 + then + let _ = "resume" + in finalRet_13 + farInp_25 + farExp_26 + ( let _ = "resume.genCode" + in v_27 + ) + cs_31 + else + let _ = "checkToken.else" + in let (# + farInp_32, + farExp_33 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_25 inp_28 of + GHC.Types.LT -> + (# + inp_28, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.EQ -> + (# + farInp_25, + farExp_26 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.GT -> + (# + farInp_25, + farExp_26 + #) + in finalRaise_18 inp_28 farInp_32 farExp_33 + else + let _ = "checkHorizon.else" + in let (# + farInp_34, + farExp_35 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_25 inp_28 of + GHC.Types.LT -> + (# + inp_28, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_25, + farExp_26 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_25, + farExp_26 + #) + in finalRaise_18 inp_28 farInp_34 farExp_35 + in let _ = "catchException lbl=fail" + in let catchHandler_36 (!failInp_37) (!farInp_38) (!farExp_39) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_40 + _ + ) + ( Data.Text.Internal.Text + _ + j_41 + _ + ) -> i_40 GHC.Classes.== j_41 + ) + init_1 + failInp_37 + then + let _ = "choicesBranch.then" + in let readFail_42 = finalRaise_18 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_37) + then + let !(# + c_43, + cs_44 + #) = readNext_3 failInp_37 + in if ('b' GHC.Classes.==) c_43 + then + let _ = "resume" + in join_24 + farInp_38 + farExp_39 + ( let _ = "resume.genCode" + in 'b' + ) + cs_44 + else + let _ = "checkToken.else" + in let (# + farInp_45, + farExp_46 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + GHC.Types.LT -> + (# + failInp_37, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + farInp_38, + farExp_39 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + farInp_38, + farExp_39 + #) + in finalRaise_18 failInp_37 farInp_45 farExp_46 + else + let _ = "checkHorizon.else" + in let (# + farInp_47, + farExp_48 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + GHC.Types.LT -> + (# + failInp_37, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp_38, + farExp_39 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp_38, + farExp_39 + #) + in finalRaise_18 failInp_37 farInp_47 farExp_48 + else + let _ = "choicesBranch.else" + in let (# + farInp_49, + farExp_50 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + GHC.Types.LT -> + (# + failInp_37, + [] + #) + GHC.Types.EQ -> + (# + farInp_38, + farExp_39 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_38, + farExp_39 + #) + in finalRaise_18 failInp_37 farInp_49 farExp_50 + in let readFail_51 = catchHandler_36 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 init_1) + then + let !(# + c_52, + cs_53 + #) = readNext_3 init_1 + in if ('a' GHC.Classes.==) c_52 + then + let _ = "resume" + in join_24 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' + ) + cs_53 + else + let _ = "checkToken.else" + in let (# + farInp_54, + farExp_55 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_51 init_1 farInp_54 farExp_55 + else + let _ = "checkHorizon.else" + in let (# + farInp_56, + farExp_57 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_51 init_1 farInp_56 farExp_57 diff --git a/test/Golden/Splice/G16.expected.txt b/test/Golden/Splice/G16.expected.txt new file mode 100644 index 0000000..e1399e8 --- /dev/null +++ b/test/Golden/Splice/G16.expected.txt @@ -0,0 +1,389 @@ +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let + in let join_24 = \farInp_25 farExp_26 v_27 (!inp_28) -> + let readFail_29 = finalRaise_18 + in if readMore_2 inp_28 + then + let !(# + c_30, + cs_31 + #) = readNext_3 inp_28 + in if ('d' GHC.Classes.==) c_30 + then + let _ = "resume" + in finalRet_13 + farInp_25 + farExp_26 + ( let _ = "resume.genCode" + in v_27 + ) + cs_31 + else + let _ = "checkToken.else" + in let (# + farInp_32, + farExp_33 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_25 inp_28 of + GHC.Types.LT -> + (# + inp_28, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] + #) + GHC.Types.EQ -> + (# + farInp_25, + farExp_26 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] + #) + GHC.Types.GT -> + (# + farInp_25, + farExp_26 + #) + in finalRaise_18 inp_28 farInp_32 farExp_33 + else + let _ = "checkHorizon.else" + in let (# + farInp_34, + farExp_35 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_25 inp_28 of + GHC.Types.LT -> + (# + inp_28, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_25, + farExp_26 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_25, + farExp_26 + #) + in finalRaise_18 inp_28 farInp_34 farExp_35 + in let _ = "catchException lbl=fail" + in let catchHandler_36 (!failInp_37) (!farInp_38) (!farExp_39) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_40 + _ + ) + ( Data.Text.Internal.Text + _ + j_41 + _ + ) -> i_40 GHC.Classes.== j_41 + ) + init_1 + failInp_37 + then + let _ = "choicesBranch.then" + in let readFail_42 = finalRaise_18 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_37) + then + let !(# + c_43, + cs_44 + #) = readNext_3 failInp_37 + in if ('c' GHC.Classes.==) c_43 + then + let _ = "resume" + in join_24 + farInp_38 + farExp_39 + ( let _ = "resume.genCode" + in 'c' + ) + cs_44 + else + let _ = "checkToken.else" + in let (# + farInp_45, + farExp_46 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + GHC.Types.LT -> + (# + failInp_37, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.EQ -> + (# + farInp_38, + farExp_39 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.GT -> + (# + farInp_38, + farExp_39 + #) + in finalRaise_18 failInp_37 farInp_45 farExp_46 + else + let _ = "checkHorizon.else" + in let (# + farInp_47, + farExp_48 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + GHC.Types.LT -> + (# + failInp_37, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp_38, + farExp_39 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp_38, + farExp_39 + #) + in finalRaise_18 failInp_37 farInp_47 farExp_48 + else + let _ = "choicesBranch.else" + in let (# + farInp_49, + farExp_50 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + GHC.Types.LT -> + (# + failInp_37, + [] + #) + GHC.Types.EQ -> + (# + farInp_38, + farExp_39 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_38, + farExp_39 + #) + in finalRaise_18 failInp_37 farInp_49 farExp_50 + in let join_51 = \farInp_52 farExp_53 v_54 (!inp_55) -> + let _ = "resume" + in join_24 + farInp_52 + farExp_53 + ( let _ = "resume.genCode" + in v_54 + ) + inp_55 + in let _ = "catchException lbl=fail" + in let catchHandler_56 (!failInp_57) (!farInp_58) (!farExp_59) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_60 + _ + ) + ( Data.Text.Internal.Text + _ + j_61 + _ + ) -> i_60 GHC.Classes.== j_61 + ) + init_1 + failInp_57 + then + let _ = "choicesBranch.then" + in let readFail_62 = catchHandler_36 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_57) + then + let !(# + c_63, + cs_64 + #) = readNext_3 failInp_57 + in if ('b' GHC.Classes.==) c_63 + then + let _ = "resume" + in join_51 + farInp_58 + farExp_59 + ( let _ = "resume.genCode" + in 'b' + ) + cs_64 + else + let _ = "checkToken.else" + in let (# + farInp_65, + farExp_66 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_58 failInp_57 of + GHC.Types.LT -> + (# + failInp_57, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + farInp_58, + farExp_59 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + farInp_58, + farExp_59 + #) + in readFail_62 failInp_57 farInp_65 farExp_66 + else + let _ = "checkHorizon.else" + in let (# + farInp_67, + farExp_68 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_58 failInp_57 of + GHC.Types.LT -> + (# + failInp_57, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp_58, + farExp_59 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp_58, + farExp_59 + #) + in readFail_62 failInp_57 farInp_67 farExp_68 + else + let _ = "choicesBranch.else" + in let (# + farInp_69, + farExp_70 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_58 failInp_57 of + GHC.Types.LT -> + (# + failInp_57, + [] + #) + GHC.Types.EQ -> + (# + farInp_58, + farExp_59 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_58, + farExp_59 + #) + in catchHandler_36 failInp_57 farInp_69 farExp_70 + in let readFail_71 = catchHandler_56 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 init_1) + then + let !(# + c_72, + cs_73 + #) = readNext_3 init_1 + in if ('a' GHC.Classes.==) c_72 + then + let _ = "resume" + in join_51 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' + ) + cs_73 + else + let _ = "checkToken.else" + in let (# + farInp_74, + farExp_75 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_71 init_1 farInp_74 farExp_75 + else + let _ = "checkHorizon.else" + in let (# + farInp_76, + farExp_77 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_71 init_1 farInp_76 farExp_77 diff --git a/test/Golden/Splice/G2.expected.txt b/test/Golden/Splice/G2.expected.txt index b288272..817177e 100644 --- a/test/Golden/Splice/G2.expected.txt +++ b/test/Golden/Splice/G2.expected.txt @@ -1,100 +1,197 @@ -test/Golden/Splice/G2.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g2 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let + in let _ = "catchException lbl=fail" + in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_28, + farExp_29 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 init_1 of + GHC.Types.LT -> + (# + init_1, + [] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 init_1 farInp_28 farExp_29 + in let readFail_30 = catchHandler_24 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 2 init_1) + then + let !(# + c_31, + cs_32 + #) = readNext_3 init_1 + in if ('a' GHC.Classes.==) c_31 + then + let readFail_33 = readFail_30 + in let !(# + c_34, + cs_35 + #) = readNext_3 cs_32 + in if ('b' GHC.Classes.==) c_34 + then + let readFail_36 = readFail_30 + in let !(# + c_37, + cs_38 + #) = readNext_3 cs_35 + in if ('c' GHC.Classes.==) c_37 + then + let _ = "resume" + in finalRet_13 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: GHC.Types . [])) + ) + cs_38 + else + let _ = "checkToken.else" + in let (# + farInp_39, + farExp_40 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_35 of + GHC.Types.LT -> + (# + cs_35, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_30 cs_35 farInp_39 farExp_40 else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) init of - LT -> (# init, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((finalRaise init) farInp) farExp - in - if readMore ((P.shiftRightText 2) init) then - let !(# c, cs #) = readNext init - in - if ('a' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('b' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('c' ==) c then - let _ = "resume" - in - (((finalRet init) []) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x - -> \ x -> \ x -> ('a' : ('b' : ('c' : []))))) - c)) - c)) - c)) - cs - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) cs of - LT -> (# cs, [P.ErrorItemToken 'c'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'c']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) cs of - LT -> (# cs, [P.ErrorItemToken 'b'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'b']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemHorizon 3] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 3]) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp + let _ = "checkToken.else" + in let (# + farInp_41, + farExp_42 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_32 of + GHC.Types.LT -> + (# + cs_32, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_30 cs_32 farInp_41 farExp_42 + else + let _ = "checkToken.else" + in let (# + farInp_43, + farExp_44 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_30 init_1 farInp_43 farExp_44 + else + let _ = "checkHorizon.else" + in let (# + farInp_45, + farExp_46 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 3] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 3] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_30 init_1 farInp_45 farExp_46 diff --git a/test/Golden/Splice/G3.expected.txt b/test/Golden/Splice/G3.expected.txt index ad0eb94..7908b13 100644 --- a/test/Golden/Splice/G3.expected.txt +++ b/test/Golden/Splice/G3.expected.txt @@ -1,121 +1,185 @@ -test/Golden/Splice/G3.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g3 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) (let _ = "resume.genCode" in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if ('a' ==) c then - let - _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x -> \ x -> \ x -> ('a' : x x))) - c)) - v)) - inp)) - cs) - (((((Data.Map.Internal.Bin 1) "fail") readFail) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip) - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp in - let - _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in ((\ x -> \ x -> x x) (\ x -> x [])) v)) - inp)) - init) - Data.Map.Internal.Tip +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + let _ = "catchException lbl=fail" + in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_32 + _ + ) + ( Data.Text.Internal.Text + _ + j_33 + _ + ) -> i_32 GHC.Classes.== j_33 + ) + inp_26 + failInp_29 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_25 + farInp_30 + farExp_31 + ( let _ = "resume.genCode" + in \x_34 -> x_34 + ) + failInp_29 + else + let _ = "choicesBranch.else" + in let (# + farInp_35, + farExp_36 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + GHC.Types.LT -> + (# + failInp_29, + [] + #) + GHC.Types.EQ -> + (# + farInp_30, + farExp_31 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_30, + farExp_31 + #) + in finalRaise_18 failInp_29 farInp_35 farExp_36 + in let readFail_37 = catchHandler_28 + in if readMore_2 inp_26 + then + let !(# + c_38, + cs_39 + #) = readNext_3 inp_26 + in if ('a' GHC.Classes.==) c_38 + then + name_24 + ( let _ = "suspend" + in \farInp_40 farExp_41 v_42 (!inp_43) -> + let _ = "resume" + in ok_25 + farInp_40 + farExp_41 + ( let _ = "resume.genCode" + in \x_44 -> 'a' GHC.Types.: v_42 x_44 + ) + inp_43 + ) + cs_39 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_45, + farExp_46 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_37 inp_26 farInp_45 farExp_46 + else + let _ = "checkHorizon.else" + in let (# + farInp_47, + farExp_48 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_37 inp_26 farInp_47 farExp_48 + in name_24 + ( let _ = "suspend" + in \farInp_49 farExp_50 v_51 (!inp_52) -> + let _ = "resume" + in finalRet_13 + farInp_49 + farExp_50 + ( let _ = "resume.genCode" + in v_51 GHC.Types . [] + ) + inp_52 + ) + init_1 + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G4.expected.txt b/test/Golden/Splice/G4.expected.txt index 1efbe08..00827cf 100644 --- a/test/Golden/Splice/G4.expected.txt +++ b/test/Golden/Splice/G4.expected.txt @@ -1,284 +1,315 @@ -test/Golden/Splice/G4.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g4 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault finalRaise) "fail") - koByLabel) - inp) - farInp) - farExp - in - if readMore ((P.shiftRightText 3) inp) then - let !(# c, cs #) = readNext inp - in - if ('a' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('b' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('c' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('d' ==) c then - let _ = "resume" - in - (((ok init) []) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x - -> \ x - -> \ x - -> \ x - -> ('a' - : ('b' - : ('c' - : ('d' - : [])))))) - c)) - c)) - c)) - c)) - cs - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - init) - cs - of - LT -> (# cs, [P.ErrorItemToken 'd'] #) - EQ - -> (# init, - ([] <> [P.ErrorItemToken 'd']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) init) - cs - of - LT -> (# cs, [P.ErrorItemToken 'c'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'c']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + let _ = "catchException lbl=fail" + in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_32 + _ + ) + ( Data.Text.Internal.Text + _ + j_33 + _ + ) -> i_32 GHC.Classes.== j_33 + ) + inp_26 + failInp_29 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_25 + farInp_30 + farExp_31 + ( let _ = "resume.genCode" + in \x_34 -> x_34 + ) + failInp_29 + else + let _ = "choicesBranch.else" + in let (# + farInp_35, + farExp_36 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + GHC.Types.LT -> + (# + failInp_29, + [] + #) + GHC.Types.EQ -> + (# + farInp_30, + farExp_31 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_30, + farExp_31 + #) + in finalRaise_18 failInp_29 farInp_35 farExp_36 + in name_37 + ( let _ = "suspend" + in \farInp_38 farExp_39 v_40 (!inp_41) -> + name_24 + ( let _ = "suspend" + in \farInp_42 farExp_43 v_44 (!inp_45) -> + let _ = "resume" + in ok_25 + farInp_42 + farExp_43 + ( let _ = "resume.genCode" + in \x_46 -> v_40 GHC.Types.: v_44 x_46 + ) + inp_45 + ) + inp_41 + Data.Map.Internal.Tip + ) + inp_26 + Data.Map.Internal.Tip + name_37 = \(!ok_47) (!inp_48) (!koByLabel_49) -> + let _ = "catchException lbl=fail" + in let catchHandler_50 (!failInp_51) (!farInp_52) (!farExp_53) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_54, + farExp_55 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_52 inp_48 of + GHC.Types.LT -> + (# + inp_48, + [] + #) + GHC.Types.EQ -> + (# + farInp_52, + farExp_53 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_52, + farExp_53 + #) + in finalRaise_18 inp_48 farInp_54 farExp_55 + in let readFail_56 = catchHandler_50 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_48) + then + let !(# + c_57, + cs_58 + #) = readNext_3 inp_48 + in if ('a' GHC.Classes.==) c_57 + then + let readFail_59 = readFail_56 + in let !(# + c_60, + cs_61 + #) = readNext_3 cs_58 + in if ('b' GHC.Classes.==) c_60 + then + let readFail_62 = readFail_56 + in let !(# + c_63, + cs_64 + #) = readNext_3 cs_61 + in if ('c' GHC.Classes.==) c_63 + then + let readFail_65 = readFail_56 + in let !(# + c_66, + cs_67 + #) = readNext_3 cs_64 + in if ('d' GHC.Classes.==) c_66 + then + let _ = "resume" + in ok_47 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: ('d' GHC.Types.: GHC.Types . []))) + ) + cs_67 + else + let _ = "checkToken.else" + in let (# + farInp_68, + farExp_69 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_64 of + GHC.Types.LT -> + (# + cs_64, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_56 cs_64 farInp_68 farExp_69 + else + let _ = "checkToken.else" + in let (# + farInp_70, + farExp_71 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_61 of + GHC.Types.LT -> + (# + cs_61, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_56 cs_61 farInp_70 farExp_71 + else + let _ = "checkToken.else" + in let (# + farInp_72, + farExp_73 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_58 of + GHC.Types.LT -> + (# + cs_58, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_56 cs_58 farInp_72 farExp_73 + else + let _ = "checkToken.else" + in let (# + farInp_74, + farExp_75 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_48 of + GHC.Types.LT -> + (# + inp_48, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_56 inp_48 farInp_74 farExp_75 else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) cs of - LT -> (# cs, [P.ErrorItemToken 'b'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'b']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemHorizon 4] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 4]) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp in - let - _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]" - in - \ farInp farExp v !inp - -> let - _ = "call exceptionsByName(name_2)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x - -> \ x - -> \ x - -> (x : x x))) - v)) - v)) - inp)) - inp) - (((((Data.Map.Internal.Bin 1) "fail") - (\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ - i - _) - (Data.Text.Internal.Text _ - j - _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ - -> (# farInp, - (farExp <> []) #) - GT - -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault - finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp)) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip))) - inp) - (((((Data.Map.Internal.Bin 1) "fail") - (\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault - finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp)) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip) in - let - _ = "call exceptionsByName(name_2)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) (\ x -> \ x -> (x : x []))) - v)) - v)) - inp)) - inp) - Data.Map.Internal.Tip)) - init) - Data.Map.Internal.Tip + let _ = "checkHorizon.else" + in let (# + farInp_76, + farExp_77 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_48 of + GHC.Types.LT -> + (# + inp_48, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_56 inp_48 farInp_76 farExp_77 + in name_37 + ( let _ = "suspend" + in \farInp_78 farExp_79 v_80 (!inp_81) -> + name_24 + ( let _ = "suspend" + in \farInp_82 farExp_83 v_84 (!inp_85) -> + let _ = "resume" + in finalRet_13 + farInp_82 + farExp_83 + ( let _ = "resume.genCode" + in v_80 GHC.Types.: v_84 GHC.Types . [] + ) + inp_85 + ) + inp_81 + Data.Map.Internal.Tip + ) + init_1 + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G5.expected.txt b/test/Golden/Splice/G5.expected.txt index 7aed34c..e08a098 100644 --- a/test/Golden/Splice/G5.expected.txt +++ b/test/Golden/Splice/G5.expected.txt @@ -1,393 +1,460 @@ -test/Golden/Splice/G5.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g5 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault finalRaise) "fail") - koByLabel) - inp) - farInp) - farExp - in - if readMore ((P.shiftRightText 3) inp) then - let !(# c, cs #) = readNext inp - in - if ('a' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('b' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('c' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('d' ==) c then - let _ = "resume" - in - (((ok init) []) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x - -> \ x - -> \ x - -> \ x - -> ('a' - : ('b' - : ('c' - : ('d' - : [])))))) - c)) - c)) - c)) - c)) - cs - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - init) - cs - of - LT -> (# cs, [P.ErrorItemToken 'd'] #) - EQ - -> (# init, - ([] <> [P.ErrorItemToken 'd']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) init) - cs - of - LT -> (# cs, [P.ErrorItemToken 'c'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'c']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + let _ = "catchException lbl=fail" + in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_32, + farExp_33 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [] + #) + GHC.Types.EQ -> + (# + farInp_30, + farExp_31 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_30, + farExp_31 + #) + in finalRaise_18 inp_26 farInp_32 farExp_33 + in let readFail_34 = catchHandler_28 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_26) + then + let !(# + c_35, + cs_36 + #) = readNext_3 inp_26 + in if ('a' GHC.Classes.==) c_35 + then + let readFail_37 = readFail_34 + in let !(# + c_38, + cs_39 + #) = readNext_3 cs_36 + in if ('b' GHC.Classes.==) c_38 + then + let readFail_40 = readFail_34 + in let !(# + c_41, + cs_42 + #) = readNext_3 cs_39 + in if ('c' GHC.Classes.==) c_41 + then + let readFail_43 = readFail_34 + in let !(# + c_44, + cs_45 + #) = readNext_3 cs_42 + in if ('d' GHC.Classes.==) c_44 + then + let _ = "resume" + in ok_25 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: ('d' GHC.Types.: GHC.Types . []))) + ) + cs_45 + else + let _ = "checkToken.else" + in let (# + farInp_46, + farExp_47 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_42 of + GHC.Types.LT -> + (# + cs_42, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_34 cs_42 farInp_46 farExp_47 + else + let _ = "checkToken.else" + in let (# + farInp_48, + farExp_49 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_39 of + GHC.Types.LT -> + (# + cs_39, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_34 cs_39 farInp_48 farExp_49 + else + let _ = "checkToken.else" + in let (# + farInp_50, + farExp_51 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_36 of + GHC.Types.LT -> + (# + cs_36, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_34 cs_36 farInp_50 farExp_51 + else + let _ = "checkToken.else" + in let (# + farInp_52, + farExp_53 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_34 inp_26 farInp_52 farExp_53 else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) cs of - LT -> (# cs, [P.ErrorItemToken 'b'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'b']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemHorizon 4] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 4]) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp in - let - _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]" - in - \ farInp farExp v !inp - -> let - _ = "call exceptionsByName(name_2)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x - -> \ x - -> \ x - -> (x : x x))) - v)) - v)) - inp)) - inp) - (((((Data.Map.Internal.Bin 1) "fail") - (\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ - i - _) - (Data.Text.Internal.Text _ - j - _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ - -> (# farInp, - (farExp <> []) #) - GT - -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault - finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp)) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip))) - inp) - (((((Data.Map.Internal.Bin 1) "fail") - (\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault - finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp)) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip) in - let - _ = "call exceptionsByName(name_2)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let - join - = \ farInp farExp v !inp - -> let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x - -> \ x -> \ x -> (x : x []))) - v)) - v)) - v)) - inp in - let _ = "catchException lbl=fail" in - let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> let _ = "resume" - in - (((join farInp) farExp) - (let _ = "resume.genCode" in ())) - inp - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if (\ x -> True) c then - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - inp - of - LT -> (# inp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - failInp - of - LT - -> (# failInp, - [P.ErrorItemEnd] #) - EQ - -> (# farInp, - (farExp - <> - [P.ErrorItemEnd]) #) - GT -> (# farInp, farExp #) - in - ((finalRaise failInp) farInp) - farExp - else - let - (# farInp, farExp #) - = case - ((compare - `Data.Function.on` - P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ - -> (# farInp, - (farExp <> []) #) - GT -> (# farInp, farExp #) - in - ((finalRaise failInp) farInp) - farExp) - inp) - farInp) - farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - inp - of - LT -> (# inp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) - inp - of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ - -> (# farInp, - (farExp <> [P.ErrorItemHorizon 1]) #) - GT -> (# farInp, farExp #) - in ((readFail inp) farInp) farExp)) - inp) - Data.Map.Internal.Tip)) - init) - Data.Map.Internal.Tip + let _ = "checkHorizon.else" + in let (# + farInp_54, + farExp_55 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_34 inp_26 farInp_54 farExp_55 + name_56 = \(!ok_57) (!inp_58) (!koByLabel_59) -> + let _ = "catchException lbl=fail" + in let catchHandler_60 (!failInp_61) (!farInp_62) (!farExp_63) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_64 + _ + ) + ( Data.Text.Internal.Text + _ + j_65 + _ + ) -> i_64 GHC.Classes.== j_65 + ) + inp_58 + failInp_61 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_57 + farInp_62 + farExp_63 + ( let _ = "resume.genCode" + in \x_66 -> x_66 + ) + failInp_61 + else + let _ = "choicesBranch.else" + in let (# + farInp_67, + farExp_68 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_62 failInp_61 of + GHC.Types.LT -> + (# + failInp_61, + [] + #) + GHC.Types.EQ -> + (# + farInp_62, + farExp_63 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_62, + farExp_63 + #) + in finalRaise_18 failInp_61 farInp_67 farExp_68 + in name_24 + ( let _ = "suspend" + in \farInp_69 farExp_70 v_71 (!inp_72) -> + name_56 + ( let _ = "suspend" + in \farInp_73 farExp_74 v_75 (!inp_76) -> + let _ = "resume" + in ok_57 + farInp_73 + farExp_74 + ( let _ = "resume.genCode" + in \x_77 -> v_71 GHC.Types.: v_75 x_77 + ) + inp_76 + ) + inp_72 + Data.Map.Internal.Tip + ) + inp_58 + Data.Map.Internal.Tip + in name_24 + ( let _ = "suspend" + in \farInp_78 farExp_79 v_80 (!inp_81) -> + name_56 + ( let _ = "suspend" + in \farInp_82 farExp_83 v_84 (!inp_85) -> + let join_86 = \farInp_87 farExp_88 v_89 (!inp_90) -> + let _ = "resume" + in finalRet_13 + farInp_87 + farExp_88 + ( let _ = "resume.genCode" + in v_80 GHC.Types.: v_84 GHC.Types . [] + ) + inp_90 + in let _ = "catchException lbl=fail" + in let catchHandler_91 (!failInp_92) (!farInp_93) (!farExp_94) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_95 + _ + ) + ( Data.Text.Internal.Text + _ + j_96 + _ + ) -> i_95 GHC.Classes.== j_96 + ) + inp_85 + failInp_92 + then + let _ = "choicesBranch.then" + in let (# + farInp_97, + farExp_98 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_93 failInp_92 of + GHC.Types.LT -> + (# + failInp_92, + [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.EQ -> + (# + farInp_93, + farExp_94 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.GT -> + (# + farInp_93, + farExp_94 + #) + in finalRaise_18 failInp_92 farInp_97 farExp_98 + else + let _ = "choicesBranch.else" + in let (# + farInp_99, + farExp_100 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_93 failInp_92 of + GHC.Types.LT -> + (# + failInp_92, + [] + #) + GHC.Types.EQ -> + (# + farInp_93, + farExp_94 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_93, + farExp_94 + #) + in finalRaise_18 failInp_92 farInp_99 farExp_100 + in let _ = "catchException lbl=fail" + in let catchHandler_101 (!failInp_102) (!farInp_103) (!farExp_104) = + let _ = "catchException.ko lbl=fail" + in let _ = "resume" + in join_86 + farInp_103 + farExp_104 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_85 + in let readFail_105 = catchHandler_101 + in if readMore_2 inp_85 + then + let !(# + c_106, + cs_107 + #) = readNext_3 inp_85 + in if (\x_108 -> GHC.Types.True) c_106 + then + let (# + farInp_109, + farExp_110 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_82 inp_85 of + GHC.Types.LT -> + (# + inp_85, + [] + #) + GHC.Types.EQ -> + (# + farInp_82, + farExp_83 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_82, + farExp_83 + #) + in catchHandler_91 inp_85 farInp_109 farExp_110 + else + let _ = "checkToken.else" + in let (# + farInp_111, + farExp_112 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_82 inp_85 of + GHC.Types.LT -> + (# + inp_85, + [] + #) + GHC.Types.EQ -> + (# + farInp_82, + farExp_83 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_82, + farExp_83 + #) + in readFail_105 inp_85 farInp_111 farExp_112 + else + let _ = "checkHorizon.else" + in let (# + farInp_113, + farExp_114 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_82 inp_85 of + GHC.Types.LT -> + (# + inp_85, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_82, + farExp_83 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_82, + farExp_83 + #) + in readFail_105 inp_85 farInp_113 farExp_114 + ) + inp_81 + Data.Map.Internal.Tip + ) + init_1 + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G6.expected.txt b/test/Golden/Splice/G6.expected.txt index 8aac1fb..1244bdb 100644 --- a/test/Golden/Splice/G6.expected.txt +++ b/test/Golden/Splice/G6.expected.txt @@ -1,144 +1,275 @@ -test/Golden/Splice/G6.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g6 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let + in let _ = "catchException lbl=fail" + in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_28 + _ + ) + ( Data.Text.Internal.Text + _ + j_29 + _ + ) -> i_28 GHC.Classes.== j_29 + ) + init_1 + failInp_25 + then + let _ = "choicesBranch.then" + in let readFail_30 = finalRaise_18 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_25) + then + let !(# + c_31, + cs_32 + #) = readNext_3 failInp_25 + in if ('a' GHC.Classes.==) c_31 + then + let readFail_33 = finalRaise_18 + in let !(# + c_34, + cs_35 + #) = readNext_3 cs_32 + in if ('b' GHC.Classes.==) c_34 + then + let _ = "resume" + in finalRet_13 + farInp_26 + farExp_27 + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) + ) + cs_35 + else + let _ = "checkToken.else" + in let (# + farInp_36, + farExp_37 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 cs_32 of + GHC.Types.LT -> + (# + cs_32, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 cs_32 farInp_36 farExp_37 + else + let _ = "checkToken.else" + in let (# + farInp_38, + farExp_39 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 failInp_25 farInp_38 farExp_39 + else + let _ = "checkHorizon.else" + in let (# + farInp_40, + farExp_41 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 failInp_25 farInp_40 farExp_41 + else + let _ = "choicesBranch.else" + in let (# + farInp_42, + farExp_43 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 failInp_25 farInp_42 farExp_43 + in let readFail_44 = catchHandler_24 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 init_1) + then + let !(# + c_45, + cs_46 + #) = readNext_3 init_1 + in if ('a' GHC.Classes.==) c_45 + then + let readFail_47 = readFail_44 + in let !(# + c_48, + cs_49 + #) = readNext_3 cs_46 + in if ('a' GHC.Classes.==) c_48 + then + let _ = "resume" + in finalRet_13 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) + ) + cs_49 else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - init) - failInp) then - let readFail = finalRaise - in - if readMore ((P.shiftRightText 1) failInp) then - let !(# c, cs #) = readNext failInp - in - if ('a' ==) c then - let readFail = finalRaise in - let !(# c, cs #) = readNext cs - in - if ('b' ==) c then - let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x -> \ x -> ('a' : ('b' : [])))) - c)) - c)) - cs - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) - cs - of - LT -> (# cs, [P.ErrorItemToken 'b'] #) - EQ - -> (# farInp, - (farExp <> [P.ErrorItemToken 'b']) #) - GT -> (# farInp, farExp #) - in ((finalRaise cs) farInp) farExp + let _ = "checkToken.else" + in let (# + farInp_50, + farExp_51 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_46 of + GHC.Types.LT -> + (# + cs_46, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_44 cs_46 farInp_50 farExp_51 + else + let _ = "checkToken.else" + in let (# + farInp_52, + farExp_53 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_44 init_1 farInp_52 farExp_53 else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) failInp - of - LT -> (# failInp, [P.ErrorItemToken 'a'] #) - EQ -> (# farInp, (farExp <> [P.ErrorItemToken 'a']) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) failInp of - LT -> (# failInp, [P.ErrorItemHorizon 2] #) - EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 2]) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - else - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) failInp of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - in - if readMore ((P.shiftRightText 1) init) then - let !(# c, cs #) = readNext init - in - if ('a' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('a' ==) c then - let _ = "resume" - in - (((finalRet init) []) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) (\ x -> \ x -> ('a' : ('a' : [])))) c)) - c)) - cs - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) cs of - LT -> (# cs, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemHorizon 2] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 2]) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp + let _ = "checkHorizon.else" + in let (# + farInp_54, + farExp_55 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_44 init_1 farInp_54 farExp_55 diff --git a/test/Golden/Splice/G7.expected.txt b/test/Golden/Splice/G7.expected.txt index d734a2d..aea8e4a 100644 --- a/test/Golden/Splice/G7.expected.txt +++ b/test/Golden/Splice/G7.expected.txt @@ -1,184 +1,321 @@ -test/Golden/Splice/G7.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g7 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = "catchException lbl=fail" in - let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) init of - LT -> (# init, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - init) - failInp) then - let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - in - if readMore ((P.shiftRightText 1) failInp) then - let !(# c, cs #) = readNext failInp - in - if ('a' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('b' ==) c then - let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x - -> \ x -> ('a' : ('b' : [])))) - c)) - c)) - cs +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let + in let _ = "catchException lbl=fail" + in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_28 + _ + ) + ( Data.Text.Internal.Text + _ + j_29 + _ + ) -> i_28 GHC.Classes.== j_29 + ) + init_1 + failInp_25 + then + let _ = "choicesBranch.then" + in let _ = "catchException lbl=fail" + in let catchHandler_30 (!failInp_31) (!farInp_32) (!farExp_33) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_34, + farExp_35 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_32 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [] + #) + GHC.Types.EQ -> + (# + farInp_32, + farExp_33 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_32, + farExp_33 + #) + in finalRaise_18 failInp_25 farInp_34 farExp_35 + in let readFail_36 = catchHandler_30 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_25) + then + let !(# + c_37, + cs_38 + #) = readNext_3 failInp_25 + in if ('a' GHC.Classes.==) c_37 + then + let readFail_39 = readFail_36 + in let !(# + c_40, + cs_41 + #) = readNext_3 cs_38 + in if ('b' GHC.Classes.==) c_40 + then + let _ = "resume" + in finalRet_13 + farInp_26 + farExp_27 + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) + ) + cs_41 + else + let _ = "checkToken.else" + in let (# + farInp_42, + farExp_43 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 cs_38 of + GHC.Types.LT -> + (# + cs_38, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in readFail_36 cs_38 farInp_42 farExp_43 + else + let _ = "checkToken.else" + in let (# + farInp_44, + farExp_45 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in readFail_36 failInp_25 farInp_44 farExp_45 + else + let _ = "checkHorizon.else" + in let (# + farInp_46, + farExp_47 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in readFail_36 failInp_25 farInp_46 farExp_47 + else + let _ = "choicesBranch.else" + in let (# + farInp_48, + farExp_49 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 failInp_25 farInp_48 farExp_49 + in let _ = "catchException lbl=fail" + in let catchHandler_50 (!failInp_51) (!farInp_52) (!farExp_53) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp_54, + farExp_55 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_52 init_1 of + GHC.Types.LT -> + (# + init_1, + [] + #) + GHC.Types.EQ -> + (# + farInp_52, + farExp_53 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_52, + farExp_53 + #) + in catchHandler_24 init_1 farInp_54 farExp_55 + in let readFail_56 = catchHandler_50 + in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 init_1) + then + let !(# + c_57, + cs_58 + #) = readNext_3 init_1 + in if ('a' GHC.Classes.==) c_57 + then + let readFail_59 = readFail_56 + in let !(# + c_60, + cs_61 + #) = readNext_3 cs_58 + in if ('a' GHC.Classes.==) c_60 + then + let _ = "resume" + in finalRet_13 init_1 GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) + ) + cs_61 + else + let _ = "checkToken.else" + in let (# + farInp_62, + farExp_63 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_58 of + GHC.Types.LT -> + (# + cs_58, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_56 cs_58 farInp_62 farExp_63 else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - cs - of - LT -> (# cs, [P.ErrorItemToken 'b'] #) - EQ - -> (# farInp, - (farExp - <> [P.ErrorItemToken 'b']) #) - GT -> (# farInp, farExp #) - in ((readFail cs) farInp) farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - failInp - of - LT -> (# failInp, [P.ErrorItemToken 'a'] #) - EQ - -> (# farInp, - (farExp <> [P.ErrorItemToken 'a']) #) - GT -> (# farInp, farExp #) - in ((readFail failInp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) - failInp - of - LT -> (# failInp, [P.ErrorItemHorizon 2] #) - EQ - -> (# farInp, - (farExp <> [P.ErrorItemHorizon 2]) #) - GT -> (# farInp, farExp #) - in ((readFail failInp) farInp) farExp - else - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp) - init) - farInp) - farExp - in - if readMore ((P.shiftRightText 1) init) then - let !(# c, cs #) = readNext init - in - if ('a' ==) c then - let readFail = readFail in - let !(# c, cs #) = readNext cs - in - if ('a' ==) c then - let _ = "resume" - in - (((finalRet init) []) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) (\ x -> \ x -> ('a' : ('a' : [])))) c)) - c)) - cs - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) cs of - LT -> (# cs, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail cs) farInp) farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemToken 'a'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemHorizon 2] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 2]) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp + let _ = "checkToken.else" + in let (# + farInp_64, + farExp_65 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_56 init_1 farInp_64 farExp_65 + else + let _ = "checkHorizon.else" + in let (# + farInp_66, + farExp_67 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_56 init_1 farInp_66 farExp_67 diff --git a/test/Golden/Splice/G8.expected.txt b/test/Golden/Splice/G8.expected.txt index 5ddcaa0..c1f8bb8 100644 --- a/test/Golden/Splice/G8.expected.txt +++ b/test/Golden/Splice/G8.expected.txt @@ -1,199 +1,330 @@ -test/Golden/Splice/G8.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g8 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let - name - = \ !ok !inp !koByLabel - -> let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let _ = "resume" - in - (((ok farInp) farExp) (let _ = "resume.genCode" in \ x -> x)) - failInp - else - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((((Data.Map.Strict.Internal.findWithDefault finalRaise) - "fail") - koByLabel) - failInp) - farInp) - farExp - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if ('r' ==) c then - let - _ = "call exceptionsByName(name_1)=[] catchStackByLabel(ctx)=["fail"]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [])]" - in - \ farInp farExp v !inp - -> let _ = "resume" - in - (((ok farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) - (\ x -> \ x -> \ x -> ('r' : x x))) - c)) - v)) - inp)) - cs) - (((((Data.Map.Internal.Bin 1) "fail") readFail) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip) - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemToken 'r'] #) - EQ -> (# init, ([] <> [P.ErrorItemToken 'r']) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) inp of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) - GT -> (# init, [] #) - in ((readFail inp) farInp) farExp in - let - _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]" - in - ((name - (let - _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]" - in - \ farInp farExp v !inp - -> let - join - = \ farInp farExp v !inp - -> let _ = "resume" - in - (((finalRet farInp) farExp) - (let _ = "resume.genCode" - in - ((\ x -> \ x -> x x) - (((\ x -> \ x -> x x) (\ x -> \ x -> x [])) v)) - v)) - inp in - let _ = "catchException lbl=fail" in - let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> let _ = "resume" - in (((join farInp) farExp) (let _ = "resume.genCode" in ())) inp - in - if readMore inp then - let !(# c, cs #) = readNext inp - in - if (\ x -> True) c then - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in - (((\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - inp) - failInp) then - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - failInp - of - LT -> (# failInp, [P.ErrorItemEnd] #) - EQ - -> (# farInp, - (farExp <> [P.ErrorItemEnd]) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - else - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) - farInp) - failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp) - inp) - farInp) - farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((readFail inp) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) farInp) inp of - LT -> (# inp, [P.ErrorItemHorizon 1] #) - EQ -> (# farInp, (farExp <> [P.ErrorItemHorizon 1]) #) - GT -> (# farInp, farExp #) - in ((readFail inp) farInp) farExp)) - init) - Data.Map.Internal.Tip +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + let _ = "catchException lbl=fail" + in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_32 + _ + ) + ( Data.Text.Internal.Text + _ + j_33 + _ + ) -> i_32 GHC.Classes.== j_33 + ) + inp_26 + failInp_29 + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok_25 + farInp_30 + farExp_31 + ( let _ = "resume.genCode" + in \x_34 -> x_34 + ) + failInp_29 + else + let _ = "choicesBranch.else" + in let (# + farInp_35, + farExp_36 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + GHC.Types.LT -> + (# + failInp_29, + [] + #) + GHC.Types.EQ -> + (# + farInp_30, + farExp_31 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_30, + farExp_31 + #) + in finalRaise_18 failInp_29 farInp_35 farExp_36 + in let readFail_37 = catchHandler_28 + in if readMore_2 inp_26 + then + let !(# + c_38, + cs_39 + #) = readNext_3 inp_26 + in if ('r' GHC.Classes.==) c_38 + then + name_24 + ( let _ = "suspend" + in \farInp_40 farExp_41 v_42 (!inp_43) -> + let _ = "resume" + in ok_25 + farInp_40 + farExp_41 + ( let _ = "resume.genCode" + in \x_44 -> 'r' GHC.Types.: v_42 x_44 + ) + inp_43 + ) + cs_39 + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp_45, + farExp_46 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_37 inp_26 farInp_45 farExp_46 + else + let _ = "checkHorizon.else" + in let (# + farInp_47, + farExp_48 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + GHC.Types.LT -> + (# + inp_26, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_37 inp_26 farInp_47 farExp_48 + in name_24 + ( let _ = "suspend" + in \farInp_49 farExp_50 v_51 (!inp_52) -> + let join_53 = \farInp_54 farExp_55 v_56 (!inp_57) -> + let _ = "resume" + in finalRet_13 + farInp_54 + farExp_55 + ( let _ = "resume.genCode" + in v_51 GHC.Types . [] + ) + inp_57 + in let _ = "catchException lbl=fail" + in let catchHandler_58 (!failInp_59) (!farInp_60) (!farExp_61) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_62 + _ + ) + ( Data.Text.Internal.Text + _ + j_63 + _ + ) -> i_62 GHC.Classes.== j_63 + ) + inp_52 + failInp_59 + then + let _ = "choicesBranch.then" + in let (# + farInp_64, + farExp_65 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_60 failInp_59 of + GHC.Types.LT -> + (# + failInp_59, + [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.EQ -> + (# + farInp_60, + farExp_61 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.GT -> + (# + farInp_60, + farExp_61 + #) + in finalRaise_18 failInp_59 farInp_64 farExp_65 + else + let _ = "choicesBranch.else" + in let (# + farInp_66, + farExp_67 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_60 failInp_59 of + GHC.Types.LT -> + (# + failInp_59, + [] + #) + GHC.Types.EQ -> + (# + farInp_60, + farExp_61 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_60, + farExp_61 + #) + in finalRaise_18 failInp_59 farInp_66 farExp_67 + in let _ = "catchException lbl=fail" + in let catchHandler_68 (!failInp_69) (!farInp_70) (!farExp_71) = + let _ = "catchException.ko lbl=fail" + in let _ = "resume" + in join_53 + farInp_70 + farExp_71 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp_52 + in let readFail_72 = catchHandler_68 + in if readMore_2 inp_52 + then + let !(# + c_73, + cs_74 + #) = readNext_3 inp_52 + in if (\x_75 -> GHC.Types.True) c_73 + then + let (# + farInp_76, + farExp_77 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + GHC.Types.LT -> + (# + inp_52, + [] + #) + GHC.Types.EQ -> + (# + farInp_49, + farExp_50 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_49, + farExp_50 + #) + in catchHandler_58 inp_52 farInp_76 farExp_77 + else + let _ = "checkToken.else" + in let (# + farInp_78, + farExp_79 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + GHC.Types.LT -> + (# + inp_52, + [] + #) + GHC.Types.EQ -> + (# + farInp_49, + farExp_50 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_49, + farExp_50 + #) + in readFail_72 inp_52 farInp_78 farExp_79 + else + let _ = "checkHorizon.else" + in let (# + farInp_80, + farExp_81 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + GHC.Types.LT -> + (# + inp_52, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp_49, + farExp_50 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp_49, + farExp_50 + #) + in readFail_72 inp_52 farInp_80 farExp_81 + ) + init_1 + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G9.expected.txt b/test/Golden/Splice/G9.expected.txt index 244b9cb..09f7f6e 100644 --- a/test/Golden/Splice/G9.expected.txt +++ b/test/Golden/Splice/G9.expected.txt @@ -1,93 +1,200 @@ -test/Golden/Splice/G9.hs:0:0:: Splicing expression - P.runParser @Text Grammar.g9 - ======> - \ (input :: inp) - -> let - !(# init, readMore, readNext #) - = let _ = "cursorOf" in - let - next t@(Data.Text.Internal.Text arr off unconsumed) - = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0 - in - (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #) - more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0) - in (# input, more, next #) in - let finalRet = \ _farInp _farExp v _inp -> Right v in - let - finalRaise :: forall b. P.Catcher inp b - = \ _failInp !farInp !farExp - -> Left - P.ParsingErrorStandard - {P.parsingErrorOffset = P.offset farInp, - P.parsingErrorUnexpected = if readMore farInp then - Just (let (# c, _ #) = readNext farInp in c) - else - Nothing, - P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in - let _ = "catchException lbl=fail" in - let _ = "catchException lbl=fail" in - let - readFail - = \ !failInp !farInp !farExp - -> let _ = "resume" - in - (((finalRet farInp) farExp) (let _ = "resume.genCode" in ())) init - in - if readMore init then - let !(# c, cs #) = readNext init - in - if (\ x -> True) c then - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [] #) - EQ -> (# init, ([] <> []) #) - GT -> (# init, [] #) - in - (((\ !failInp !farInp !farExp - -> if (\ x -> x) - (((\ (Data.Text.Internal.Text _ i _) - (Data.Text.Internal.Text _ j _) - -> (i == j)) - init) - failInp) then - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) failInp - of - LT -> (# failInp, [P.ErrorItemEnd] #) - EQ -> (# farInp, (farExp <> [P.ErrorItemEnd]) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp - else - let - (# farInp, farExp #) - = case - ((compare `Data.Function.on` P.offset) farInp) failInp - of - LT -> (# failInp, [] #) - EQ -> (# farInp, (farExp <> []) #) - GT -> (# farInp, farExp #) - in ((finalRaise failInp) farInp) farExp) - init) - farInp) - farExp - else - let _ = "checkToken.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [] #) - EQ -> (# init, ([] <> []) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp - else - let _ = "checkHorizon.else" in - let - (# farInp, farExp #) - = case ((compare `Data.Function.on` P.offset) init) init of - LT -> (# init, [P.ErrorItemHorizon 1] #) - EQ -> (# init, ([] <> [P.ErrorItemHorizon 1]) #) - GT -> (# init, [] #) - in ((readFail init) farInp) farExp +\(input_0 :: inp_6989586621679059048) -> + let !(# + init_1, + readMore_2, + readNext_3 + #) = + let _ = "cursorOf" + in let next_4 + ( t_5@( Data.Text.Internal.Text + arr_6 + off_7 + unconsumed_8 + ) + ) = + let !( Data.Text.Unsafe.Iter + c_9 + d_10 + ) = Data.Text.Unsafe.iter t_5 0 + in (# + c_9, + Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + #) + more_11 + ( Data.Text.Internal.Text + _ + _ + unconsumed_12 + ) = unconsumed_12 GHC.Classes.> 0 + in (# + input_0, + more_11, + next_4 + #) + in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 + in let finalRaise_18 :: + forall b_19. + Symantic.Parser.Machine.Generate.Catcher + inp_6989586621679059048 + b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore_2 farInp_21 + then + GHC.Maybe.Just + ( let (# + c_23, + _ + #) = readNext_3 farInp_21 + in c_23 + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + } + in let + in let _ = "catchException lbl=fail" + in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i_28 + _ + ) + ( Data.Text.Internal.Text + _ + j_29 + _ + ) -> i_28 GHC.Classes.== j_29 + ) + init_1 + failInp_25 + then + let _ = "choicesBranch.then" + in let (# + farInp_30, + farExp_31 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 failInp_25 farInp_30 farExp_31 + else + let _ = "choicesBranch.else" + in let (# + farInp_32, + farExp_33 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of + GHC.Types.LT -> + (# + failInp_25, + [] + #) + GHC.Types.EQ -> + (# + farInp_26, + farExp_27 GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp_26, + farExp_27 + #) + in finalRaise_18 failInp_25 farInp_32 farExp_33 + in let _ = "catchException lbl=fail" + in let catchHandler_34 (!failInp_35) (!farInp_36) (!farExp_37) = + let _ = "catchException.ko lbl=fail" + in let _ = "resume" + in finalRet_13 + farInp_36 + farExp_37 + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + init_1 + in let readFail_38 = catchHandler_34 + in if readMore_2 init_1 + then + let !(# + c_39, + cs_40 + #) = readNext_3 init_1 + in if (\x_41 -> GHC.Types.True) c_39 + then + let (# + farInp_42, + farExp_43 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in catchHandler_24 init_1 farInp_42 farExp_43 + else + let _ = "checkToken.else" + in let (# + farInp_44, + farExp_45 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_38 init_1 farInp_44 farExp_45 + else + let _ = "checkHorizon.else" + in let (# + farInp_46, + farExp_47 + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + GHC.Types.LT -> + (# + init_1, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init_1, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init_1, + GHC.Types . [] + #) + in readFail_38 init_1 farInp_46 farExp_47 diff --git a/test/Golden/Splice/Utils.hs b/test/Golden/Splice/Utils.hs index 1377fda..743bdd8 100644 --- a/test/Golden/Splice/Utils.hs +++ b/test/Golden/Splice/Utils.hs @@ -5,37 +5,55 @@ module Golden.Splice.Utils where -- Build_symantic_parser is auto-generated by Setup.hs import Build_symantic_parser (ghcPath, ghcFlags, rootDir) import Control.Applicative (Applicative(..)) -import Control.Monad (unless) +import Control.Monad (Monad(..), unless, void) import Data.Foldable (asum) -import Data.Function (($), (.), const) +import Data.Function (($), (.), const, on) import Data.Functor ((<$>), (<$)) -import Data.List (cycle, zipWith) +import Data.Eq (Eq(..)) import Data.Maybe (Maybe(..)) import Data.Semigroup (Semigroup(..)) import Data.String (String, IsString(..)) import Data.Text (Text) +import Data.Tuple (fst) +-- import System.Environment (getEnvironment) import System.FilePath (FilePath, dropExtensions, takeBaseName, (), (<.>), (-<.>)) -import System.IO (IO, IOMode(..), openFile) +import System.IO (IO, IOMode(..), openFile, print) import Test.Tasty (TestTree) -import Test.Tasty.Golden (goldenVsFileDiff) -import qualified System.Process as Process +import Test.Tasty.Golden (goldenVsFileDiff, goldenVsStringDiff) +import Text.Show (Show(..)) import qualified Control.Exception as IO +import qualified Data.List as List +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH +import qualified Language.Haskell.TH.PprLib as TH import qualified System.Directory as IO import qualified System.IO.Error as IO +import qualified System.Process as Process +--import qualified Text.PrettyPrint as PP import qualified Turtle import Golden.Utils +import Debug.Trace + ghcOpts :: [String] -ghcOpts = ghcFlags <> +ghcOpts = traceShowId ghcFlags <> [ "-v0" , "-c" , "-ddump-splices" , "-dsuppress-uniques" + --, "-static" + --, "-dynamic" + --, "-O", "-prof", "-fprof-auto-exported" + --, "-osuf", "p_o", "-hisuf", "p_hi" + -- , "-prof" --, "-fprof-auto" + -- , "-eventlog", "-debug" + -- , "-fexternal-interpreter", "-opti+RTS", "-opti-p", "-opti-L100", "-opti-ls", "-opti-xc" + --, "-fhpc", "-hpcdir", "-opti/home/julm/work/sourcephile/haskell/symantic-parser/dist-newstyle/build/x86_64-linux/ghc-9.0.1/symantic-parser-0.1.0.20210201/hpc/vanilla/mix/symantic-parser-test" + -- , "-opti-fhpc", "-opti-hpcdir", "-opti/home/julm/work/sourcephile/haskell/symantic-parser/dist-newstyle/build/x86_64-linux/ghc-9.0.1/symantic-parser-0.1.0.20210201/hpc/vanilla/mix/symantic-parser-test" , "-fforce-recomp" , "-fprint-explicit-kinds" , "-O0" - --, "-i" <>rootDir"test" --, "-XConstraintKinds" , "-XDataKinds" --, "-XDefaultSignatures" @@ -67,16 +85,42 @@ testSplice spliceFile = (rootDirspliceFile-<.>"expected"<.>"txt") actualFile $ do h <- openFile actualFile WriteMode + --env <- getEnvironment (_, _, _, pid) <- Process.createProcess (Process.proc ghcPath (spliceFile : ghcOpts)) { Process.std_out = Process.UseHandle h , Process.std_err = Process.UseHandle h - , Process.cwd = Just rootDir } - _ <- Process.waitForProcess pid + , Process.cwd = Just rootDir + {- + , Process.env = Just $ traceShowId $ + List.deleteBy ((==) `on` fst) ("HPCTIXFILE", "") env + -} + } + void $ Process.waitForProcess pid normalizeSplice actualFile where actualFile = rootDirspliceFile-<.>"actual"<.>"txt" +coverSplice :: IO (TH.TExp a) -> FilePath -> TestTree +coverSplice splice spliceFile = + goldenVsStringDiff (takeBaseName (dropExtensions spliceFile)) goldenDiff + (rootDirspliceFile) $ do + --resetTHNameCounter + tExp <- splice + fromString <$> Process.readProcess "ormolu" + [ "-o", "-XMagicHash" + , "-o", "-XUnboxedTuples" + , "-o", "-XBangPatterns" + , "-o", "-XTypeApplications" ] + (show (TH.ppr (TH.unType tExp))) + {- + return $ fromString $ PP.renderStyle PP.Style + { PP.lineLength = 100 + , PP.ribbonsPerLine = 0.1 + , PP.mode = PP.PageMode + } $ TH.to_HPJ_Doc $ TH.ppr $ TH.unType tExp + -} + normalizeSplice :: FilePath -> IO () normalizeSplice = Turtle.inplace pat . fromString where @@ -95,7 +139,7 @@ normalizeSplice = Turtle.inplace pat . fromString verNum = d `Turtle.sepBy` Turtle.char '.' numPair = () <$ "(" <* d <* "," <* d <* ")" punctSym = Turtle.oneOf "!#$%&*+./>" - numPeriod = zipWith const (cycle "0123456789876543210") + numPeriod = List.zipWith const (List.cycle "0123456789876543210") d = Turtle.some Turtle.digit rmFile :: FilePath -> IO () diff --git a/test/Grammar.hs b/test/Grammar.hs index f045bbd..5db5f28 100644 --- a/test/Grammar.hs +++ b/test/Grammar.hs @@ -7,6 +7,7 @@ {-# OPTIONS_GHC -Wno-missing-signatures #-} module Grammar where import Data.Char (Char) +import qualified Data.Functor as Functor import qualified Grammar.Brainfuck import qualified Grammar.Nandlang @@ -18,8 +19,8 @@ data G = forall a. G ( repr a ) -grammars :: [G] -grammars = +rawGrammars :: [G] +rawGrammars = [ G g1 , G g2 , G g3 @@ -33,8 +34,12 @@ grammars = , G g11 , G g12 , G g13 - --, G g14 + , G g14 + , G g15 + , G g16 ] +grammars :: [G] +grammars = (\(G g) -> G (observeSharing g)) Functor.<$> rawGrammars g1 = char 'a' g2 = string "abc" @@ -49,4 +54,6 @@ g10 = char 'a' <|> char 'b' g11 = many (char 'a') <* char 'b' g12 = many (oneOf ['a', 'b', 'c', 'd']) <* eof g13 = Grammar.Brainfuck.grammar ---g14 = Grammar.Nandlang.grammar +g14 = Grammar.Nandlang.grammar +g15 = (char 'a' <|> char 'b') <* char 'c' +g16 = (char 'a' <|> char 'b' <|> char 'c') <* char 'd' diff --git a/test/Grammar/Nandlang.hs b/test/Grammar/Nandlang.hs index e9fe194..8e96f21 100644 --- a/test/Grammar/Nandlang.hs +++ b/test/Grammar/Nandlang.hs @@ -42,72 +42,64 @@ grammar :: forall repr. repr () grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof where - index :: repr () - index = brackets nat - identifier :: repr () - identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace - variable :: repr () - variable = identifier P.*> P.optional index - literal :: repr () literal = bit P.<|> charLit - - keyword :: String -> repr () - keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace - - identStart = P.satisfy - [P.ErrorItemLabel "identStart"] - (trans (H.ValueCode nandIdentStart [||nandIdentStart||])) - identLetter = P.satisfy - [P.ErrorItemLabel "identLetter"] - (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||])) - notIdentLetter = P.negLook identLetter - bit :: repr () bit = (P.char '0' P.<|> P.char '1') P.*> whitespace - - nat :: repr () - nat = decimal - charLit :: repr () charLit = P.between (P.char '\'') (symbol '\'') charChar - charChar :: repr () charChar = P.void (P.satisfy [P.ErrorItemLabel "Char"] (trans (H.ValueCode nandStringLetter [||nandStringLetter||]))) P.<|> esc - esc :: repr () esc = P.char '\\' P.*> P.void (P.oneOf "0tnvfr") - expr :: repr () expr = nandexpr P.*> P.skipMany (symbol '!' P.*> nandexpr) - nandexpr :: repr () nandexpr = literal P.<|> funccallOrVar - funccallOrVar :: repr () funccallOrVar = identifier P.*> P.optional (parens exprlist P.<|> index) + identifier :: repr () + identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace + identStart = P.satisfy + [P.ErrorItemLabel "identStart"] + (trans (H.ValueCode nandIdentStart [||nandIdentStart||])) - exprlist = commaSep expr + exprlist = commaSep expr exprlist1 = commaSep1 expr - varlist = commaSep variable - varlist1 = commaSep1 variable + varlist = commaSep variable + varlist1 = commaSep1 variable + variable :: repr () + variable = identifier P.*> P.optional index + index :: repr () + index = brackets nat + nat :: repr () + nat = decimal + decimal :: repr () + decimal = number (P.oneOf ['0'..'9']) + number :: repr a -> repr () + number digit = P.skipSome digit + funcdef = keyword "function" P.*> identifier P.*> parens funcparam P.*> block funcparam = varlist P.*> P.optional (symbol ':' P.*> varlist) - varstmt = P.optional (keyword "var") P.*> varlist1 P.*> symbol '=' P.*> exprlist1 P.<* semi - ifstmt = keyword "if" P.*> expr P.*> block P.*> P.optional (keyword "else" P.*> block) - whilestmt = keyword "while" P.*> expr P.*> block - statement = ifstmt P.<|> whilestmt P.<|> P.try varstmt P.<|> expr P.<* semi block = braces (P.skipMany statement) - funcdef = keyword "function" P.*> identifier P.*> parens funcparam P.*> block + statement = + ifstmt P.<|> whilestmt P.<|> P.try varstmt P.<|> expr P.<* semi + -- P.pure H.unit + ifstmt = keyword "if" -- P.*> expr P.*> block P.*> P.optional (keyword "else" P.*> block) + whilestmt = keyword "while" P.*> expr P.*> block + varstmt = P.optional (keyword "var") P.*> varlist1 P.*> symbol '=' P.*> exprlist1 P.<* semi + keyword :: String -> repr () + keyword k = P.string k P.*> P.pure H.unit + -- keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace + notIdentLetter = P.negLook identLetter + identLetter = P.satisfy + [P.ErrorItemLabel "identLetter"] + (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||])) - decimal :: repr () - decimal = number (P.oneOf ['0'..'9']) -- hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9'])) -- octal = P.oneOf "oO" P.*> number (P.oneOf ['0'..'7']) - number :: repr a -> repr () - number digit = P.skipSome digit symbol :: Char -> repr Char symbol c = P.char c P.<* whitespace @@ -131,7 +123,8 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof [P.ErrorItemLabel "space"] (trans (H.ValueCode isSpace [||isSpace||]))) whitespace :: repr () - whitespace = P.skipMany (spaces P.<|> oneLineComment) + whitespace = spaces + -- whitespace = P.skipMany (spaces P.<|> oneLineComment) spaces :: repr () spaces = P.skipSome space oneLineComment :: repr () diff --git a/test/Machine.hs b/test/Machine.hs index ee434cc..d49a12f 100644 --- a/test/Machine.hs +++ b/test/Machine.hs @@ -2,11 +2,14 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Machine where +-- import Data.Char (Char) import Data.Text (Text) import Data.Functor ((<$>)) +import System.IO (IO) import qualified Symantic.Parser as P import Grammar @@ -16,8 +19,18 @@ import Grammar data M = forall a. M ( forall repr inp. inp ~ Text => P.Machine (P.InputToken inp) repr => - repr inp '[] a + IO (repr inp '[] a) ) machines :: [M] -machines = (\(G g) -> M (P.machine g)) <$> grammars +machines = (\(G g) -> M (P.optimizeMachine g)) <$> grammars +{- +e1 = P.fixByName (P.analysisByLet (P.machine @[Char] g1)) +h1 = P.runAnalysis (P.machine @[Char] g1) +e13 = P.fixByName (P.analysisByLet (P.machine @[Char] g13)) +h2 = P.runAnalysis (P.machine @[Char] g2) +h3 = P.runAnalysis (P.machine @[Char] g3) +h4 = P.runAnalysis (P.machine @[Char] g4) +h13 = P.runAnalysis (P.machine @[Char] g13) +h14 = P.runGenAnalysis (P.genAnalysisByLet (P.machine @[Char] g14)) +-} diff --git a/test/Main.hs b/test/Main.hs index 2a3db37..8ae0ba5 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -6,9 +6,10 @@ import Golden --import HUnit main :: IO () -main = defaultMain ( - testGroup "" - [ Golden.goldens - --, hunits - ] - ) +main = do + defaultMain ( + testGroup "" + [ Golden.goldens + --, hunits + ] + ) diff --git a/test/Parser.hs b/test/Parser.hs index 5f2b1ed..f67c443 100644 --- a/test/Parser.hs +++ b/test/Parser.hs @@ -17,6 +17,11 @@ import Data.Text (Text) import Text.Show (Show) import Symantic.Parser import Grammar +import qualified Data.IORef as IORef +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH +import Control.DeepSeq +import System.IO (IO) data P = forall a. Show a => P ( Text -> Either (ParsingError Text) a @@ -24,7 +29,7 @@ data P = forall a. Show a => P ( parsers :: [P] parsers = - [ P p1 + [ {-P p1 , P p2 , P p3 , P p4 @@ -36,10 +41,17 @@ parsers = , P p10 , P p11 , P p12 - -- , P p13 - -- , P p14 + , P p13 + , P p14 + , P p15 + -} ] -p1 = $$(runParser @Text g1) + +{- +p1 = $$(TH.Code (do + TH.qRunIO (IORef.writeIORef TH.counter 0) + TH.examineCode (runParser @Text g1) + )) p2 = $$(runParser @Text g2) p3 = $$(runParser @Text g3) p4 = $$(runParser @Text g4) @@ -51,5 +63,9 @@ p9 = $$(runParser @Text g9) p10 = $$(runParser @Text g10) p11 = $$(runParser @Text g11) p12 = $$(runParser @Text g12) ---p13 = $$(runParser @Text g13) ---p14 = $$(runParser @Text g14) +p13 = $$(runParser @Text g13) +-} +-- p14 = $$(TH.runQ (TH.examineCode (runParser @Text g14)) `deepseq` runParser @Text g14) +-- p14 = $$({- `deepseq`-} runParser @Text g14) +q14 = TH.runQ (TH.examineCode (runParser @Text g14)) +-- p15 = $$(runParser @Text g15) -- 2.44.1 From da1ab6da759f88518d1e2d7f08257c9452db15c8 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Thu, 25 Mar 2021 02:53:57 +0100 Subject: [PATCH 04/16] test: dump splices using TH.runQ instead of calling ghc --- Setup.hs | 145 - src/Language/Haskell/TH/HideName.hs | 133 + src/Symantic/Parser/Grammar/Optimize.hs | 2 +- src/Symantic/Parser/Machine/Generate.hs | 100 +- src/Symantic/Parser/Machine/Optimize.hs | 7 +- symantic-parser.cabal | 32 +- test/Golden.hs | 2 +- test/Golden/Grammar.hs | 4 +- .../Grammar/OptimizeGrammar/G1.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G10.expected.txt | 16 +- .../Grammar/OptimizeGrammar/G11.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G12.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G13.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G14.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G15.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G16.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G2.expected.txt | 18 +- .../Grammar/OptimizeGrammar/G3.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G4.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G5.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G6.expected.txt | 20 +- .../Grammar/OptimizeGrammar/G7.expected.txt | 28 +- .../Grammar/OptimizeGrammar/G8.expected.txt | 2 +- .../Grammar/OptimizeGrammar/G9.expected.txt | 4 +- .../Grammar/ViewGrammar/G1.expected.txt | 10 +- .../Grammar/ViewGrammar/G10.expected.txt | 22 +- .../Grammar/ViewGrammar/G11.expected.txt | 16 +- .../Grammar/ViewGrammar/G12.expected.txt | 14 +- .../Grammar/ViewGrammar/G13.expected.txt | 14 +- .../Grammar/ViewGrammar/G14.expected.txt | 42 +- .../Grammar/ViewGrammar/G15.expected.txt | 32 +- .../Grammar/ViewGrammar/G16.expected.txt | 44 +- .../Grammar/ViewGrammar/G2.expected.txt | 26 +- .../Grammar/ViewGrammar/G3.expected.txt | 6 +- .../Grammar/ViewGrammar/G4.expected.txt | 12 +- .../Grammar/ViewGrammar/G5.expected.txt | 22 +- .../Grammar/ViewGrammar/G6.expected.txt | 52 +- .../Grammar/ViewGrammar/G7.expected.txt | 62 +- .../Grammar/ViewGrammar/G8.expected.txt | 14 +- .../Grammar/ViewGrammar/G9.expected.txt | 4 +- test/Golden/Machine.hs | 21 +- test/Golden/Machine/G1.expected.txt | 6 + test/Golden/Machine/G10.expected.txt | 16 +- test/Golden/Machine/G11.expected.txt | 6 + test/Golden/Machine/G12.expected.txt | 6 + test/Golden/Machine/G13.expected.txt | 6 + test/Golden/Machine/G14.expected.txt | 6 + test/Golden/Machine/G15.expected.txt | 6 + test/Golden/Machine/G16.expected.txt | 6 + test/Golden/Machine/G2.expected.txt | 6 + test/Golden/Machine/G3.expected.txt | 6 + test/Golden/Machine/G4.expected.txt | 6 + test/Golden/Machine/G5.expected.txt | 6 + test/Golden/Machine/G6.expected.txt | 16 +- test/Golden/Machine/G7.expected.txt | 16 +- test/Golden/Machine/G8.expected.txt | 6 + test/Golden/Machine/G9.expected.txt | 14 +- test/Golden/Parser.hs | 41 +- test/Golden/Splice.hs | 71 +- test/Golden/Splice/G1.expected.txt | 109 +- test/Golden/Splice/G10.expected.txt | 392 +- test/Golden/Splice/G11.expected.txt | 226 +- test/Golden/Splice/G12.expected.txt | 304 +- test/Golden/Splice/G13.expected.txt | 910 +- test/Golden/Splice/G14.expected.txt | 7480 ++++++++--------- test/Golden/Splice/G15.expected.txt | 253 +- test/Golden/Splice/G16.expected.txt | 352 +- test/Golden/Splice/G2.expected.txt | 176 +- test/Golden/Splice/G3.expected.txt | 178 +- test/Golden/Splice/G4.expected.txt | 288 +- test/Golden/Splice/G5.expected.txt | 488 +- test/Golden/Splice/G6.expected.txt | 508 +- test/Golden/Splice/G7.expected.txt | 600 +- test/Golden/Splice/G8.expected.txt | 304 +- test/Golden/Splice/G9.expected.txt | 334 +- test/Golden/Splice/Utils.hs | 149 - test/Grammar.hs | 52 +- test/Machine.hs | 21 - test/Parser.hs | 71 - 79 files changed, 7126 insertions(+), 7261 deletions(-) delete mode 100644 Setup.hs create mode 100644 src/Language/Haskell/TH/HideName.hs delete mode 100644 test/Golden/Splice/Utils.hs delete mode 100644 test/Parser.hs diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 index b649c36..0000000 --- a/Setup.hs +++ /dev/null @@ -1,145 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} --- | This module autogenerates a Build_symantic_parser module --- exporting ghcPath, ghcFlags and rootDir --- used to build TemplateHaskell splices in golden tests. --- The code is adapted from singletons-base's Setup.hs -module Main (main) where - -import Control.Monad (when) -import Data.List (nub) -import Data.String (fromString) -import Distribution.PackageDescription -import Distribution.Simple -import Distribution.Simple.BuildPaths -import Distribution.Simple.LocalBuildInfo -import Distribution.Simple.PackageIndex -import Distribution.Simple.Program -import Distribution.Simple.Setup -import Distribution.Simple.Utils -import Distribution.Text -import System.Directory (getCurrentDirectory, makeAbsolute) -import System.FilePath ((), (<.>)) - -buildModule :: FilePath -buildModule = "Build_symantic_parser" - -testSuiteName :: String -testSuiteName = "symantic-parser-test" - -main :: IO () -main = defaultMainWithHooks simpleUserHooks - { buildHook = \pkg lbi hooks flags -> do - generateBuildModule flags pkg lbi - buildHook simpleUserHooks pkg lbi hooks flags - , confHook = \(gpd, hbi) flags -> - confHook simpleUserHooks (amendGPD gpd, hbi) flags - , haddockHook = \pkg lbi hooks flags -> do - generateBuildModule (haddockToBuildFlags flags) pkg lbi - haddockHook simpleUserHooks pkg lbi hooks flags - } - --- | Convert only flags used by 'generateBuildModule'. -haddockToBuildFlags :: HaddockFlags -> BuildFlags -haddockToBuildFlags f = emptyBuildFlags - { buildVerbosity = haddockVerbosity f - , buildDistPref = haddockDistPref f - } - -generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () -generateBuildModule flags pkg lbi = do - rootDir <- getCurrentDirectory - distPref{-ix-} <- makeAbsolute $ fromFlag (buildDistPref flags) - let verbosity = fromFlag (buildVerbosity flags) - dbStack = withPackageDB lbi <> [ SpecificPackageDB $ distPref"package.conf.inplace" ] - dbFlags = "-hide-all-packages" : "-package-env=-" : packageDbArgsDb dbStack - Just ghc = lookupProgram ghcProgram (withPrograms lbi) - -- globalAutogenDir = autogenPackageModulesDir lbi - -- createDirectoryIfMissingVerbose verbosity True globalAutogenDir - withTestLBI pkg lbi $ \testSuite testCLBI -> - when (testName testSuite == fromString testSuiteName) $ do - let testAutogenDir = autogenComponentModulesDir lbi testCLBI - let buildFile = testAutogenDirbuildModule<.>"hs" - createDirectoryIfMissingVerbose verbosity True testAutogenDir - withLibLBI pkg lbi $ \_libSuite libCLBI -> do - let libDeps = fst <$> componentPackageDeps libCLBI - Left pidx = dependencyClosure (installedPkgs lbi) libDeps - libTransDeps = installedUnitId <$> allPackages pidx - packageUnitId = componentUnitId libCLBI - depsFlags = (\installedPkgId -> "-package-id=" <> display installedPkgId) <$> (packageUnitId:libTransDeps) - PerCompilerFlavor profFlags _ghcjs = profOptions (testBuildInfo testSuite) - TestSuiteExeV10 _ mainFile = testInterface testSuite - exe = Executable { - exeName = testName testSuite, - modulePath = mainFile, - exeScope = ExecutablePublic, - buildInfo = testBuildInfo testSuite - } - ghcFlags = mconcat - [ dbFlags - , depsFlags - -- This -i enables to `import Grammar` in TemplateHaskell splicing modules. - -- Because `test/Grammar.hs' is not in a package. - , [ "-i"<>exeBuildDir lbi exe ] - , [ x | withProfExe lbi, x <- ["-prof", "-osuf", "p_o", "-hisuf", "p_hi"] <> profFlags ] - -- , [ x | libCoverage lbi, x <- ["-fhpc"] <> profFlags ] - , programOverrideArgs ghc - ] - writeFile buildFile $ unlines - [ "module "<>buildModule<>" where" - , "import Data.String (String)" - , "import System.FilePath (FilePath)" - , "" - , "ghcPath :: FilePath" - , "ghcPath = "<>show (locationPath $ programLocation ghc) - , "" - , "ghcFlags :: [String]" - , "ghcFlags = "<>show ghcFlags - , "" - , "rootDir :: FilePath" - , "rootDir = "<>show rootDir - ] - where - -- GHC >= 7.6 uses the '-package-db' flag. - -- See https://ghc.haskell.org/trac/ghc/ticket/5977. - packageDbArgsDb :: [PackageDB] -> [String] - -- special cases to make arguments prettier in common scenarios - packageDbArgsDb dbstack = case dbstack of - (GlobalPackageDB:UserPackageDB:dbs) - | all isSpecific dbs -> concatMap single dbs - (GlobalPackageDB:dbs) - | all isSpecific dbs -> "-no-user-package-db" : concatMap single dbs - dbs -> "-clear-package-db" : concatMap single dbs - where - single (SpecificPackageDB db) = [ "-package-db=" <> db ] - single GlobalPackageDB = [ "-global-package-db" ] - single UserPackageDB = [ "-user-package-db" ] - isSpecific (SpecificPackageDB _) = True - isSpecific _ = False - -amendGPD :: GenericPackageDescription -> GenericPackageDescription -amendGPD gpd = gpd { condTestSuites = f <$> condTestSuites gpd } - where - f (name, condTree) - | name == fromString testSuiteName = (name, condTree') - | otherwise = (name, condTree) - where - condTree' = condTree { condTreeData = - testSuite { testBuildInfo = - bi { otherModules = om' - , autogenModules = am' } } } - testSuite = condTreeData condTree - bi = testBuildInfo testSuite - om = otherModules bi - am = autogenModules bi - - -- Cons the module to both other-modules and autogen-modules. - -- At the moment, cabal-spec-2.0 and cabal-spec-2.2 don't have - -- "all autogen-modules are other-modules - -- if they aren't exposed-modules" rule. - -- Hopefully cabal-spec-3.0 will have. - -- - -- Note: we `nub`, because it's unclear - -- if that's ok to have duplicate modules in the lists. - om' = nub $ mn : om - am' = nub $ mn : am - mn = fromString buildModule diff --git a/src/Language/Haskell/TH/HideName.hs b/src/Language/Haskell/TH/HideName.hs new file mode 100644 index 0000000..55b04f5 --- /dev/null +++ b/src/Language/Haskell/TH/HideName.hs @@ -0,0 +1,133 @@ +module Language.Haskell.TH.HideName where + +import Data.Functor ((<$>)) +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import Prelude (undefined) + +class HideName a where + -- | Map all 'Name's to a constant in order to overcome + -- cases where reseting 'TH.counter' is not enough + -- to get deterministic 'TH.Name's. + hideName :: a -> a +instance HideName Body where + hideName (GuardedB gs) = GuardedB ((\(g, e) -> (hideName g, hideName e)) <$> gs) + hideName (NormalB e) = NormalB (hideName e) +instance HideName Clause where + hideName (Clause ps b ds) = Clause (hideName <$> ps) (hideName b) (hideName <$> ds) +instance HideName Dec where + hideName (FunD f cs) = FunD (hideName f) (hideName <$> cs) + hideName (ValD p r ds) = ValD (hideName p) (hideName r) (hideName <$> ds) + -- Other alternatives are not used by Symantic.Parser, hence don't bother. + hideName _ = undefined +instance HideName Exp where + hideName (AppE e1 e2) = AppE (hideName e1) (hideName e2) + hideName (AppTypeE e t) = AppTypeE (hideName e) t + hideName (ArithSeqE d) = ArithSeqE (hideName d) + hideName (CaseE e ms) = CaseE (hideName e) (hideName <$> ms) + hideName (CompE ss) = CompE (hideName <$> ss) + hideName (ConE c) = ConE (hideName c) + hideName (CondE guard true false) = CondE (hideName guard) (hideName true) (hideName false) + hideName (DoE m ss) = DoE (hideName <$> m) (hideName <$> ss) + hideName (ImplicitParamVarE n) = ImplicitParamVarE n + hideName (InfixE e1 op e2) = InfixE (hideName <$> e1) (hideName op) (hideName <$> e2) + hideName (LabelE s) = LabelE s + hideName (LamCaseE ms) = LamCaseE (hideName <$> ms) + hideName (LamE ps e) = LamE (hideName <$> ps) (hideName e) + hideName (LetE ds e) = LetE (hideName <$> ds) (hideName e) + hideName (ListE es) = ListE (hideName <$> es) + hideName (LitE l) = LitE l + hideName (MDoE m ss) = MDoE (hideName <$> m) (hideName <$> ss) + hideName (MultiIfE alts) = MultiIfE ((\(g, e) -> (hideName g, hideName e)) <$> alts) + hideName (ParensE e) = ParensE (hideName e) + hideName (RecConE nm fs) = RecConE (hideName nm) ((\(n, e) -> (hideName n, hideName e)) <$> fs) + hideName (RecUpdE e fs) = RecUpdE (hideName e) ((\(n, ee) -> (hideName n, hideName ee)) <$> fs) + hideName (SigE e t) = SigE (hideName e) (hideName t) + hideName (StaticE e) = StaticE (hideName e) + hideName (TupE es) = TupE ((hideName <$>) <$> es) + hideName (UInfixE e1 op e2) = UInfixE (hideName e1) (hideName op) (hideName e2) + hideName (UnboundVarE v) = UnboundVarE (hideName v) + hideName (UnboxedSumE e alt arity) = UnboxedSumE (hideName e) alt arity + hideName (UnboxedTupE es) = UnboxedTupE ((hideName <$>) <$> es) + hideName (VarE v) = VarE (hideName v) +instance HideName Guard where + hideName (NormalG e) = NormalG (hideName e) + hideName (PatG ss) = PatG (hideName <$> ss) +instance HideName Lit where + hideName x = x +instance HideName Match where + hideName (Match p b ds) = Match (hideName p) (hideName b) (hideName <$> ds) +instance HideName ModName where + hideName (ModName n) = ModName n +instance HideName Name where + -- This is the hidding + hideName (Name (OccName on) (NameU _u)) = Name (OccName on) NameS + hideName (Name (OccName on) (NameL _u)) = Name (OccName on) NameS + hideName (Name on n) = Name (hideName on) (hideName n) +instance HideName NameFlavour where + hideName (NameG n p m) = NameG n p m + hideName (NameL n) = NameL n + hideName (NameQ n) = NameQ n + hideName NameS = NameS + hideName (NameU n) = NameU n +instance HideName OccName where + hideName (OccName n) = OccName n +instance HideName Range where + hideName (FromR e) = FromR (hideName e) + hideName (FromThenR f t) = FromThenR (hideName f) (hideName t) + hideName (FromToR f t) = FromToR (hideName f) (hideName t) + hideName (FromThenToR f t to) = FromThenToR (hideName f) (hideName t) (hideName to) +instance HideName Stmt where + hideName (BindS p e) = BindS (hideName p) (hideName e) + hideName (LetS ds) = LetS (hideName <$> ds) + hideName (NoBindS e) = NoBindS (hideName e) + hideName (ParS ss) = ParS ((hideName <$>) <$> ss) + hideName (RecS ss) = RecS (hideName <$> ss) +instance HideName (TyVarBndr f) where + hideName (PlainTV n f) = PlainTV (hideName n) f + hideName (KindedTV n f k) = KindedTV (hideName n) f (hideName k) +instance HideName Type where + hideName (ForallT vs ctx t) = ForallT (hideName <$> vs) (hideName <$> ctx) (hideName t) + hideName (ForallVisT vs t) = ForallVisT (hideName <$> vs) (hideName t) + hideName (AppT t x) = AppT (hideName t) (hideName x) + hideName (AppKindT t k) = AppKindT (hideName t) (hideName k) + hideName (SigT t k) = SigT (hideName t) (hideName k) + hideName (VarT n) = VarT (hideName n) + hideName (ConT n) = ConT (hideName n) + hideName (PromotedT n) = PromotedT (hideName n) + hideName (InfixT x n y) = InfixT (hideName x) (hideName n) (hideName y) + hideName (UInfixT x n y) = UInfixT (hideName x) (hideName n) (hideName y) + hideName (ParensT t) = ParensT (hideName t) + hideName (TupleT x) = TupleT x + hideName (UnboxedTupleT x) = UnboxedTupleT x + hideName (UnboxedSumT x) = UnboxedSumT x + hideName (ArrowT) = ArrowT + hideName (MulArrowT) = MulArrowT + hideName (EqualityT) = EqualityT + hideName (ListT) = ListT + hideName (PromotedTupleT x) = PromotedTupleT x + hideName (PromotedNilT) = PromotedNilT + hideName (PromotedConsT) = PromotedConsT + hideName (StarT) = StarT + hideName (ConstraintT) = ConstraintT + hideName (LitT t) = LitT t + hideName (WildCardT) = WildCardT + hideName (ImplicitParamT n t) = ImplicitParamT n (hideName t) +instance HideName Pat where + hideName (AsP v p) = AsP (hideName v) (hideName p) + hideName (BangP p) = BangP (hideName p) + hideName (ConP s ps) = ConP (hideName s) (hideName <$> ps) + hideName (InfixP p1 n p2) = InfixP (hideName p1) (hideName n) (hideName p2) + hideName (ListP ps) = ListP (hideName <$> ps) + hideName (LitP l) = LitP (hideName l) + hideName (ParensP p) = ParensP (hideName p) + hideName (RecP nm fs) = RecP (nm) ((\(n,p) -> (hideName n, hideName p)) <$> fs) + hideName (SigP p t) = SigP (hideName p) (hideName t) + hideName (TildeP p) = TildeP (hideName p) + hideName (TupP ps) = TupP (hideName <$> ps) + hideName (UInfixP p1 n p2) = UInfixP (hideName p1) (hideName n) (hideName p2) + hideName (UnboxedSumP p alt arity) = UnboxedSumP (hideName p) alt arity + hideName (UnboxedTupP ps) = UnboxedTupP (hideName <$> ps) + hideName (VarP v) = VarP (hideName v) + hideName (ViewP e p) = ViewP (hideName e) (hideName p) + hideName WildP = WildP diff --git a/src/Symantic/Parser/Grammar/Optimize.hs b/src/Symantic/Parser/Grammar/Optimize.hs index fce15cb..69af541 100644 --- a/src/Symantic/Parser/Grammar/Optimize.hs +++ b/src/Symantic/Parser/Grammar/Optimize.hs @@ -66,7 +66,7 @@ type ReprComb = Type -> Type -- -- The optimizations are directly applied within it, -- to avoid introducing an extra newtype, --- this also give a more comprehensible code. +-- this also give a more understandable code. data SomeComb repr a = forall comb. (Trans (Comb comb repr) repr, Typeable comb) => diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs index c059fc2..2b7a364 100644 --- a/src/Symantic/Parser/Machine/Generate.hs +++ b/src/Symantic/Parser/Machine/Generate.hs @@ -12,7 +12,7 @@ import Data.Char (Char) import Data.Either (Either(..), either) import Data.Function (($), (.), id, const, on) import Data.Functor (Functor, (<$>), (<$)) -import Data.Foldable (foldMap') +import Data.Foldable (foldMap', toList) import Data.Int (Int) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) @@ -22,7 +22,6 @@ import Data.Semigroup (Semigroup(..)) import Data.Set (Set) import Data.String (String) import Data.Traversable (Traversable(..)) -import Data.Tuple (fst) import GHC.TypeLits (symbolVal) import Language.Haskell.TH (CodeQ) import Prelude ((+), (-), error) @@ -42,10 +41,10 @@ import Symantic.Univariant.Trans import Symantic.Parser.Grammar.Combinators (ErrorItem(..)) import Symantic.Parser.Machine.Input import Symantic.Parser.Machine.Instructions +import qualified Language.Haskell.TH.HideName as TH import qualified Symantic.Parser.Haskell as H --import Debug.Trace -trace = const id genCode :: TermInstr a -> CodeQ a genCode = trans @@ -183,14 +182,6 @@ altGenAnalysis aas@(a:|as) = GenAnalysis } --- ** Type 'Cont' -type Cont inp v a = - {-farthestInput-}Cursor inp -> - {-farthestExpecting-}[ErrorItem (InputToken inp)] -> - v -> - Cursor inp -> - Either (ParsingError inp) a - {- -- *** Type 'FarthestError' data FarthestError inp = FarthestError @@ -244,22 +235,22 @@ data ValueStack vs where instance InstrValuable Gen where pushValue x k = k - { unGen = \ctx -> trace "unGen.pushValue" $ unGen k ctx + { unGen = \ctx -> {-trace "unGen.pushValue" $-} unGen k ctx { valueStack = ValueStackCons x (valueStack ctx) } } popValue k = k - { unGen = \ctx -> trace "unGen.popValue" $ unGen k ctx + { unGen = \ctx -> {-trace "unGen.popValue" $-} unGen k ctx { valueStack = valueStackTail (valueStack ctx) } } lift2Value f k = k - { unGen = \ctx -> trace "unGen.lift2Value" $ unGen k ctx + { unGen = \ctx -> {-trace "unGen.lift2Value" $-} unGen k ctx { valueStack = let ValueStackCons y (ValueStackCons x vs) = valueStack ctx in ValueStackCons (f H.:@ x H.:@ y) vs } } swapValue k = k - { unGen = \ctx -> trace "unGen.swapValue" $ unGen k ctx + { unGen = \ctx -> {-trace "unGen.swapValue" $-} unGen k ctx { valueStack = let ValueStackCons y (ValueStackCons x vs) = valueStack ctx in ValueStackCons x (ValueStackCons y vs) @@ -269,7 +260,7 @@ instance InstrBranchable Gen where caseBranch kx ky = Gen { genAnalysisByLet = genAnalysisByLet kx <> genAnalysisByLet ky , genAnalysis = \final ct -> altGenAnalysis $ genAnalysis kx final ct :| [genAnalysis ky final ct] - , unGen = \ctx -> trace "unGen.caseBranch" $ + , unGen = \ctx -> {-trace "unGen.caseBranch" $-} let ValueStackCons v vs = valueStack ctx in [|| case $$(genCode v) of @@ -280,7 +271,7 @@ instance InstrBranchable Gen where choicesBranch fs ks kd = Gen { genAnalysisByLet = sconcat $ genAnalysisByLet kd :| (genAnalysisByLet <$> ks) , genAnalysis = \final ct -> altGenAnalysis $ (\k -> genAnalysis k final ct) <$> (kd:|ks) - , unGen = \ctx -> trace "unGen.choicesBranch" $ + , unGen = \ctx -> {-trace "unGen.choicesBranch" $-} let ValueStackCons v vs = valueStack ctx in go ctx{valueStack = vs} v fs ks } @@ -289,7 +280,7 @@ instance InstrBranchable Gen where if $$(genCode (H.optimizeTerm (f H.:@ x))) then let _ = "choicesBranch.then" in - $$(trace "unGen.choicesBranch.k" $ unGen k ctx) + $$({-trace "unGen.choicesBranch.k" $-} unGen k ctx) else let _ = "choicesBranch.else" in $$(go ctx x fs' ks') @@ -302,7 +293,7 @@ instance InstrExceptionable Gen where { minReads = Left (symbolVal lbl) , mayRaise = Map.singleton (symbolVal lbl) () } - , unGen = \ctx@GenCtx{} -> trace ("unGen.raiseException: "<>symbolVal lbl) $ [|| + , unGen = \ctx@GenCtx{} -> {-trace ("unGen.raiseException: "<>symbolVal lbl) $-} [|| let (# farInp, farExp #) = case $$compareOffset $$(farthestInput ctx) $$(input ctx) of LT -> (# $$(input ctx), failExp #) @@ -316,7 +307,7 @@ instance InstrExceptionable Gen where ||] } popException lbl k = k - { unGen = \ctx -> trace ("unGen.popException: "<>symbolVal lbl) $ + { unGen = \ctx -> {-trace ("unGen.popException: "<>symbolVal lbl) $-} unGen k ctx{catchStackByLabel = Map.update (\case _r0:|(r1:rs) -> Just (r1:|rs) _ -> Nothing @@ -328,11 +319,11 @@ instance InstrExceptionable Gen where , genAnalysis = \final ct -> let ga = altGenAnalysis $ genAnalysis ok final ct :| [ genAnalysis ko final ct ] in ga { mayRaise = Map.delete (symbolVal lbl) (mayRaise ga) } - , unGen = \ctx@GenCtx{} -> trace ("unGen.catchException: "<>symbolVal lbl) $ [|| + , unGen = \ctx@GenCtx{} -> {-trace ("unGen.catchException: "<>symbolVal lbl) $-} [|| let _ = $$(liftTypedString ("catchException lbl="<>symbolVal lbl)) in let catchHandler !failInp !farInp !farExp = let _ = $$(liftTypedString ("catchException.ko lbl="<>symbolVal lbl)) in - $$(trace ("unGen.catchException.ko: "<>symbolVal lbl) $ unGen ko ctx + $$({-trace ("unGen.catchException.ko: "<>symbolVal lbl) $-} unGen ko ctx -- Push 'input' and 'checkedHorizon' -- as they were when entering 'catchException'. { valueStack = @@ -348,12 +339,12 @@ instance InstrExceptionable Gen where -- Nor whether 'failInp' is after -- 'checkedHorizon' 'ctx' or not. , checkedHorizon = 0 - -- Set the farthestInput to the farthest computed by 'fail' + -- Set the farthestInput to the farthest computed by 'fail'. , farthestInput = [||farInp||] , farthestExpecting = [||farExp||] }) in - $$(trace ("unGen.catchException.ok: "<>symbolVal lbl) $ unGen ok ctx + $$({-trace ("unGen.catchException.ok: "<>symbolVal lbl) $-} unGen ok ctx { catchStackByLabel = Map.insertWith (<>) (symbolVal lbl) (NE.singleton [||catchHandler||]) (catchStackByLabel ctx) } @@ -369,7 +360,7 @@ type Catcher inp a = instance InstrInputable Gen where pushInput k = k { unGen = \ctx -> - trace "unGen.pushInput" $ + {-trace "unGen.pushInput" $-} unGen k ctx { valueStack = H.Term (input ctx) `ValueStackCons` valueStack ctx , horizonStack = checkedHorizon ctx : horizonStack ctx @@ -377,7 +368,7 @@ instance InstrInputable Gen where } loadInput k = k { unGen = \ctx -> - trace "unGen.loadInput" $ + {-trace "unGen.loadInput" $-} let ValueStackCons input vs = valueStack ctx in let (h, hs) = case horizonStack ctx of [] -> (0, []) @@ -396,13 +387,18 @@ instance InstrInputable Gen where instance InstrCallable Gen where defLet defs k = k { unGen = \ctx@GenCtx{} -> - trace ("unGen.defLet: defs="<>show (HM.keys defs)) $ + {-trace ("unGen.defLet: defs="<>show (HM.keys defs)) $-} TH.unsafeCodeCoerce $ do - decls <- traverse (makeDecl ctx) $ - List.sortBy (compare `on` fst) $ - HM.toList defs - body <- TH.unTypeQ (TH.examineCode (trace "unGen.defLet.body" $ unGen k ctx)) - return (TH.LetE decls body) + decls <- traverse (makeDecl ctx) (HM.toList defs) + body <- TH.unTypeQ $ TH.examineCode $ + {-trace "unGen.defLet.body" $-} + unGen k ctx + return $ TH.LetE ( + -- | Try to output more deterministic code to be able to golden test it, + -- at the cost of more computations (at compile-time only though). + List.sortBy (compare `on` TH.hideName) $ + toList decls + ) body , genAnalysisByLet = foldMap' (\(SomeLet sub) -> genAnalysisByLet sub) defs <> ((\(SomeLet sub) -> genAnalysis sub) <$> defs) <> @@ -415,17 +411,17 @@ instance InstrCallable Gen where \ !ok{-from generateSuspend or retCode-} !inp !koByLabel{- 'catchStackByLabel' from the 'call'-site -} -> - $$(trace ("unGen.defLet.sub: "<>show n) $ unGen sub ctx + $$({-trace ("unGen.defLet.sub: "<>show n) $-} unGen sub ctx { valueStack = ValueStackEmpty -- Build a 'catchStackByLabel' from the one available at the 'call'-site. -- Note that all the 'mayRaise' of the 'sub'routine may not be available, -- hence 'Map.findWithDefault' is used instead of 'Map.!'. , catchStackByLabel = Map.mapWithKey (\lbl () -> NE.singleton [||Map.findWithDefault $$(defaultCatch ctx) lbl koByLabel||]) - (trace ("mayRaise: "<>show n) $ + ({-trace ("mayRaise: "<>show n) $-} mayRaise (finalGenAnalysisByLet ctx HM.! n)) , input = [||inp||] - , retCode = trace ("unGen.defLet.sub.retCode: "<>show n) [||ok||] + , retCode = {-trace ("unGen.defLet.sub.retCode: "<>show n) $-} [||ok||] -- These are passed by the caller via 'ok' or 'ko' -- , farthestInput = @@ -450,7 +446,7 @@ instance InstrCallable Gen where , mayRaise = Map.empty } else (final HM.! n) (n:ct) - , unGen = \ctx -> trace ("unGen.jump: "<>show n) $ [|| + , unGen = \ctx -> {-trace ("unGen.jump: "<>show n) $-} [|| let _ = "jump" in $$(TH.unsafeCodeCoerce (return (TH.VarE n))) {-ok-}$$(retCode ctx) @@ -473,7 +469,7 @@ instance InstrCallable Gen where else seqGenAnalysis $ (final HM.! n) (n:ct) :| [ genAnalysis k final ct ] - , unGen = trace ("unGen.call: "<>show n) $ \ctx -> + , unGen = {-trace ("unGen.call: "<>show n) $-} \ctx -> -- let ks = (Map.keys (catchStackByLabel ctx)) in [|| -- let _ = $$(liftTypedString $ "call exceptByLet("<>show n<>")="<>show (Map.keys (Map.findWithDefault Map.empty n (exceptByLet ctx))) <> " catchStackByLabel(ctx)="<> show ks) in @@ -494,7 +490,7 @@ instance InstrCallable Gen where { minReads = Right 0 , mayRaise = Map.empty } - , unGen = \ctx -> trace "unGen.ret" $ unGen (trace "unGen.ret.generateResume" $ generateResume (trace "unGen.ret.retCode" $ retCode ctx)) ctx + , unGen = \ctx -> {-trace "unGen.ret" $-} unGen ({-trace "unGen.ret.generateResume" $-} generateResume ({-trace "unGen.ret.retCode" $-} retCode ctx)) ctx } -- | Like 'TH.liftString' but on 'TH.Code'. @@ -513,6 +509,14 @@ liftTypedRaiseByLabel Map_.Tip = [|| Map_.Tip ||] liftTypedRaiseByLabel (Map_.Bin s k (h:|_hs) l r) = [|| Map_.Bin s k $$h $$(liftTypedRaiseByLabel l) $$(liftTypedRaiseByLabel r) ||] +-- ** Type 'Cont' +type Cont inp v a = + {-farthestInput-}Cursor inp -> + {-farthestExpecting-}[ErrorItem (InputToken inp)] -> + v -> + Cursor inp -> + Either (ParsingError inp) a + -- | Generate a 'retCode' 'Cont'inuation to be called with 'generateResume'. -- Used when 'call' 'ret'urns. -- The return 'v'alue is 'pushValue'-ed on the 'valueStack'. @@ -523,8 +527,8 @@ generateSuspend :: generateSuspend k ctx = [|| let _ = $$(liftTypedString $ "suspend") in \farInp farExp v !inp -> - $$(trace "unGen.generateSuspend" $ unGen k ctx - { valueStack = ValueStackCons (trace "unGen.generateSuspend.value" $ H.Term [||v||]) (valueStack ctx) + $$({-trace "unGen.generateSuspend" $-} unGen k ctx + { valueStack = ValueStackCons ({-trace "unGen.generateSuspend.value" $-} H.Term [||v||]) (valueStack ctx) , input = [||inp||] , farthestInput = [||farInp||] , farthestExpecting = [||farExp||] @@ -544,12 +548,12 @@ generateResume k = Gen { minReads = Right 0 , mayRaise = Map.empty } - , unGen = \ctx -> trace "unGen.generateResume" $ [|| + , unGen = \ctx -> {-trace "unGen.generateResume" $-} [|| let _ = "resume" in $$k $$(farthestInput ctx) $$(farthestExpecting ctx) - (let _ = "resume.genCode" in $$(trace "unGen.generateResume.genCode" $ genCode $ H.optimizeTerm $ + (let _ = "resume.genCode" in $$({-trace "unGen.generateResume.genCode" $-} genCode $ H.optimizeTerm $ valueStackHead $ valueStack ctx)) $$(input ctx) ||] @@ -559,12 +563,12 @@ instance InstrJoinable Gen where defJoin (LetName n) sub k = k { unGen = \ctx -> - trace ("unGen.defJoin: "<>show n) $ + {-trace ("unGen.defJoin: "<>show n) $-} TH.unsafeCodeCoerce $ do next <- TH.unTypeQ $ TH.examineCode $ [|| -- Called by 'generateResume'. \farInp farExp v !inp -> - $$(trace ("unGen.defJoin.next: "<>show n) $ unGen sub ctx + $$({-trace ("unGen.defJoin.next: "<>show n) $-} unGen sub ctx { valueStack = ValueStackCons (H.Term [||v||]) (valueStack ctx) , input = [||inp||] , farthestInput = [||farInp||] @@ -578,7 +582,7 @@ instance InstrJoinable Gen where }) ||] let decl = TH.FunD n [TH.Clause [] (TH.NormalB next) []] - expr <- TH.unTypeQ (TH.examineCode (trace ("unGen.defJoin.expr: "<>show n) $ unGen k ctx)) + expr <- TH.unTypeQ (TH.examineCode ({-trace ("unGen.defJoin.expr: "<>show n) $-} unGen k ctx)) return (TH.LetE [decl] expr) , genAnalysisByLet = (genAnalysisByLet sub <>) $ @@ -587,7 +591,7 @@ instance InstrJoinable Gen where } refJoin (LetName n) = Gen { unGen = \ctx -> - trace ("unGen.refJoin: "<>show n) $ + {-trace ("unGen.refJoin: "<>show n) $-} unGen (generateResume (TH.unsafeCodeCoerce (return (TH.VarE n)))) ctx , genAnalysisByLet = HM.empty @@ -615,7 +619,7 @@ checkHorizon ok = ok } :| [ genAnalysis ok final ct ] , unGen = \ctx0@GenCtx{} -> - trace "unGen.checkHorizon" $ + {-trace "unGen.checkHorizon" $-} let raiseFail = NE.head (Map.findWithDefault (NE.singleton (defaultCatch ctx0)) @@ -662,7 +666,7 @@ checkToken :: {-ok-}Gen inp (InputToken inp ': vs) a -> Gen inp vs a checkToken farExp p ok = ok - { unGen = \ctx -> trace "unGen.read" $ [|| + { unGen = \ctx -> {-trace "unGen.read" $-} [|| let !(# c, cs #) = $$(nextInput ctx) $$(input ctx) in if $$(genCode p) c then $$(unGen ok ctx diff --git a/src/Symantic/Parser/Machine/Optimize.hs b/src/Symantic/Parser/Machine/Optimize.hs index 2b8a6f0..5cd39ee 100644 --- a/src/Symantic/Parser/Machine/Optimize.hs +++ b/src/Symantic/Parser/Machine/Optimize.hs @@ -1,6 +1,5 @@ {-# LANGUAGE PatternSynonyms #-} -- For Instr {-# LANGUAGE ViewPatterns #-} -- For unSomeInstr -{-# LANGUAGE UndecidableInstances #-} -- | Initial encoding with bottom-up optimizations of 'Instr'uctions, -- re-optimizing downward as needed after each optimization. -- There is only one optimization (for 'pushValue') so far, @@ -49,10 +48,12 @@ pattern Instr x <- (unSomeInstr -> Just x) -- As in 'SomeComb', a first pass of optimizations -- is directly applied in it -- to avoid introducing an extra newtype, --- this also give a more comprehensible code. +-- this also give a more undestandable code. data SomeInstr repr inp vs a = forall instr. - (Trans (Instr instr repr inp vs) (repr inp vs), Typeable instr) => + ( Trans (Instr instr repr inp vs) (repr inp vs) + , Typeable instr + ) => SomeInstr (Instr instr repr inp vs a) instance Trans (SomeInstr repr inp vs) (repr inp vs) where diff --git a/symantic-parser.cabal b/symantic-parser.cabal index 943337d..b1fc2d5 100644 --- a/symantic-parser.cabal +++ b/symantic-parser.cabal @@ -31,9 +31,9 @@ extra-source-files: flake.lock flake.nix shell.nix - --test/Golden/**/*.txt + test/Golden/**/*.txt extra-tmp-files: -build-type: Custom +build-type: Simple tested-with: GHC==9.0.1 source-repository head @@ -45,18 +45,11 @@ flag dump-core manual: True default: False -flag dump-splices - description: Dump code generated by Template Haskell - manual: True - default: False - common boilerplate default-language: Haskell2010 default-extensions: NoImplicitPrelude ghc-options: - -- -dynamic-too - ---static -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates @@ -64,17 +57,11 @@ common boilerplate -fhide-source-paths -freverse-errors -custom-setup - setup-depends: - base >= 4.14, - Cabal >= 3.2, - directory >= 1, - filepath >= 1.3 - library import: boilerplate hs-source-dirs: src exposed-modules: + Language.Haskell.TH.HideName Symantic.Parser Symantic.Parser.Grammar Symantic.Parser.Grammar.Combinators @@ -89,7 +76,6 @@ library Symantic.Parser.Haskell.View Symantic.Parser.Machine Symantic.Parser.Machine.Generate - --Symantic.Parser.Machine.Horizon Symantic.Parser.Machine.Input Symantic.Parser.Machine.Instructions Symantic.Parser.Machine.Optimize @@ -136,19 +122,13 @@ test-suite symantic-parser-test Golden.Machine Golden.Parser Golden.Splice - Golden.Splice.Utils Golden.Utils Grammar Grammar.Brainfuck Grammar.Nandlang Grammar.Playground - Parser - Machine - -- Paths_symantic_parser -- HUnit -- QuickCheck - -- autogen-modules: - -- Paths_symantic_parser ghc-options: ghc-prof-options: -fexternal-interpreter @@ -156,14 +136,12 @@ test-suite symantic-parser-test symantic-parser, base >= 4.10 && < 5, bytestring >= 0.10, - --ghc-bignum, -- Needed for exported Data.Map.Internal containers >= 0.5.10.1, deepseq >= 1.4, directory >= 1.3, filepath >= 1.4, hashable >= 1.2.6, - --pretty >= 1.1, process >= 1.6, strict >= 0.4, tasty >= 0.11, @@ -183,7 +161,3 @@ test-suite symantic-parser-test if flag(dump-core) build-depends: dump-core ghc-options: -fplugin=DumpCore - if flag(dump-splices) - ghc-options: - -ddump-splices - -ddump-to-file diff --git a/test/Golden.hs b/test/Golden.hs index 33e297c..255d6bd 100644 --- a/test/Golden.hs +++ b/test/Golden.hs @@ -11,6 +11,6 @@ goldens :: TestTree goldens = testGroup "Golden" [ Golden.Grammar.goldens , Golden.Machine.goldens - , Golden.Splice.goldens , Golden.Parser.goldens + , Golden.Splice.goldens ] diff --git a/test/Golden/Grammar.hs b/test/Golden/Grammar.hs index 339458c..bb57f26 100644 --- a/test/Golden/Grammar.hs +++ b/test/Golden/Grammar.hs @@ -21,14 +21,14 @@ import qualified Grammar goldens :: TestTree goldens = testGroup "Grammar" $ [ testGroup "ViewGrammar" $ - (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \(Grammar.G gram) g -> + (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \gram g -> let grammarFile = "test/Golden/Grammar/ViewGrammar/G"<>show g<>".expected.txt" in goldenVsStringDiff ("G"<>show g) goldenDiff grammarFile $ do resetTHNameCounter return $ fromString $ show $ P.viewGrammar @'False gram , testGroup "OptimizeGrammar" $ - (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \(Grammar.G gram) g -> + (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \gram g -> let grammarFile = "test/Golden/Grammar/OptimizeGrammar/G"<>show g<>".expected.txt" in goldenVsStringDiff ("G"<>show g) goldenDiff grammarFile $ do resetTHNameCounter diff --git a/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt index 9540500..9a44baa 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G1.expected.txt @@ -1,4 +1,4 @@ lets ` <*> - + pure (\u1 -> 'a') + + pure (\u1 -> Term 'a') ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt index a4a657e..43dfea7 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G10.expected.txt @@ -1,8 +1,10 @@ lets -` <|> - + <*> - | + pure (\u1 -> 'a') - | ` satisfy - ` <*> - + pure (\u1 -> 'b') - ` satisfy +` <*> + + pure Term + ` <|> + + <*> + | + pure (\u1 -> 'a') + | ` satisfy + ` <*> + + pure (\u1 -> 'b') + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt index 280b6a4..df39eb9 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G11.expected.txt @@ -9,6 +9,6 @@ lets | ` pure (\u1 -> u1) ` <*> + <*> - | + pure (\u1 -> (\u2 -> u1 Term)) + | + pure (\u1 -> (\u2 -> Term (u1 Term))) | ` ref ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt index 23964e2..66b406f 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G12.expected.txt @@ -9,6 +9,6 @@ lets | ` pure (\u1 -> u1) ` <*> + <*> - | + pure (\u1 -> (\u2 -> u1 Term)) + | + pure (\u1 -> (\u2 -> Term (u1 Term))) | ` ref ` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt index 8e1b3c3..a51057f 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt @@ -58,6 +58,6 @@ lets | ` pure (\u1 -> u1) ` <*> + <*> - | + pure (\u1 -> (\u2 -> u2)) + | + pure (\u1 -> (\u2 -> Term u2)) | ` ref ` ref diff --git a/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt index d402742..8e0a20b 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G14.expected.txt @@ -402,7 +402,7 @@ lets | + <*> | | + <*> | | | + <*> - | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4))))) + | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> Term u4))))) | | | | ` ref | | | ` ref | | ` ref diff --git a/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt index d4daa2b..d22e2b0 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G15.expected.txt @@ -1,7 +1,7 @@ lets ` <*> + <*> - | + pure (\u1 -> (\u2 -> u1)) + | + pure (\u1 -> (\u2 -> Term u1)) | ` <|> | + <*> | | + pure (\u1 -> 'a') diff --git a/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt index b0e13cb..bbbb0a2 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G16.expected.txt @@ -1,7 +1,7 @@ lets ` <*> + <*> - | + pure (\u1 -> (\u2 -> u1)) + | + pure (\u1 -> (\u2 -> Term u1)) | ` <|> | + <*> | | + pure (\u1 -> 'a') diff --git a/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt index 34cae6e..27176f0 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G2.expected.txt @@ -1,9 +1,11 @@ lets -` try - ` <*> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : ('b' : ('c' : Term))))) - | | ` satisfy - | ` satisfy - ` satisfy +` <*> + + pure Term + ` try + ` <*> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : ('b' : ('c' : Term))))) + | | ` satisfy + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt index 80ca96c..26897f0 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G3.expected.txt @@ -8,5 +8,5 @@ lets | | ` rec | ` pure (\u1 -> u1) ` <*> - + pure (\u1 -> u1 Term) + + pure (\u1 -> Term (u1 Term)) ` ref diff --git a/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt index 3b441ab..1186b5f 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G4.expected.txt @@ -20,6 +20,6 @@ lets | ` satisfy ` <*> + <*> - | + pure (\u1 -> (\u2 -> u1 : u2 Term)) + | + pure (\u1 -> (\u2 -> Term (u1 : u2 Term))) | ` ref ` ref diff --git a/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt index a5dd2cc..891a972 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G5.expected.txt @@ -21,7 +21,7 @@ lets ` <*> + <*> | + <*> - | | + pure (\u1 -> (\u2 -> (\u3 -> u1 : u2 Term))) + | | + pure (\u1 -> (\u2 -> (\u3 -> Term (u1 : u2 Term)))) | | ` ref | ` ref ` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt index ecb0f34..9a5dfcf 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G6.expected.txt @@ -1,12 +1,14 @@ lets -` <|> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) - | | ` satisfy - | ` satisfy - ` <*> +` <*> + + pure Term + ` <|> + <*> - | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | + <*> + | | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) + | | ` satisfy | ` satisfy - ` satisfy + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt index 0ed842c..082109c 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G7.expected.txt @@ -1,14 +1,16 @@ lets -` <|> - + try - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) - | | ` satisfy - | ` satisfy - ` try - ` <*> - + <*> - | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) - | ` satisfy - ` satisfy +` <*> + + pure Term + ` <|> + + try + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> 'a' : ('a' : Term))) + | | ` satisfy + | ` satisfy + ` try + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> 'a' : ('b' : Term))) + | ` satisfy + ` satisfy diff --git a/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt index fcb2d3d..3cd79c9 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G8.expected.txt @@ -9,6 +9,6 @@ lets | ` pure (\u1 -> u1) ` <*> + <*> - | + pure (\u1 -> (\u2 -> u1 Term)) + | + pure (\u1 -> (\u2 -> Term (u1 Term))) | ` ref ` eof diff --git a/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt index 9c1ae43..1d6dc23 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G9.expected.txt @@ -1,2 +1,4 @@ lets -` eof +` <*> + + pure Term + ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G1.expected.txt b/test/Golden/Grammar/ViewGrammar/G1.expected.txt index a78e743..aaf3c80 100644 --- a/test/Golden/Grammar/ViewGrammar/G1.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G1.expected.txt @@ -1,6 +1,8 @@ lets ` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` pure 'a' - ` satisfy + + pure Term + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'a' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G10.expected.txt b/test/Golden/Grammar/ViewGrammar/G10.expected.txt index 75fe8d3..4f5d361 100644 --- a/test/Golden/Grammar/ViewGrammar/G10.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G10.expected.txt @@ -1,12 +1,14 @@ lets -` <|> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` satisfy - ` <*> +` <*> + + pure Term + ` <|> + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` pure 'b' - ` satisfy + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'a' + | ` satisfy + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'b' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G11.expected.txt b/test/Golden/Grammar/ViewGrammar/G11.expected.txt index 529efb2..5de6029 100644 --- a/test/Golden/Grammar/ViewGrammar/G11.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G11.expected.txt @@ -14,13 +14,15 @@ lets | | ` rec | ` pure (\u1 -> u1) ` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` <*> - | + ref - | ` pure Term + + pure Term ` <*> + <*> | + pure (\u1 -> (\u2 -> u1)) - | ` pure 'b' - ` satisfy + | ` <*> + | + ref + | ` pure Term + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'b' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G12.expected.txt b/test/Golden/Grammar/ViewGrammar/G12.expected.txt index 8f94a46..06d5666 100644 --- a/test/Golden/Grammar/ViewGrammar/G12.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G12.expected.txt @@ -10,9 +10,11 @@ lets | | ` rec | ` pure (\u1 -> u1) ` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` <*> - | + ref - | ` pure Term - ` eof + + pure Term + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <*> + | + ref + | ` pure Term + ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G13.expected.txt b/test/Golden/Grammar/ViewGrammar/G13.expected.txt index 42938c4..0ea3514 100644 --- a/test/Golden/Grammar/ViewGrammar/G13.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G13.expected.txt @@ -97,9 +97,11 @@ lets | | ` rec | ` pure (\u1 -> u1) ` <*> - + <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure (\u1 -> u1) - | ` ref - ` ref + + pure Term + ` <*> + + <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure (\u1 -> u1) + | ` ref + ` ref diff --git a/test/Golden/Grammar/ViewGrammar/G14.expected.txt b/test/Golden/Grammar/ViewGrammar/G14.expected.txt index ccdeb1c..cd26151 100644 --- a/test/Golden/Grammar/ViewGrammar/G14.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G14.expected.txt @@ -820,23 +820,25 @@ lets + let | ` satisfy ` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` <*> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> u1)) - | | | ` pure (\u1 -> u1) - | | ` ref - | ` <*> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> u1)) - | | | ` pure (\u1 -> u1) - | | ` <*> - | | + <*> - | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) - | | | ` ref - | | ` ref - | ` ref - ` eof + + pure Term + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <*> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure (\u1 -> u1) + | | ` ref + | ` <*> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure (\u1 -> u1) + | | ` <*> + | | + <*> + | | | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) + | | | ` ref + | | ` ref + | ` ref + ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G15.expected.txt b/test/Golden/Grammar/ViewGrammar/G15.expected.txt index be638a9..35f596b 100644 --- a/test/Golden/Grammar/ViewGrammar/G15.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G15.expected.txt @@ -1,20 +1,22 @@ lets ` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` <|> - | + <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> u1)) - | | | ` pure 'a' - | | ` satisfy - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' - | ` satisfy + + pure Term ` <*> + <*> | + pure (\u1 -> (\u2 -> u1)) - | ` pure 'c' - ` satisfy + | ` <|> + | + <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'c' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G16.expected.txt b/test/Golden/Grammar/ViewGrammar/G16.expected.txt index a2dbb63..a2df365 100644 --- a/test/Golden/Grammar/ViewGrammar/G16.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G16.expected.txt @@ -1,26 +1,28 @@ lets ` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` <|> - | + <|> - | | + <*> - | | | + <*> - | | | | + pure (\u1 -> (\u2 -> u1)) - | | | | ` pure 'a' - | | | ` satisfy - | | ` <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> u1)) - | | | ` pure 'b' - | | ` satisfy - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'c' - | ` satisfy + + pure Term ` <*> + <*> | + pure (\u1 -> (\u2 -> u1)) - | ` pure 'd' - ` satisfy + | ` <|> + | + <|> + | | + <*> + | | | + <*> + | | | | + pure (\u1 -> (\u2 -> u1)) + | | | | ` pure 'a' + | | | ` satisfy + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'b' + | | ` satisfy + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'c' + | ` satisfy + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` pure 'd' + ` satisfy diff --git a/test/Golden/Grammar/ViewGrammar/G2.expected.txt b/test/Golden/Grammar/ViewGrammar/G2.expected.txt index a6a1662..f0cee61 100644 --- a/test/Golden/Grammar/ViewGrammar/G2.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G2.expected.txt @@ -1,20 +1,14 @@ lets -` try - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` satisfy +` <*> + + pure Term + ` try ` <*> + <*> | + pure cons | ` <*> | + <*> | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' + | | ` pure 'a' | ` satisfy ` <*> + <*> @@ -22,6 +16,14 @@ lets | ` <*> | + <*> | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'c' + | | ` pure 'b' | ` satisfy - ` pure Term + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'c' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G3.expected.txt b/test/Golden/Grammar/ViewGrammar/G3.expected.txt index 03c867e..78a5537 100644 --- a/test/Golden/Grammar/ViewGrammar/G3.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G3.expected.txt @@ -14,5 +14,7 @@ lets | | ` rec | ` pure (\u1 -> u1) ` <*> - + ref - ` pure Term + + pure Term + ` <*> + + ref + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G4.expected.txt b/test/Golden/Grammar/ViewGrammar/G4.expected.txt index 61ee02d..c430655 100644 --- a/test/Golden/Grammar/ViewGrammar/G4.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G4.expected.txt @@ -45,9 +45,11 @@ lets | | ` satisfy | ` pure Term ` <*> - + <*> - | + pure cons - | ` ref + + pure Term ` <*> - + ref - ` pure Term + + <*> + | + pure cons + | ` ref + ` <*> + + ref + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G5.expected.txt b/test/Golden/Grammar/ViewGrammar/G5.expected.txt index b346292..6d6efb6 100644 --- a/test/Golden/Grammar/ViewGrammar/G5.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G5.expected.txt @@ -45,13 +45,15 @@ lets | | ` satisfy | ` pure Term ` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` <*> - | + <*> - | | + pure cons - | | ` ref - | ` <*> - | + ref - | ` pure Term - ` eof + + pure Term + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <*> + | + <*> + | | + pure cons + | | ` ref + | ` <*> + | + ref + | ` pure Term + ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G6.expected.txt b/test/Golden/Grammar/ViewGrammar/G6.expected.txt index a0b4294..61b8450 100644 --- a/test/Golden/Grammar/ViewGrammar/G6.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G6.expected.txt @@ -1,36 +1,38 @@ lets -` <|> - + <*> - | + <*> - | | + pure cons - | | ` <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> u1)) - | | | ` pure 'a' - | | ` satisfy - | ` <*> - | + <*> - | | + pure cons - | | ` <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> u1)) - | | | ` pure 'a' - | | ` satisfy - | ` pure Term - ` <*> +` <*> + + pure Term + ` <|> + <*> - | + pure cons + | + <*> + | | + pure cons + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy | ` <*> | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` satisfy + | | + pure cons + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy + | ` pure Term ` <*> + <*> | + pure cons | ` <*> | + <*> | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' + | | ` pure 'a' | ` satisfy - ` pure Term + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G7.expected.txt b/test/Golden/Grammar/ViewGrammar/G7.expected.txt index ec4f52b..ed98365 100644 --- a/test/Golden/Grammar/ViewGrammar/G7.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G7.expected.txt @@ -1,38 +1,40 @@ lets -` <|> - + try - | ` <*> - | + <*> - | | + pure cons - | | ` <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> u1)) - | | | ` pure 'a' - | | ` satisfy - | ` <*> - | + <*> - | | + pure cons - | | ` <*> - | | + <*> - | | | + pure (\u1 -> (\u2 -> u1)) - | | | ` pure 'a' - | | ` satisfy - | ` pure Term - ` try - ` <*> - + <*> - | + pure cons - | ` <*> - | + <*> - | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'a' - | ` satisfy +` <*> + + pure Term + ` <|> + + try + | ` <*> + | + <*> + | | + pure cons + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy + | ` <*> + | + <*> + | | + pure cons + | | ` <*> + | | + <*> + | | | + pure (\u1 -> (\u2 -> u1)) + | | | ` pure 'a' + | | ` satisfy + | ` pure Term + ` try ` <*> + <*> | + pure cons | ` <*> | + <*> | | + pure (\u1 -> (\u2 -> u1)) - | | ` pure 'b' + | | ` pure 'a' | ` satisfy - ` pure Term + ` <*> + + <*> + | + pure cons + | ` <*> + | + <*> + | | + pure (\u1 -> (\u2 -> u1)) + | | ` pure 'b' + | ` satisfy + ` pure Term diff --git a/test/Golden/Grammar/ViewGrammar/G8.expected.txt b/test/Golden/Grammar/ViewGrammar/G8.expected.txt index b666342..873e9e7 100644 --- a/test/Golden/Grammar/ViewGrammar/G8.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G8.expected.txt @@ -14,9 +14,11 @@ lets | | ` rec | ` pure (\u1 -> u1) ` <*> - + <*> - | + pure (\u1 -> (\u2 -> u1)) - | ` <*> - | + ref - | ` pure Term - ` eof + + pure Term + ` <*> + + <*> + | + pure (\u1 -> (\u2 -> u1)) + | ` <*> + | + ref + | ` pure Term + ` eof diff --git a/test/Golden/Grammar/ViewGrammar/G9.expected.txt b/test/Golden/Grammar/ViewGrammar/G9.expected.txt index 9c1ae43..1d6dc23 100644 --- a/test/Golden/Grammar/ViewGrammar/G9.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G9.expected.txt @@ -1,2 +1,4 @@ lets -` eof +` <*> + + pure Term + ` eof diff --git a/test/Golden/Machine.hs b/test/Golden/Machine.hs index cd0d10e..055f15d 100644 --- a/test/Golden/Machine.hs +++ b/test/Golden/Machine.hs @@ -1,28 +1,41 @@ {-# LANGUAGE DataKinds #-} -- For using P.viewMachine -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} -- For machines +{-# LANGUAGE GADTs #-} -- For machines +{-# LANGUAGE TypeApplications #-} -- For P.viewMachine module Golden.Machine where import Data.Bool (Bool(..)) +import Data.Char (Char) import Control.Monad (Monad(..)) import Data.Int (Int) import Data.Function (($)) +import Data.Functor ((<$>)) import Data.Semigroup (Semigroup(..)) -import Data.String (IsString(..)) +import Data.String (String, IsString(..)) +import Data.Text (Text) +import System.IO (IO) import Test.Tasty import Test.Tasty.Golden import Text.Show (Show(..)) import qualified Data.List as List import Golden.Utils +import Grammar import qualified Symantic.Parser as P -import qualified Machine goldens :: TestTree goldens = testGroup "Machine" $ - (\f -> List.zipWith f Machine.machines [1::Int ..]) $ \(Machine.M mach) g -> + (\f -> List.zipWith f (machines @Text) [1::Int ..]) $ \mach g -> let machineFile = "test/Golden/Machine/G"<>show g<>".expected.txt" in goldenVsStringDiff ("G"<>show g) goldenDiff machineFile $ do resetTHNameCounter m <- mach return $ fromString $ show $ P.viewMachine @'False m + +machines :: + P.InputToken inp ~ Char => + P.Cursorable (P.Cursor inp) => + P.Machine (P.InputToken inp) repr => + [IO (repr inp '[] String)] +machines = P.optimizeMachine <$> grammars diff --git a/test/Golden/Machine/G1.expected.txt b/test/Golden/Machine/G1.expected.txt index 3fd4e12..13bf6c1 100644 --- a/test/Golden/Machine/G1.expected.txt +++ b/test/Golden/Machine/G1.expected.txt @@ -1,3 +1,6 @@ +pushValue Term + minReads=(Right 1) + mayRaise=["fail"] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 1) mayRaise=["fail"] @@ -13,6 +16,9 @@ read ('a' ==) lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G10.expected.txt b/test/Golden/Machine/G10.expected.txt index c77ce0c..0f6e18a 100644 --- a/test/Golden/Machine/G10.expected.txt +++ b/test/Golden/Machine/G10.expected.txt @@ -1,3 +1,15 @@ +pushValue Term + minReads=(Right 1) + mayRaise=[] +join + minReads=(Right 0) + mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] catchException "fail" minReads=(Right 1) mayRaise=[] @@ -20,7 +32,7 @@ catchException "fail" | | popException "fail" | | minReads=(Right 0) | | mayRaise=[] -| | ret +| | refJoin | | minReads=(Right 0) | | mayRaise=[] | @@ -49,7 +61,7 @@ catchException "fail" | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | ret +| | | | refJoin | | | | minReads=(Right 0) | | | | mayRaise=[] | | | diff --git a/test/Golden/Machine/G11.expected.txt b/test/Golden/Machine/G11.expected.txt index 9c6d792..f5263f1 100644 --- a/test/Golden/Machine/G11.expected.txt +++ b/test/Golden/Machine/G11.expected.txt @@ -65,6 +65,9 @@ let | | | | | raiseException "fail" | | | | | minReads=(Left "fail") | | | | | mayRaise=["fail"] +pushValue Term + minReads=(Right 1) + mayRaise=["fail"] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 1) mayRaise=["fail"] @@ -98,6 +101,9 @@ lift2Value (\u1 -> (\u2 -> u1 u2)) lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G12.expected.txt b/test/Golden/Machine/G12.expected.txt index 8975a09..3ab4d49 100644 --- a/test/Golden/Machine/G12.expected.txt +++ b/test/Golden/Machine/G12.expected.txt @@ -53,6 +53,9 @@ let | | | | | raiseException "fail" | | | | | minReads=(Left "fail") | | | | | mayRaise=["fail"] +pushValue Term + minReads=(Right 0) + mayRaise=[] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 0) mayRaise=[] @@ -74,6 +77,9 @@ join | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret | minReads=(Right 0) | mayRaise=[] diff --git a/test/Golden/Machine/G13.expected.txt b/test/Golden/Machine/G13.expected.txt index ed39490..b4faeb3 100644 --- a/test/Golden/Machine/G13.expected.txt +++ b/test/Golden/Machine/G13.expected.txt @@ -380,6 +380,9 @@ let | ret | minReads=(Right 0) | mayRaise=[] +pushValue Term + minReads=(Right 0) + mayRaise=[] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 0) mayRaise=[] @@ -401,6 +404,9 @@ call lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G14.expected.txt b/test/Golden/Machine/G14.expected.txt index abf6e2a..e6d501a 100644 --- a/test/Golden/Machine/G14.expected.txt +++ b/test/Golden/Machine/G14.expected.txt @@ -3202,6 +3202,9 @@ let | ret | minReads=(Right 0) | mayRaise=[] +pushValue Term + minReads=(Right 1) + mayRaise=["fail"] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 1) mayRaise=["fail"] @@ -3265,6 +3268,9 @@ join | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret | minReads=(Right 0) | mayRaise=[] diff --git a/test/Golden/Machine/G15.expected.txt b/test/Golden/Machine/G15.expected.txt index 39e4984..e04827e 100644 --- a/test/Golden/Machine/G15.expected.txt +++ b/test/Golden/Machine/G15.expected.txt @@ -1,3 +1,6 @@ +pushValue Term + minReads=(Right 2) + mayRaise=[] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 2) mayRaise=[] @@ -25,6 +28,9 @@ join | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret | minReads=(Right 0) | mayRaise=[] diff --git a/test/Golden/Machine/G16.expected.txt b/test/Golden/Machine/G16.expected.txt index b54fad7..442113d 100644 --- a/test/Golden/Machine/G16.expected.txt +++ b/test/Golden/Machine/G16.expected.txt @@ -1,3 +1,6 @@ +pushValue Term + minReads=(Right 2) + mayRaise=[] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 2) mayRaise=[] @@ -25,6 +28,9 @@ join | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret | minReads=(Right 0) | mayRaise=[] diff --git a/test/Golden/Machine/G2.expected.txt b/test/Golden/Machine/G2.expected.txt index 264b0aa..5d9b057 100644 --- a/test/Golden/Machine/G2.expected.txt +++ b/test/Golden/Machine/G2.expected.txt @@ -1,3 +1,6 @@ +pushValue Term + minReads=(Right 3) + mayRaise=[] catchException "fail" minReads=(Right 3) mayRaise=[] @@ -80,6 +83,9 @@ catchException "fail" | | popException "fail" | | minReads=(Right 0) | | mayRaise=[] +| | lift2Value (\u1 -> (\u2 -> u1 u2)) +| | minReads=(Right 0) +| | mayRaise=[] | | ret | | minReads=(Right 0) | | mayRaise=[] diff --git a/test/Golden/Machine/G3.expected.txt b/test/Golden/Machine/G3.expected.txt index 06c7e61..cc1773b 100644 --- a/test/Golden/Machine/G3.expected.txt +++ b/test/Golden/Machine/G3.expected.txt @@ -65,6 +65,9 @@ let | | | | | raiseException "fail" | | | | | minReads=(Left "fail") | | | | | mayRaise=["fail"] +pushValue Term + minReads=(Right 0) + mayRaise=[] call minReads=(Right 0) mayRaise=[] @@ -74,6 +77,9 @@ pushValue Term lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G4.expected.txt b/test/Golden/Machine/G4.expected.txt index 60a5be0..046a9c5 100644 --- a/test/Golden/Machine/G4.expected.txt +++ b/test/Golden/Machine/G4.expected.txt @@ -172,6 +172,9 @@ let | | | raiseException "fail" | | | minReads=(Left "fail") | | | mayRaise=["fail"] +pushValue Term + minReads=(Right 4) + mayRaise=[] pushValue cons minReads=(Right 4) mayRaise=[] @@ -193,6 +196,9 @@ lift2Value (\u1 -> (\u2 -> u1 u2)) lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] +lift2Value (\u1 -> (\u2 -> u1 u2)) + minReads=(Right 0) + mayRaise=[] ret minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G5.expected.txt b/test/Golden/Machine/G5.expected.txt index 7200161..63f8788 100644 --- a/test/Golden/Machine/G5.expected.txt +++ b/test/Golden/Machine/G5.expected.txt @@ -172,6 +172,9 @@ let | | | raiseException "fail" | | | minReads=(Left "fail") | | | mayRaise=["fail"] +pushValue Term + minReads=(Right 4) + mayRaise=[] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 4) mayRaise=[] @@ -205,6 +208,9 @@ join | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret | minReads=(Right 0) | mayRaise=[] diff --git a/test/Golden/Machine/G6.expected.txt b/test/Golden/Machine/G6.expected.txt index b3555a9..3be8baa 100644 --- a/test/Golden/Machine/G6.expected.txt +++ b/test/Golden/Machine/G6.expected.txt @@ -1,3 +1,15 @@ +pushValue Term + minReads=(Right 2) + mayRaise=[] +join + minReads=(Right 0) + mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] catchException "fail" minReads=(Right 2) mayRaise=[] @@ -56,7 +68,7 @@ catchException "fail" | | popException "fail" | | minReads=(Right 0) | | mayRaise=[] -| | ret +| | refJoin | | minReads=(Right 0) | | mayRaise=[] | @@ -121,7 +133,7 @@ catchException "fail" | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | ret +| | | | refJoin | | | | minReads=(Right 0) | | | | mayRaise=[] | | | diff --git a/test/Golden/Machine/G7.expected.txt b/test/Golden/Machine/G7.expected.txt index 8414a00..d02eab8 100644 --- a/test/Golden/Machine/G7.expected.txt +++ b/test/Golden/Machine/G7.expected.txt @@ -1,3 +1,15 @@ +pushValue Term + minReads=(Right 2) + mayRaise=[] +join + minReads=(Right 0) + mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] catchException "fail" minReads=(Right 2) mayRaise=[] @@ -63,7 +75,7 @@ catchException "fail" | | | | popException "fail" | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | ret +| | | | refJoin | | | | minReads=(Right 0) | | | | mayRaise=[] | | | @@ -142,7 +154,7 @@ catchException "fail" | | | | | | popException "fail" | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] -| | | | | | ret +| | | | | | refJoin | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] | | | | | diff --git a/test/Golden/Machine/G8.expected.txt b/test/Golden/Machine/G8.expected.txt index 4386c99..1a87cc1 100644 --- a/test/Golden/Machine/G8.expected.txt +++ b/test/Golden/Machine/G8.expected.txt @@ -65,6 +65,9 @@ let | | | | | raiseException "fail" | | | | | minReads=(Left "fail") | | | | | mayRaise=["fail"] +pushValue Term + minReads=(Right 0) + mayRaise=[] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 0) mayRaise=[] @@ -86,6 +89,9 @@ join | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] | ret | minReads=(Right 0) | mayRaise=[] diff --git a/test/Golden/Machine/G9.expected.txt b/test/Golden/Machine/G9.expected.txt index eb3aa61..e321a20 100644 --- a/test/Golden/Machine/G9.expected.txt +++ b/test/Golden/Machine/G9.expected.txt @@ -1,3 +1,15 @@ +pushValue Term + minReads=(Right 0) + mayRaise=[] +join + minReads=(Right 0) + mayRaise=[] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] catchException "fail" minReads=(Right 0) mayRaise=[] @@ -34,7 +46,7 @@ catchException "fail" | | | | popException "fail" | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | ret +| | | | refJoin | | | | minReads=(Right 0) | | | | mayRaise=[] | diff --git a/test/Golden/Parser.hs b/test/Golden/Parser.hs index 97db1d7..67ac6ed 100644 --- a/test/Golden/Parser.hs +++ b/test/Golden/Parser.hs @@ -2,6 +2,14 @@ {-# LANGUAGE FlexibleContexts #-} -- For using P.Grammar Char {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeApplications #-} +-- For TH splices +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} module Golden.Parser where import Control.Monad (Monad(..)) @@ -10,11 +18,11 @@ import Data.Function (($)) import Data.Functor ((<$>)) import Data.Int (Int) import Data.Semigroup (Semigroup(..)) -import Data.String (IsString(..)) +import Data.String (String, IsString(..)) +import Data.Text (Text) import Data.Text.IO (readFile) import System.FilePath ((<.>), (), dropExtensions, takeBaseName) import System.IO.Unsafe (unsafePerformIO) -import System.IO (print) import Test.Tasty import Test.Tasty.Golden import Text.Show (Show(..)) @@ -22,13 +30,15 @@ import qualified Control.Exception as IO import qualified Data.List as List import qualified System.Directory as IO import qualified System.IO.Error as IO +import qualified Language.Haskell.TH as TH +import qualified Symantic.Parser as P import Golden.Utils -import Parser +import Golden.Splice goldens :: TestTree goldens = testGroup "Parser" $ - (\f -> List.zipWith f parsers [1::Int ..]) $ \(P p) g -> + (\f -> List.zipWith f parsers [1::Int ..]) $ \p g -> -- Collect the existing files: test/Golden/Parser/G*.input.txt let parserDir = "test/Golden/Parser/G"<>show g in let inputs = @@ -51,3 +61,26 @@ goldens = testGroup "Parser" $ case p input of Left err -> show err Right a -> show a + +parsers :: [Text -> Either (P.ParsingError Text) String] +parsers = + [ p1, p2, p3, p4, p5, p6, p7, p8, p9 + , p10, p11, p12, p13, p14, p15, p16 + ] + +p1 = $$(TH.Code $ TH.runIO s1) +p2 = $$(TH.Code $ TH.runIO s2) +p3 = $$(TH.Code $ TH.runIO s3) +p4 = $$(TH.Code $ TH.runIO s4) +p5 = $$(TH.Code $ TH.runIO s5) +p6 = $$(TH.Code $ TH.runIO s6) +p7 = $$(TH.Code $ TH.runIO s7) +p8 = $$(TH.Code $ TH.runIO s8) +p9 = $$(TH.Code $ TH.runIO s9) +p10 = $$(TH.Code $ TH.runIO s10) +p11 = $$(TH.Code $ TH.runIO s11) +p12 = $$(TH.Code $ TH.runIO s12) +p13 = $$(TH.Code $ TH.runIO s13) +p14 = $$(TH.Code $ TH.runIO s14) +p15 = $$(TH.Code $ TH.runIO s15) +p16 = $$(TH.Code $ TH.runIO s16) diff --git a/test/Golden/Splice.hs b/test/Golden/Splice.hs index aa142a6..8cce588 100644 --- a/test/Golden/Splice.hs +++ b/test/Golden/Splice.hs @@ -1,61 +1,48 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Golden.Splice where import Data.Either (Either(..)) import Data.Function (($)) import Data.Functor ((<$>)) import Data.Int (Int) +import Data.List ((++)) +import Data.String (String, IsString(..)) import Data.Text (Text) -import Data.Semigroup (Semigroup(..)) -import System.FilePath ((), (<.>)) +import Symantic.Parser (ParsingError, optimizeMachine, generateCode) +import System.FilePath (dropExtensions, takeBaseName, (), (<.>)) import System.IO (IO) import Test.Tasty +import Test.Tasty.Golden (goldenVsStringDiff) import Text.Show (Show(..)) import qualified Data.List as List import qualified Language.Haskell.TH as TH -import qualified Language.Haskell.TH.Syntax as TH -import Symantic.Parser (ParsingError, optimizeMachine, generateCode) +import qualified Language.Haskell.TH.HideName as TH +import qualified System.Process as Process ---import Build_symantic_parser -import Golden.Splice.Utils +import Golden.Utils import qualified Grammar goldens :: TestTree -goldens = testGroup "Splice" $ - {-[ - let spliceFile = "test/Golden/Splice/""G"<>show g<.>"hs" in - withResource - (writeFile (rootDirspliceFile) $ List.unlines - [ "module Golden.Splice.G"<>show g<>" where" - , "import Data.Text (Text)" - , "import qualified Symantic.Parser as P" - , "import qualified Data.IORef as IORef" - , "import qualified Language.Haskell.TH.Syntax as TH" - , "import qualified Grammar" - , "" - , "splice = $$(TH.Code (do" - -- This is for 'TH.Name's to match with the ones in - -- 'viewGrammar' and 'viewMachine', which ease debugging. - , " TH.qRunIO (IORef.writeIORef TH.counter 0)" - , " TH.examineCode (P.runParser @Text Grammar.g"<>show g<>")" - , " ))" - ]) - (\() -> do - rmFile (rootDirspliceFile) - rmFile (rootDirspliceFile-<.>"hi") - rmFile (rootDirspliceFile-<.>"o") - rmFile (rootDirspliceFile-<.>"p_hi") - rmFile (rootDirspliceFile-<.>"p_o")) - (\_io -> testSplice spliceFile) - | g <- [1::Int .. List.length Grammar.grammars] - ]-} - [ coverSplice splice $ "test/Golden/Splice/""G"<>show g<.>"expected"<.>"txt" - | (g, S splice) <- List.zip [1::Int ..] splices +goldens = testGroup "Splice" + [ let spliceFile = "test/Golden/Splice/""G"++show g<.>"expected"<.>"txt" in + goldenVsStringDiff (takeBaseName (dropExtensions spliceFile)) goldenDiff spliceFile $ do + tExp <- splice + fromString <$> Process.readProcess "ormolu" + [ "-o", "-XMagicHash" + , "-o", "-XUnboxedTuples" + , "-o", "-XBangPatterns" + , "-o", "-XTypeApplications" ] + (show (TH.ppr (TH.hideName (TH.unType tExp)))) + | (g, splice) <- List.zip [1::Int ..] splices ] -data S inp = forall a. S (IO (TH.TExp (inp -> Either (ParsingError inp) a))) -splices :: [S Text] -splices = (<$> Grammar.grammars) $ \(Grammar.G g) -> S $ TH.runQ $ do - mach <- TH.qRunIO $ optimizeMachine g +splices :: [IO (TH.TExp (Text -> Either (ParsingError Text) String))] +splices = (<$> Grammar.grammars) $ \g -> TH.runQ $ do + TH.runIO resetTHNameCounter + mach <- TH.runIO $ optimizeMachine g TH.examineCode $ generateCode mach + +[ s1,s2,s3,s4,s5,s6,s7,s8,s9 + ,s10,s11,s12,s13,s14,s15,s16 + ] = splices diff --git a/test/Golden/Splice/G1.expected.txt b/test/Golden/Splice/G1.expected.txt index 0541d7d..259d668 100644 --- a/test/Golden/Splice/G1.expected.txt +++ b/test/Golden/Splice/G1.expected.txt @@ -1,116 +1,109 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } in let - in let readFail_24 = finalRaise_18 - in if readMore_2 init_1 + in let readFail = finalRaise + in if readMore init then - let !(# - c_25, - cs_26 - #) = readNext_3 init_1 - in if ('a' GHC.Classes.==) c_25 + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c then let _ = "resume" - in finalRet_13 init_1 GHC.Types + in finalRet init GHC.Types . [] ( let _ = "resume.genCode" - in 'a' + in GHC.Show.show 'a' ) - cs_26 + cs else let _ = "checkToken.else" in let (# - farInp_27, - farExp_28 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of GHC.Types.LT -> (# - init_1, + init, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in finalRaise_18 init_1 farInp_27 farExp_28 + in finalRaise init farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_29, - farExp_30 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of GHC.Types.LT -> (# - init_1, + init, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in finalRaise_18 init_1 farInp_29 farExp_30 + in finalRaise init farInp farExp diff --git a/test/Golden/Splice/G10.expected.txt b/test/Golden/Splice/G10.expected.txt index cdc019a..5e461b5 100644 --- a/test/Golden/Splice/G10.expected.txt +++ b/test/Golden/Splice/G10.expected.txt @@ -1,217 +1,219 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } in let - in let _ = "catchException lbl=fail" - in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_28 - _ - ) - ( Data.Text.Internal.Text - _ - j_29 - _ - ) -> i_28 GHC.Classes.== j_29 - ) - init_1 - failInp_25 - then - let _ = "choicesBranch.then" - in let readFail_30 = finalRaise_18 - in if readMore_2 failInp_25 - then - let !(# - c_31, - cs_32 - #) = readNext_3 failInp_25 - in if ('b' GHC.Classes.==) c_31 - then - let _ = "resume" - in finalRet_13 - farInp_26 - farExp_27 - ( let _ = "resume.genCode" - in 'b' - ) - cs_32 - else - let _ = "checkToken.else" - in let (# - farInp_33, - farExp_34 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 failInp_25 farInp_33 farExp_34 - else - let _ = "checkHorizon.else" - in let (# - farInp_35, - farExp_36 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 failInp_25 farInp_35 farExp_36 - else - let _ = "choicesBranch.else" - in let (# - farInp_37, - farExp_38 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 failInp_25 farInp_37 farExp_38 - in let readFail_39 = catchHandler_24 - in if readMore_2 init_1 - then - let !(# - c_40, - cs_41 - #) = readNext_3 init_1 - in if ('a' GHC.Classes.==) c_40 - then - let _ = "resume" - in finalRet_13 init_1 GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' - ) - cs_41 - else - let _ = "checkToken.else" - in let (# - farInp_42, - farExp_43 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of - GHC.Types.LT -> - (# - init_1, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_39 init_1 farInp_42 farExp_43 - else - let _ = "checkHorizon.else" - in let (# - farInp_44, - farExp_45 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of - GHC.Types.LT -> - (# - init_1, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_39 init_1 farInp_44 farExp_45 + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let readFail = finalRaise + in if readMore failInp + then + let !(# + c, + cs + #) = readNext failInp + in if ('b' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in 'b' + ) + cs + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore init + then + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c + then + let _ = "resume" + in join init GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' + ) + cs + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail init farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail init farInp farExp diff --git a/test/Golden/Splice/G11.expected.txt b/test/Golden/Splice/G11.expected.txt index 4b1b0ef..c4d033b 100644 --- a/test/Golden/Splice/G11.expected.txt +++ b/test/Golden/Splice/G11.expected.txt @@ -1,238 +1,234 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } - in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + in let name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_32 + i _ ) ( Data.Text.Internal.Text _ - j_33 + j _ - ) -> i_32 GHC.Classes.== j_33 + ) -> i GHC.Classes.== j ) - inp_26 - failInp_29 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_25 - farInp_30 - farExp_31 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_34 -> x_34 + in \x -> x ) - failInp_29 + failInp else let _ = "choicesBranch.else" in let (# - farInp_35, - farExp_36 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_29, + failInp, [] #) GHC.Types.EQ -> (# - farInp_30, - farExp_31 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_30, - farExp_31 + farInp, + farExp #) - in finalRaise_18 failInp_29 farInp_35 farExp_36 - in let readFail_37 = catchHandler_28 - in if readMore_2 inp_26 + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore inp then let !(# - c_38, - cs_39 - #) = readNext_3 inp_26 - in if ('a' GHC.Classes.==) c_38 + c, + cs + #) = readNext inp + in if ('a' GHC.Classes.==) c then - name_24 + name ( let _ = "suspend" - in \farInp_40 farExp_41 v_42 (!inp_43) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in ok_25 - farInp_40 - farExp_41 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_44 -> 'a' GHC.Types.: v_42 x_44 + in \x -> 'a' GHC.Types.: v x ) - inp_43 + inp ) - cs_39 + cs Data.Map.Internal.Tip else let _ = "checkToken.else" in let (# - farInp_45, - farExp_46 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_37 inp_26 farInp_45 farExp_46 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_47, - farExp_48 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_37 inp_26 farInp_47 farExp_48 - in name_24 + in readFail inp farInp farExp + in name ( let _ = "suspend" - in \farInp_49 farExp_50 v_51 (!inp_52) -> - let readFail_53 = finalRaise_18 - in if readMore_2 inp_52 + in \farInp farExp v (!inp) -> + let readFail = finalRaise + in if readMore inp then let !(# - c_54, - cs_55 - #) = readNext_3 inp_52 - in if ('b' GHC.Classes.==) c_54 + c, + cs + #) = readNext inp + in if ('b' GHC.Classes.==) c then let _ = "resume" - in finalRet_13 - farInp_49 - farExp_50 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_51 GHC.Types . [] + in GHC.Show.show (v GHC.Types . []) ) - cs_55 + cs else let _ = "checkToken.else" in let (# - farInp_56, - farExp_57 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_52, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.EQ -> (# - farInp_49, - farExp_50 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.GT -> (# - farInp_49, - farExp_50 + farInp, + farExp #) - in finalRaise_18 inp_52 farInp_56 farExp_57 + in finalRaise inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_58, - farExp_59 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_52, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - farInp_49, - farExp_50 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - farInp_49, - farExp_50 + farInp, + farExp #) - in finalRaise_18 inp_52 farInp_58 farExp_59 + in finalRaise inp farInp farExp ) - init_1 + init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G12.expected.txt b/test/Golden/Splice/G12.expected.txt index 7f660ac..d4a412b 100644 --- a/test/Golden/Splice/G12.expected.txt +++ b/test/Golden/Splice/G12.expected.txt @@ -1,330 +1,326 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } - in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + in let name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_32 + i _ ) ( Data.Text.Internal.Text _ - j_33 + j _ - ) -> i_32 GHC.Classes.== j_33 + ) -> i GHC.Classes.== j ) - inp_26 - failInp_29 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_25 - farInp_30 - farExp_31 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_34 -> x_34 + in \x -> x ) - failInp_29 + failInp else let _ = "choicesBranch.else" in let (# - farInp_35, - farExp_36 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_29, + failInp, [] #) GHC.Types.EQ -> (# - farInp_30, - farExp_31 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_30, - farExp_31 + farInp, + farExp #) - in finalRaise_18 failInp_29 farInp_35 farExp_36 - in let readFail_37 = catchHandler_28 - in if readMore_2 inp_26 + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore inp then let !(# - c_38, - cs_39 - #) = readNext_3 inp_26 - in if (\t_40 -> ('a' GHC.Classes.== t_40) GHC.Classes.|| (('b' GHC.Classes.== t_40) GHC.Classes.|| (('c' GHC.Classes.== t_40) GHC.Classes.|| (('d' GHC.Classes.== t_40) GHC.Classes.|| GHC.Types.False)))) c_38 + c, + cs + #) = readNext inp + in if (\t -> ('a' GHC.Classes.== t) GHC.Classes.|| (('b' GHC.Classes.== t) GHC.Classes.|| (('c' GHC.Classes.== t) GHC.Classes.|| (('d' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))) c then - name_24 + name ( let _ = "suspend" - in \farInp_41 farExp_42 v_43 (!inp_44) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in ok_25 - farInp_41 - farExp_42 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_45 -> c_38 GHC.Types.: v_43 x_45 + in \x -> c GHC.Types.: v x ) - inp_44 + inp ) - cs_39 + cs Data.Map.Internal.Tip else let _ = "checkToken.else" in let (# - farInp_46, - farExp_47 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_37 inp_26 farInp_46 farExp_47 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_48, - farExp_49 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_37 inp_26 farInp_48 farExp_49 - in name_24 + in readFail inp farInp farExp + in name ( let _ = "suspend" - in \farInp_50 farExp_51 v_52 (!inp_53) -> - let join_54 = \farInp_55 farExp_56 v_57 (!inp_58) -> + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> let _ = "resume" - in finalRet_13 - farInp_55 - farExp_56 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_52 GHC.Types . [] + in GHC.Show.show (v GHC.Types . []) ) - inp_58 + inp in let _ = "catchException lbl=fail" - in let catchHandler_59 (!failInp_60) (!farInp_61) (!farExp_62) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_63 + i _ ) ( Data.Text.Internal.Text _ - j_64 + j _ - ) -> i_63 GHC.Classes.== j_64 + ) -> i GHC.Classes.== j ) - inp_53 - failInp_60 + inp + failInp then let _ = "choicesBranch.then" in let (# - farInp_65, - farExp_66 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_61 failInp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_60, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] #) GHC.Types.EQ -> (# - farInp_61, - farExp_62 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] #) GHC.Types.GT -> (# - farInp_61, - farExp_62 + farInp, + farExp #) - in finalRaise_18 failInp_60 farInp_65 farExp_66 + in finalRaise failInp farInp farExp else let _ = "choicesBranch.else" in let (# - farInp_67, - farExp_68 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_61 failInp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_60, + failInp, [] #) GHC.Types.EQ -> (# - farInp_61, - farExp_62 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_61, - farExp_62 + farInp, + farExp #) - in finalRaise_18 failInp_60 farInp_67 farExp_68 + in finalRaise failInp farInp farExp in let _ = "catchException lbl=fail" - in let catchHandler_69 (!failInp_70) (!farInp_71) (!farExp_72) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in let _ = "resume" - in join_54 - farInp_71 - farExp_72 + in join + farInp + farExp ( let _ = "resume.genCode" in GHC.Tuple . () ) - inp_53 - in let readFail_73 = catchHandler_69 - in if readMore_2 inp_53 + inp + in let readFail = catchHandler + in if readMore inp then let !(# - c_74, - cs_75 - #) = readNext_3 inp_53 - in if (\x_76 -> GHC.Types.True) c_74 + c, + cs + #) = readNext inp + in if (\x -> GHC.Types.True) c then let (# - farInp_77, - farExp_78 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_50 inp_53 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_53, + inp, [] #) GHC.Types.EQ -> (# - farInp_50, - farExp_51 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_50, - farExp_51 + farInp, + farExp #) - in catchHandler_59 inp_53 farInp_77 farExp_78 + in catchHandler inp farInp farExp else let _ = "checkToken.else" in let (# - farInp_79, - farExp_80 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_50 inp_53 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_53, + inp, [] #) GHC.Types.EQ -> (# - farInp_50, - farExp_51 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_50, - farExp_51 + farInp, + farExp #) - in readFail_73 inp_53 farInp_79 farExp_80 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_81, - farExp_82 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_50 inp_53 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_53, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - farInp_50, - farExp_51 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - farInp_50, - farExp_51 + farInp, + farExp #) - in readFail_73 inp_53 farInp_81 farExp_82 + in readFail inp farInp farExp ) - init_1 + init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G13.expected.txt b/test/Golden/Splice/G13.expected.txt index c4b9be8..0ee1d9f 100644 --- a/test/Golden/Splice/G13.expected.txt +++ b/test/Golden/Splice/G13.expected.txt @@ -1,904 +1,900 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } - in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> - name_28 + in let name = \(!ok) (!inp) (!koByLabel) -> + name ( let _ = "suspend" - in \farInp_29 farExp_30 v_31 (!inp_32) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in ok_25 - farInp_29 - farExp_30 + in ok + farInp + farExp ( let _ = "resume.genCode" in GHC.Tuple . () ) - inp_32 + inp ) - inp_26 + inp Data.Map.Internal.Tip - name_28 = \(!ok_33) (!inp_34) (!koByLabel_35) -> - let _ = "catchException lbl=fail" - in let catchHandler_36 (!failInp_37) (!farInp_38) (!farExp_39) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_40 - _ - ) - ( Data.Text.Internal.Text - _ - j_41 - _ - ) -> i_40 GHC.Classes.== j_41 - ) - inp_34 - failInp_37 - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok_33 - farInp_38 - farExp_39 - ( let _ = "resume.genCode" - in \x_42 -> x_42 - ) - failInp_37 - else - let _ = "choicesBranch.else" - in let (# - farInp_43, - farExp_44 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of - GHC.Types.LT -> - (# - failInp_37, - [] - #) - GHC.Types.EQ -> - (# - farInp_38, - farExp_39 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_38, - farExp_39 - #) - in finalRaise_18 failInp_37 farInp_43 farExp_44 - in let readFail_45 = catchHandler_36 - in if readMore_2 inp_34 - then - let !(# - c_46, - cs_47 - #) = readNext_3 inp_34 - in if (\c_48 -> GHC.Classes.not (('<' GHC.Classes.== c_48) GHC.Classes.|| (('>' GHC.Classes.== c_48) GHC.Classes.|| (('+' GHC.Classes.== c_48) GHC.Classes.|| (('-' GHC.Classes.== c_48) GHC.Classes.|| (('[' GHC.Classes.== c_48) GHC.Classes.|| ((']' GHC.Classes.== c_48) GHC.Classes.|| ((',' GHC.Classes.== c_48) GHC.Classes.|| (('.' GHC.Classes.== c_48) GHC.Classes.|| (('$' GHC.Classes.== c_48) GHC.Classes.|| GHC.Types.False)))))))))) c_46 - then - name_28 - ( let _ = "suspend" - in \farInp_49 farExp_50 v_51 (!inp_52) -> - let _ = "resume" - in ok_33 - farInp_49 - farExp_50 - ( let _ = "resume.genCode" - in \x_53 -> v_51 x_53 - ) - inp_52 - ) - cs_47 - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp_54, - farExp_55 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_34 of - GHC.Types.LT -> - (# - inp_34, - [ Symantic.Parser.Grammar.Combinators.ErrorItemToken '<', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '>', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '+', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '-', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '[', - Symantic.Parser.Grammar.Combinators.ErrorItemToken ']', - Symantic.Parser.Grammar.Combinators.ErrorItemToken ',', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '.', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '$' - ] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] - GHC.Base.<> [ Symantic.Parser.Grammar.Combinators.ErrorItemToken '<', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '>', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '+', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '-', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '[', - Symantic.Parser.Grammar.Combinators.ErrorItemToken ']', - Symantic.Parser.Grammar.Combinators.ErrorItemToken ',', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '.', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '$' - ] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_45 inp_34 farInp_54 farExp_55 - else - let _ = "checkHorizon.else" - in let (# - farInp_56, - farExp_57 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_34 of - GHC.Types.LT -> - (# - inp_34, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_45 inp_34 farInp_56 farExp_57 - name_58 = \(!ok_59) (!inp_60) (!koByLabel_61) -> + name = \(!ok) (!inp) (!koByLabel) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v GHC.Types . [] + ) + inp + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_62 (!failInp_63) (!farInp_64) (!farExp_65) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_66 + i _ ) ( Data.Text.Internal.Text _ - j_67 + j _ - ) -> i_66 GHC.Classes.== j_67 + ) -> i GHC.Classes.== j ) - inp_60 - failInp_63 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_59 - farInp_64 - farExp_65 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_68 -> x_68 + in \x -> x ) - failInp_63 + failInp else let _ = "choicesBranch.else" in let (# - farInp_69, - farExp_70 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_64 failInp_63 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_63, + failInp, [] #) GHC.Types.EQ -> (# - farInp_64, - farExp_65 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_64, - farExp_65 + farInp, + farExp #) - in finalRaise_18 failInp_63 farInp_69 farExp_70 - in let join_71 = \farInp_72 farExp_73 v_74 (!inp_75) -> - name_24 + in finalRaise failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_76 farExp_77 v_78 (!inp_79) -> - name_58 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_80 farExp_81 v_82 (!inp_83) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in ok_59 - farInp_80 - farExp_81 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_84 -> v_74 GHC.Types.: v_82 x_84 + in \x -> v GHC.Types.: v x ) - inp_83 + inp ) - inp_79 + inp Data.Map.Internal.Tip ) - inp_75 + inp Data.Map.Internal.Tip - in let readFail_85 = catchHandler_62 - in if readMore_2 inp_60 + in let readFail = catchHandler + in if readMore inp then let !(# - c_86, - cs_87 - #) = readNext_3 inp_60 - in if (\x_88 -> \x_89 -> x_88) GHC.Types.True c_86 + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c then - if '>' GHC.Classes.== c_86 + if '>' GHC.Classes.== c then let _ = "choicesBranch.then" - in let readFail_90 = readFail_85 - in if readMore_2 inp_60 + in let readFail = readFail + in if readMore inp then let !(# - c_91, - cs_92 - #) = readNext_3 inp_60 - in if (\x_93 -> \x_94 -> x_93) GHC.Types.True c_91 + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c then let _ = "resume" - in join_71 init_1 GHC.Types + in join init GHC.Types . [] ( let _ = "resume.genCode" in Grammar.Brainfuck.RightPointer ) - cs_92 + cs else let _ = "checkToken.else" in let (# - farInp_95, - farExp_96 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_90 inp_60 farInp_95 farExp_96 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_97, - farExp_98 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_90 inp_60 farInp_97 farExp_98 + in readFail inp farInp farExp else let _ = "choicesBranch.else" - in if '<' GHC.Classes.== c_86 + in if '<' GHC.Classes.== c then let _ = "choicesBranch.then" - in let readFail_99 = readFail_85 - in if readMore_2 inp_60 + in let readFail = readFail + in if readMore inp then let !(# - c_100, - cs_101 - #) = readNext_3 inp_60 - in if (\x_102 -> \x_103 -> x_102) GHC.Types.True c_100 + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c then let _ = "resume" - in join_71 init_1 GHC.Types + in join init GHC.Types . [] ( let _ = "resume.genCode" in Grammar.Brainfuck.LeftPointer ) - cs_101 + cs else let _ = "checkToken.else" in let (# - farInp_104, - farExp_105 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_99 inp_60 farInp_104 farExp_105 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_106, - farExp_107 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_99 inp_60 farInp_106 farExp_107 + in readFail inp farInp farExp else let _ = "choicesBranch.else" - in if '+' GHC.Classes.== c_86 + in if '+' GHC.Classes.== c then let _ = "choicesBranch.then" - in let readFail_108 = readFail_85 - in if readMore_2 inp_60 + in let readFail = readFail + in if readMore inp then let !(# - c_109, - cs_110 - #) = readNext_3 inp_60 - in if (\x_111 -> \x_112 -> x_111) GHC.Types.True c_109 + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c then let _ = "resume" - in join_71 init_1 GHC.Types + in join init GHC.Types . [] ( let _ = "resume.genCode" in Grammar.Brainfuck.Increment ) - cs_110 + cs else let _ = "checkToken.else" in let (# - farInp_113, - farExp_114 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_108 inp_60 farInp_113 farExp_114 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_115, - farExp_116 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_108 inp_60 farInp_115 farExp_116 + in readFail inp farInp farExp else let _ = "choicesBranch.else" - in if '-' GHC.Classes.== c_86 + in if '-' GHC.Classes.== c then let _ = "choicesBranch.then" - in let readFail_117 = readFail_85 - in if readMore_2 inp_60 + in let readFail = readFail + in if readMore inp then let !(# - c_118, - cs_119 - #) = readNext_3 inp_60 - in if (\x_120 -> \x_121 -> x_120) GHC.Types.True c_118 + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c then let _ = "resume" - in join_71 init_1 GHC.Types + in join init GHC.Types . [] ( let _ = "resume.genCode" in Grammar.Brainfuck.Decrement ) - cs_119 + cs else let _ = "checkToken.else" in let (# - farInp_122, - farExp_123 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_117 inp_60 farInp_122 farExp_123 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_124, - farExp_125 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_117 inp_60 farInp_124 farExp_125 + in readFail inp farInp farExp else let _ = "choicesBranch.else" - in if '.' GHC.Classes.== c_86 + in if '.' GHC.Classes.== c then let _ = "choicesBranch.then" - in let readFail_126 = readFail_85 - in if readMore_2 inp_60 + in let readFail = readFail + in if readMore inp then let !(# - c_127, - cs_128 - #) = readNext_3 inp_60 - in if (\x_129 -> \x_130 -> x_129) GHC.Types.True c_127 + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c then let _ = "resume" - in join_71 init_1 GHC.Types + in join init GHC.Types . [] ( let _ = "resume.genCode" in Grammar.Brainfuck.Output ) - cs_128 + cs else let _ = "checkToken.else" in let (# - farInp_131, - farExp_132 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_126 inp_60 farInp_131 farExp_132 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_133, - farExp_134 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_126 inp_60 farInp_133 farExp_134 + in readFail inp farInp farExp else let _ = "choicesBranch.else" - in if ',' GHC.Classes.== c_86 + in if ',' GHC.Classes.== c then let _ = "choicesBranch.then" - in let readFail_135 = readFail_85 - in if readMore_2 inp_60 + in let readFail = readFail + in if readMore inp then let !(# - c_136, - cs_137 - #) = readNext_3 inp_60 - in if (\x_138 -> \x_139 -> x_138) GHC.Types.True c_136 + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c then let _ = "resume" - in join_71 init_1 GHC.Types + in join init GHC.Types . [] ( let _ = "resume.genCode" in Grammar.Brainfuck.Input ) - cs_137 + cs else let _ = "checkToken.else" in let (# - farInp_140, - farExp_141 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_135 inp_60 farInp_140 farExp_141 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_142, - farExp_143 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_135 inp_60 farInp_142 farExp_143 + in readFail inp farInp farExp else let _ = "choicesBranch.else" - in if '[' GHC.Classes.== c_86 + in if '[' GHC.Classes.== c then let _ = "choicesBranch.then" - in let readFail_144 = readFail_85 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_60) + in let readFail = readFail + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) then let !(# - c_145, - cs_146 - #) = readNext_3 inp_60 - in if (\x_147 -> \x_148 -> x_147) GHC.Types.True c_145 + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c then - name_24 + name ( let _ = "suspend" - in \farInp_149 farExp_150 v_151 (!inp_152) -> - name_153 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_154 farExp_155 v_156 (!inp_157) -> - let readFail_158 = readFail_144 - in if readMore_2 inp_157 + in \farInp farExp v (!inp) -> + let readFail = readFail + in if readMore inp then let !(# - c_159, - cs_160 - #) = readNext_3 inp_157 - in if (']' GHC.Classes.==) c_159 + c, + cs + #) = readNext inp + in if (']' GHC.Classes.==) c then let _ = "resume" - in join_71 - farInp_154 - farExp_155 + in join + farInp + farExp ( let _ = "resume.genCode" - in Grammar.Brainfuck.Loop v_156 + in Grammar.Brainfuck.Loop v ) - cs_160 + cs else let _ = "checkToken.else" in let (# - farInp_161, - farExp_162 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_154 inp_157 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_157, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] #) GHC.Types.EQ -> (# - farInp_154, - farExp_155 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] #) GHC.Types.GT -> (# - farInp_154, - farExp_155 + farInp, + farExp #) - in readFail_158 inp_157 farInp_161 farExp_162 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_163, - farExp_164 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_154 inp_157 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_157, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - farInp_154, - farExp_155 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - farInp_154, - farExp_155 + farInp, + farExp #) - in readFail_158 inp_157 farInp_163 farExp_164 + in readFail inp farInp farExp ) - inp_152 + inp Data.Map.Internal.Tip ) - cs_146 + cs Data.Map.Internal.Tip else let _ = "checkToken.else" in let (# - farInp_165, - farExp_166 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_144 inp_60 farInp_165 farExp_166 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_167, - farExp_168 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_144 inp_60 farInp_167 farExp_168 + in readFail inp farInp farExp else let _ = "choicesBranch.else" in let (# - farInp_169, - farExp_170 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_85 inp_60 farInp_169 farExp_170 + in readFail inp farInp farExp else let _ = "checkToken.else" in let (# - farInp_171, - farExp_172 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_85 inp_60 farInp_171 farExp_172 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_173, - farExp_174 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_60 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_60, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_85 inp_60 farInp_173 farExp_174 - name_153 = \(!ok_175) (!inp_176) (!koByLabel_177) -> - name_58 - ( let _ = "suspend" - in \farInp_178 farExp_179 v_180 (!inp_181) -> - let _ = "resume" - in ok_175 - farInp_178 - farExp_179 - ( let _ = "resume.genCode" - in v_180 GHC.Types . [] - ) - inp_181 - ) - inp_176 - Data.Map.Internal.Tip - in name_24 + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\c -> GHC.Classes.not (('<' GHC.Classes.== c) GHC.Classes.|| (('>' GHC.Classes.== c) GHC.Classes.|| (('+' GHC.Classes.== c) GHC.Classes.|| (('-' GHC.Classes.== c) GHC.Classes.|| (('[' GHC.Classes.== c) GHC.Classes.|| ((']' GHC.Classes.== c) GHC.Classes.|| ((',' GHC.Classes.== c) GHC.Classes.|| (('.' GHC.Classes.== c) GHC.Classes.|| (('$' GHC.Classes.== c) GHC.Classes.|| GHC.Types.False)))))))))) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [ Symantic.Parser.Grammar.Combinators.ErrorItemToken '<', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '>', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '+', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '-', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '[', + Symantic.Parser.Grammar.Combinators.ErrorItemToken ']', + Symantic.Parser.Grammar.Combinators.ErrorItemToken ',', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '.', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '$' + ] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] + GHC.Base.<> [ Symantic.Parser.Grammar.Combinators.ErrorItemToken '<', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '>', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '+', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '-', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '[', + Symantic.Parser.Grammar.Combinators.ErrorItemToken ']', + Symantic.Parser.Grammar.Combinators.ErrorItemToken ',', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '.', + Symantic.Parser.Grammar.Combinators.ErrorItemToken '$' + ] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + in name ( let _ = "suspend" - in \farInp_182 farExp_183 v_184 (!inp_185) -> - name_153 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_186 farExp_187 v_188 (!inp_189) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in finalRet_13 - farInp_186 - farExp_187 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_188 + in GHC.Show.show v ) - inp_189 + inp ) - inp_185 + inp Data.Map.Internal.Tip ) - init_1 + init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G14.expected.txt b/test/Golden/Splice/G14.expected.txt index cba7284..51db5ad 100644 --- a/test/Golden/Splice/G14.expected.txt +++ b/test/Golden/Splice/G14.expected.txt @@ -1,4186 +1,4182 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } - in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> - let _ = "catchException lbl=fail" - in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_32 - _ + in let name = \(!ok) (!inp) (!koByLabel) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + Data.Map.Internal.Tip ) - ( Data.Text.Internal.Text - _ - j_33 - _ - ) -> i_32 GHC.Classes.== j_33 - ) - inp_26 - failInp_29 - then - let _ = "choicesBranch.then" - in name_34 + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 "fail" (Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) + name = \(!ok) (!inp) (!koByLabel) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in name ( let _ = "suspend" - in \farInp_35 farExp_36 v_37 (!inp_38) -> - let join_39 = \farInp_40 farExp_41 v_42 (!inp_43) -> - let _ = "resume" - in ok_25 - farInp_40 - farExp_41 - ( let _ = "resume.genCode" - in v_42 - ) - inp_43 - in let _ = "catchException lbl=fail" - in let catchHandler_44 (!failInp_45) (!farInp_46) (!farExp_47) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_48 - _ - ) - ( Data.Text.Internal.Text - _ - j_49 - _ - ) -> i_48 GHC.Classes.== j_49 - ) - inp_38 - failInp_45 - then - let _ = "choicesBranch.then" - in name_50 - ( let _ = "suspend" - in \farInp_51 farExp_52 v_53 (!inp_54) -> - let _ = "resume" - in join_39 - farInp_51 - farExp_52 - ( let _ = "resume.genCode" - in v_53 - ) - inp_54 - ) - failInp_45 - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp_55, - farExp_56 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_46 failInp_45 of - GHC.Types.LT -> - (# - failInp_45, - [] - #) - GHC.Types.EQ -> - (# - farInp_46, - farExp_47 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_46, - farExp_47 - #) - in finalRaise_18 failInp_45 farInp_55 farExp_56 - in let join_57 = \farInp_58 farExp_59 v_60 (!inp_61) -> - let _ = "resume" - in join_39 - farInp_58 - farExp_59 - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_61 - in let _ = "catchException lbl=fail" - in let catchHandler_62 (!failInp_63) (!farInp_64) (!farExp_65) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_66 - _ - ) - ( Data.Text.Internal.Text - _ - j_67 - _ - ) -> i_66 GHC.Classes.== j_67 - ) - inp_38 - failInp_63 - then - let _ = "choicesBranch.then" - in name_68 - ( let _ = "suspend" - in \farInp_69 farExp_70 v_71 (!inp_72) -> - let _ = "resume" - in join_57 - farInp_69 - farExp_70 - ( let _ = "resume.genCode" - in v_71 - ) - inp_72 - ) - failInp_63 - (Data.Map.Internal.Bin 1 "fail" catchHandler_44 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "choicesBranch.else" - in let (# - farInp_73, - farExp_74 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_64 failInp_63 of - GHC.Types.LT -> - (# - failInp_63, - [] - #) - GHC.Types.EQ -> - (# - farInp_64, - farExp_65 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_64, - farExp_65 - #) - in catchHandler_44 failInp_63 farInp_73 farExp_74 - in name_75 - ( let _ = "suspend" - in \farInp_76 farExp_77 v_78 (!inp_79) -> - let join_80 = \farInp_81 farExp_82 v_83 (!inp_84) -> - name_85 - ( let _ = "suspend" - in \farInp_86 farExp_87 v_88 (!inp_89) -> - let _ = "resume" - in join_57 - farInp_86 - farExp_87 - ( let _ = "resume.genCode" - in v_83 - ) - inp_89 - ) - inp_84 - (Data.Map.Internal.Bin 1 "fail" catchHandler_62 Data.Map.Internal.Tip Data.Map.Internal.Tip) - in let _ = "catchException lbl=fail" - in let catchHandler_90 (!failInp_91) (!farInp_92) (!farExp_93) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_94 - _ - ) - ( Data.Text.Internal.Text - _ - j_95 - _ - ) -> i_94 GHC.Classes.== j_95 - ) - inp_79 - failInp_91 - then - let _ = "choicesBranch.then" - in name_50 - ( let _ = "suspend" - in \farInp_96 farExp_97 v_98 (!inp_99) -> - let _ = "resume" - in join_80 - farInp_96 - farExp_97 - ( let _ = "resume.genCode" - in v_98 - ) - inp_99 - ) - failInp_91 - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp_100, - farExp_101 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_92 failInp_91 of - GHC.Types.LT -> - (# - failInp_91, - [] - #) - GHC.Types.EQ -> - (# - farInp_92, - farExp_93 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_92, - farExp_93 - #) - in catchHandler_62 failInp_91 farInp_100 farExp_101 - in name_102 - ( let _ = "suspend" - in \farInp_103 farExp_104 v_105 (!inp_106) -> - name_50 - ( let _ = "suspend" - in \farInp_107 farExp_108 v_109 (!inp_110) -> - name_111 - ( let _ = "suspend" - in \farInp_112 farExp_113 v_114 (!inp_115) -> - name_50 - ( let _ = "suspend" - in \farInp_116 farExp_117 v_118 (!inp_119) -> - let _ = "resume" - in join_80 - farInp_116 - farExp_117 - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_119 - ) - inp_115 - Data.Map.Internal.Tip - ) - inp_110 - Data.Map.Internal.Tip - ) - inp_106 - Data.Map.Internal.Tip - ) - inp_79 - Data.Map.Internal.Tip - ) - inp_38 - (Data.Map.Internal.Bin 1 "fail" catchHandler_62 Data.Map.Internal.Tip Data.Map.Internal.Tip) + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp ) - failInp_29 - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp_120, - farExp_121 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of - GHC.Types.LT -> - (# - failInp_29, - [] - #) - GHC.Types.EQ -> - (# - farInp_30, - farExp_31 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_30, - farExp_31 - #) - in finalRaise_18 failInp_29 farInp_120 farExp_121 - in let join_122 = \farInp_123 farExp_124 v_125 (!inp_126) -> - let _ = "resume" - in ok_25 - farInp_123 - farExp_124 - ( let _ = "resume.genCode" - in v_125 - ) - inp_126 - in let _ = "catchException lbl=fail" - in let catchHandler_127 (!failInp_128) (!farInp_129) (!farExp_130) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_131 - _ - ) - ( Data.Text.Internal.Text - _ - j_132 - _ - ) -> i_131 GHC.Classes.== j_132 - ) - inp_26 - failInp_128 - then - let _ = "choicesBranch.then" - in let readFail_133 = catchHandler_28 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 failInp_128) - then - let !(# - c_134, - cs_135 - #) = readNext_3 failInp_128 - in if ('\'' GHC.Classes.==) c_134 - then - let join_136 = \farInp_137 farExp_138 v_139 (!inp_140) -> - let readFail_141 = readFail_133 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_140) - then - let !(# - c_142, - cs_143 - #) = readNext_3 inp_140 - in if ('\'' GHC.Classes.==) c_142 - then - name_144 - ( let _ = "suspend" - in \farInp_145 farExp_146 v_147 (!inp_148) -> - let _ = "resume" - in join_122 - farInp_145 - farExp_146 - ( let _ = "resume.genCode" - in v_139 - ) - inp_148 - ) - cs_143 - (Data.Map.Internal.Bin 1 "fail" readFail_141 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_149, - farExp_150 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_137 inp_140 of - GHC.Types.LT -> - (# - inp_140, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] - #) - GHC.Types.EQ -> - (# - farInp_137, - farExp_138 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] - #) - GHC.Types.GT -> - (# - farInp_137, - farExp_138 - #) - in readFail_141 inp_140 farInp_149 farExp_150 - else - let _ = "checkHorizon.else" - in let (# - farInp_151, - farExp_152 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_137 inp_140 of - GHC.Types.LT -> - (# - inp_140, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp_137, - farExp_138 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp_137, - farExp_138 - #) - in readFail_141 inp_140 farInp_151 farExp_152 - in let _ = "catchException lbl=fail" - in let catchHandler_153 (!failInp_154) (!farInp_155) (!farExp_156) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_157 - _ - ) - ( Data.Text.Internal.Text - _ - j_158 - _ - ) -> i_157 GHC.Classes.== j_158 - ) - cs_135 - failInp_154 - then - let _ = "choicesBranch.then" - in let readFail_159 = readFail_133 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 failInp_154) - then - let !(# - c_160, - cs_161 - #) = readNext_3 failInp_154 - in if ('\\' GHC.Classes.==) c_160 - then - let readFail_162 = readFail_159 - in let !(# - c_163, - cs_164 - #) = readNext_3 cs_161 - in if (\t_165 -> ('0' GHC.Classes.== t_165) GHC.Classes.|| (('t' GHC.Classes.== t_165) GHC.Classes.|| (('n' GHC.Classes.== t_165) GHC.Classes.|| (('v' GHC.Classes.== t_165) GHC.Classes.|| (('f' GHC.Classes.== t_165) GHC.Classes.|| (('r' GHC.Classes.== t_165) GHC.Classes.|| GHC.Types.False)))))) c_163 - then - name_50 - ( let _ = "suspend" - in \farInp_166 farExp_167 v_168 (!inp_169) -> - let _ = "resume" - in join_136 - farInp_166 - farExp_167 - ( let _ = "resume.genCode" - in v_168 - ) - inp_169 - ) - cs_164 - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp_170, - farExp_171 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_155 cs_161 of - GHC.Types.LT -> - (# - cs_161, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] - #) - GHC.Types.EQ -> - (# - farInp_155, - farExp_156 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] - #) - GHC.Types.GT -> - (# - farInp_155, - farExp_156 - #) - in readFail_159 cs_161 farInp_170 farExp_171 - else - let _ = "checkToken.else" - in let (# - farInp_172, - farExp_173 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_155 failInp_154 of - GHC.Types.LT -> - (# - failInp_154, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\\'] - #) - GHC.Types.EQ -> - (# - farInp_155, - farExp_156 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\\'] - #) - GHC.Types.GT -> - (# - farInp_155, - farExp_156 - #) - in readFail_159 failInp_154 farInp_172 farExp_173 - else - let _ = "checkHorizon.else" - in let (# - farInp_174, - farExp_175 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_155 failInp_154 of - GHC.Types.LT -> - (# - failInp_154, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - farInp_155, - farExp_156 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - farInp_155, - farExp_156 - #) - in readFail_159 failInp_154 farInp_174 farExp_175 - else - let _ = "choicesBranch.else" - in let (# - farInp_176, - farExp_177 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_155 failInp_154 of - GHC.Types.LT -> - (# - failInp_154, - [] - #) - GHC.Types.EQ -> - (# - farInp_155, - farExp_156 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_155, - farExp_156 - #) - in readFail_133 failInp_154 farInp_176 farExp_177 - in let readFail_178 = catchHandler_153 - in let !(# - c_179, - cs_180 - #) = readNext_3 cs_135 - in if Grammar.Nandlang.nandStringLetter c_179 - then - name_50 - ( let _ = "suspend" - in \farInp_181 farExp_182 v_183 (!inp_184) -> - let _ = "resume" - in join_136 - farInp_181 - farExp_182 - ( let _ = "resume.genCode" - in v_183 - ) - inp_184 - ) - cs_180 - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp_185, - farExp_186 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_129 cs_135 of - GHC.Types.LT -> - (# - cs_135, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "Char"] - #) - GHC.Types.EQ -> - (# - farInp_129, - farExp_130 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "Char"] - #) - GHC.Types.GT -> - (# - farInp_129, - farExp_130 - #) - in catchHandler_153 cs_135 farInp_185 farExp_186 - else - let _ = "checkToken.else" - in let (# - farInp_187, - farExp_188 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_129 failInp_128 of - GHC.Types.LT -> - (# - failInp_128, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] - #) - GHC.Types.EQ -> - (# - farInp_129, - farExp_130 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] - #) - GHC.Types.GT -> - (# - farInp_129, - farExp_130 - #) - in readFail_133 failInp_128 farInp_187 farExp_188 - else - let _ = "checkHorizon.else" - in let (# - farInp_189, - farExp_190 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_129 failInp_128 of - GHC.Types.LT -> - (# - failInp_128, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - farInp_129, - farExp_130 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - farInp_129, - farExp_130 - #) - in readFail_133 failInp_128 farInp_189 farExp_190 - else - let _ = "choicesBranch.else" - in let (# - farInp_191, - farExp_192 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_129 failInp_128 of - GHC.Types.LT -> - (# - failInp_128, - [] - #) - GHC.Types.EQ -> - (# - farInp_129, - farExp_130 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_129, - farExp_130 - #) - in catchHandler_28 failInp_128 farInp_191 farExp_192 - in let join_193 = \farInp_194 farExp_195 v_196 (!inp_197) -> - name_144 - ( let _ = "suspend" - in \farInp_198 farExp_199 v_200 (!inp_201) -> - let _ = "resume" - in join_122 - farInp_198 - farExp_199 - ( let _ = "resume.genCode" - in v_200 - ) - inp_201 - ) - inp_197 - (Data.Map.Internal.Bin 1 "fail" catchHandler_127 Data.Map.Internal.Tip Data.Map.Internal.Tip) - in let _ = "catchException lbl=fail" - in let catchHandler_202 (!failInp_203) (!farInp_204) (!farExp_205) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_206 - _ - ) - ( Data.Text.Internal.Text - _ - j_207 - _ - ) -> i_206 GHC.Classes.== j_207 - ) - inp_26 - failInp_203 - then - let _ = "choicesBranch.then" - in let readFail_208 = catchHandler_127 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_203) - then - let !(# - c_209, - cs_210 - #) = readNext_3 failInp_203 - in if ('1' GHC.Classes.==) c_209 - then - let _ = "resume" - in join_193 - farInp_204 - farExp_205 - ( let _ = "resume.genCode" - in '1' - ) - cs_210 - else - let _ = "checkToken.else" - in let (# - farInp_211, - farExp_212 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_204 failInp_203 of - GHC.Types.LT -> - (# - failInp_203, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '1'] - #) - GHC.Types.EQ -> - (# - farInp_204, - farExp_205 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '1'] - #) - GHC.Types.GT -> - (# - farInp_204, - farExp_205 - #) - in readFail_208 failInp_203 farInp_211 farExp_212 - else - let _ = "checkHorizon.else" - in let (# - farInp_213, - farExp_214 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_204 failInp_203 of - GHC.Types.LT -> - (# - failInp_203, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp_204, - farExp_205 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp_204, - farExp_205 - #) - in readFail_208 failInp_203 farInp_213 farExp_214 - else - let _ = "choicesBranch.else" - in let (# - farInp_215, - farExp_216 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_204 failInp_203 of - GHC.Types.LT -> - (# - failInp_203, - [] - #) - GHC.Types.EQ -> - (# - farInp_204, - farExp_205 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_204, - farExp_205 - #) - in catchHandler_127 failInp_203 farInp_215 farExp_216 - in let readFail_217 = catchHandler_202 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_26) - then - let !(# - c_218, - cs_219 - #) = readNext_3 inp_26 - in if ('0' GHC.Classes.==) c_218 - then - let _ = "resume" - in join_193 init_1 GHC.Types - . [] - ( let _ = "resume.genCode" - in '0' - ) - cs_219 - else - let _ = "checkToken.else" - in let (# - farInp_220, - farExp_221 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of - GHC.Types.LT -> - (# - inp_26, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '0'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '0'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_217 inp_26 farInp_220 farExp_221 - else - let _ = "checkHorizon.else" - in let (# - farInp_222, - farExp_223 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of - GHC.Types.LT -> - (# - inp_26, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_217 inp_26 farInp_222 farExp_223 - name_224 = \(!ok_225) (!inp_226) (!koByLabel_227) -> - let _ = "catchException lbl=fail" - in let catchHandler_228 (!failInp_229) (!farInp_230) (!farExp_231) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_232 - _ - ) - ( Data.Text.Internal.Text - _ - j_233 - _ - ) -> i_232 GHC.Classes.== j_233 - ) - inp_226 - failInp_229 - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok_225 - farInp_230 - farExp_231 - ( let _ = "resume.genCode" - in \x_234 -> x_234 - ) - failInp_229 - else - let _ = "choicesBranch.else" - in let (# - farInp_235, - farExp_236 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_230 failInp_229 of - GHC.Types.LT -> - (# - failInp_229, - [] - #) - GHC.Types.EQ -> - (# - farInp_230, - farExp_231 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_230, - farExp_231 - #) - in finalRaise_18 failInp_229 farInp_235 farExp_236 - in name_237 - ( let _ = "suspend" - in \farInp_238 farExp_239 v_240 (!inp_241) -> - name_242 - ( let _ = "suspend" - in \farInp_243 farExp_244 v_245 (!inp_246) -> - name_102 - ( let _ = "suspend" - in \farInp_247 farExp_248 v_249 (!inp_250) -> - name_224 - ( let _ = "suspend" - in \farInp_251 farExp_252 v_253 (!inp_254) -> - let _ = "resume" - in ok_225 - farInp_251 - farExp_252 - ( let _ = "resume.genCode" - in \x_255 -> v_240 v_249 (v_253 x_255) - ) - inp_254 - ) - inp_250 - Data.Map.Internal.Tip - ) - inp_246 - Data.Map.Internal.Tip - ) - inp_241 - (Data.Map.Internal.Bin 1 "fail" catchHandler_228 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp_226 - Data.Map.Internal.Tip - name_256 = \(!ok_257) (!inp_258) (!koByLabel_259) -> - let _ = "catchException lbl=fail" - in let catchHandler_260 (!failInp_261) (!farInp_262) (!farExp_263) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_264 - _ - ) - ( Data.Text.Internal.Text - _ - j_265 - _ - ) -> i_264 GHC.Classes.== j_265 - ) - inp_258 - failInp_261 - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok_257 - farInp_262 - farExp_263 - ( let _ = "resume.genCode" - in \x_266 -> x_266 - ) - failInp_261 - else - let _ = "choicesBranch.else" - in let (# - farInp_267, - farExp_268 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_262 failInp_261 of - GHC.Types.LT -> - (# - failInp_261, - [] - #) - GHC.Types.EQ -> - (# - farInp_262, - farExp_263 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_262, - farExp_263 - #) - in finalRaise_18 failInp_261 farInp_267 farExp_268 - in name_237 - ( let _ = "suspend" - in \farInp_269 farExp_270 v_271 (!inp_272) -> - name_242 - ( let _ = "suspend" - in \farInp_273 farExp_274 v_275 (!inp_276) -> - name_277 - ( let _ = "suspend" - in \farInp_278 farExp_279 v_280 (!inp_281) -> - name_256 - ( let _ = "suspend" - in \farInp_282 farExp_283 v_284 (!inp_285) -> - let _ = "resume" - in ok_257 - farInp_282 - farExp_283 - ( let _ = "resume.genCode" - in \x_286 -> v_271 v_280 (v_284 x_286) - ) - inp_285 - ) - inp_281 - Data.Map.Internal.Tip - ) - inp_276 - Data.Map.Internal.Tip - ) - inp_272 - (Data.Map.Internal.Bin 1 "fail" catchHandler_260 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp_258 - Data.Map.Internal.Tip - name_287 = \(!ok_288) (!inp_289) (!koByLabel_290) -> - let _ = "catchException lbl=fail" - in let catchHandler_291 (!failInp_292) (!farInp_293) (!farExp_294) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_295 - _ - ) - ( Data.Text.Internal.Text - _ - j_296 - _ - ) -> i_295 GHC.Classes.== j_296 - ) - inp_289 - failInp_292 - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok_288 - farInp_293 - farExp_294 - ( let _ = "resume.genCode" - in \x_297 -> x_297 - ) - failInp_292 - else - let _ = "choicesBranch.else" - in let (# - farInp_298, - farExp_299 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_293 failInp_292 of - GHC.Types.LT -> - (# - failInp_292, - [] - #) - GHC.Types.EQ -> - (# - farInp_293, - farExp_294 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_293, - farExp_294 - #) - in finalRaise_18 failInp_292 farInp_298 farExp_299 - in let join_300 = \farInp_301 farExp_302 v_303 (!inp_304) -> - name_287 - ( let _ = "suspend" - in \farInp_305 farExp_306 v_307 (!inp_308) -> - let _ = "resume" - in ok_288 - farInp_305 - farExp_306 - ( let _ = "resume.genCode" - in \x_309 -> v_307 x_309 - ) - inp_308 - ) - inp_304 - Data.Map.Internal.Tip - in let _ = "catchException lbl=fail" - in let catchHandler_310 (!failInp_311) (!farInp_312) (!farExp_313) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_314 - _ - ) - ( Data.Text.Internal.Text - _ - j_315 - _ - ) -> i_314 GHC.Classes.== j_315 - ) - inp_289 - failInp_311 - then - let _ = "choicesBranch.then" - in name_102 - ( let _ = "suspend" - in \farInp_316 farExp_317 v_318 (!inp_319) -> - name_320 - ( let _ = "suspend" - in \farInp_321 farExp_322 v_323 (!inp_324) -> - let _ = "resume" - in join_300 - farInp_321 - farExp_322 - ( let _ = "resume.genCode" - in v_318 - ) - inp_324 - ) - inp_319 - (Data.Map.Internal.Bin 1 "fail" catchHandler_291 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - failInp_311 - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp_325, - farExp_326 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_312 failInp_311 of - GHC.Types.LT -> - (# - failInp_311, - [] - #) - GHC.Types.EQ -> - (# - farInp_312, - farExp_313 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_312, - farExp_313 - #) - in catchHandler_291 failInp_311 farInp_325 farExp_326 - in let join_327 = \farInp_328 farExp_329 v_330 (!inp_331) -> + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if GHC.Unicode.isSpace c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "space"] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "space"] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\t -> ('0' GHC.Classes.== t) GHC.Classes.|| (('1' GHC.Classes.== t) GHC.Classes.|| (('2' GHC.Classes.== t) GHC.Classes.|| (('3' GHC.Classes.== t) GHC.Classes.|| (('4' GHC.Classes.== t) GHC.Classes.|| (('5' GHC.Classes.== t) GHC.Classes.|| (('6' GHC.Classes.== t) GHC.Classes.|| (('7' GHC.Classes.== t) GHC.Classes.|| (('8' GHC.Classes.== t) GHC.Classes.|| (('9' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))))))))) c + then + let _ = "resume" + in ok init GHC.Types + . [] + ( let _ = "resume.genCode" + in c + ) + cs + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('(' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in '(' + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '('] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '('] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if (')' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in ')' + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ')'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ')'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if (',' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in ',' + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ','] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ','] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if (';' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> let _ = "resume" - in join_300 - farInp_328 - farExp_329 + in ok + farInp + farExp ( let _ = "resume.genCode" - in v_330 + in ';' ) - inp_331 - in let _ = "catchException lbl=fail" - in let catchHandler_332 (!failInp_333) (!farInp_334) (!farExp_335) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_336 - _ - ) - ( Data.Text.Internal.Text - _ - j_337 - _ - ) -> i_336 GHC.Classes.== j_337 - ) - inp_289 - failInp_333 - then - let _ = "choicesBranch.then" - in let _ = "catchException lbl=fail" - in let catchHandler_338 (!failInp_339) (!farInp_340) (!farExp_341) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp_342, - farExp_343 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_340 failInp_333 of - GHC.Types.LT -> - (# - failInp_333, - [] - #) - GHC.Types.EQ -> - (# - farInp_340, - farExp_341 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_340, - farExp_341 - #) - in catchHandler_310 failInp_333 farInp_342 farExp_343 - in let join_344 = \farInp_345 farExp_346 v_347 (!inp_348) -> - name_277 - ( let _ = "suspend" - in \farInp_349 farExp_350 v_351 (!inp_352) -> - name_50 - ( let _ = "suspend" - in \farInp_353 farExp_354 v_355 (!inp_356) -> - name_256 - ( let _ = "suspend" - in \farInp_357 farExp_358 v_359 (!inp_360) -> - name_50 - ( let _ = "suspend" - in \farInp_361 farExp_362 v_363 (!inp_364) -> - let readFail_365 = catchHandler_338 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_364) - then - let !(# - c_366, - cs_367 - #) = readNext_3 inp_364 - in if ('=' GHC.Classes.==) c_366 - then - name_144 - ( let _ = "suspend" - in \farInp_368 farExp_369 v_370 (!inp_371) -> - name_102 - ( let _ = "suspend" - in \farInp_372 farExp_373 v_374 (!inp_375) -> - name_50 - ( let _ = "suspend" - in \farInp_376 farExp_377 v_378 (!inp_379) -> - name_224 - ( let _ = "suspend" - in \farInp_380 farExp_381 v_382 (!inp_383) -> - name_50 - ( let _ = "suspend" - in \farInp_384 farExp_385 v_386 (!inp_387) -> - name_320 - ( let _ = "suspend" - in \farInp_388 farExp_389 v_390 (!inp_391) -> - let _ = "resume" - in join_327 - farInp_388 - farExp_389 - ( let _ = "resume.genCode" - in v_386 - ) - inp_391 - ) - inp_387 - (Data.Map.Internal.Bin 1 "fail" readFail_365 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp_383 - Data.Map.Internal.Tip - ) - inp_379 - Data.Map.Internal.Tip - ) - inp_375 - Data.Map.Internal.Tip - ) - inp_371 - Data.Map.Internal.Tip - ) - cs_367 - (Data.Map.Internal.Bin 1 "fail" readFail_365 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_392, - farExp_393 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_361 inp_364 of - GHC.Types.LT -> - (# - inp_364, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '='] - #) - GHC.Types.EQ -> - (# - farInp_361, - farExp_362 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '='] - #) - GHC.Types.GT -> - (# - farInp_361, - farExp_362 - #) - in readFail_365 inp_364 farInp_392 farExp_393 - else - let _ = "checkHorizon.else" - in let (# - farInp_394, - farExp_395 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_361 inp_364 of - GHC.Types.LT -> - (# - inp_364, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - farInp_361, - farExp_362 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - farInp_361, - farExp_362 - #) - in readFail_365 inp_364 farInp_394 farExp_395 - ) - inp_360 - Data.Map.Internal.Tip - ) - inp_356 - Data.Map.Internal.Tip - ) - inp_352 - Data.Map.Internal.Tip - ) - inp_348 - Data.Map.Internal.Tip - in let _ = "catchException lbl=fail" - in let catchHandler_396 (!failInp_397) (!farInp_398) (!farExp_399) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_400 - _ - ) - ( Data.Text.Internal.Text - _ - j_401 - _ - ) -> i_400 GHC.Classes.== j_401 - ) - failInp_333 - failInp_397 - then - let _ = "choicesBranch.then" - in name_50 - ( let _ = "suspend" - in \farInp_402 farExp_403 v_404 (!inp_405) -> - let _ = "resume" - in join_344 - farInp_402 - farExp_403 - ( let _ = "resume.genCode" - in v_404 - ) - inp_405 - ) - failInp_397 - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp_406, - farExp_407 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_398 failInp_397 of - GHC.Types.LT -> - (# - failInp_397, - [] - #) - GHC.Types.EQ -> - (# - farInp_398, - farExp_399 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_398, - farExp_399 - #) - in catchHandler_338 failInp_397 farInp_406 farExp_407 - in let _ = "catchException lbl=fail" - in let catchHandler_408 (!failInp_409) (!farInp_410) (!farExp_411) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp_412, - farExp_413 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_410 failInp_333 of - GHC.Types.LT -> - (# - failInp_333, - [] - #) - GHC.Types.EQ -> - (# - farInp_410, - farExp_411 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_410, - farExp_411 - #) - in catchHandler_396 failInp_333 farInp_412 farExp_413 - in let readFail_414 = catchHandler_408 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 10 failInp_333) - then - let !(# - c_415, - cs_416 - #) = readNext_3 failInp_333 - in if ('v' GHC.Classes.==) c_415 - then - let readFail_417 = readFail_414 - in let !(# - c_418, - cs_419 - #) = readNext_3 cs_416 - in if ('a' GHC.Classes.==) c_418 - then - let readFail_420 = readFail_414 - in let !(# - c_421, - cs_422 - #) = readNext_3 cs_419 - in if ('r' GHC.Classes.==) c_421 - then - name_423 - ( let _ = "suspend" - in \farInp_424 farExp_425 v_426 (!inp_427) -> - let _ = "resume" - in join_344 - farInp_424 - farExp_425 - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_427 - ) - cs_422 - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp_428, - farExp_429 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 cs_419 of - GHC.Types.LT -> - (# - cs_419, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] - #) - GHC.Types.EQ -> - (# - farInp_334, - farExp_335 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] - #) - GHC.Types.GT -> - (# - farInp_334, - farExp_335 - #) - in readFail_414 cs_419 farInp_428 farExp_429 - else - let _ = "checkToken.else" - in let (# - farInp_430, - farExp_431 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 cs_416 of - GHC.Types.LT -> - (# - cs_416, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - farInp_334, - farExp_335 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - farInp_334, - farExp_335 - #) - in readFail_414 cs_416 farInp_430 farExp_431 - else - let _ = "checkToken.else" - in let (# - farInp_432, - farExp_433 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 failInp_333 of - GHC.Types.LT -> - (# - failInp_333, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'v'] - #) - GHC.Types.EQ -> - (# - farInp_334, - farExp_335 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'v'] - #) - GHC.Types.GT -> - (# - farInp_334, - farExp_335 - #) - in readFail_414 failInp_333 farInp_432 farExp_433 - else - let _ = "checkHorizon.else" - in let (# - farInp_434, - farExp_435 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 failInp_333 of - GHC.Types.LT -> - (# - failInp_333, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] - #) - GHC.Types.EQ -> - (# - farInp_334, - farExp_335 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] - #) - GHC.Types.GT -> - (# - farInp_334, - farExp_335 - #) - in readFail_414 failInp_333 farInp_434 farExp_435 - else - let _ = "choicesBranch.else" - in let (# - farInp_436, - farExp_437 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_334 failInp_333 of - GHC.Types.LT -> - (# - failInp_333, - [] - #) - GHC.Types.EQ -> - (# - farInp_334, - farExp_335 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_334, - farExp_335 - #) - in catchHandler_310 failInp_333 farInp_436 farExp_437 - in let join_438 = \farInp_439 farExp_440 v_441 (!inp_442) -> + inp + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ';'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ';'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('{' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let readFail = readFail + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if ('}' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '}'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '}'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '{'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '{'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 4 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('[' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let readFail = readFail + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (']' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '['] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '['] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 5] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 5] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> let _ = "resume" - in join_327 - farInp_439 - farExp_440 + in ok + farInp + farExp ( let _ = "resume.genCode" - in v_441 + in v ) - inp_442 + inp in let _ = "catchException lbl=fail" - in let catchHandler_443 (!failInp_444) (!farInp_445) (!farExp_446) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_447 + i + _ + ) + ( Data.Text.Internal.Text _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + failInp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip ) - ( Data.Text.Internal.Text - _ - j_448 - _ - ) -> i_447 GHC.Classes.== j_448 - ) - inp_289 - failInp_444 - then - let _ = "choicesBranch.then" - in let _ = "catchException lbl=fail" - in let catchHandler_449 (!failInp_450) (!farInp_451) (!farExp_452) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp_453, - farExp_454 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_451 failInp_444 of - GHC.Types.LT -> - (# - failInp_444, - [] - #) - GHC.Types.EQ -> - (# - farInp_451, - farExp_452 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_451, - farExp_452 - #) - in catchHandler_332 failInp_444 farInp_453 farExp_454 - in let readFail_455 = catchHandler_449 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 10 failInp_444) - then - let !(# - c_456, - cs_457 - #) = readNext_3 failInp_444 - in if ('w' GHC.Classes.==) c_456 - then - let readFail_458 = readFail_455 - in let !(# - c_459, - cs_460 - #) = readNext_3 cs_457 - in if ('h' GHC.Classes.==) c_459 - then - let readFail_461 = readFail_455 - in let !(# - c_462, - cs_463 - #) = readNext_3 cs_460 - in if ('i' GHC.Classes.==) c_462 - then - let readFail_464 = readFail_455 - in let !(# - c_465, - cs_466 - #) = readNext_3 cs_463 - in if ('l' GHC.Classes.==) c_465 - then - let readFail_467 = readFail_455 - in let !(# - c_468, - cs_469 - #) = readNext_3 cs_466 - in if ('e' GHC.Classes.==) c_468 - then - name_423 - ( let _ = "suspend" - in \farInp_470 farExp_471 v_472 (!inp_473) -> - name_102 - ( let _ = "suspend" - in \farInp_474 farExp_475 v_476 (!inp_477) -> - name_478 - ( let _ = "suspend" - in \farInp_479 farExp_480 v_481 (!inp_482) -> - let _ = "resume" - in join_438 - farInp_479 - farExp_480 - ( let _ = "resume.genCode" - in v_481 - ) - inp_482 - ) - inp_477 - (Data.Map.Internal.Bin 1 "fail" catchHandler_332 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp_473 - Data.Map.Internal.Tip - ) - cs_469 - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp_483, - farExp_484 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 cs_466 of - GHC.Types.LT -> - (# - cs_466, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'e'] - #) - GHC.Types.EQ -> - (# - farInp_445, - farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'e'] - #) - GHC.Types.GT -> - (# - farInp_445, - farExp_446 - #) - in readFail_455 cs_466 farInp_483 farExp_484 - else - let _ = "checkToken.else" - in let (# - farInp_485, - farExp_486 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 cs_463 of - GHC.Types.LT -> - (# - cs_463, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'l'] - #) - GHC.Types.EQ -> - (# - farInp_445, - farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'l'] - #) - GHC.Types.GT -> - (# - farInp_445, - farExp_446 - #) - in readFail_455 cs_463 farInp_485 farExp_486 - else - let _ = "checkToken.else" - in let (# - farInp_487, - farExp_488 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 cs_460 of - GHC.Types.LT -> - (# - cs_460, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.EQ -> - (# - farInp_445, - farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.GT -> - (# - farInp_445, - farExp_446 - #) - in readFail_455 cs_460 farInp_487 farExp_488 - else - let _ = "checkToken.else" - in let (# - farInp_489, - farExp_490 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 cs_457 of - GHC.Types.LT -> - (# - cs_457, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'h'] - #) - GHC.Types.EQ -> - (# - farInp_445, - farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'h'] - #) - GHC.Types.GT -> - (# - farInp_445, - farExp_446 - #) - in readFail_455 cs_457 farInp_489 farExp_490 - else - let _ = "checkToken.else" - in let (# - farInp_491, - farExp_492 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 failInp_444 of - GHC.Types.LT -> - (# - failInp_444, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'w'] - #) - GHC.Types.EQ -> - (# - farInp_445, - farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'w'] - #) - GHC.Types.GT -> - (# - farInp_445, - farExp_446 - #) - in readFail_455 failInp_444 farInp_491 farExp_492 + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('\'' GHC.Classes.==) c + then + let join = \farInp farExp v (!inp) -> + let readFail = readFail + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('\'' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + cs + failInp + then + let _ = "choicesBranch.then" + in let readFail = readFail + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('\\' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if (\t -> ('0' GHC.Classes.== t) GHC.Classes.|| (('t' GHC.Classes.== t) GHC.Classes.|| (('n' GHC.Classes.== t) GHC.Classes.|| (('v' GHC.Classes.== t) GHC.Classes.|| (('f' GHC.Classes.== t) GHC.Classes.|| (('r' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))))) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\\'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\\'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + in let readFail = catchHandler + in let !(# + c, + cs + #) = readNext cs + in if Grammar.Nandlang.nandStringLetter c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + Data.Map.Internal.Tip else - let _ = "checkHorizon.else" + let _ = "checkToken.else" in let (# - farInp_493, - farExp_494 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 failInp_444 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of GHC.Types.LT -> (# - failInp_444, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "Char"] #) GHC.Types.EQ -> (# - farInp_445, - farExp_446 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "Char"] #) GHC.Types.GT -> (# - farInp_445, - farExp_446 + farInp, + farExp #) - in readFail_455 failInp_444 farInp_493 farExp_494 - else - let _ = "choicesBranch.else" - in let (# - farInp_495, - farExp_496 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_445 failInp_444 of - GHC.Types.LT -> - (# - failInp_444, - [] - #) - GHC.Types.EQ -> - (# - farInp_445, - farExp_446 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_445, - farExp_446 - #) - in catchHandler_332 failInp_444 farInp_495 farExp_496 - in let _ = "catchException lbl=fail" - in let catchHandler_497 (!failInp_498) (!farInp_499) (!farExp_500) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp_501, - farExp_502 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_499 inp_289 of - GHC.Types.LT -> - (# - inp_289, - [] - #) - GHC.Types.EQ -> - (# - farInp_499, - farExp_500 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_499, - farExp_500 - #) - in catchHandler_443 inp_289 farInp_501 farExp_502 - in let readFail_503 = catchHandler_497 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_289) - then - let !(# - c_504, - cs_505 - #) = readNext_3 inp_289 - in if ('i' GHC.Classes.==) c_504 - then - let readFail_506 = readFail_503 - in let !(# - c_507, - cs_508 - #) = readNext_3 cs_505 - in if ('f' GHC.Classes.==) c_507 - then - name_423 - ( let _ = "suspend" - in \farInp_509 farExp_510 v_511 (!inp_512) -> - let _ = "resume" - in join_438 - farInp_509 - farExp_510 - ( let _ = "resume.genCode" - in v_511 - ) - inp_512 - ) - cs_508 - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp_513, - farExp_514 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_505 of - GHC.Types.LT -> - (# - cs_505, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_503 cs_505 farInp_513 farExp_514 - else - let _ = "checkToken.else" - in let (# - farInp_515, - farExp_516 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_289 of - GHC.Types.LT -> - (# - inp_289, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_503 inp_289 farInp_515 farExp_516 - else - let _ = "checkHorizon.else" - in let (# - farInp_517, - farExp_518 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_289 of - GHC.Types.LT -> - (# - inp_289, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_503 inp_289 farInp_517 farExp_518 - name_85 = \(!ok_519) (!inp_520) (!koByLabel_521) -> - let readFail_522 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_521 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_520) - then - let !(# - c_523, - cs_524 - #) = readNext_3 inp_520 - in if (')' GHC.Classes.==) c_523 - then - name_144 - ( let _ = "suspend" - in \farInp_525 farExp_526 v_527 (!inp_528) -> - let _ = "resume" - in ok_519 - farInp_525 - farExp_526 - ( let _ = "resume.genCode" - in ')' - ) - inp_528 - ) - cs_524 - (Data.Map.Internal.Bin 1 "fail" readFail_522 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_529, - farExp_530 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_520 of - GHC.Types.LT -> - (# - inp_520, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ')'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ')'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_522 inp_520 farInp_529 farExp_530 - else - let _ = "checkHorizon.else" - in let (# - farInp_531, - farExp_532 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_520 of - GHC.Types.LT -> - (# - inp_520, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_522 inp_520 farInp_531 farExp_532 - name_68 = \(!ok_533) (!inp_534) (!koByLabel_535) -> - let readFail_536 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_535 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 4 inp_534) - then - let !(# - c_537, - cs_538 - #) = readNext_3 inp_534 - in if ('[' GHC.Classes.==) c_537 - then - name_144 - ( let _ = "suspend" - in \farInp_539 farExp_540 v_541 (!inp_542) -> - name_543 + in catchHandler cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_544 farExp_545 v_546 (!inp_547) -> - name_548 - ( let _ = "suspend" - in \farInp_549 farExp_550 v_551 (!inp_552) -> - let readFail_553 = readFail_536 - in if readMore_2 inp_552 + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) then let !(# - c_554, - cs_555 - #) = readNext_3 inp_552 - in if (']' GHC.Classes.==) c_554 + c, + cs + #) = readNext failInp + in if ('1' GHC.Classes.==) c then - name_144 - ( let _ = "suspend" - in \farInp_556 farExp_557 v_558 (!inp_559) -> - let _ = "resume" - in ok_533 - farInp_556 - farExp_557 - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_559 - ) - cs_555 - (Data.Map.Internal.Bin 1 "fail" readFail_553 Data.Map.Internal.Tip Data.Map.Internal.Tip) + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in '1' + ) + cs else let _ = "checkToken.else" in let (# - farInp_560, - farExp_561 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_549 inp_552 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - inp_552, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '1'] #) GHC.Types.EQ -> (# - farInp_549, - farExp_550 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '1'] #) GHC.Types.GT -> (# - farInp_549, - farExp_550 + farInp, + farExp #) - in readFail_553 inp_552 farInp_560 farExp_561 + in readFail failInp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_562, - farExp_563 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_549 inp_552 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - inp_552, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.EQ -> (# - farInp_549, - farExp_550 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.GT -> (# - farInp_549, - farExp_550 + farInp, + farExp #) - in readFail_553 inp_552 farInp_562 farExp_563 - ) - inp_547 - Data.Map.Internal.Tip + in readFail failInp farInp farExp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('0' GHC.Classes.==) c + then + let _ = "resume" + in join init GHC.Types + . [] + ( let _ = "resume.genCode" + in '0' + ) + cs + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '0'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '0'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "jump" + in name ok failInp Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x ) - inp_542 - (Data.Map.Internal.Bin 1 "fail" readFail_536 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - cs_538 - (Data.Map.Internal.Bin 1 "fail" readFail_536 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_564, - farExp_565 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_534 of - GHC.Types.LT -> - (# - inp_534, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '['] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '['] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_536 inp_534 farInp_564 farExp_565 - else - let _ = "checkHorizon.else" - in let (# - farInp_566, - farExp_567 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_534 of - GHC.Types.LT -> - (# - inp_534, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 5] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 5] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_536 inp_534 farInp_566 farExp_567 - name_75 = \(!ok_568) (!inp_569) (!koByLabel_570) -> - let readFail_571 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_570 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_569) - then - let !(# - c_572, - cs_573 - #) = readNext_3 inp_569 - in if ('(' GHC.Classes.==) c_572 - then - name_144 - ( let _ = "suspend" - in \farInp_574 farExp_575 v_576 (!inp_577) -> - let _ = "resume" - in ok_568 - farInp_574 - farExp_575 - ( let _ = "resume.genCode" - in '(' - ) - inp_577 - ) - cs_573 - (Data.Map.Internal.Bin 1 "fail" readFail_571 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_578, - farExp_579 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_569 of - GHC.Types.LT -> - (# - inp_569, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '('] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '('] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_571 inp_569 farInp_578 farExp_579 - else - let _ = "checkHorizon.else" - in let (# - farInp_580, - farExp_581 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_569 of - GHC.Types.LT -> - (# - inp_569, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_571 inp_569 farInp_580 farExp_581 - name_548 = \(!ok_582) (!inp_583) (!koByLabel_584) -> + failInp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v v (v x) + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_585 (!failInp_586) (!farInp_587) (!farExp_588) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_589 + i _ ) ( Data.Text.Internal.Text _ - j_590 + j _ - ) -> i_589 GHC.Classes.== j_590 + ) -> i GHC.Classes.== j ) - inp_583 - failInp_586 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_582 - farInp_587 - farExp_588 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_591 -> x_591 + in \x -> x ) - failInp_586 + failInp else let _ = "choicesBranch.else" in let (# - farInp_592, - farExp_593 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_587 failInp_586 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_586, + failInp, [] #) GHC.Types.EQ -> (# - farInp_587, - farExp_588 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_587, - farExp_588 + farInp, + farExp #) - in finalRaise_18 failInp_586 farInp_592 farExp_593 - in name_543 + in finalRaise failInp farInp farExp + in name ( let _ = "suspend" - in \farInp_594 farExp_595 v_596 (!inp_597) -> - name_548 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_598 farExp_599 v_600 (!inp_601) -> - let _ = "resume" - in ok_582 - farInp_598 - farExp_599 - ( let _ = "resume.genCode" - in \x_602 -> v_600 x_602 - ) - inp_601 + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v v (v x) + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip ) - inp_597 - Data.Map.Internal.Tip + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) - inp_583 - (Data.Map.Internal.Bin 1 "fail" catchHandler_585 Data.Map.Internal.Tip Data.Map.Internal.Tip) - name_237 = \(!ok_603) (!inp_604) (!koByLabel_605) -> - let _ = "resume" - in ok_603 init_1 GHC.Types - . [] - ( let _ = "resume.genCode" - in \x_606 -> \x_607 -> x_607 - ) - inp_604 - name_50 = \(!ok_608) (!inp_609) (!koByLabel_610) -> - let _ = "resume" - in ok_608 init_1 GHC.Types - . [] - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_609 - name_611 = \(!ok_612) (!inp_613) (!koByLabel_614) -> + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_615 (!failInp_616) (!farInp_617) (!farExp_618) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_619 + i _ ) ( Data.Text.Internal.Text _ - j_620 + j _ - ) -> i_619 GHC.Classes.== j_620 + ) -> i GHC.Classes.== j ) - inp_613 - failInp_616 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_612 - farInp_617 - farExp_618 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_621 -> x_621 + in \x -> x ) - failInp_616 + failInp else let _ = "choicesBranch.else" in let (# - farInp_622, - farExp_623 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_617 failInp_616 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_616, + failInp, [] #) GHC.Types.EQ -> (# - farInp_617, - farExp_618 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_617, - farExp_618 + farInp, + farExp #) - in finalRaise_18 failInp_616 farInp_622 farExp_623 - in let readFail_624 = catchHandler_615 - in if readMore_2 inp_613 - then - let !(# - c_625, - cs_626 - #) = readNext_3 inp_613 - in if Grammar.Nandlang.nandIdentLetter c_625 - then - name_611 - ( let _ = "suspend" - in \farInp_627 farExp_628 v_629 (!inp_630) -> - let _ = "resume" - in ok_612 - farInp_627 - farExp_628 - ( let _ = "resume.genCode" - in \x_631 -> v_629 x_631 + in finalRaise failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v v (v x) + ) + inp ) - inp_630 - ) - cs_626 - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp_632, - farExp_633 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_613 of - GHC.Types.LT -> - (# - inp_613, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identLetter"] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identLetter"] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_624 inp_613 farInp_632 farExp_633 - else - let _ = "checkHorizon.else" - in let (# - farInp_634, - farExp_635 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_613 of - GHC.Types.LT -> - (# - inp_613, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_624 inp_613 farInp_634 farExp_635 - name_636 = \(!ok_637) (!inp_638) (!koByLabel_639) -> + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v v (v x) + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_640 (!failInp_641) (!farInp_642) (!farExp_643) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_644 + i _ ) ( Data.Text.Internal.Text _ - j_645 + j _ - ) -> i_644 GHC.Classes.== j_645 + ) -> i GHC.Classes.== j ) - inp_638 - failInp_641 + inp + failInp then let _ = "choicesBranch.then" - in let _ = "jump" - in name_50 ok_637 failInp_641 Data.Map.Internal.Tip + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp else let _ = "choicesBranch.else" in let (# - farInp_646, - farExp_647 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_642 failInp_641 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_641, + failInp, [] #) GHC.Types.EQ -> (# - farInp_642, - farExp_643 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_642, - farExp_643 + farInp, + farExp #) - in finalRaise_18 failInp_641 farInp_646 farExp_647 - in name_277 + in finalRaise failInp farInp farExp + in name ( let _ = "suspend" - in \farInp_648 farExp_649 v_650 (!inp_651) -> - name_50 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_652 farExp_653 v_654 (!inp_655) -> - name_656 - ( let _ = "suspend" - in \farInp_657 farExp_658 v_659 (!inp_660) -> - name_50 - ( let _ = "suspend" - in \farInp_661 farExp_662 v_663 (!inp_664) -> - let _ = "resume" - in ok_637 - farInp_661 - farExp_662 - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_664 - ) - inp_660 - Data.Map.Internal.Tip - ) - inp_655 - Data.Map.Internal.Tip + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp ) - inp_651 + inp Data.Map.Internal.Tip ) - inp_638 - Data.Map.Internal.Tip - name_320 = \(!ok_665) (!inp_666) (!koByLabel_667) -> - let readFail_668 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_667 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_666) - then - let !(# - c_669, - cs_670 - #) = readNext_3 inp_666 - in if (';' GHC.Classes.==) c_669 - then - name_144 - ( let _ = "suspend" - in \farInp_671 farExp_672 v_673 (!inp_674) -> - let _ = "resume" - in ok_665 - farInp_671 - farExp_672 - ( let _ = "resume.genCode" - in ';' - ) - inp_674 - ) - cs_670 - (Data.Map.Internal.Bin 1 "fail" readFail_668 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_675, - farExp_676 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_666 of - GHC.Types.LT -> - (# - inp_666, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ';'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ';'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_668 inp_666 farInp_675 farExp_676 - else - let _ = "checkHorizon.else" - in let (# - farInp_677, - farExp_678 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_666 of - GHC.Types.LT -> - (# - inp_666, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_668 inp_666 farInp_677 farExp_678 - name_102 = \(!ok_679) (!inp_680) (!koByLabel_681) -> - name_24 - ( let _ = "suspend" - in \farInp_682 farExp_683 v_684 (!inp_685) -> - name_50 - ( let _ = "suspend" - in \farInp_686 farExp_687 v_688 (!inp_689) -> - name_690 - ( let _ = "suspend" - in \farInp_691 farExp_692 v_693 (!inp_694) -> - name_50 - ( let _ = "suspend" - in \farInp_695 farExp_696 v_697 (!inp_698) -> - let _ = "resume" - in ok_679 - farInp_695 - farExp_696 - ( let _ = "resume.genCode" - in v_697 - ) - inp_698 - ) - inp_694 - Data.Map.Internal.Tip - ) - inp_689 - Data.Map.Internal.Tip - ) - inp_685 - Data.Map.Internal.Tip - ) - inp_680 - Data.Map.Internal.Tip - name_699 = \(!ok_700) (!inp_701) (!koByLabel_702) -> + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_703 (!failInp_704) (!farInp_705) (!farExp_706) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_707 + i _ ) ( Data.Text.Internal.Text _ - j_708 + j _ - ) -> i_707 GHC.Classes.== j_708 + ) -> i GHC.Classes.== j ) - inp_701 - failInp_704 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_700 - farInp_705 - farExp_706 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_709 -> x_709 + in \x -> x ) - failInp_704 + failInp else let _ = "choicesBranch.else" in let (# - farInp_710, - farExp_711 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_705 failInp_704 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_704, + failInp, [] #) GHC.Types.EQ -> (# - farInp_705, - farExp_706 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_705, - farExp_706 + farInp, + farExp #) - in finalRaise_18 failInp_704 farInp_710 farExp_711 - in let _ = "catchException lbl=fail" - in let catchHandler_712 (!failInp_713) (!farInp_714) (!farExp_715) = - let _ = "catchException.ko lbl=fail" + in finalRaise failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" in let (# - farInp_716, - farExp_717 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_714 inp_701 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - inp_701, + failInp, [] #) GHC.Types.EQ -> (# - farInp_714, - farExp_715 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_714, - farExp_715 + farInp, + farExp #) - in catchHandler_703 inp_701 farInp_716 farExp_717 - in let readFail_718 = catchHandler_712 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 17 inp_701) - then - let !(# - c_719, - cs_720 - #) = readNext_3 inp_701 - in if ('f' GHC.Classes.==) c_719 - then - let readFail_721 = readFail_718 - in let !(# - c_722, - cs_723 - #) = readNext_3 cs_720 - in if ('u' GHC.Classes.==) c_722 - then - let readFail_724 = readFail_718 - in let !(# - c_725, - cs_726 - #) = readNext_3 cs_723 - in if ('n' GHC.Classes.==) c_725 - then - let readFail_727 = readFail_718 - in let !(# - c_728, - cs_729 - #) = readNext_3 cs_726 - in if ('c' GHC.Classes.==) c_728 + in finalRaise failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + inp + Data.Map.Internal.Tip + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('=' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '='] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '='] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + failInp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 10 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('v' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('r' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'v'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'v'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 10 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('w' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('h' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('i' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('l' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('e' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'e'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'e'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'l'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'l'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'h'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'h'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'w'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'w'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('i' GHC.Classes.==) c then - let readFail_730 = readFail_718 + let readFail = readFail in let !(# - c_731, - cs_732 - #) = readNext_3 cs_729 - in if ('t' GHC.Classes.==) c_731 + c, + cs + #) = readNext cs + in if ('f' GHC.Classes.==) c then - let readFail_733 = readFail_718 - in let !(# - c_734, - cs_735 - #) = readNext_3 cs_732 - in if ('i' GHC.Classes.==) c_734 - then - let readFail_736 = readFail_718 - in let !(# - c_737, - cs_738 - #) = readNext_3 cs_735 - in if ('o' GHC.Classes.==) c_737 - then - let readFail_739 = readFail_718 - in let !(# - c_740, - cs_741 - #) = readNext_3 cs_738 - in if ('n' GHC.Classes.==) c_740 - then - name_423 - ( let _ = "suspend" - in \farInp_742 farExp_743 v_744 (!inp_745) -> - name_34 - ( let _ = "suspend" - in \farInp_746 farExp_747 v_748 (!inp_749) -> - name_75 - ( let _ = "suspend" - in \farInp_750 farExp_751 v_752 (!inp_753) -> - name_636 - ( let _ = "suspend" - in \farInp_754 farExp_755 v_756 (!inp_757) -> - let join_758 = \farInp_759 farExp_760 v_761 (!inp_762) -> - name_85 - ( let _ = "suspend" - in \farInp_763 farExp_764 v_765 (!inp_766) -> - name_478 - ( let _ = "suspend" - in \farInp_767 farExp_768 v_769 (!inp_770) -> - name_699 - ( let _ = "suspend" - in \farInp_771 farExp_772 v_773 (!inp_774) -> - let _ = "resume" - in ok_700 - farInp_771 - farExp_772 - ( let _ = "resume.genCode" - in \x_775 -> v_773 x_775 - ) - inp_774 - ) - inp_770 - Data.Map.Internal.Tip - ) - inp_766 - (Data.Map.Internal.Bin 1 "fail" catchHandler_703 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp_762 - (Data.Map.Internal.Bin 1 "fail" catchHandler_703 Data.Map.Internal.Tip Data.Map.Internal.Tip) - in let _ = "catchException lbl=fail" - in let catchHandler_776 (!failInp_777) (!farInp_778) (!farExp_779) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_780 - _ - ) - ( Data.Text.Internal.Text - _ - j_781 - _ - ) -> i_780 GHC.Classes.== j_781 - ) - inp_757 - failInp_777 - then - let _ = "choicesBranch.then" - in name_50 - ( let _ = "suspend" - in \farInp_782 farExp_783 v_784 (!inp_785) -> - let _ = "resume" - in join_758 - farInp_782 - farExp_783 - ( let _ = "resume.genCode" - in v_784 - ) - inp_785 - ) - failInp_777 - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp_786, - farExp_787 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_778 failInp_777 of - GHC.Types.LT -> - (# - failInp_777, - [] - #) - GHC.Types.EQ -> - (# - farInp_778, - farExp_779 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_778, - farExp_779 - #) - in catchHandler_703 failInp_777 farInp_786 farExp_787 - in let readFail_788 = catchHandler_776 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_757) - then - let !(# - c_789, - cs_790 - #) = readNext_3 inp_757 - in if (':' GHC.Classes.==) c_789 - then - name_144 - ( let _ = "suspend" - in \farInp_791 farExp_792 v_793 (!inp_794) -> - name_636 - ( let _ = "suspend" - in \farInp_795 farExp_796 v_797 (!inp_798) -> - let _ = "resume" - in join_758 - farInp_795 - farExp_796 - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_798 - ) - inp_794 - Data.Map.Internal.Tip - ) - cs_790 - (Data.Map.Internal.Bin 1 "fail" readFail_788 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_799, - farExp_800 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_754 inp_757 of - GHC.Types.LT -> - (# - inp_757, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ':'] - #) - GHC.Types.EQ -> - (# - farInp_754, - farExp_755 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ':'] - #) - GHC.Types.GT -> - (# - farInp_754, - farExp_755 - #) - in readFail_788 inp_757 farInp_799 farExp_800 - else - let _ = "checkHorizon.else" - in let (# - farInp_801, - farExp_802 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_754 inp_757 of - GHC.Types.LT -> - (# - inp_757, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp_754, - farExp_755 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp_754, - farExp_755 - #) - in readFail_788 inp_757 farInp_801 farExp_802 - ) - inp_753 - Data.Map.Internal.Tip - ) - inp_749 - (Data.Map.Internal.Bin 1 "fail" catchHandler_703 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp_745 - Data.Map.Internal.Tip - ) - cs_741 - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp_803, - farExp_804 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_738 of - GHC.Types.LT -> - (# - cs_738, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_718 cs_738 farInp_803 farExp_804 - else - let _ = "checkToken.else" - in let (# - farInp_805, - farExp_806 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_735 of - GHC.Types.LT -> - (# - cs_735, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'o'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'o'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_718 cs_735 farInp_805 farExp_806 - else - let _ = "checkToken.else" - in let (# - farInp_807, - farExp_808 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_732 of - GHC.Types.LT -> - (# - cs_732, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_718 cs_732 farInp_807 farExp_808 + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + Data.Map.Internal.Tip else let _ = "checkToken.else" in let (# - farInp_809, - farExp_810 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_729 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of GHC.Types.LT -> (# - cs_729, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 't'] + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] #) GHC.Types.EQ -> (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 't'] + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_718 cs_729 farInp_809 farExp_810 + in readFail cs farInp farExp else let _ = "checkToken.else" in let (# - farInp_811, - farExp_812 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_726 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - cs_726, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] #) GHC.Types.EQ -> (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_718 cs_726 farInp_811 farExp_812 - else - let _ = "checkToken.else" - in let (# - farInp_813, - farExp_814 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_723 of - GHC.Types.LT -> - (# - cs_723, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_718 cs_723 farInp_813 farExp_814 - else - let _ = "checkToken.else" - in let (# - farInp_815, - farExp_816 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_720 of - GHC.Types.LT -> - (# - cs_720, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'u'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'u'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_718 cs_720 farInp_815 farExp_816 - else - let _ = "checkToken.else" - in let (# - farInp_817, - farExp_818 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_701 of - GHC.Types.LT -> - (# - inp_701, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_718 inp_701 farInp_817 farExp_818 - else - let _ = "checkHorizon.else" - in let (# - farInp_819, - farExp_820 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_701 of - GHC.Types.LT -> - (# - inp_701, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 18] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 18] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_718 inp_701 farInp_819 farExp_820 - name_34 = \(!ok_821) (!inp_822) (!koByLabel_823) -> - let _ = "catchException lbl=fail" - in let catchHandler_824 (!failInp_825) (!farInp_826) (!farExp_827) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp_828, - farExp_829 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_826 inp_822 of - GHC.Types.LT -> - (# - inp_822, - [] - #) - GHC.Types.EQ -> - (# - farInp_826, - farExp_827 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_826, - farExp_827 - #) - in finalRaise_18 inp_822 farInp_828 farExp_829 - in let readFail_830 = catchHandler_824 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_822) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore inp then let !(# - c_831, - cs_832 - #) = readNext_3 inp_822 - in if Grammar.Nandlang.nandIdentStart c_831 + c, + cs + #) = readNext inp + in if Grammar.Nandlang.nandIdentLetter c then - name_50 + name ( let _ = "suspend" - in \farInp_833 farExp_834 v_835 (!inp_836) -> - name_611 - ( let _ = "suspend" - in \farInp_837 farExp_838 v_839 (!inp_840) -> - name_50 - ( let _ = "suspend" - in \farInp_841 farExp_842 v_843 (!inp_844) -> - name_144 - ( let _ = "suspend" - in \farInp_845 farExp_846 v_847 (!inp_848) -> - let _ = "resume" - in ok_821 - farInp_845 - farExp_846 - ( let _ = "resume.genCode" - in v_847 - ) - inp_848 - ) - inp_844 - Data.Map.Internal.Tip - ) - inp_840 - Data.Map.Internal.Tip - ) - inp_836 - Data.Map.Internal.Tip + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp ) - cs_832 + cs Data.Map.Internal.Tip else let _ = "checkToken.else" in let (# - farInp_849, - farExp_850 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_822 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_822, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identStart"] + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identLetter"] #) GHC.Types.EQ -> (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identStart"] + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identLetter"] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_830 inp_822 farInp_849 farExp_850 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_851, - farExp_852 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_822 of - GHC.Types.LT -> - (# - inp_822, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_830 inp_822 farInp_851 farExp_852 - name_478 = \(!ok_853) (!inp_854) (!koByLabel_855) -> - let readFail_856 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_855 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_854) - then - let !(# - c_857, - cs_858 - #) = readNext_3 inp_854 - in if ('{' GHC.Classes.==) c_857 - then - name_144 - ( let _ = "suspend" - in \farInp_859 farExp_860 v_861 (!inp_862) -> - name_50 - ( let _ = "suspend" - in \farInp_863 farExp_864 v_865 (!inp_866) -> - name_287 - ( let _ = "suspend" - in \farInp_867 farExp_868 v_869 (!inp_870) -> - name_50 - ( let _ = "suspend" - in \farInp_871 farExp_872 v_873 (!inp_874) -> - let readFail_875 = readFail_856 - in if readMore_2 inp_874 - then - let !(# - c_876, - cs_877 - #) = readNext_3 inp_874 - in if ('}' GHC.Classes.==) c_876 - then - name_144 - ( let _ = "suspend" - in \farInp_878 farExp_879 v_880 (!inp_881) -> - let _ = "resume" - in ok_853 - farInp_878 - farExp_879 - ( let _ = "resume.genCode" - in v_873 - ) - inp_881 - ) - cs_877 - (Data.Map.Internal.Bin 1 "fail" readFail_875 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_882, - farExp_883 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_871 inp_874 of - GHC.Types.LT -> - (# - inp_874, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '}'] - #) - GHC.Types.EQ -> - (# - farInp_871, - farExp_872 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '}'] - #) - GHC.Types.GT -> - (# - farInp_871, - farExp_872 - #) - in readFail_875 inp_874 farInp_882 farExp_883 - else - let _ = "checkHorizon.else" - in let (# - farInp_884, - farExp_885 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_871 inp_874 of - GHC.Types.LT -> - (# - inp_874, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp_871, - farExp_872 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp_871, - farExp_872 - #) - in readFail_875 inp_874 farInp_884 farExp_885 - ) - inp_870 - Data.Map.Internal.Tip - ) - inp_866 - Data.Map.Internal.Tip - ) - inp_862 - Data.Map.Internal.Tip - ) - cs_858 - (Data.Map.Internal.Bin 1 "fail" readFail_856 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_886, - farExp_887 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_854 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_854, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '{'] + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '{'] + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_856 inp_854 farInp_886 farExp_887 - else - let _ = "checkHorizon.else" - in let (# - farInp_888, - farExp_889 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_854 of - GHC.Types.LT -> - (# - inp_854, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_856 inp_854 farInp_888 farExp_889 - name_656 = \(!ok_890) (!inp_891) (!koByLabel_892) -> - let _ = "catchException lbl=fail" - in let catchHandler_893 (!failInp_894) (!farInp_895) (!farExp_896) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_897 - _ - ) - ( Data.Text.Internal.Text - _ - j_898 - _ - ) -> i_897 GHC.Classes.== j_898 - ) - inp_891 - failInp_894 - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok_890 - farInp_895 - farExp_896 - ( let _ = "resume.genCode" - in \x_899 -> x_899 - ) - failInp_894 - else - let _ = "choicesBranch.else" - in let (# - farInp_900, - farExp_901 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_895 failInp_894 of - GHC.Types.LT -> - (# - failInp_894, - [] - #) - GHC.Types.EQ -> - (# - farInp_895, - farExp_896 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_895, - farExp_896 - #) - in finalRaise_18 failInp_894 farInp_900 farExp_901 - in name_237 - ( let _ = "suspend" - in \farInp_902 farExp_903 v_904 (!inp_905) -> - name_242 - ( let _ = "suspend" - in \farInp_906 farExp_907 v_908 (!inp_909) -> - name_277 - ( let _ = "suspend" - in \farInp_910 farExp_911 v_912 (!inp_913) -> - name_656 - ( let _ = "suspend" - in \farInp_914 farExp_915 v_916 (!inp_917) -> - let _ = "resume" - in ok_890 - farInp_914 - farExp_915 - ( let _ = "resume.genCode" - in \x_918 -> v_904 v_912 (v_916 x_918) - ) - inp_917 - ) - inp_913 - Data.Map.Internal.Tip - ) - inp_909 - Data.Map.Internal.Tip - ) - inp_905 - (Data.Map.Internal.Bin 1 "fail" catchHandler_893 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp_891 - Data.Map.Internal.Tip - name_423 = \(!ok_919) (!inp_920) (!koByLabel_921) -> - let _ = "resume" - in ok_919 init_1 GHC.Types - . [] - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_920 - name_922 = \(!ok_923) (!inp_924) (!koByLabel_925) -> + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_926 (!failInp_927) (!farInp_928) (!farExp_929) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_930 + i _ ) ( Data.Text.Internal.Text _ - j_931 + j _ - ) -> i_930 GHC.Classes.== j_931 + ) -> i GHC.Classes.== j ) - inp_924 - failInp_927 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_923 - farInp_928 - farExp_929 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_932 -> x_932 + in \x -> x ) - failInp_927 + failInp else let _ = "choicesBranch.else" in let (# - farInp_933, - farExp_934 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_928 failInp_927 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_927, + failInp, [] #) GHC.Types.EQ -> (# - farInp_928, - farExp_929 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_928, - farExp_929 + farInp, + farExp #) - in finalRaise_18 failInp_927 farInp_933 farExp_934 - in name_935 - ( let _ = "suspend" - in \farInp_936 farExp_937 v_938 (!inp_939) -> - name_922 - ( let _ = "suspend" - in \farInp_940 farExp_941 v_942 (!inp_943) -> - let _ = "resume" - in ok_923 - farInp_940 - farExp_941 - ( let _ = "resume.genCode" - in \x_944 -> v_942 x_944 - ) - inp_943 - ) - inp_939 - Data.Map.Internal.Tip - ) - inp_924 - (Data.Map.Internal.Bin 1 "fail" catchHandler_926 Data.Map.Internal.Tip Data.Map.Internal.Tip) - name_935 = \(!ok_945) (!inp_946) (!koByLabel_947) -> - let readFail_948 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_947 - in if readMore_2 inp_946 - then - let !(# - c_949, - cs_950 - #) = readNext_3 inp_946 - in if GHC.Unicode.isSpace c_949 + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) then - name_50 - ( let _ = "suspend" - in \farInp_951 farExp_952 v_953 (!inp_954) -> - let _ = "resume" - in ok_945 - farInp_951 - farExp_952 - ( let _ = "resume.genCode" - in v_953 - ) - inp_954 - ) - cs_950 - Data.Map.Internal.Tip + let !(# + c, + cs + #) = readNext inp + in if ('!' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken '!'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '!'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp else - let _ = "checkToken.else" + let _ = "checkHorizon.else" in let (# - farInp_955, - farExp_956 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_946 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_946, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "space"] + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] #) GHC.Types.EQ -> (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "space"] + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_948 inp_946 farInp_955 farExp_956 - else - let _ = "checkHorizon.else" - in let (# - farInp_957, - farExp_958 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_946 of - GHC.Types.LT -> - (# - inp_946, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_948 inp_946 farInp_957 farExp_958 - name_690 = \(!ok_959) (!inp_960) (!koByLabel_961) -> + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 17 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('f' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('u' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('n' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('c' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('t' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('i' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('o' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('n' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if (':' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + cs + (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken ':'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ':'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail inp farInp farExp + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'o'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'o'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 't'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 't'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'u'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'u'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 18] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 18] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_962 (!failInp_963) (!farInp_964) (!farExp_965) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_966 - _ - ) - ( Data.Text.Internal.Text - _ - j_967 - _ - ) -> i_966 GHC.Classes.== j_967 - ) - inp_960 - failInp_963 - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok_959 - farInp_964 - farExp_965 - ( let _ = "resume.genCode" - in \x_968 -> x_968 - ) - failInp_963 - else - let _ = "choicesBranch.else" - in let (# - farInp_969, - farExp_970 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_964 failInp_963 of - GHC.Types.LT -> - (# - failInp_963, - [] - #) - GHC.Types.EQ -> - (# - farInp_964, - farExp_965 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_964, - farExp_965 - #) - in finalRaise_18 failInp_963 farInp_969 farExp_970 - in let readFail_971 = catchHandler_962 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_960) + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) then let !(# - c_972, - cs_973 - #) = readNext_3 inp_960 - in if ('!' GHC.Classes.==) c_972 + c, + cs + #) = readNext inp + in if Grammar.Nandlang.nandIdentStart c then - name_144 + name ( let _ = "suspend" - in \farInp_974 farExp_975 v_976 (!inp_977) -> - name_24 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_978 farExp_979 v_980 (!inp_981) -> - name_690 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_982 farExp_983 v_984 (!inp_985) -> - let _ = "resume" - in ok_959 - farInp_982 - farExp_983 - ( let _ = "resume.genCode" - in \x_986 -> v_984 x_986 - ) - inp_985 + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + Data.Map.Internal.Tip ) - inp_981 + inp Data.Map.Internal.Tip ) - inp_977 + inp Data.Map.Internal.Tip ) - cs_973 - (Data.Map.Internal.Bin 1 "fail" readFail_971 Data.Map.Internal.Tip Data.Map.Internal.Tip) + cs + Data.Map.Internal.Tip else let _ = "checkToken.else" in let (# - farInp_987, - farExp_988 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_960 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_960, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '!'] + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identStart"] #) GHC.Types.EQ -> (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '!'] + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identStart"] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_971 inp_960 farInp_987 farExp_988 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_989, - farExp_990 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_960 of - GHC.Types.LT -> - (# - inp_960, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_971 inp_960 farInp_989 farExp_990 - name_242 = \(!ok_991) (!inp_992) (!koByLabel_993) -> - let readFail_994 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_993 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 inp_992) - then - let !(# - c_995, - cs_996 - #) = readNext_3 inp_992 - in if (',' GHC.Classes.==) c_995 - then - name_144 - ( let _ = "suspend" - in \farInp_997 farExp_998 v_999 (!inp_1000) -> - let _ = "resume" - in ok_991 - farInp_997 - farExp_998 - ( let _ = "resume.genCode" - in ',' - ) - inp_1000 - ) - cs_996 - (Data.Map.Internal.Bin 1 "fail" readFail_994 Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp_1001, - farExp_1002 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_992 of - GHC.Types.LT -> - (# - inp_992, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ','] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ','] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_994 inp_992 farInp_1001 farExp_1002 - else - let _ = "checkHorizon.else" - in let (# - farInp_1003, - farExp_1004 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_992 of - GHC.Types.LT -> - (# - inp_992, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_994 inp_992 farInp_1003 farExp_1004 - name_277 = \(!ok_1005) (!inp_1006) (!koByLabel_1007) -> - name_34 - ( let _ = "suspend" - in \farInp_1008 farExp_1009 v_1010 (!inp_1011) -> - let join_1012 = \farInp_1013 farExp_1014 v_1015 (!inp_1016) -> - let _ = "resume" - in ok_1005 - farInp_1013 - farExp_1014 - ( let _ = "resume.genCode" - in v_1015 - ) - inp_1016 - in let _ = "catchException lbl=fail" - in let catchHandler_1017 (!failInp_1018) (!farInp_1019) (!farExp_1020) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_1021 - _ - ) - ( Data.Text.Internal.Text - _ - j_1022 - _ - ) -> i_1021 GHC.Classes.== j_1022 - ) - inp_1011 - failInp_1018 - then - let _ = "choicesBranch.then" - in name_50 - ( let _ = "suspend" - in \farInp_1023 farExp_1024 v_1025 (!inp_1026) -> - let _ = "resume" - in join_1012 - farInp_1023 - farExp_1024 - ( let _ = "resume.genCode" - in v_1025 - ) - inp_1026 - ) - failInp_1018 - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp_1027, - farExp_1028 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1019 failInp_1018 of - GHC.Types.LT -> - (# - failInp_1018, - [] - #) - GHC.Types.EQ -> - (# - farInp_1019, - farExp_1020 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_1019, - farExp_1020 - #) - in finalRaise_18 failInp_1018 farInp_1027 farExp_1028 - in name_68 - ( let _ = "suspend" - in \farInp_1029 farExp_1030 v_1031 (!inp_1032) -> - let _ = "resume" - in join_1012 - farInp_1029 - farExp_1030 - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_1032 - ) - inp_1011 - (Data.Map.Internal.Bin 1 "fail" catchHandler_1017 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp_1006 - Data.Map.Internal.Tip - name_543 = \(!ok_1033) (!inp_1034) (!koByLabel_1035) -> - let readFail_1036 = Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_1035 - in if readMore_2 inp_1034 - then - let !(# - c_1037, - cs_1038 - #) = readNext_3 inp_1034 - in if (\t_1039 -> ('0' GHC.Classes.== t_1039) GHC.Classes.|| (('1' GHC.Classes.== t_1039) GHC.Classes.|| (('2' GHC.Classes.== t_1039) GHC.Classes.|| (('3' GHC.Classes.== t_1039) GHC.Classes.|| (('4' GHC.Classes.== t_1039) GHC.Classes.|| (('5' GHC.Classes.== t_1039) GHC.Classes.|| (('6' GHC.Classes.== t_1039) GHC.Classes.|| (('7' GHC.Classes.== t_1039) GHC.Classes.|| (('8' GHC.Classes.== t_1039) GHC.Classes.|| (('9' GHC.Classes.== t_1039) GHC.Classes.|| GHC.Types.False)))))))))) c_1037 - then - let _ = "resume" - in ok_1033 init_1 GHC.Types - . [] - ( let _ = "resume.genCode" - in c_1037 - ) - cs_1038 - else - let _ = "checkToken.else" - in let (# - farInp_1040, - farExp_1041 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_1034 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_1034, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + inp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.EQ -> (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_1036 inp_1034 farInp_1040 farExp_1041 - else - let _ = "checkHorizon.else" - in let (# - farInp_1042, - farExp_1043 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_1034 of - GHC.Types.LT -> - (# - inp_1034, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_1036 inp_1034 farInp_1042 farExp_1043 - name_111 = \(!ok_1044) (!inp_1045) (!koByLabel_1046) -> - let _ = "catchException lbl=fail" - in let catchHandler_1047 (!failInp_1048) (!farInp_1049) (!farExp_1050) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_1051 - _ - ) - ( Data.Text.Internal.Text - _ - j_1052 - _ - ) -> i_1051 GHC.Classes.== j_1052 - ) - inp_1045 - failInp_1048 - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok_1044 - farInp_1049 - farExp_1050 - ( let _ = "resume.genCode" - in \x_1053 -> x_1053 - ) - failInp_1048 - else - let _ = "choicesBranch.else" - in let (# - farInp_1054, - farExp_1055 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1049 failInp_1048 of - GHC.Types.LT -> - (# - failInp_1048, - [] - #) - GHC.Types.EQ -> - (# - farInp_1049, - farExp_1050 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_1049, - farExp_1050 - #) - in finalRaise_18 failInp_1048 farInp_1054 farExp_1055 - in name_237 - ( let _ = "suspend" - in \farInp_1056 farExp_1057 v_1058 (!inp_1059) -> - name_242 - ( let _ = "suspend" - in \farInp_1060 farExp_1061 v_1062 (!inp_1063) -> - name_102 - ( let _ = "suspend" - in \farInp_1064 farExp_1065 v_1066 (!inp_1067) -> - name_111 - ( let _ = "suspend" - in \farInp_1068 farExp_1069 v_1070 (!inp_1071) -> - let _ = "resume" - in ok_1044 - farInp_1068 - farExp_1069 - ( let _ = "resume.genCode" - in \x_1072 -> v_1058 v_1066 (v_1070 x_1072) - ) - inp_1071 - ) - inp_1067 - Data.Map.Internal.Tip - ) - inp_1063 - Data.Map.Internal.Tip - ) - inp_1059 - (Data.Map.Internal.Bin 1 "fail" catchHandler_1047 Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp_1045 - Data.Map.Internal.Tip - name_144 = \(!ok_1073) (!inp_1074) (!koByLabel_1075) -> - name_935 - ( let _ = "suspend" - in \farInp_1076 farExp_1077 v_1078 (!inp_1079) -> - name_922 - ( let _ = "suspend" - in \farInp_1080 farExp_1081 v_1082 (!inp_1083) -> - let _ = "resume" - in ok_1073 - farInp_1080 - farExp_1081 - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp_1083 - ) - inp_1079 - Data.Map.Internal.Tip - ) - inp_1074 - (Data.Map.Internal.Bin 1 "fail" (Data.Map.Strict.Internal.findWithDefault finalRaise_18 "fail" koByLabel_1075) Data.Map.Internal.Tip Data.Map.Internal.Tip) - in name_144 + in readFail inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "resume" + in ok init GHC.Types + . [] + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "resume" + in ok init GHC.Types + . [] + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "resume" + in ok init GHC.Types + . [] + ( let _ = "resume.genCode" + in \x -> \x -> x + ) + inp + in name ( let _ = "suspend" - in \farInp_1084 farExp_1085 v_1086 (!inp_1087) -> - name_50 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_1088 farExp_1089 v_1090 (!inp_1091) -> - name_699 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_1092 farExp_1093 v_1094 (!inp_1095) -> - name_50 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_1096 farExp_1097 v_1098 (!inp_1099) -> - let join_1100 = \farInp_1101 farExp_1102 v_1103 (!inp_1104) -> + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> let _ = "resume" - in finalRet_13 - farInp_1101 - farExp_1102 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_1098 + in GHC.Show.show v ) - inp_1104 + inp in let _ = "catchException lbl=fail" - in let catchHandler_1105 (!failInp_1106) (!farInp_1107) (!farExp_1108) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_1109 + i _ ) ( Data.Text.Internal.Text _ - j_1110 + j _ - ) -> i_1109 GHC.Classes.== j_1110 + ) -> i GHC.Classes.== j ) - inp_1099 - failInp_1106 + inp + failInp then let _ = "choicesBranch.then" in let (# - farInp_1111, - farExp_1112 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1107 failInp_1106 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_1106, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] #) GHC.Types.EQ -> (# - farInp_1107, - farExp_1108 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] #) GHC.Types.GT -> (# - farInp_1107, - farExp_1108 + farInp, + farExp #) - in finalRaise_18 failInp_1106 farInp_1111 farExp_1112 + in finalRaise failInp farInp farExp else let _ = "choicesBranch.else" in let (# - farInp_1113, - farExp_1114 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1107 failInp_1106 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_1106, + failInp, [] #) GHC.Types.EQ -> (# - farInp_1107, - farExp_1108 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_1107, - farExp_1108 + farInp, + farExp #) - in finalRaise_18 failInp_1106 farInp_1113 farExp_1114 + in finalRaise failInp farInp farExp in let _ = "catchException lbl=fail" - in let catchHandler_1115 (!failInp_1116) (!farInp_1117) (!farExp_1118) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in let _ = "resume" - in join_1100 - farInp_1117 - farExp_1118 + in join + farInp + farExp ( let _ = "resume.genCode" in GHC.Tuple . () ) - inp_1099 - in let readFail_1119 = catchHandler_1115 - in if readMore_2 inp_1099 + inp + in let readFail = catchHandler + in if readMore inp then let !(# - c_1120, - cs_1121 - #) = readNext_3 inp_1099 - in if (\x_1122 -> GHC.Types.True) c_1120 + c, + cs + #) = readNext inp + in if (\x -> GHC.Types.True) c then let (# - farInp_1123, - farExp_1124 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1096 inp_1099 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_1099, + inp, [] #) GHC.Types.EQ -> (# - farInp_1096, - farExp_1097 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_1096, - farExp_1097 + farInp, + farExp #) - in catchHandler_1105 inp_1099 farInp_1123 farExp_1124 + in catchHandler inp farInp farExp else let _ = "checkToken.else" in let (# - farInp_1125, - farExp_1126 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1096 inp_1099 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_1099, + inp, [] #) GHC.Types.EQ -> (# - farInp_1096, - farExp_1097 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_1096, - farExp_1097 + farInp, + farExp #) - in readFail_1119 inp_1099 farInp_1125 farExp_1126 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_1127, - farExp_1128 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_1096 inp_1099 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_1099, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - farInp_1096, - farExp_1097 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - farInp_1096, - farExp_1097 + farInp, + farExp #) - in readFail_1119 inp_1099 farInp_1127 farExp_1128 + in readFail inp farInp farExp ) - inp_1095 + inp Data.Map.Internal.Tip ) - inp_1091 + inp Data.Map.Internal.Tip ) - inp_1087 + inp Data.Map.Internal.Tip ) - init_1 + init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G15.expected.txt b/test/Golden/Splice/G15.expected.txt index 057616d..7ece61e 100644 --- a/test/Golden/Splice/G15.expected.txt +++ b/test/Golden/Splice/G15.expected.txt @@ -1,279 +1,272 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } in let - in let join_24 = \farInp_25 farExp_26 v_27 (!inp_28) -> - let readFail_29 = finalRaise_18 - in if readMore_2 inp_28 + in let join = \farInp farExp v (!inp) -> + let readFail = finalRaise + in if readMore inp then let !(# - c_30, - cs_31 - #) = readNext_3 inp_28 - in if ('c' GHC.Classes.==) c_30 + c, + cs + #) = readNext inp + in if ('c' GHC.Classes.==) c then let _ = "resume" - in finalRet_13 - farInp_25 - farExp_26 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_27 + in GHC.Show.show v ) - cs_31 + cs else let _ = "checkToken.else" in let (# - farInp_32, - farExp_33 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_25 inp_28 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_28, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.EQ -> (# - farInp_25, - farExp_26 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.GT -> (# - farInp_25, - farExp_26 + farInp, + farExp #) - in finalRaise_18 inp_28 farInp_32 farExp_33 + in finalRaise inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_34, - farExp_35 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_25 inp_28 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_28, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - farInp_25, - farExp_26 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - farInp_25, - farExp_26 + farInp, + farExp #) - in finalRaise_18 inp_28 farInp_34 farExp_35 + in finalRaise inp farInp farExp in let _ = "catchException lbl=fail" - in let catchHandler_36 (!failInp_37) (!farInp_38) (!farExp_39) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_40 + i _ ) ( Data.Text.Internal.Text _ - j_41 + j _ - ) -> i_40 GHC.Classes.== j_41 + ) -> i GHC.Classes.== j ) - init_1 - failInp_37 + init + failInp then let _ = "choicesBranch.then" - in let readFail_42 = finalRaise_18 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_37) + in let readFail = finalRaise + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) then let !(# - c_43, - cs_44 - #) = readNext_3 failInp_37 - in if ('b' GHC.Classes.==) c_43 + c, + cs + #) = readNext failInp + in if ('b' GHC.Classes.==) c then let _ = "resume" - in join_24 - farInp_38 - farExp_39 + in join + farInp + farExp ( let _ = "resume.genCode" in 'b' ) - cs_44 + cs else let _ = "checkToken.else" in let (# - farInp_45, - farExp_46 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_37, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.EQ -> (# - farInp_38, - farExp_39 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.GT -> (# - farInp_38, - farExp_39 + farInp, + farExp #) - in finalRaise_18 failInp_37 farInp_45 farExp_46 + in finalRaise failInp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_47, - farExp_48 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_37, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.EQ -> (# - farInp_38, - farExp_39 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.GT -> (# - farInp_38, - farExp_39 + farInp, + farExp #) - in finalRaise_18 failInp_37 farInp_47 farExp_48 + in finalRaise failInp farInp farExp else let _ = "choicesBranch.else" in let (# - farInp_49, - farExp_50 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_37, + failInp, [] #) GHC.Types.EQ -> (# - farInp_38, - farExp_39 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_38, - farExp_39 + farInp, + farExp #) - in finalRaise_18 failInp_37 farInp_49 farExp_50 - in let readFail_51 = catchHandler_36 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 init_1) + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) then - let !(# - c_52, - cs_53 - #) = readNext_3 init_1 - in if ('a' GHC.Classes.==) c_52 + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c then let _ = "resume" - in join_24 init_1 GHC.Types + in join init GHC.Types . [] ( let _ = "resume.genCode" in 'a' ) - cs_53 + cs else let _ = "checkToken.else" in let (# - farInp_54, - farExp_55 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of GHC.Types.LT -> (# - init_1, + init, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_51 init_1 farInp_54 farExp_55 + in readFail init farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_56, - farExp_57 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of GHC.Types.LT -> (# - init_1, + init, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_51 init_1 farInp_56 farExp_57 + in readFail init farInp farExp diff --git a/test/Golden/Splice/G16.expected.txt b/test/Golden/Splice/G16.expected.txt index e1399e8..e5e7732 100644 --- a/test/Golden/Splice/G16.expected.txt +++ b/test/Golden/Splice/G16.expected.txt @@ -1,389 +1,385 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } in let - in let join_24 = \farInp_25 farExp_26 v_27 (!inp_28) -> - let readFail_29 = finalRaise_18 - in if readMore_2 inp_28 + in let join = \farInp farExp v (!inp) -> + let readFail = finalRaise + in if readMore inp then let !(# - c_30, - cs_31 - #) = readNext_3 inp_28 - in if ('d' GHC.Classes.==) c_30 + c, + cs + #) = readNext inp + in if ('d' GHC.Classes.==) c then let _ = "resume" - in finalRet_13 - farInp_25 - farExp_26 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_27 + in GHC.Show.show v ) - cs_31 + cs else let _ = "checkToken.else" in let (# - farInp_32, - farExp_33 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_25 inp_28 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_28, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] #) GHC.Types.EQ -> (# - farInp_25, - farExp_26 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] #) GHC.Types.GT -> (# - farInp_25, - farExp_26 + farInp, + farExp #) - in finalRaise_18 inp_28 farInp_32 farExp_33 + in finalRaise inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_34, - farExp_35 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_25 inp_28 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_28, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - farInp_25, - farExp_26 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - farInp_25, - farExp_26 + farInp, + farExp #) - in finalRaise_18 inp_28 farInp_34 farExp_35 + in finalRaise inp farInp farExp in let _ = "catchException lbl=fail" - in let catchHandler_36 (!failInp_37) (!farInp_38) (!farExp_39) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_40 + i _ ) ( Data.Text.Internal.Text _ - j_41 + j _ - ) -> i_40 GHC.Classes.== j_41 + ) -> i GHC.Classes.== j ) - init_1 - failInp_37 + init + failInp then let _ = "choicesBranch.then" - in let readFail_42 = finalRaise_18 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_37) + in let readFail = finalRaise + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) then let !(# - c_43, - cs_44 - #) = readNext_3 failInp_37 - in if ('c' GHC.Classes.==) c_43 + c, + cs + #) = readNext failInp + in if ('c' GHC.Classes.==) c then let _ = "resume" - in join_24 - farInp_38 - farExp_39 + in join + farInp + farExp ( let _ = "resume.genCode" in 'c' ) - cs_44 + cs else let _ = "checkToken.else" in let (# - farInp_45, - farExp_46 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_37, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.EQ -> (# - farInp_38, - farExp_39 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.GT -> (# - farInp_38, - farExp_39 + farInp, + farExp #) - in finalRaise_18 failInp_37 farInp_45 farExp_46 + in finalRaise failInp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_47, - farExp_48 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_37, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.EQ -> (# - farInp_38, - farExp_39 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.GT -> (# - farInp_38, - farExp_39 + farInp, + farExp #) - in finalRaise_18 failInp_37 farInp_47 farExp_48 + in finalRaise failInp farInp farExp else let _ = "choicesBranch.else" in let (# - farInp_49, - farExp_50 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_38 failInp_37 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_37, + failInp, [] #) GHC.Types.EQ -> (# - farInp_38, - farExp_39 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_38, - farExp_39 + farInp, + farExp #) - in finalRaise_18 failInp_37 farInp_49 farExp_50 - in let join_51 = \farInp_52 farExp_53 v_54 (!inp_55) -> + in finalRaise failInp farInp farExp + in let join = \farInp farExp v (!inp) -> let _ = "resume" - in join_24 - farInp_52 - farExp_53 + in join + farInp + farExp ( let _ = "resume.genCode" - in v_54 + in v ) - inp_55 + inp in let _ = "catchException lbl=fail" - in let catchHandler_56 (!failInp_57) (!farInp_58) (!farExp_59) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_60 + i _ ) ( Data.Text.Internal.Text _ - j_61 + j _ - ) -> i_60 GHC.Classes.== j_61 + ) -> i GHC.Classes.== j ) - init_1 - failInp_57 + init + failInp then let _ = "choicesBranch.then" - in let readFail_62 = catchHandler_36 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_57) + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) then let !(# - c_63, - cs_64 - #) = readNext_3 failInp_57 - in if ('b' GHC.Classes.==) c_63 + c, + cs + #) = readNext failInp + in if ('b' GHC.Classes.==) c then let _ = "resume" - in join_51 - farInp_58 - farExp_59 + in join + farInp + farExp ( let _ = "resume.genCode" in 'b' ) - cs_64 + cs else let _ = "checkToken.else" in let (# - farInp_65, - farExp_66 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_58 failInp_57 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_57, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.EQ -> (# - farInp_58, - farExp_59 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.GT -> (# - farInp_58, - farExp_59 + farInp, + farExp #) - in readFail_62 failInp_57 farInp_65 farExp_66 + in readFail failInp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_67, - farExp_68 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_58 failInp_57 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_57, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.EQ -> (# - farInp_58, - farExp_59 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.GT -> (# - farInp_58, - farExp_59 + farInp, + farExp #) - in readFail_62 failInp_57 farInp_67 farExp_68 + in readFail failInp farInp farExp else let _ = "choicesBranch.else" in let (# - farInp_69, - farExp_70 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_58 failInp_57 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_57, + failInp, [] #) GHC.Types.EQ -> (# - farInp_58, - farExp_59 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_58, - farExp_59 + farInp, + farExp #) - in catchHandler_36 failInp_57 farInp_69 farExp_70 - in let readFail_71 = catchHandler_56 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 init_1) + in catchHandler failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) then let !(# - c_72, - cs_73 - #) = readNext_3 init_1 - in if ('a' GHC.Classes.==) c_72 + c, + cs + #) = readNext init + in if ('a' GHC.Classes.==) c then let _ = "resume" - in join_51 init_1 GHC.Types + in join init GHC.Types . [] ( let _ = "resume.genCode" in 'a' ) - cs_73 + cs else let _ = "checkToken.else" in let (# - farInp_74, - farExp_75 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of GHC.Types.LT -> (# - init_1, + init, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_71 init_1 farInp_74 farExp_75 + in readFail init farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_76, - farExp_77 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of GHC.Types.LT -> (# - init_1, + init, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_71 init_1 farInp_76 farExp_77 + in readFail init farInp farExp diff --git a/test/Golden/Splice/G2.expected.txt b/test/Golden/Splice/G2.expected.txt index 817177e..f721ae3 100644 --- a/test/Golden/Splice/G2.expected.txt +++ b/test/Golden/Splice/G2.expected.txt @@ -1,197 +1,187 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } in let in let _ = "catchException lbl=fail" - in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in let (# - farInp_28, - farExp_29 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 init_1 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp init of GHC.Types.LT -> (# - init_1, + init, [] #) GHC.Types.EQ -> (# - farInp_26, - farExp_27 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_26, - farExp_27 + farInp, + farExp #) - in finalRaise_18 init_1 farInp_28 farExp_29 - in let readFail_30 = catchHandler_24 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 2 init_1) + in finalRaise init farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 2 init) then - let !(# - c_31, - cs_32 - #) = readNext_3 init_1 - in if ('a' GHC.Classes.==) c_31 + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c then - let readFail_33 = readFail_30 - in let !(# - c_34, - cs_35 - #) = readNext_3 cs_32 - in if ('b' GHC.Classes.==) c_34 + let readFail = readFail + in let !(# c, cs #) = readNext cs + in if ('b' GHC.Classes.==) c then - let readFail_36 = readFail_30 + let readFail = readFail in let !(# - c_37, - cs_38 - #) = readNext_3 cs_35 - in if ('c' GHC.Classes.==) c_37 + c, + cs + #) = readNext cs + in if ('c' GHC.Classes.==) c then let _ = "resume" - in finalRet_13 init_1 GHC.Types + in finalRet init GHC.Types . [] ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: GHC.Types . [])) + in GHC.Show.show ('a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: GHC.Types . []))) ) - cs_38 + cs else let _ = "checkToken.else" in let (# - farInp_39, - farExp_40 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_35 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of GHC.Types.LT -> (# - cs_35, + cs, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_30 cs_35 farInp_39 farExp_40 + in readFail cs farInp farExp else let _ = "checkToken.else" in let (# - farInp_41, - farExp_42 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_32 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of GHC.Types.LT -> (# - cs_32, + cs, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_30 cs_32 farInp_41 farExp_42 + in readFail cs farInp farExp else let _ = "checkToken.else" in let (# - farInp_43, - farExp_44 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of GHC.Types.LT -> (# - init_1, + init, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_30 init_1 farInp_43 farExp_44 + in readFail init farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_45, - farExp_46 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of GHC.Types.LT -> (# - init_1, + init, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 3] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 3] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_30 init_1 farInp_45 farExp_46 + in readFail init farInp farExp diff --git a/test/Golden/Splice/G3.expected.txt b/test/Golden/Splice/G3.expected.txt index 7908b13..2f1efe2 100644 --- a/test/Golden/Splice/G3.expected.txt +++ b/test/Golden/Splice/G3.expected.txt @@ -1,185 +1,181 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } - in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + in let name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_32 + i _ ) ( Data.Text.Internal.Text _ - j_33 + j _ - ) -> i_32 GHC.Classes.== j_33 + ) -> i GHC.Classes.== j ) - inp_26 - failInp_29 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_25 - farInp_30 - farExp_31 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_34 -> x_34 + in \x -> x ) - failInp_29 + failInp else let _ = "choicesBranch.else" in let (# - farInp_35, - farExp_36 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_29, + failInp, [] #) GHC.Types.EQ -> (# - farInp_30, - farExp_31 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_30, - farExp_31 + farInp, + farExp #) - in finalRaise_18 failInp_29 farInp_35 farExp_36 - in let readFail_37 = catchHandler_28 - in if readMore_2 inp_26 + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore inp then let !(# - c_38, - cs_39 - #) = readNext_3 inp_26 - in if ('a' GHC.Classes.==) c_38 + c, + cs + #) = readNext inp + in if ('a' GHC.Classes.==) c then - name_24 + name ( let _ = "suspend" - in \farInp_40 farExp_41 v_42 (!inp_43) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in ok_25 - farInp_40 - farExp_41 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_44 -> 'a' GHC.Types.: v_42 x_44 + in \x -> 'a' GHC.Types.: v x ) - inp_43 + inp ) - cs_39 + cs Data.Map.Internal.Tip else let _ = "checkToken.else" in let (# - farInp_45, - farExp_46 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_37 inp_26 farInp_45 farExp_46 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_47, - farExp_48 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_37 inp_26 farInp_47 farExp_48 - in name_24 + in readFail inp farInp farExp + in name ( let _ = "suspend" - in \farInp_49 farExp_50 v_51 (!inp_52) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in finalRet_13 - farInp_49 - farExp_50 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_51 GHC.Types . [] + in GHC.Show.show (v GHC.Types . []) ) - inp_52 + inp ) - init_1 + init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G4.expected.txt b/test/Golden/Splice/G4.expected.txt index 00827cf..1dc43db 100644 --- a/test/Golden/Splice/G4.expected.txt +++ b/test/Golden/Splice/G4.expected.txt @@ -1,315 +1,311 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } - in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + in let name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_32 + i _ ) ( Data.Text.Internal.Text _ - j_33 + j _ - ) -> i_32 GHC.Classes.== j_33 + ) -> i GHC.Classes.== j ) - inp_26 - failInp_29 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_25 - farInp_30 - farExp_31 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_34 -> x_34 + in \x -> x ) - failInp_29 + failInp else let _ = "choicesBranch.else" in let (# - farInp_35, - farExp_36 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_29, + failInp, [] #) GHC.Types.EQ -> (# - farInp_30, - farExp_31 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_30, - farExp_31 + farInp, + farExp #) - in finalRaise_18 failInp_29 farInp_35 farExp_36 - in name_37 + in finalRaise failInp farInp farExp + in name ( let _ = "suspend" - in \farInp_38 farExp_39 v_40 (!inp_41) -> - name_24 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_42 farExp_43 v_44 (!inp_45) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in ok_25 - farInp_42 - farExp_43 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_46 -> v_40 GHC.Types.: v_44 x_46 + in \x -> v GHC.Types.: v x ) - inp_45 + inp ) - inp_41 + inp Data.Map.Internal.Tip ) - inp_26 + inp Data.Map.Internal.Tip - name_37 = \(!ok_47) (!inp_48) (!koByLabel_49) -> + name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_50 (!failInp_51) (!farInp_52) (!farExp_53) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in let (# - farInp_54, - farExp_55 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_52 inp_48 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_48, + inp, [] #) GHC.Types.EQ -> (# - farInp_52, - farExp_53 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_52, - farExp_53 + farInp, + farExp #) - in finalRaise_18 inp_48 farInp_54 farExp_55 - in let readFail_56 = catchHandler_50 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_48) + in finalRaise inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) then let !(# - c_57, - cs_58 - #) = readNext_3 inp_48 - in if ('a' GHC.Classes.==) c_57 + c, + cs + #) = readNext inp + in if ('a' GHC.Classes.==) c then - let readFail_59 = readFail_56 + let readFail = readFail in let !(# - c_60, - cs_61 - #) = readNext_3 cs_58 - in if ('b' GHC.Classes.==) c_60 + c, + cs + #) = readNext cs + in if ('b' GHC.Classes.==) c then - let readFail_62 = readFail_56 + let readFail = readFail in let !(# - c_63, - cs_64 - #) = readNext_3 cs_61 - in if ('c' GHC.Classes.==) c_63 + c, + cs + #) = readNext cs + in if ('c' GHC.Classes.==) c then - let readFail_65 = readFail_56 + let readFail = readFail in let !(# - c_66, - cs_67 - #) = readNext_3 cs_64 - in if ('d' GHC.Classes.==) c_66 + c, + cs + #) = readNext cs + in if ('d' GHC.Classes.==) c then let _ = "resume" - in ok_47 init_1 GHC.Types + in ok init GHC.Types . [] ( let _ = "resume.genCode" in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: ('d' GHC.Types.: GHC.Types . []))) ) - cs_67 + cs else let _ = "checkToken.else" in let (# - farInp_68, - farExp_69 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_64 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of GHC.Types.LT -> (# - cs_64, + cs, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_56 cs_64 farInp_68 farExp_69 + in readFail cs farInp farExp else let _ = "checkToken.else" in let (# - farInp_70, - farExp_71 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_61 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of GHC.Types.LT -> (# - cs_61, + cs, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_56 cs_61 farInp_70 farExp_71 + in readFail cs farInp farExp else let _ = "checkToken.else" in let (# - farInp_72, - farExp_73 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_58 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of GHC.Types.LT -> (# - cs_58, + cs, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_56 cs_58 farInp_72 farExp_73 + in readFail cs farInp farExp else let _ = "checkToken.else" in let (# - farInp_74, - farExp_75 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_48 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_48, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_56 inp_48 farInp_74 farExp_75 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_76, - farExp_77 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_48 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_48, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_56 inp_48 farInp_76 farExp_77 - in name_37 + in readFail inp farInp farExp + in name ( let _ = "suspend" - in \farInp_78 farExp_79 v_80 (!inp_81) -> - name_24 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_82 farExp_83 v_84 (!inp_85) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in finalRet_13 - farInp_82 - farExp_83 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_80 GHC.Types.: v_84 GHC.Types . [] + in GHC.Show.show (v GHC.Types.: v GHC.Types . []) ) - inp_85 + inp ) - inp_81 + inp Data.Map.Internal.Tip ) - init_1 + init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G5.expected.txt b/test/Golden/Splice/G5.expected.txt index e08a098..ac117ad 100644 --- a/test/Golden/Splice/G5.expected.txt +++ b/test/Golden/Splice/G5.expected.txt @@ -1,460 +1,456 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } - in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + in let name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v GHC.Types.: v x + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in let (# - farInp_32, - farExp_33 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_26, + inp, [] #) GHC.Types.EQ -> (# - farInp_30, - farExp_31 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_30, - farExp_31 + farInp, + farExp #) - in finalRaise_18 inp_26 farInp_32 farExp_33 - in let readFail_34 = catchHandler_28 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 3 inp_26) + in finalRaise inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) then let !(# - c_35, - cs_36 - #) = readNext_3 inp_26 - in if ('a' GHC.Classes.==) c_35 + c, + cs + #) = readNext inp + in if ('a' GHC.Classes.==) c then - let readFail_37 = readFail_34 + let readFail = readFail in let !(# - c_38, - cs_39 - #) = readNext_3 cs_36 - in if ('b' GHC.Classes.==) c_38 + c, + cs + #) = readNext cs + in if ('b' GHC.Classes.==) c then - let readFail_40 = readFail_34 + let readFail = readFail in let !(# - c_41, - cs_42 - #) = readNext_3 cs_39 - in if ('c' GHC.Classes.==) c_41 + c, + cs + #) = readNext cs + in if ('c' GHC.Classes.==) c then - let readFail_43 = readFail_34 + let readFail = readFail in let !(# - c_44, - cs_45 - #) = readNext_3 cs_42 - in if ('d' GHC.Classes.==) c_44 + c, + cs + #) = readNext cs + in if ('d' GHC.Classes.==) c then let _ = "resume" - in ok_25 init_1 GHC.Types + in ok init GHC.Types . [] ( let _ = "resume.genCode" in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: ('d' GHC.Types.: GHC.Types . []))) ) - cs_45 + cs else let _ = "checkToken.else" in let (# - farInp_46, - farExp_47 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_42 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of GHC.Types.LT -> (# - cs_42, + cs, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_34 cs_42 farInp_46 farExp_47 + in readFail cs farInp farExp else let _ = "checkToken.else" in let (# - farInp_48, - farExp_49 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_39 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of GHC.Types.LT -> (# - cs_39, + cs, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_34 cs_39 farInp_48 farExp_49 + in readFail cs farInp farExp else let _ = "checkToken.else" in let (# - farInp_50, - farExp_51 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_36 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of GHC.Types.LT -> (# - cs_36, + cs, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_34 cs_36 farInp_50 farExp_51 + in readFail cs farInp farExp else let _ = "checkToken.else" in let (# - farInp_52, - farExp_53 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_34 inp_26 farInp_52 farExp_53 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_54, - farExp_55 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_34 inp_26 farInp_54 farExp_55 - name_56 = \(!ok_57) (!inp_58) (!koByLabel_59) -> - let _ = "catchException lbl=fail" - in let catchHandler_60 (!failInp_61) (!farInp_62) (!farExp_63) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_64 - _ - ) - ( Data.Text.Internal.Text - _ - j_65 - _ - ) -> i_64 GHC.Classes.== j_65 - ) - inp_58 - failInp_61 - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok_57 - farInp_62 - farExp_63 - ( let _ = "resume.genCode" - in \x_66 -> x_66 - ) - failInp_61 - else - let _ = "choicesBranch.else" - in let (# - farInp_67, - farExp_68 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_62 failInp_61 of - GHC.Types.LT -> - (# - failInp_61, - [] - #) - GHC.Types.EQ -> - (# - farInp_62, - farExp_63 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_62, - farExp_63 - #) - in finalRaise_18 failInp_61 farInp_67 farExp_68 - in name_24 - ( let _ = "suspend" - in \farInp_69 farExp_70 v_71 (!inp_72) -> - name_56 - ( let _ = "suspend" - in \farInp_73 farExp_74 v_75 (!inp_76) -> - let _ = "resume" - in ok_57 - farInp_73 - farExp_74 - ( let _ = "resume.genCode" - in \x_77 -> v_71 GHC.Types.: v_75 x_77 - ) - inp_76 - ) - inp_72 - Data.Map.Internal.Tip - ) - inp_58 - Data.Map.Internal.Tip - in name_24 + in readFail inp farInp farExp + in name ( let _ = "suspend" - in \farInp_78 farExp_79 v_80 (!inp_81) -> - name_56 + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" - in \farInp_82 farExp_83 v_84 (!inp_85) -> - let join_86 = \farInp_87 farExp_88 v_89 (!inp_90) -> + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> let _ = "resume" - in finalRet_13 - farInp_87 - farExp_88 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_80 GHC.Types.: v_84 GHC.Types . [] + in GHC.Show.show (v GHC.Types.: v GHC.Types . []) ) - inp_90 + inp in let _ = "catchException lbl=fail" - in let catchHandler_91 (!failInp_92) (!farInp_93) (!farExp_94) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_95 + i _ ) ( Data.Text.Internal.Text _ - j_96 + j _ - ) -> i_95 GHC.Classes.== j_96 + ) -> i GHC.Classes.== j ) - inp_85 - failInp_92 + inp + failInp then let _ = "choicesBranch.then" in let (# - farInp_97, - farExp_98 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_93 failInp_92 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_92, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] #) GHC.Types.EQ -> (# - farInp_93, - farExp_94 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] #) GHC.Types.GT -> (# - farInp_93, - farExp_94 + farInp, + farExp #) - in finalRaise_18 failInp_92 farInp_97 farExp_98 + in finalRaise failInp farInp farExp else let _ = "choicesBranch.else" in let (# - farInp_99, - farExp_100 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_93 failInp_92 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_92, + failInp, [] #) GHC.Types.EQ -> (# - farInp_93, - farExp_94 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_93, - farExp_94 + farInp, + farExp #) - in finalRaise_18 failInp_92 farInp_99 farExp_100 + in finalRaise failInp farInp farExp in let _ = "catchException lbl=fail" - in let catchHandler_101 (!failInp_102) (!farInp_103) (!farExp_104) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in let _ = "resume" - in join_86 - farInp_103 - farExp_104 + in join + farInp + farExp ( let _ = "resume.genCode" in GHC.Tuple . () ) - inp_85 - in let readFail_105 = catchHandler_101 - in if readMore_2 inp_85 + inp + in let readFail = catchHandler + in if readMore inp then let !(# - c_106, - cs_107 - #) = readNext_3 inp_85 - in if (\x_108 -> GHC.Types.True) c_106 + c, + cs + #) = readNext inp + in if (\x -> GHC.Types.True) c then let (# - farInp_109, - farExp_110 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_82 inp_85 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_85, + inp, [] #) GHC.Types.EQ -> (# - farInp_82, - farExp_83 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_82, - farExp_83 + farInp, + farExp #) - in catchHandler_91 inp_85 farInp_109 farExp_110 + in catchHandler inp farInp farExp else let _ = "checkToken.else" in let (# - farInp_111, - farExp_112 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_82 inp_85 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_85, + inp, [] #) GHC.Types.EQ -> (# - farInp_82, - farExp_83 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_82, - farExp_83 + farInp, + farExp #) - in readFail_105 inp_85 farInp_111 farExp_112 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_113, - farExp_114 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_82 inp_85 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_85, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - farInp_82, - farExp_83 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - farInp_82, - farExp_83 + farInp, + farExp #) - in readFail_105 inp_85 farInp_113 farExp_114 + in readFail inp farInp farExp ) - inp_81 + inp Data.Map.Internal.Tip ) - init_1 + init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G6.expected.txt b/test/Golden/Splice/G6.expected.txt index 1244bdb..b8c34d7 100644 --- a/test/Golden/Splice/G6.expected.txt +++ b/test/Golden/Splice/G6.expected.txt @@ -1,275 +1,277 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } in let - in let _ = "catchException lbl=fail" - in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_28 - _ - ) - ( Data.Text.Internal.Text - _ - j_29 - _ - ) -> i_28 GHC.Classes.== j_29 - ) - init_1 - failInp_25 - then - let _ = "choicesBranch.then" - in let readFail_30 = finalRaise_18 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_25) - then - let !(# - c_31, - cs_32 - #) = readNext_3 failInp_25 - in if ('a' GHC.Classes.==) c_31 - then - let readFail_33 = finalRaise_18 - in let !(# - c_34, - cs_35 - #) = readNext_3 cs_32 - in if ('b' GHC.Classes.==) c_34 - then - let _ = "resume" - in finalRet_13 - farInp_26 - farExp_27 - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) - ) - cs_35 - else - let _ = "checkToken.else" - in let (# - farInp_36, - farExp_37 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 cs_32 of - GHC.Types.LT -> - (# - cs_32, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 cs_32 farInp_36 farExp_37 - else - let _ = "checkToken.else" - in let (# - farInp_38, - farExp_39 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 failInp_25 farInp_38 farExp_39 - else - let _ = "checkHorizon.else" - in let (# - farInp_40, - farExp_41 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 failInp_25 farInp_40 farExp_41 - else - let _ = "choicesBranch.else" - in let (# - farInp_42, - farExp_43 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 failInp_25 farInp_42 farExp_43 - in let readFail_44 = catchHandler_24 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 init_1) - then - let !(# - c_45, - cs_46 - #) = readNext_3 init_1 - in if ('a' GHC.Classes.==) c_45 - then - let readFail_47 = readFail_44 - in let !(# - c_48, - cs_49 - #) = readNext_3 cs_46 - in if ('a' GHC.Classes.==) c_48 - then - let _ = "resume" - in finalRet_13 init_1 GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) - ) - cs_49 - else - let _ = "checkToken.else" - in let (# - farInp_50, - farExp_51 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_46 of - GHC.Types.LT -> - (# - cs_46, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_44 cs_46 farInp_50 farExp_51 - else - let _ = "checkToken.else" - in let (# - farInp_52, - farExp_53 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of - GHC.Types.LT -> - (# - init_1, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_44 init_1 farInp_52 farExp_53 - else - let _ = "checkHorizon.else" - in let (# - farInp_54, - farExp_55 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of - GHC.Types.LT -> - (# - init_1, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_44 init_1 farInp_54 farExp_55 + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let readFail = finalRaise + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('a' GHC.Classes.==) c + then + let readFail = finalRaise + in let !(# + c, + cs + #) = readNext cs + in if ('b' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) + ) + cs + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) + then + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('a' GHC.Classes.==) c + then + let _ = "resume" + in join init GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) + ) + cs + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail init farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail init farInp farExp diff --git a/test/Golden/Splice/G7.expected.txt b/test/Golden/Splice/G7.expected.txt index aea8e4a..9eb5cc6 100644 --- a/test/Golden/Splice/G7.expected.txt +++ b/test/Golden/Splice/G7.expected.txt @@ -1,321 +1,323 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } in let - in let _ = "catchException lbl=fail" - in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_28 - _ - ) - ( Data.Text.Internal.Text - _ - j_29 - _ - ) -> i_28 GHC.Classes.== j_29 - ) - init_1 - failInp_25 - then - let _ = "choicesBranch.then" - in let _ = "catchException lbl=fail" - in let catchHandler_30 (!failInp_31) (!farInp_32) (!farExp_33) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp_34, - farExp_35 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_32 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [] - #) - GHC.Types.EQ -> - (# - farInp_32, - farExp_33 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_32, - farExp_33 - #) - in finalRaise_18 failInp_25 farInp_34 farExp_35 - in let readFail_36 = catchHandler_30 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 failInp_25) - then - let !(# - c_37, - cs_38 - #) = readNext_3 failInp_25 - in if ('a' GHC.Classes.==) c_37 - then - let readFail_39 = readFail_36 - in let !(# - c_40, - cs_41 - #) = readNext_3 cs_38 - in if ('b' GHC.Classes.==) c_40 - then - let _ = "resume" - in finalRet_13 - farInp_26 - farExp_27 - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) - ) - cs_41 - else - let _ = "checkToken.else" - in let (# - farInp_42, - farExp_43 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 cs_38 of - GHC.Types.LT -> - (# - cs_38, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in readFail_36 cs_38 farInp_42 farExp_43 - else - let _ = "checkToken.else" - in let (# - farInp_44, - farExp_45 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in readFail_36 failInp_25 farInp_44 farExp_45 - else - let _ = "checkHorizon.else" - in let (# - farInp_46, - farExp_47 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in readFail_36 failInp_25 farInp_46 farExp_47 - else - let _ = "choicesBranch.else" - in let (# - farInp_48, - farExp_49 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 failInp_25 farInp_48 farExp_49 - in let _ = "catchException lbl=fail" - in let catchHandler_50 (!failInp_51) (!farInp_52) (!farExp_53) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp_54, - farExp_55 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_52 init_1 of - GHC.Types.LT -> - (# - init_1, - [] - #) - GHC.Types.EQ -> - (# - farInp_52, - farExp_53 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_52, - farExp_53 - #) - in catchHandler_24 init_1 farInp_54 farExp_55 - in let readFail_56 = catchHandler_50 - in if readMore_2 (Symantic.Parser.Machine.Input.shiftRightText 1 init_1) - then - let !(# - c_57, - cs_58 - #) = readNext_3 init_1 - in if ('a' GHC.Classes.==) c_57 - then - let readFail_59 = readFail_56 - in let !(# - c_60, - cs_61 - #) = readNext_3 cs_58 - in if ('a' GHC.Classes.==) c_60 - then - let _ = "resume" - in finalRet_13 init_1 GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) - ) - cs_61 - else - let _ = "checkToken.else" - in let (# - farInp_62, - farExp_63 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 cs_58 of - GHC.Types.LT -> - (# - cs_58, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_56 cs_58 farInp_62 farExp_63 - else - let _ = "checkToken.else" - in let (# - farInp_64, - farExp_65 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of - GHC.Types.LT -> - (# - init_1, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_56 init_1 farInp_64 farExp_65 - else - let _ = "checkHorizon.else" - in let (# - farInp_66, - farExp_67 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of - GHC.Types.LT -> - (# - init_1, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_56 init_1 farInp_66 farExp_67 + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('b' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) + ) + cs + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail failInp farInp farExp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp init of + GHC.Types.LT -> + (# + init, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in catchHandler init farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) + then + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('a' GHC.Classes.==) c + then + let _ = "resume" + in join init GHC.Types + . [] + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) + ) + cs + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail cs farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail init farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail init farInp farExp diff --git a/test/Golden/Splice/G8.expected.txt b/test/Golden/Splice/G8.expected.txt index c1f8bb8..1a85469 100644 --- a/test/Golden/Splice/G8.expected.txt +++ b/test/Golden/Splice/G8.expected.txt @@ -1,330 +1,326 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } - in let name_24 = \(!ok_25) (!inp_26) (!koByLabel_27) -> + in let name = \(!ok) (!inp) (!koByLabel) -> let _ = "catchException lbl=fail" - in let catchHandler_28 (!failInp_29) (!farInp_30) (!farExp_31) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_32 + i _ ) ( Data.Text.Internal.Text _ - j_33 + j _ - ) -> i_32 GHC.Classes.== j_33 + ) -> i GHC.Classes.== j ) - inp_26 - failInp_29 + inp + failInp then let _ = "choicesBranch.then" in let _ = "resume" - in ok_25 - farInp_30 - farExp_31 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_34 -> x_34 + in \x -> x ) - failInp_29 + failInp else let _ = "choicesBranch.else" in let (# - farInp_35, - farExp_36 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_30 failInp_29 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_29, + failInp, [] #) GHC.Types.EQ -> (# - farInp_30, - farExp_31 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_30, - farExp_31 + farInp, + farExp #) - in finalRaise_18 failInp_29 farInp_35 farExp_36 - in let readFail_37 = catchHandler_28 - in if readMore_2 inp_26 + in finalRaise failInp farInp farExp + in let readFail = catchHandler + in if readMore inp then let !(# - c_38, - cs_39 - #) = readNext_3 inp_26 - in if ('r' GHC.Classes.==) c_38 + c, + cs + #) = readNext inp + in if ('r' GHC.Classes.==) c then - name_24 + name ( let _ = "suspend" - in \farInp_40 farExp_41 v_42 (!inp_43) -> + in \farInp farExp v (!inp) -> let _ = "resume" - in ok_25 - farInp_40 - farExp_41 + in ok + farInp + farExp ( let _ = "resume.genCode" - in \x_44 -> 'r' GHC.Types.: v_42 x_44 + in \x -> 'r' GHC.Types.: v x ) - inp_43 + inp ) - cs_39 + cs Data.Map.Internal.Tip else let _ = "checkToken.else" in let (# - farInp_45, - farExp_46 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_37 inp_26 farInp_45 farExp_46 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_47, - farExp_48 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 inp_26 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# - inp_26, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_37 inp_26 farInp_47 farExp_48 - in name_24 + in readFail inp farInp farExp + in name ( let _ = "suspend" - in \farInp_49 farExp_50 v_51 (!inp_52) -> - let join_53 = \farInp_54 farExp_55 v_56 (!inp_57) -> + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> let _ = "resume" - in finalRet_13 - farInp_54 - farExp_55 + in finalRet + farInp + farExp ( let _ = "resume.genCode" - in v_51 GHC.Types . [] + in GHC.Show.show (v GHC.Types . []) ) - inp_57 + inp in let _ = "catchException lbl=fail" - in let catchHandler_58 (!failInp_59) (!farInp_60) (!farExp_61) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in if ( \( Data.Text.Internal.Text _ - i_62 + i _ ) ( Data.Text.Internal.Text _ - j_63 + j _ - ) -> i_62 GHC.Classes.== j_63 + ) -> i GHC.Classes.== j ) - inp_52 - failInp_59 + inp + failInp then let _ = "choicesBranch.then" in let (# - farInp_64, - farExp_65 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_60 failInp_59 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_59, + failInp, [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] #) GHC.Types.EQ -> (# - farInp_60, - farExp_61 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] #) GHC.Types.GT -> (# - farInp_60, - farExp_61 + farInp, + farExp #) - in finalRaise_18 failInp_59 farInp_64 farExp_65 + in finalRaise failInp farInp farExp else let _ = "choicesBranch.else" in let (# - farInp_66, - farExp_67 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_60 failInp_59 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - failInp_59, + failInp, [] #) GHC.Types.EQ -> (# - farInp_60, - farExp_61 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_60, - farExp_61 + farInp, + farExp #) - in finalRaise_18 failInp_59 farInp_66 farExp_67 + in finalRaise failInp farInp farExp in let _ = "catchException lbl=fail" - in let catchHandler_68 (!failInp_69) (!farInp_70) (!farExp_71) = + in let catchHandler (!failInp) (!farInp) (!farExp) = let _ = "catchException.ko lbl=fail" in let _ = "resume" - in join_53 - farInp_70 - farExp_71 + in join + farInp + farExp ( let _ = "resume.genCode" in GHC.Tuple . () ) - inp_52 - in let readFail_72 = catchHandler_68 - in if readMore_2 inp_52 + inp + in let readFail = catchHandler + in if readMore inp then let !(# - c_73, - cs_74 - #) = readNext_3 inp_52 - in if (\x_75 -> GHC.Types.True) c_73 + c, + cs + #) = readNext inp + in if (\x -> GHC.Types.True) c then let (# - farInp_76, - farExp_77 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_52, + inp, [] #) GHC.Types.EQ -> (# - farInp_49, - farExp_50 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_49, - farExp_50 + farInp, + farExp #) - in catchHandler_58 inp_52 farInp_76 farExp_77 + in catchHandler inp farInp farExp else let _ = "checkToken.else" in let (# - farInp_78, - farExp_79 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_52, + inp, [] #) GHC.Types.EQ -> (# - farInp_49, - farExp_50 GHC.Base.<> [] + farInp, + farExp GHC.Base.<> [] #) GHC.Types.GT -> (# - farInp_49, - farExp_50 + farInp, + farExp #) - in readFail_72 inp_52 farInp_78 farExp_79 + in readFail inp farInp farExp else let _ = "checkHorizon.else" in let (# - farInp_80, - farExp_81 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_49 inp_52 of + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of GHC.Types.LT -> (# - inp_52, + inp, [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.EQ -> (# - farInp_49, - farExp_50 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] #) GHC.Types.GT -> (# - farInp_49, - farExp_50 + farInp, + farExp #) - in readFail_72 inp_52 farInp_80 farExp_81 + in readFail inp farInp farExp ) - init_1 + init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G9.expected.txt b/test/Golden/Splice/G9.expected.txt index 09f7f6e..187466a 100644 --- a/test/Golden/Splice/G9.expected.txt +++ b/test/Golden/Splice/G9.expected.txt @@ -1,200 +1,202 @@ -\(input_0 :: inp_6989586621679059048) -> +\(input :: inp) -> let !(# - init_1, - readMore_2, - readNext_3 + init, + readMore, + readNext #) = let _ = "cursorOf" - in let next_4 - ( t_5@( Data.Text.Internal.Text - arr_6 - off_7 - unconsumed_8 - ) + in let next + ( t@( Data.Text.Internal.Text + arr + off + unconsumed + ) ) = let !( Data.Text.Unsafe.Iter - c_9 - d_10 - ) = Data.Text.Unsafe.iter t_5 0 + c + d + ) = Data.Text.Unsafe.iter t 0 in (# - c_9, - Data.Text.Internal.Text arr_6 (off_7 GHC.Num.+ d_10) (unconsumed_8 GHC.Num.- d_10) + c, + Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d) #) - more_11 + more ( Data.Text.Internal.Text _ _ - unconsumed_12 - ) = unconsumed_12 GHC.Classes.> 0 - in (# - input_0, - more_11, - next_4 - #) - in let finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16 - in let finalRaise_18 :: - forall b_19. + unconsumed + ) = unconsumed GHC.Classes.> 0 + in (# input, more, next #) + in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + in let finalRaise :: + forall b. Symantic.Parser.Machine.Generate.Catcher - inp_6989586621679059048 - b_19 = \_failInp_20 (!farInp_21) (!farExp_22) -> + inp + b = \_failInp (!farInp) (!farExp) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_21, + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore_2 farInp_21 + if readMore farInp then GHC.Maybe.Just ( let (# - c_23, + c, _ - #) = readNext_3 farInp_21 - in c_23 + #) = readNext farInp + in c ) else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp_22 + Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp } in let - in let _ = "catchException lbl=fail" - in let catchHandler_24 (!failInp_25) (!farInp_26) (!farExp_27) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i_28 - _ - ) - ( Data.Text.Internal.Text - _ - j_29 - _ - ) -> i_28 GHC.Classes.== j_29 - ) - init_1 - failInp_25 - then - let _ = "choicesBranch.then" - in let (# - farInp_30, - farExp_31 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 failInp_25 farInp_30 farExp_31 - else - let _ = "choicesBranch.else" - in let (# - farInp_32, - farExp_33 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp_26 failInp_25 of - GHC.Types.LT -> - (# - failInp_25, - [] - #) - GHC.Types.EQ -> - (# - farInp_26, - farExp_27 GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp_26, - farExp_27 - #) - in finalRaise_18 failInp_25 farInp_32 farExp_33 - in let _ = "catchException lbl=fail" - in let catchHandler_34 (!failInp_35) (!farInp_36) (!farExp_37) = - let _ = "catchException.ko lbl=fail" - in let _ = "resume" - in finalRet_13 - farInp_36 - farExp_37 - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - init_1 - in let readFail_38 = catchHandler_34 - in if readMore_2 init_1 - then - let !(# - c_39, - cs_40 - #) = readNext_3 init_1 - in if (\x_41 -> GHC.Types.True) c_39 - then - let (# - farInp_42, - farExp_43 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of - GHC.Types.LT -> - (# - init_1, - [] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in catchHandler_24 init_1 farInp_42 farExp_43 - else - let _ = "checkToken.else" - in let (# - farInp_44, - farExp_45 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + else + let _ = "choicesBranch.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + [] + #) + GHC.Types.EQ -> + (# + farInp, + farExp GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise failInp farInp farExp + in let _ = "catchException lbl=fail" + in let catchHandler (!failInp) (!farInp) (!farExp) = + let _ = "catchException.ko lbl=fail" + in let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + init + in let readFail = catchHandler + in if readMore init + then + let !(# c, cs #) = readNext init + in if (\x -> GHC.Types.True) c + then + let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of GHC.Types.LT -> (# - init_1, + init, [] #) GHC.Types.EQ -> (# - init_1, + init, GHC.Types . [] GHC.Base.<> [] #) GHC.Types.GT -> (# - init_1, + init, GHC.Types . [] #) - in readFail_38 init_1 farInp_44 farExp_45 - else - let _ = "checkHorizon.else" - in let (# - farInp_46, - farExp_47 - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init_1 init_1 of - GHC.Types.LT -> - (# - init_1, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init_1, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init_1, - GHC.Types . [] - #) - in readFail_38 init_1 farInp_46 farExp_47 + in catchHandler init farInp farExp + else + let _ = "checkToken.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + [] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail init farInp farExp + else + let _ = "checkHorizon.else" + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.EQ -> + (# + init, + GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + #) + GHC.Types.GT -> + (# + init, + GHC.Types . [] + #) + in readFail init farInp farExp diff --git a/test/Golden/Splice/Utils.hs b/test/Golden/Splice/Utils.hs deleted file mode 100644 index 743bdd8..0000000 --- a/test/Golden/Splice/Utils.hs +++ /dev/null @@ -1,149 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -module Golden.Splice.Utils where - --- Build_symantic_parser is auto-generated by Setup.hs -import Build_symantic_parser (ghcPath, ghcFlags, rootDir) -import Control.Applicative (Applicative(..)) -import Control.Monad (Monad(..), unless, void) -import Data.Foldable (asum) -import Data.Function (($), (.), const, on) -import Data.Functor ((<$>), (<$)) -import Data.Eq (Eq(..)) -import Data.Maybe (Maybe(..)) -import Data.Semigroup (Semigroup(..)) -import Data.String (String, IsString(..)) -import Data.Text (Text) -import Data.Tuple (fst) --- import System.Environment (getEnvironment) -import System.FilePath (FilePath, dropExtensions, takeBaseName, (), (<.>), (-<.>)) -import System.IO (IO, IOMode(..), openFile, print) -import Test.Tasty (TestTree) -import Test.Tasty.Golden (goldenVsFileDiff, goldenVsStringDiff) -import Text.Show (Show(..)) -import qualified Control.Exception as IO -import qualified Data.List as List -import qualified Language.Haskell.TH as TH -import qualified Language.Haskell.TH.Syntax as TH -import qualified Language.Haskell.TH.PprLib as TH -import qualified System.Directory as IO -import qualified System.IO.Error as IO -import qualified System.Process as Process ---import qualified Text.PrettyPrint as PP -import qualified Turtle - -import Golden.Utils - -import Debug.Trace - -ghcOpts :: [String] -ghcOpts = traceShowId ghcFlags <> - [ "-v0" - , "-c" - , "-ddump-splices" - , "-dsuppress-uniques" - --, "-static" - --, "-dynamic" - --, "-O", "-prof", "-fprof-auto-exported" - --, "-osuf", "p_o", "-hisuf", "p_hi" - -- , "-prof" --, "-fprof-auto" - -- , "-eventlog", "-debug" - -- , "-fexternal-interpreter", "-opti+RTS", "-opti-p", "-opti-L100", "-opti-ls", "-opti-xc" - --, "-fhpc", "-hpcdir", "-opti/home/julm/work/sourcephile/haskell/symantic-parser/dist-newstyle/build/x86_64-linux/ghc-9.0.1/symantic-parser-0.1.0.20210201/hpc/vanilla/mix/symantic-parser-test" - -- , "-opti-fhpc", "-opti-hpcdir", "-opti/home/julm/work/sourcephile/haskell/symantic-parser/dist-newstyle/build/x86_64-linux/ghc-9.0.1/symantic-parser-0.1.0.20210201/hpc/vanilla/mix/symantic-parser-test" - , "-fforce-recomp" - , "-fprint-explicit-kinds" - , "-O0" - --, "-XConstraintKinds" - , "-XDataKinds" - --, "-XDefaultSignatures" - --, "-XEmptyCase" - , "-XFlexibleContexts" - , "-XFlexibleInstances" - , "-XGADTs" - --, "-XInstanceSigs" - --, "-XKindSignatures" - , "-XLambdaCase" - , "-XMultiParamTypeClasses" - --, "-XNoStarIsType" - --, "-XPolyKinds" - , "-XRankNTypes" - , "-XScopedTypeVariables" - --, "-XStandaloneDeriving" - --, "-XStandaloneKindSignatures" - , "-XTemplateHaskell" - , "-XTypeApplications" - , "-XTypeFamilies" - , "-XTypeOperators" - , "-XUnboxedTuples" - --, "-XUndecidableInstances" - ] - -testSplice :: FilePath -> TestTree -testSplice spliceFile = - goldenVsFileDiff (takeBaseName (dropExtensions spliceFile)) goldenDiff - (rootDirspliceFile-<.>"expected"<.>"txt") - actualFile $ do - h <- openFile actualFile WriteMode - --env <- getEnvironment - (_, _, _, pid) <- Process.createProcess - (Process.proc ghcPath (spliceFile : ghcOpts)) - { Process.std_out = Process.UseHandle h - , Process.std_err = Process.UseHandle h - , Process.cwd = Just rootDir - {- - , Process.env = Just $ traceShowId $ - List.deleteBy ((==) `on` fst) ("HPCTIXFILE", "") env - -} - } - void $ Process.waitForProcess pid - normalizeSplice actualFile - where - actualFile = rootDirspliceFile-<.>"actual"<.>"txt" - -coverSplice :: IO (TH.TExp a) -> FilePath -> TestTree -coverSplice splice spliceFile = - goldenVsStringDiff (takeBaseName (dropExtensions spliceFile)) goldenDiff - (rootDirspliceFile) $ do - --resetTHNameCounter - tExp <- splice - fromString <$> Process.readProcess "ormolu" - [ "-o", "-XMagicHash" - , "-o", "-XUnboxedTuples" - , "-o", "-XBangPatterns" - , "-o", "-XTypeApplications" ] - (show (TH.ppr (TH.unType tExp))) - {- - return $ fromString $ PP.renderStyle PP.Style - { PP.lineLength = 100 - , PP.ribbonsPerLine = 0.1 - , PP.mode = PP.PageMode - } $ TH.to_HPJ_Doc $ TH.ppr $ TH.unType tExp - -} - -normalizeSplice :: FilePath -> IO () -normalizeSplice = Turtle.inplace pat . fromString - where - pat :: Turtle.Pattern Text - pat = asum - [ "(0,0)-(0,0)" <$ numPair <* "-" <* numPair - , ":0:0:" <$ ":" <* d <* ":" <* d <* "-" <* d - , ":0:0" <$ ":" <* d <* ":" <* d - , fromString @Text . numPeriod <$> Turtle.lowerBounded 10 Turtle.digit - , fromString @Text . ('%' <$) <$> Turtle.lowerBounded 10 punctSym - -- Remove pretty-printed references to the symantic-parser package - -- (e.g., turn `symantic-parser-1.2.3:Catcher` into `Catcher`) - -- to make the output more stable. - , "" <$ "symantic-parser-" <* verNum <* ":" - ] - verNum = d `Turtle.sepBy` Turtle.char '.' - numPair = () <$ "(" <* d <* "," <* d <* ")" - punctSym = Turtle.oneOf "!#$%&*+./>" - numPeriod = List.zipWith const (List.cycle "0123456789876543210") - d = Turtle.some Turtle.digit - -rmFile :: FilePath -> IO () -rmFile path = - IO.catchIOError (IO.removeFile path) $ \exn -> - unless (IO.isDoesNotExistError exn) $ - IO.throwIO exn diff --git a/test/Grammar.hs b/test/Grammar.hs index 5db5f28..da1d654 100644 --- a/test/Grammar.hs +++ b/test/Grammar.hs @@ -1,45 +1,41 @@ -{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies#-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} module Grammar where import Data.Char (Char) +import Data.String (String) +import Text.Show (Show(..)) import qualified Data.Functor as Functor import qualified Grammar.Brainfuck import qualified Grammar.Nandlang import Symantic.Parser +import qualified Symantic.Parser.Haskell as H -data G = forall a. G ( - forall repr. - Grammar Char repr => - repr a - ) - -rawGrammars :: [G] +rawGrammars :: Grammar Char repr => [repr String] rawGrammars = - [ G g1 - , G g2 - , G g3 - , G g4 - , G g5 - , G g6 - , G g7 - , G g8 - , G g9 - , G g10 - , G g11 - , G g12 - , G g13 - , G g14 - , G g15 - , G g16 + [ H.Term (H.ValueCode show [||show||]) <$> g1 + , H.Term (H.ValueCode show [||show||]) <$> g2 + , H.Term (H.ValueCode show [||show||]) <$> g3 + , H.Term (H.ValueCode show [||show||]) <$> g4 + , H.Term (H.ValueCode show [||show||]) <$> g5 + , H.Term (H.ValueCode show [||show||]) <$> g6 + , H.Term (H.ValueCode show [||show||]) <$> g7 + , H.Term (H.ValueCode show [||show||]) <$> g8 + , H.Term (H.ValueCode show [||show||]) <$> g9 + , H.Term (H.ValueCode show [||show||]) <$> g10 + , H.Term (H.ValueCode show [||show||]) <$> g11 + , H.Term (H.ValueCode show [||show||]) <$> g12 + , H.Term (H.ValueCode show [||show||]) <$> g13 + , H.Term (H.ValueCode show [||show||]) <$> g14 + , H.Term (H.ValueCode show [||show||]) <$> g15 + , H.Term (H.ValueCode show [||show||]) <$> g16 ] -grammars :: [G] -grammars = (\(G g) -> G (observeSharing g)) Functor.<$> rawGrammars +grammars :: Grammar Char repr => [repr String] +grammars = observeSharing Functor.<$> rawGrammars g1 = char 'a' g2 = string "abc" diff --git a/test/Machine.hs b/test/Machine.hs index d49a12f..2dd9a3e 100644 --- a/test/Machine.hs +++ b/test/Machine.hs @@ -13,24 +13,3 @@ import System.IO (IO) import qualified Symantic.Parser as P import Grammar - --- | Existential type to gather machines --- returning different values in the same @('machines')@ list. -data M = forall a. M ( - forall repr inp. inp ~ Text => - P.Machine (P.InputToken inp) repr => - IO (repr inp '[] a) - ) - -machines :: [M] -machines = (\(G g) -> M (P.optimizeMachine g)) <$> grammars -{- -e1 = P.fixByName (P.analysisByLet (P.machine @[Char] g1)) -h1 = P.runAnalysis (P.machine @[Char] g1) -e13 = P.fixByName (P.analysisByLet (P.machine @[Char] g13)) -h2 = P.runAnalysis (P.machine @[Char] g2) -h3 = P.runAnalysis (P.machine @[Char] g3) -h4 = P.runAnalysis (P.machine @[Char] g4) -h13 = P.runAnalysis (P.machine @[Char] g13) -h14 = P.runGenAnalysis (P.genAnalysisByLet (P.machine @[Char] g14)) --} diff --git a/test/Parser.hs b/test/Parser.hs deleted file mode 100644 index f67c443..0000000 --- a/test/Parser.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -Wno-missing-signatures #-} --- For TH splices -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE UnboxedTuples #-} -{-# OPTIONS_GHC -Wno-unused-local-binds #-} -{-# OPTIONS_GHC -Wno-unused-matches #-} -module Parser where - -import Data.Either (Either(..)) -import Data.Text (Text) -import Text.Show (Show) -import Symantic.Parser -import Grammar -import qualified Data.IORef as IORef -import qualified Language.Haskell.TH as TH -import qualified Language.Haskell.TH.Syntax as TH -import Control.DeepSeq -import System.IO (IO) - -data P = forall a. Show a => P ( - Text -> Either (ParsingError Text) a - ) - -parsers :: [P] -parsers = - [ {-P p1 - , P p2 - , P p3 - , P p4 - , P p5 - , P p6 - , P p7 - , P p8 - , P p9 - , P p10 - , P p11 - , P p12 - , P p13 - , P p14 - , P p15 - -} - ] - -{- -p1 = $$(TH.Code (do - TH.qRunIO (IORef.writeIORef TH.counter 0) - TH.examineCode (runParser @Text g1) - )) -p2 = $$(runParser @Text g2) -p3 = $$(runParser @Text g3) -p4 = $$(runParser @Text g4) -p5 = $$(runParser @Text g5) -p6 = $$(runParser @Text g6) -p7 = $$(runParser @Text g7) -p8 = $$(runParser @Text g8) -p9 = $$(runParser @Text g9) -p10 = $$(runParser @Text g10) -p11 = $$(runParser @Text g11) -p12 = $$(runParser @Text g12) -p13 = $$(runParser @Text g13) --} --- p14 = $$(TH.runQ (TH.examineCode (runParser @Text g14)) `deepseq` runParser @Text g14) --- p14 = $$({- `deepseq`-} runParser @Text g14) -q14 = TH.runQ (TH.examineCode (runParser @Text g14)) --- p15 = $$(runParser @Text g15) -- 2.44.1 From 89fb721ba4f24b628538f44201813fbc49f4856b Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 26 Mar 2021 02:17:30 +0100 Subject: [PATCH 05/16] grammar: sort symantics by name --- Makefile | 3 +- src/Symantic/Parser/Grammar.hs | 15 +- src/Symantic/Parser/Grammar/Combinators.hs | 561 +++++++++--------- src/Symantic/Parser/Grammar/ObserveSharing.hs | 76 +-- src/Symantic/Parser/Grammar/Optimize.hs | 409 ++++++------- src/Symantic/Parser/Grammar/View.hs | 49 +- src/Symantic/Parser/Grammar/Write.hs | 133 +++-- src/Symantic/Parser/Machine/Program.hs | 118 ++-- test/Grammar/Playground.hs | 2 +- 9 files changed, 685 insertions(+), 681 deletions(-) diff --git a/Makefile b/Makefile index ad5e24d..a888609 100644 --- a/Makefile +++ b/Makefile @@ -17,11 +17,12 @@ t: %/cover: TESTFLAGS+=--enable-coverage %/cover: % +t/prof: OPTIFLAGS?=-xc t/prof: cabal v2-build lib:symantic-parser --enable-profiling --write-ghc-environment-files=always cabal test $(TESTFLAGS) --enable-profiling -fprof-auto -fprof-auto-calls \ --test-show-details always --test-options "$(TESTOPTIONS) $${p:+-p $$p}" \ - --ghc-options "-opti+RTS -opti-p -opti-L100 -opti-ls -opti-xc" + --ghc-options "-opti+RTS -opti-p -opti-L100 -opti-ls $(addprefix -opti,$(OPTIFLAGS))" t/repl: cabal repl --enable-tests symantic-parser-test diff --git a/src/Symantic/Parser/Grammar.hs b/src/Symantic/Parser/Grammar.hs index a32bb4e..011570a 100644 --- a/src/Symantic/Parser/Grammar.hs +++ b/src/Symantic/Parser/Grammar.hs @@ -25,15 +25,16 @@ import qualified Language.Haskell.TH.Syntax as TH -- * Class 'Grammar' type Grammar tok repr = - ( Applicable repr - , Alternable repr - , Satisfiable tok repr + ( CombAlternable repr + , CombApplicable repr + , CombFoldable repr , Letable TH.Name repr , Letsable TH.Name repr - , Selectable repr - , Matchable repr - , Foldable repr - , Lookable repr + , CombLookable repr + , CombMatchable repr + , CombSatisfiable tok repr + , CombSelectable repr + , CombThrowable repr ) -- | A usual pipeline to interpret 'Comb'inators: diff --git a/src/Symantic/Parser/Grammar/Combinators.hs b/src/Symantic/Parser/Grammar/Combinators.hs index ffbdede..47ad381 100644 --- a/src/Symantic/Parser/Grammar/Combinators.hs +++ b/src/Symantic/Parser/Grammar/Combinators.hs @@ -17,13 +17,12 @@ import Data.Char (Char) import Data.Either (Either(..)) import Data.Eq (Eq(..)) import Data.Function ((.), flip, const) -import Data.Kind (Constraint) import Data.Int (Int) import Data.Maybe (Maybe(..)) import Data.Ord (Ord) import Data.Proxy (Proxy(..)) import Data.String (String) -import GHC.TypeLits (KnownSymbol, Symbol) +import GHC.TypeLits (KnownSymbol) import Text.Show (Show(..)) import qualified Data.Functor as Functor import qualified Data.List as List @@ -36,7 +35,59 @@ import qualified Symantic.Parser.Haskell as H -- * Type 'TermGrammar' type TermGrammar = H.Term H.ValueCode --- * Class 'Applicable' +-- * Class 'CombAlternable' +class CombAlternable repr where + -- | @(rl '<|>' rr)@ parses @(rl)@ and return its return value or, + -- if it fails, parses @(rr)@ from where @(rl)@ has left the input stream, + -- and returns its return value. + (<|>) :: repr a -> repr a -> repr a + -- | @(empty)@ parses nothing, always failing to return a value. + empty :: repr a + -- | @('try' ra)@ records the input stream position, + -- then parses like @(ra)@ and either returns its value it it succeeds or fails + -- if it fails but with a reset of the input stream to the recorded position. + -- Generally used on the first alternative: @('try' rl '<|>' rr)@. + try :: repr a -> repr a + default (<|>) :: + Sym.Liftable2 repr => CombAlternable (Sym.Output repr) => + repr a -> repr a -> repr a + default empty :: + Sym.Liftable repr => CombAlternable (Sym.Output repr) => + repr a + default try :: + Sym.Liftable1 repr => CombAlternable (Sym.Output repr) => + repr a -> repr a + (<|>) = Sym.lift2 (<|>) + empty = Sym.lift empty + try = Sym.lift1 try + -- | Like @('<|>')@ but with different returning types for the alternatives, + -- and a return value wrapped in an 'Either' accordingly. + (<+>) :: CombApplicable repr => CombAlternable repr => repr a -> repr b -> repr (Either a b) + p <+> q = H.left <$> p <|> H.right <$> q +infixl 3 <|>, <+> + +optionally :: CombApplicable repr => CombAlternable repr => repr a -> TermGrammar b -> repr b +optionally p x = p $> x <|> pure x + +optional :: CombApplicable repr => CombAlternable repr => repr a -> repr () +optional = flip optionally H.unit + +option :: CombApplicable repr => CombAlternable repr => TermGrammar a -> repr a -> repr a +option x p = p <|> pure x + +choice :: CombAlternable repr => [repr a] -> repr a +choice = List.foldr (<|>) empty + -- FIXME: Here hlint suggests to use Data.Foldable.asum, + -- but at this point there is no asum for our own (<|>) + +maybeP :: CombApplicable repr => CombAlternable repr => repr a -> repr (Maybe a) +maybeP p = option H.nothing (H.just <$> p) + +manyTill :: CombApplicable repr => CombAlternable repr => repr a -> repr b -> repr [a] +manyTill p end = let go = end $> H.nil <|> p <:> go in go + + +-- * Class 'CombApplicable' -- | This is like the usual 'Functor' and 'Applicative' type classes -- from the @base@ package, but using @('TermGrammar' a)@ instead of just @(a)@ -- to be able to use and pattern match on some usual terms of type @(a)@ (like 'H.id') @@ -44,7 +95,7 @@ type TermGrammar = H.Term H.ValueCode -- @(repr)@, for "representation", is the usual tagless-final abstraction -- over the many semantics that this syntax (formed by the methods -- of type class like this one) will be interpreted. -class Applicable repr where +class CombApplicable repr where -- | @(a2b '<$>' ra)@ parses like @(ra)@ but maps its returned value with @(a2b)@. (<$>) :: TermGrammar (a -> b) -> repr a -> repr b (<$>) f = (pure f <*>) @@ -64,7 +115,7 @@ class Applicable repr where -- | @('pure' a)@ parses the empty string, always succeeding in returning @(a)@. pure :: TermGrammar a -> repr a default pure :: - Sym.Liftable repr => Applicable (Sym.Output repr) => + Sym.Liftable repr => CombApplicable (Sym.Output repr) => TermGrammar a -> repr a pure = Sym.lift . pure @@ -73,7 +124,7 @@ class Applicable repr where -- to the value returned by @(ra)@. (<*>) :: repr (a -> b) -> repr a -> repr b default (<*>) :: - Sym.Liftable2 repr => Applicable (Sym.Output repr) => + Sym.Liftable2 repr => CombApplicable (Sym.Output repr) => repr (a -> b) -> repr a -> repr b (<*>) = Sym.lift2 (<*>) @@ -101,115 +152,52 @@ class Applicable repr where -} infixl 4 <$>, <&>, <$, $>, <*>, <*, *>, <**> --- * Class 'Alternable' -class Alternable repr where - -- | @(rl '<|>' rr)@ parses @(rl)@ and return its return value or, - -- if it fails, parses @(rr)@ from where @(rl)@ has left the input stream, - -- and returns its return value. - (<|>) :: repr a -> repr a -> repr a - -- | @(empty)@ parses nothing, always failing to return a value. - empty :: repr a - -- | @('try' ra)@ records the input stream position, - -- then parses like @(ra)@ and either returns its value it it succeeds or fails - -- if it fails but with a reset of the input stream to the recorded position. - -- Generally used on the first alternative: @('try' rl '<|>' rr)@. - try :: repr a -> repr a - default (<|>) :: - Sym.Liftable2 repr => Alternable (Sym.Output repr) => - repr a -> repr a -> repr a - default empty :: - Sym.Liftable repr => Alternable (Sym.Output repr) => - repr a - default try :: - Sym.Liftable1 repr => Alternable (Sym.Output repr) => - repr a -> repr a - (<|>) = Sym.lift2 (<|>) - empty = Sym.lift empty - try = Sym.lift1 try - -- | Like @('<|>')@ but with different returning types for the alternatives, - -- and a return value wrapped in an 'Either' accordingly. - (<+>) :: Applicable repr => Alternable repr => repr a -> repr b -> repr (Either a b) - p <+> q = H.left <$> p <|> H.right <$> q -infixl 3 <|>, <+> - -class Throwable repr where - type ThrowableLabel repr (lbl::Symbol) :: Constraint - --type ThrowableLabel repr lbl = ThrowableLabel (Sym.Output repr) lbl - throw :: - KnownSymbol lbl => - ThrowableLabel repr lbl => - Proxy lbl -> repr a - default throw :: - forall lbl a. - Sym.Liftable repr => Alternable (Sym.Output repr) => - KnownSymbol lbl => - Throwable (Sym.Output repr) => - ThrowableLabel (Sym.Output repr) lbl => - Proxy lbl -> repr a - throw lbl = Sym.lift (throw lbl) - -optionally :: Applicable repr => Alternable repr => repr a -> TermGrammar b -> repr b -optionally p x = p $> x <|> pure x - -optional :: Applicable repr => Alternable repr => repr a -> repr () -optional = flip optionally H.unit - -option :: Applicable repr => Alternable repr => TermGrammar a -> repr a -> repr a -option x p = p <|> pure x +{-# INLINE (<:>) #-} +infixl 4 <:> +(<:>) :: CombApplicable repr => repr a -> repr [a] -> repr [a] +(<:>) = liftA2 H.cons -choice :: Alternable repr => [repr a] -> repr a -choice = List.foldr (<|>) empty - -- FIXME: Here hlint suggests to use Data.Foldable.asum, - -- but at this point there is no asum for our own (<|>) +sequence :: CombApplicable repr => [repr a] -> repr [a] +sequence = List.foldr (<:>) (pure H.nil) -maybeP :: Applicable repr => Alternable repr => repr a -> repr (Maybe a) -maybeP p = option H.nothing (H.just <$> p) +traverse :: CombApplicable repr => (a -> repr b) -> [a] -> repr [b] +traverse f = sequence . List.map f + -- FIXME: Here hlint suggests to use Control.Monad.mapM, + -- but at this point there is no mapM for our own sequence -manyTill :: Applicable repr => Alternable repr => repr a -> repr b -> repr [a] -manyTill p end = let go = end $> H.nil <|> p <:> go in go +repeat :: CombApplicable repr => Int -> repr a -> repr [a] +repeat n p = traverse (const p) [1..n] --- * Class 'Selectable' -class Selectable repr where - branch :: repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c - default branch :: - Sym.Liftable3 repr => Selectable (Sym.Output repr) => - repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c - branch = Sym.lift3 branch +between :: CombApplicable repr => repr o -> repr c -> repr a -> repr a +between open close p = open *> p <* close --- * Class 'Matchable' -class Matchable repr where - conditional :: - Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b - default conditional :: - Sym.Unliftable repr => Sym.Liftable1 repr => Matchable (Sym.Output repr) => - Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b - conditional a ps bs = Sym.lift1 (conditional (Sym.trans a) ps (Sym.trans Functor.<$> bs)) +void :: CombApplicable repr => repr a -> repr () +void p = p *> unit - match :: Eq a => repr a -> [TermGrammar a] -> (TermGrammar a -> repr b) -> repr b -> repr b - match a as a2b = conditional a ((H.eq H..@) Functor.<$> as) (a2b Functor.<$> as) - -- match a as a2b = conditional a (((H.eq H..@ H.qual) H..@) Functor.<$> as) (a2b Functor.<$> as) +unit :: CombApplicable repr => repr () +unit = pure H.unit --- * Class 'Foldable' -class Foldable repr where +-- * Class 'CombFoldable' +class CombFoldable repr where chainPre :: repr (a -> a) -> repr a -> repr a chainPost :: repr a -> repr (a -> a) -> repr a {- default chainPre :: - Sym.Liftable2 repr => Foldable (Sym.Output repr) => + Sym.Liftable2 repr => CombFoldable (Sym.Output repr) => repr (a -> a) -> repr a -> repr a default chainPost :: - Sym.Liftable2 repr => Foldable (Sym.Output repr) => + Sym.Liftable2 repr => CombFoldable (Sym.Output repr) => repr a -> repr (a -> a) -> repr a chainPre = Sym.lift2 chainPre chainPost = Sym.lift2 chainPost -} default chainPre :: - Applicable repr => - Alternable repr => + CombApplicable repr => + CombAlternable repr => repr (a -> a) -> repr a -> repr a default chainPost :: - Applicable repr => - Alternable repr => + CombApplicable repr => + CombAlternable repr => repr a -> repr (a -> a) -> repr a chainPre op p = go <*> p where go = (H..) <$> op <*> go <|> pure H.id chainPost p op = p <**> go where go = (H..) <$> op <*> go <|> pure H.id @@ -219,202 +207,40 @@ class Foldable repr where -} {- -conditional :: Selectable repr => [(TermGrammar (a -> Bool), repr b)] -> repr a -> repr b -> repr b +conditional :: CombSelectable repr => [(TermGrammar (a -> Bool), repr b)] -> repr a -> repr b -> repr b conditional cs p def = match p fs qs def where (fs, qs) = List.unzip cs -} --- * Class 'Satisfiable' -class Satisfiable tok repr where - satisfy :: [ErrorItem tok] -> TermGrammar (tok -> Bool) -> repr tok - default satisfy :: - Sym.Liftable repr => Satisfiable tok (Sym.Output repr) => - [ErrorItem tok] -> - TermGrammar (tok -> Bool) -> repr tok - satisfy es = Sym.lift . satisfy es - - item :: repr tok - item = satisfy [] (H.const H..@ H.bool True) - --- ** Type 'ErrorItem' -data ErrorItem tok - = ErrorItemToken tok - | ErrorItemLabel String - | ErrorItemHorizon Int - | ErrorItemEnd -deriving instance Eq tok => Eq (ErrorItem tok) -deriving instance Ord tok => Ord (ErrorItem tok) -deriving instance Show tok => Show (ErrorItem tok) -deriving instance TH.Lift tok => TH.Lift (ErrorItem tok) - --- * Class 'Lookable' -class Lookable repr where - look :: repr a -> repr a - negLook :: repr a -> repr () - default look :: Sym.Liftable1 repr => Lookable (Sym.Output repr) => repr a -> repr a - default negLook :: Sym.Liftable1 repr => Lookable (Sym.Output repr) => repr a -> repr () - look = Sym.lift1 look - negLook = Sym.lift1 negLook - - eof :: repr () - eof = Sym.lift eof - default eof :: Sym.Liftable repr => Lookable (Sym.Output repr) => repr () - -- eof = negLook (satisfy @Char [ErrorItemAny] (H.const H..@ H.bool True)) - -- (item @Char) - -{-# INLINE (<:>) #-} -infixl 4 <:> -(<:>) :: Applicable repr => repr a -> repr [a] -> repr [a] -(<:>) = liftA2 H.cons - -sequence :: Applicable repr => [repr a] -> repr [a] -sequence = List.foldr (<:>) (pure H.nil) - -traverse :: Applicable repr => (a -> repr b) -> [a] -> repr [b] -traverse f = sequence . List.map f - -- FIXME: Here hlint suggests to use Control.Monad.mapM, - -- but at this point there is no mapM for our own sequence - -repeat :: Applicable repr => Int -> repr a -> repr [a] -repeat n p = traverse (const p) [1..n] - -between :: Applicable repr => repr o -> repr c -> repr a -> repr a -between open close p = open *> p <* close - -string :: - Applicable repr => Alternable repr => - Satisfiable Char repr => - [Char] -> repr [Char] -string = try . traverse char - -oneOf :: - TH.Lift tok => Eq tok => - Satisfiable tok repr => - [tok] -> repr tok -oneOf ts = satisfy [ErrorItemLabel "oneOf"] - (Sym.trans H.ValueCode - { value = (`List.elem` ts) - , code = [||\t -> $$(ofChars ts [||t||])||] }) - -noneOf :: - TH.Lift tok => Eq tok => - Satisfiable tok repr => - [tok] -> repr tok -noneOf cs = satisfy (ErrorItemToken Functor.<$> cs) (Sym.trans H.ValueCode - { value = not . (`List.elem` cs) - , code = [||\c -> not $$(ofChars cs [||c||])||] - }) - -ofChars :: - TH.Lift tok => Eq tok => - {-alternatives-}[tok] -> - {-input-}TH.CodeQ tok -> - TH.CodeQ Bool -ofChars = List.foldr (\alt acc -> - \inp -> [|| alt == $$inp || $$(acc inp) ||]) - (const [||False||]) - -more :: Applicable repr => Satisfiable Char repr => Lookable repr => repr () -more = look (void (item @Char)) - -char :: - Applicable repr => Satisfiable Char repr => - Char -> repr Char -char c = satisfy [ErrorItemToken c] (H.eq H..@ H.char c) $> H.char c --- char c = satisfy [ErrorItemToken c] (H.eq H..@ H.qual H..@ H.char c) $> H.char c - -anyChar :: Satisfiable Char repr => repr Char -anyChar = satisfy [] (H.const H..@ H.bool True) - -token :: - TH.Lift tok => Show tok => Eq tok => - Applicable repr => Satisfiable tok repr => - tok -> repr tok -token tok = satisfy [ErrorItemToken tok] (H.eq H..@ H.char tok) $> H.char tok --- token tok = satisfy [ErrorItemToken tok] (H.eq H..@ H.qual H..@ H.char tok) $> H.char tok - -tokens :: - TH.Lift tok => Eq tok => Show tok => - Applicable repr => Alternable repr => - Satisfiable tok repr => [tok] -> repr [tok] -tokens = try . traverse token - --- Composite Combinators --- someTill :: repr a -> repr b -> repr [a] --- someTill p end = negLook end *> (p <:> manyTill p end) - -void :: Applicable repr => repr a -> repr () -void p = p *> unit - -unit :: Applicable repr => repr () -unit = pure H.unit - -{- -constp :: Applicable repr => repr a -> repr (b -> a) -constp = (H.const <$>) - - --- Alias Operations -infixl 1 >> -(>>) :: Applicable repr => repr a -> repr b -> repr b -(>>) = (*>) - --- Monoidal Operations - -infixl 4 <~> -(<~>) :: Applicable repr => repr a -> repr b -> repr (a, b) -(<~>) = liftA2 (H.runtime (,)) - -infixl 4 <~ -(<~) :: Applicable repr => repr a -> repr b -> repr a -(<~) = (<*) - -infixl 4 ~> -(~>) :: Applicable repr => repr a -> repr b -> repr b -(~>) = (*>) - --- Lift Operations -liftA2 :: - Applicable repr => - TermGrammar (a -> b -> c) -> repr a -> repr b -> repr c -liftA2 f x = (<*>) (fmap f x) - -liftA3 :: - Applicable repr => - TermGrammar (a -> b -> c -> d) -> repr a -> repr b -> repr c -> repr d -liftA3 f a b c = liftA2 f a b <*> c - --} - -- Parser Folds pfoldr :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => TermGrammar (a -> b -> b) -> TermGrammar b -> repr a -> repr b pfoldr f k p = chainPre (f <$> p) (pure k) pfoldr1 :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => TermGrammar (a -> b -> b) -> TermGrammar b -> repr a -> repr b pfoldr1 f k p = f <$> p <*> pfoldr f k p pfoldl :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => TermGrammar (b -> a -> b) -> TermGrammar b -> repr a -> repr b pfoldl f k p = chainPost (pure k) ((H.flip <$> pure f) <*> p) pfoldl1 :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => TermGrammar (b -> a -> b) -> TermGrammar b -> repr a -> repr b pfoldl1 f k p = chainPost (f <$> pure k <*> p) ((H.flip <$> pure f) <*> p) -- Chain Combinators chainl1' :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => TermGrammar (a -> b) -> repr a -> repr (b -> a -> b) -> repr b chainl1' f p op = chainPost (f <$> p) (H.flip <$> op <*> p) chainl1 :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => repr a -> repr (a -> a -> a) -> repr a chainl1 = chainl1' H.id @@ -434,69 +260,69 @@ chainr p op x = option x (chainr1 p op) -} chainl :: - Applicable repr => Alternable repr => Foldable repr => + CombApplicable repr => CombAlternable repr => CombFoldable repr => repr a -> repr (a -> a -> a) -> TermGrammar a -> repr a chainl p op x = option x (chainl1 p op) -- Derived Combinators many :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => repr a -> repr [a] many = pfoldr H.cons H.nil manyN :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => Int -> repr a -> repr [a] manyN n p = List.foldr (const (p <:>)) (many p) [1..n] some :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => repr a -> repr [a] some = manyN 1 skipMany :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => repr a -> repr () --skipMany p = let skipManyp = p *> skipManyp <|> unit in skipManyp skipMany = void . pfoldl H.const H.unit -- the void here will encourage the optimiser to recognise that the register is unused skipManyN :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => Int -> repr a -> repr () skipManyN n p = List.foldr (const (p *>)) (skipMany p) [1..n] skipSome :: - Applicable repr => Foldable repr => + CombApplicable repr => CombFoldable repr => repr a -> repr () skipSome = skipManyN 1 sepBy :: - Applicable repr => Alternable repr => Foldable repr => + CombApplicable repr => CombAlternable repr => CombFoldable repr => repr a -> repr b -> repr [a] sepBy p sep = option H.nil (sepBy1 p sep) sepBy1 :: - Applicable repr => Alternable repr => Foldable repr => + CombApplicable repr => CombAlternable repr => CombFoldable repr => repr a -> repr b -> repr [a] sepBy1 p sep = p <:> many (sep *> p) endBy :: - Applicable repr => Alternable repr => Foldable repr => + CombApplicable repr => CombAlternable repr => CombFoldable repr => repr a -> repr b -> repr [a] endBy p sep = many (p <* sep) endBy1 :: - Applicable repr => Alternable repr => Foldable repr => + CombApplicable repr => CombAlternable repr => CombFoldable repr => repr a -> repr b -> repr [a] endBy1 p sep = some (p <* sep) sepEndBy :: - Applicable repr => Alternable repr => Foldable repr => + CombApplicable repr => CombAlternable repr => CombFoldable repr => repr a -> repr b -> repr [a] sepEndBy p sep = option H.nil (sepEndBy1 p sep) sepEndBy1 :: - Applicable repr => Alternable repr => Foldable repr => + CombApplicable repr => CombAlternable repr => CombFoldable repr => repr a -> repr b -> repr [a] sepEndBy1 p sep = let seb1 = p <**> (sep *> (H.flip H..@ H.cons <$> option H.nil seb1) @@ -511,13 +337,180 @@ sepEndBy1 p sep = newRegister_ H.id $ \acc -> in go <*> pure H.nil -} +-- * Class 'CombMatchable' +class CombMatchable repr where + conditional :: + Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b + default conditional :: + Sym.Unliftable repr => Sym.Liftable1 repr => CombMatchable (Sym.Output repr) => + Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b + conditional a ps bs = Sym.lift1 (conditional (Sym.trans a) ps (Sym.trans Functor.<$> bs)) + + match :: Eq a => repr a -> [TermGrammar a] -> (TermGrammar a -> repr b) -> repr b -> repr b + match a as a2b = conditional a ((H.eq H..@) Functor.<$> as) (a2b Functor.<$> as) + -- match a as a2b = conditional a (((H.eq H..@ H.qual) H..@) Functor.<$> as) (a2b Functor.<$> as) + +-- * Class 'CombSatisfiable' +class CombSatisfiable tok repr where + satisfy :: [ErrorItem tok] -> TermGrammar (tok -> Bool) -> repr tok + default satisfy :: + Sym.Liftable repr => CombSatisfiable tok (Sym.Output repr) => + [ErrorItem tok] -> + TermGrammar (tok -> Bool) -> repr tok + satisfy es = Sym.lift . satisfy es + + item :: repr tok + item = satisfy [] (H.const H..@ H.bool True) + +string :: + CombApplicable repr => CombAlternable repr => + CombSatisfiable Char repr => + [Char] -> repr [Char] +string = try . traverse char + +oneOf :: + TH.Lift tok => Eq tok => + CombSatisfiable tok repr => + [tok] -> repr tok +oneOf ts = satisfy [ErrorItemLabel "oneOf"] + (Sym.trans H.ValueCode + { value = (`List.elem` ts) + , code = [||\t -> $$(ofChars ts [||t||])||] }) + +noneOf :: + TH.Lift tok => Eq tok => + CombSatisfiable tok repr => + [tok] -> repr tok +noneOf cs = satisfy (ErrorItemToken Functor.<$> cs) (Sym.trans H.ValueCode + { value = not . (`List.elem` cs) + , code = [||\c -> not $$(ofChars cs [||c||])||] + }) + +ofChars :: + TH.Lift tok => Eq tok => + {-alternatives-}[tok] -> + {-input-}TH.CodeQ tok -> + TH.CodeQ Bool +ofChars = List.foldr (\alt acc -> + \inp -> [|| alt == $$inp || $$(acc inp) ||]) + (const [||False||]) + +more :: CombApplicable repr => CombSatisfiable Char repr => CombLookable repr => repr () +more = look (void (item @Char)) + +char :: + CombApplicable repr => CombSatisfiable Char repr => + Char -> repr Char +char c = satisfy [ErrorItemToken c] (H.eq H..@ H.char c) $> H.char c +-- char c = satisfy [ErrorItemToken c] (H.eq H..@ H.qual H..@ H.char c) $> H.char c + +anyChar :: CombSatisfiable Char repr => repr Char +anyChar = satisfy [] (H.const H..@ H.bool True) + +token :: + TH.Lift tok => Show tok => Eq tok => + CombApplicable repr => CombSatisfiable tok repr => + tok -> repr tok +token tok = satisfy [ErrorItemToken tok] (H.eq H..@ H.char tok) $> H.char tok +-- token tok = satisfy [ErrorItemToken tok] (H.eq H..@ H.qual H..@ H.char tok) $> H.char tok + +tokens :: + TH.Lift tok => Eq tok => Show tok => + CombApplicable repr => CombAlternable repr => + CombSatisfiable tok repr => [tok] -> repr [tok] +tokens = try . traverse token + +-- * Class 'CombSelectable' +class CombSelectable repr where + branch :: repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c + default branch :: + Sym.Liftable3 repr => CombSelectable (Sym.Output repr) => + repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c + branch = Sym.lift3 branch + +-- * Class 'CombThrowable' +class CombThrowable repr where + throw :: KnownSymbol lbl => Proxy lbl -> repr a + default throw :: + forall lbl a. + Sym.Liftable repr => CombThrowable (Sym.Output repr) => + KnownSymbol lbl => Proxy lbl -> repr a + throw lbl = Sym.lift (throw lbl) + +-- ** Type 'ErrorItem' +data ErrorItem tok + = ErrorItemToken tok + | ErrorItemLabel String + | ErrorItemHorizon Int + | ErrorItemEnd +deriving instance Eq tok => Eq (ErrorItem tok) +deriving instance Ord tok => Ord (ErrorItem tok) +deriving instance Show tok => Show (ErrorItem tok) +deriving instance TH.Lift tok => TH.Lift (ErrorItem tok) + +-- * Class 'CombLookable' +class CombLookable repr where + look :: repr a -> repr a + negLook :: repr a -> repr () + default look :: Sym.Liftable1 repr => CombLookable (Sym.Output repr) => repr a -> repr a + default negLook :: Sym.Liftable1 repr => CombLookable (Sym.Output repr) => repr a -> repr () + look = Sym.lift1 look + negLook = Sym.lift1 negLook + + eof :: repr () + eof = Sym.lift eof + default eof :: Sym.Liftable repr => CombLookable (Sym.Output repr) => repr () + -- eof = negLook (satisfy @Char [ErrorItemAny] (H.const H..@ H.bool True)) + -- (item @Char) + +-- Composite Combinators +-- someTill :: repr a -> repr b -> repr [a] +-- someTill p end = negLook end *> (p <:> manyTill p end) + +{- +constp :: CombApplicable repr => repr a -> repr (b -> a) +constp = (H.const <$>) + + +-- Alias Operations +infixl 1 >> +(>>) :: CombApplicable repr => repr a -> repr b -> repr b +(>>) = (*>) + +-- Monoidal Operations + +infixl 4 <~> +(<~>) :: CombApplicable repr => repr a -> repr b -> repr (a, b) +(<~>) = liftA2 (H.runtime (,)) + +infixl 4 <~ +(<~) :: CombApplicable repr => repr a -> repr b -> repr a +(<~) = (<*) + +infixl 4 ~> +(~>) :: CombApplicable repr => repr a -> repr b -> repr b +(~>) = (*>) + +-- Lift Operations +liftA2 :: + CombApplicable repr => + TermGrammar (a -> b -> c) -> repr a -> repr b -> repr c +liftA2 f x = (<*>) (fmap f x) + +liftA3 :: + CombApplicable repr => + TermGrammar (a -> b -> c -> d) -> repr a -> repr b -> repr c -> repr d +liftA3 f a b c = liftA2 f a b <*> c + +-} + {- -- Combinators interpreters for 'Sym.Any'. -instance Applicable repr => Applicable (Sym.Any repr) -instance Satisfiable repr => Satisfiable (Sym.Any repr) -instance Alternable repr => Alternable (Sym.Any repr) -instance Selectable repr => Selectable (Sym.Any repr) -instance Matchable repr => Matchable (Sym.Any repr) -instance Lookable repr => Lookable (Sym.Any repr) -instance Foldable repr => Foldable (Sym.Any repr) +instance CombApplicable repr => CombApplicable (Sym.Any repr) +instance CombSatisfiable repr => CombSatisfiable (Sym.Any repr) +instance CombAlternable repr => CombAlternable (Sym.Any repr) +instance CombSelectable repr => CombSelectable (Sym.Any repr) +instance CombMatchable repr => CombMatchable (Sym.Any repr) +instance CombLookable repr => CombLookable (Sym.Any repr) +instance CombFoldable repr => CombFoldable (Sym.Any repr) -} diff --git a/src/Symantic/Parser/Grammar/ObserveSharing.hs b/src/Symantic/Parser/Grammar/ObserveSharing.hs index 76c6415..20af3d1 100644 --- a/src/Symantic/Parser/Grammar/ObserveSharing.hs +++ b/src/Symantic/Parser/Grammar/ObserveSharing.hs @@ -19,10 +19,7 @@ import qualified Symantic.Univariant.Trans as Sym -- | Like 'Letable.observeSharing' -- but type-binding @(letName)@ to 'TH.Name' -- to avoid the trouble to always set it. -observeSharing :: - Letsable TH.Name repr => - ObserveSharing TH.Name repr a -> - repr a +observeSharing :: Letsable TH.Name repr => ObserveSharing TH.Name repr a -> repr a observeSharing os = lets defs body where (body, defs) = Letable.observeSharing os @@ -33,26 +30,23 @@ instance MakeLetName TH.Name where makeLetName _ = TH.qNewName "name" -- Combinators semantics for the 'ObserveSharing' interpreter. +instance (Letable TH.Name repr, CombAlternable repr) => + CombAlternable (ObserveSharing TH.Name repr) +instance (Letable TH.Name repr, CombApplicable repr) => + CombApplicable (ObserveSharing TH.Name repr) instance ( Letable TH.Name repr - , Satisfiable tok repr - ) => Satisfiable tok (ObserveSharing TH.Name repr) -instance - ( Letable TH.Name repr - , Alternable repr - ) => Alternable (ObserveSharing TH.Name repr) -instance - ( Letable TH.Name repr - , Applicable repr - ) => Applicable (ObserveSharing TH.Name repr) -instance - ( Letable TH.Name repr - , Selectable repr - ) => Selectable (ObserveSharing TH.Name repr) -instance - ( Letable TH.Name repr - , Matchable repr - ) => Matchable (ObserveSharing TH.Name repr) where + , CombFoldable repr + {- TODO: the following constraints are for the current CombFoldable, + - they will have to be removed when CombFoldable will have Sym.lift2 as defaults + -} + , CombApplicable repr + , CombAlternable repr + ) => CombFoldable (ObserveSharing TH.Name repr) +instance (Letable TH.Name repr, CombLookable repr) => + CombLookable (ObserveSharing TH.Name repr) +instance (Letable TH.Name repr, CombMatchable repr) => + CombMatchable (ObserveSharing TH.Name repr) where -- Here the default definition does not fit -- since there is no lift* for the type of 'conditional' -- and its default definition does not handles 'bs' @@ -63,33 +57,27 @@ instance Functor.<*> Functor.pure cs Functor.<*> mapM unObserveSharing bs Functor.<*> unObserveSharing b -instance - ( Letable TH.Name repr - , Foldable repr - {- TODO: the following constraints are for the current Foldable, - - they will have to be removed when Foldable will have Sym.lift2 as defaults - -} - , Applicable repr - , Alternable repr - ) => Foldable (ObserveSharing TH.Name repr) -instance - ( Letable TH.Name repr - , Lookable repr - ) => Lookable (ObserveSharing TH.Name repr) +instance (Letable TH.Name repr, CombSelectable repr) => + CombSelectable (ObserveSharing TH.Name repr) +instance (Letable TH.Name repr, CombSatisfiable tok repr) => + CombSatisfiable tok (ObserveSharing TH.Name repr) +instance (Letable TH.Name repr, CombThrowable repr) => + CombThrowable (ObserveSharing TH.Name repr) -- Combinators semantics for the 'FinalizeSharing' interpreter. -instance Applicable repr => Applicable (FinalizeSharing TH.Name repr) -instance Alternable repr => Alternable (FinalizeSharing TH.Name repr) -instance Satisfiable tok repr => Satisfiable tok (FinalizeSharing TH.Name repr) -instance Selectable repr => Selectable (FinalizeSharing TH.Name repr) -instance Matchable repr => Matchable (FinalizeSharing TH.Name repr) where +instance CombApplicable repr => CombApplicable (FinalizeSharing TH.Name repr) +instance CombAlternable repr => CombAlternable (FinalizeSharing TH.Name repr) +instance CombFoldable repr => CombFoldable (FinalizeSharing TH.Name repr) where + chainPre = Sym.lift2 chainPre + chainPost = Sym.lift2 chainPost +instance CombLookable repr => CombLookable (FinalizeSharing TH.Name repr) +instance CombMatchable repr => CombMatchable (FinalizeSharing TH.Name repr) where conditional a cs bs b = FinalizeSharing $ conditional Functor.<$> unFinalizeSharing a Functor.<*> Functor.pure cs Functor.<*> mapM unFinalizeSharing bs Functor.<*> unFinalizeSharing b -instance Lookable repr => Lookable (FinalizeSharing TH.Name repr) -instance Foldable repr => Foldable (FinalizeSharing TH.Name repr) where - chainPre = Sym.lift2 chainPre - chainPost = Sym.lift2 chainPost +instance CombSatisfiable tok repr => CombSatisfiable tok (FinalizeSharing TH.Name repr) +instance CombSelectable repr => CombSelectable (FinalizeSharing TH.Name repr) +instance CombThrowable repr => CombThrowable (FinalizeSharing TH.Name repr) diff --git a/src/Symantic/Parser/Grammar/Optimize.hs b/src/Symantic/Parser/Grammar/Optimize.hs index 69af541..d5c6033 100644 --- a/src/Symantic/Parser/Grammar/Optimize.hs +++ b/src/Symantic/Parser/Grammar/Optimize.hs @@ -10,12 +10,14 @@ import Data.Bool (Bool(..)) import Data.Either (Either(..), either) import Data.Eq (Eq(..)) import Data.Function ((.)) +import Data.Kind (Constraint, Type) import Data.Maybe (Maybe(..)) +import Data.Proxy (Proxy(..)) +import GHC.TypeLits (KnownSymbol) +import Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..)) +import qualified Data.Foldable as CombFoldable import qualified Data.Functor as Functor -import qualified Data.Foldable as Foldable import qualified Data.List as List -import Data.Kind (Constraint, Type) -import Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..)) import Symantic.Parser.Grammar.Combinators as Comb import Symantic.Parser.Haskell () @@ -87,30 +89,68 @@ unSomeComb (SomeComb (c::Comb c repr a)) = Just HRefl -> Just c Nothing -> Nothing --- Applicable -data instance Comb Applicable repr a where - Pure :: TermGrammar a -> Comb Applicable repr a - (:<*>:) :: SomeComb repr (a -> b) -> SomeComb repr a -> Comb Applicable repr b - (:<*:) :: SomeComb repr a -> SomeComb repr b -> Comb Applicable repr a - (:*>:) :: SomeComb repr a -> SomeComb repr b -> Comb Applicable repr b +-- CombAlternable +data instance Comb CombAlternable repr a where + Empty :: Comb CombAlternable repr a + (:<|>:) :: SomeComb repr a -> SomeComb repr a -> Comb CombAlternable repr a + Try :: SomeComb repr a -> Comb CombAlternable repr a +infixl 3 :<|>: +instance CombAlternable repr => Trans (Comb CombAlternable repr) repr where + trans = \case + Empty -> empty + f :<|>: x -> trans f <|> trans x + Try x -> try (trans x) +instance + ( CombAlternable repr + , CombApplicable repr + , CombLookable repr + , CombMatchable repr + , CombSelectable repr + ) => CombAlternable (SomeComb repr) where + empty = SomeComb Empty + + p@(Comb Pure{}) <|> _ = p + -- & trace "Left Catch Law" + Comb Empty <|> u = u + -- & trace "Left Neutral Law" + u <|> Comb Empty = u + -- & trace "Right Neutral Law" + Comb (u :<|>: v) <|> w = u <|> (v <|> w) + -- & trace "Associativity Law" + Comb (Look p) <|> Comb (Look q) = look (try p <|> q) + -- & trace "Distributivity Law" + x <|> y = SomeComb (x :<|>: y) + + try (Comb (p :$>: x)) = try p $> x + -- & trace "Try Interchange Law" + try (Comb (f :<$>: p)) = f <$> try p + -- & trace "Try Interchange Law" + try x = SomeComb (Try x) + +-- CombApplicable +data instance Comb CombApplicable repr a where + Pure :: TermGrammar a -> Comb CombApplicable repr a + (:<*>:) :: SomeComb repr (a -> b) -> SomeComb repr a -> Comb CombApplicable repr b + (:<*:) :: SomeComb repr a -> SomeComb repr b -> Comb CombApplicable repr a + (:*>:) :: SomeComb repr a -> SomeComb repr b -> Comb CombApplicable repr b infixl 4 :<*>:, :<*:, :*>: -pattern (:<$>:) :: TermGrammar (a -> b) -> SomeComb repr a -> Comb Applicable repr b +pattern (:<$>:) :: TermGrammar (a -> b) -> SomeComb repr a -> Comb CombApplicable repr b pattern t :<$>: x <- Comb (Pure t) :<*>: x -pattern (:$>:) :: SomeComb repr a -> TermGrammar b -> Comb Applicable repr b +pattern (:$>:) :: SomeComb repr a -> TermGrammar b -> Comb CombApplicable repr b pattern x :$>: t <- x :*>: Comb (Pure t) -instance Applicable repr => Trans (Comb Applicable repr) repr where +instance CombApplicable repr => Trans (Comb CombApplicable repr) repr where trans = \case Pure x -> pure (H.optimizeTerm x) f :<*>: x -> trans f <*> trans x x :<*: y -> trans x <* trans y x :*>: y -> trans x *> trans y instance - ( Applicable repr - , Alternable repr - , Lookable repr - , Matchable repr - , Selectable repr - ) => Applicable (SomeComb repr) where + ( CombApplicable repr + , CombAlternable repr + , CombLookable repr + , CombMatchable repr + , CombSelectable repr + ) => CombApplicable (SomeComb repr) where pure = SomeComb . Pure f <$> Comb (Branch b l r) = branch b @@ -185,165 +225,65 @@ instance -- & trace "Associativity Law" x <* y = SomeComb (x :<*: y) --- Alternable -data instance Comb Alternable repr a where - Empty :: Comb Alternable repr a - (:<|>:) :: SomeComb repr a -> SomeComb repr a -> Comb Alternable repr a - Try :: SomeComb repr a -> Comb Alternable repr a -infixl 3 :<|>: -instance Alternable repr => Trans (Comb Alternable repr) repr where +-- CombFoldable +data instance Comb CombFoldable repr a where + ChainPreC :: SomeComb repr (a -> a) -> SomeComb repr a -> Comb CombFoldable repr a + ChainPostC :: SomeComb repr a -> SomeComb repr (a -> a) -> Comb CombFoldable repr a +instance CombFoldable repr => Trans (Comb CombFoldable repr) repr where trans = \case - Empty -> empty - f :<|>: x -> trans f <|> trans x - Try x -> try (trans x) -instance - ( Alternable repr - , Applicable repr - , Lookable repr - , Matchable repr - , Selectable repr - ) => Alternable (SomeComb repr) where - empty = SomeComb Empty - - p@(Comb Pure{}) <|> _ = p - -- & trace "Left Catch Law" - Comb Empty <|> u = u - -- & trace "Left Neutral Law" - u <|> Comb Empty = u - -- & trace "Right Neutral Law" - Comb (u :<|>: v) <|> w = u <|> (v <|> w) - -- & trace "Associativity Law" - Comb (Look p) <|> Comb (Look q) = look (try p <|> q) - -- & trace "Distributivity Law" - x <|> y = SomeComb (x :<|>: y) - - try (Comb (p :$>: x)) = try p $> x - -- & trace "Try Interchange Law" - try (Comb (f :<$>: p)) = f <$> try p - -- & trace "Try Interchange Law" - try x = SomeComb (Try x) + ChainPreC x y -> chainPre (trans x) (trans y) + ChainPostC x y -> chainPost (trans x) (trans y) +instance CombFoldable repr => CombFoldable (SomeComb repr) where + chainPre x = SomeComb . ChainPreC x + chainPost x = SomeComb . ChainPostC x --- Selectable -data instance Comb Selectable repr a where - Branch :: - SomeComb repr (Either a b) -> - SomeComb repr (a -> c) -> - SomeComb repr (b -> c) -> - Comb Selectable repr c -instance Selectable repr => Trans (Comb Selectable repr) repr where - trans = \case - Branch lr l r -> branch (trans lr) (trans l) (trans r) +-- Letable +data instance Comb (Letable letName) repr a where + Shareable :: letName -> SomeComb repr a -> Comb (Letable letName) repr a + Ref :: Bool -> letName -> Comb (Letable letName) repr a instance - ( Applicable repr - , Alternable repr - , Lookable repr - , Selectable repr - , Matchable repr - ) => Selectable (SomeComb repr) where - branch (Comb Empty) _ _ = empty - -- & trace "Branch Absorption Law" - branch b (Comb Empty) (Comb Empty) = b *> empty - -- & trace "Branch Weakening Law" - branch (Comb (Pure (trans -> lr))) l r = - case H.value lr of - Left value -> l <*> pure (trans H.ValueCode{..}) - where code = [|| case $$(H.code lr) of Left x -> x ||] - Right value -> r <*> pure (trans H.ValueCode{..}) - where code = [|| case $$(H.code lr) of Right x -> x ||] - -- & trace "Branch Pure Left/Right Law" - branch b (Comb (Pure (trans -> l))) (Comb (Pure (trans -> r))) = - trans H.ValueCode{..} <$> b - -- & trace "Branch Generalised Identity Law" - where - value = either (H.value l) (H.value r) - code = [|| either $$(H.code l) $$(H.code r) ||] - branch (Comb (x :*>: y)) p q = x *> branch y p q - -- & trace "Interchange Law" - branch b l (Comb Empty) = - branch (pure (trans (H.ValueCode{..})) <*> b) empty l - -- & trace "Negated Branch Law" - where - value = either Right Left - code = [||either Right Left||] - branch (Comb (Branch b (Comb Empty) (Comb (Pure (trans -> lr))))) (Comb Empty) br = - branch (pure (trans H.ValueCode{..}) <*> b) empty br - -- & trace "Branch Fusion Law" - where - value Left{} = Left () - value (Right r) = case H.value lr r of - Left _ -> Left () - Right rr -> Right rr - code = [|| \case Left{} -> Left () - Right r -> case $$(H.code lr) r of - Left _ -> Left () - Right rr -> Right rr ||] - branch b l r = SomeComb (Branch b l r) - --- Matchable -data instance Comb Matchable repr a where - Conditional :: Eq a => - SomeComb repr a -> - [TermGrammar (a -> Bool)] -> - [SomeComb repr b] -> - SomeComb repr b -> - Comb Matchable repr b -instance Matchable repr => Trans (Comb Matchable repr) repr where + Letable letName repr => + Trans (Comb (Letable letName) repr) repr where trans = \case - Conditional a ps bs b -> - conditional (trans a) - (H.optimizeTerm Functor.<$> ps) - (trans Functor.<$> bs) (trans b) + Shareable n x -> shareable n (trans x) + Ref isRec n -> ref isRec n instance - ( Applicable repr - , Alternable repr - , Lookable repr - , Selectable repr - , Matchable repr - ) => Matchable (SomeComb repr) where - conditional (Comb Empty) _ _ d = d - -- & trace "Conditional Absorption Law" - conditional p _ qs (Comb Empty) - | Foldable.all (\case { Comb Empty -> True; _ -> False }) qs = p *> empty - -- & trace "Conditional Weakening Law" - conditional a _ps bs (Comb Empty) - | Foldable.all (\case { Comb Empty -> True; _ -> False }) bs = a *> empty - -- & trace "Conditional Weakening Law" - conditional (Comb (Pure (trans -> a))) ps bs d = - Foldable.foldr (\(trans -> p, b) next -> - if H.value p (H.value a) then b else next - ) d (List.zip ps bs) - -- & trace "Conditional Pure Law" - conditional a ps bs d = SomeComb (Conditional a ps bs d) + (Letable letName repr, Typeable letName) => + Letable letName (SomeComb repr) where + shareable n = SomeComb . Shareable n + ref isRec = SomeComb . Ref isRec --- Foldable -data instance Comb Foldable repr a where - ChainPreC :: SomeComb repr (a -> a) -> SomeComb repr a -> Comb Foldable repr a - ChainPostC :: SomeComb repr a -> SomeComb repr (a -> a) -> Comb Foldable repr a -instance Foldable repr => Trans (Comb Foldable repr) repr where +-- Letsable +data instance Comb (Letsable letName) repr a where + Lets :: LetBindings letName (SomeComb repr) -> + SomeComb repr a -> Comb (Letsable letName) repr a +instance + Letsable letName repr => + Trans (Comb (Letsable letName) repr) repr where trans = \case - ChainPreC x y -> chainPre (trans x) (trans y) - ChainPostC x y -> chainPost (trans x) (trans y) -instance Foldable repr => Foldable (SomeComb repr) where - chainPre x = SomeComb . ChainPreC x - chainPost x = SomeComb . ChainPostC x + Lets defs x -> lets ((\(SomeLet sub) -> SomeLet (trans sub)) Functor.<$> defs) (trans x) +instance + (Letsable letName repr, Typeable letName) => + Letsable letName (SomeComb repr) where + lets defs = SomeComb . Lets defs --- Lookable -data instance Comb Lookable repr a where - Look :: SomeComb repr a -> Comb Lookable repr a - NegLook :: SomeComb repr a -> Comb Lookable repr () - Eof :: Comb Lookable repr () -instance Lookable repr => Trans (Comb Lookable repr) repr where +-- CombLookable +data instance Comb CombLookable repr a where + Look :: SomeComb repr a -> Comb CombLookable repr a + NegLook :: SomeComb repr a -> Comb CombLookable repr () + Eof :: Comb CombLookable repr () +instance CombLookable repr => Trans (Comb CombLookable repr) repr where trans = \case Look x -> look (trans x) NegLook x -> negLook (trans x) Eof -> eof instance - ( Alternable repr - , Applicable repr - , Lookable repr - , Selectable repr - , Matchable repr - ) => Lookable (SomeComb repr) where + ( CombAlternable repr + , CombApplicable repr + , CombLookable repr + , CombSelectable repr + , CombMatchable repr + ) => CombLookable (SomeComb repr) where look p@(Comb Pure{}) = p -- & trace "Pure Look Law" look p@(Comb Empty) = p @@ -376,52 +316,125 @@ instance eof = SomeComb Eof --- Satisfiable -data instance Comb (Satisfiable tok) repr a where +-- CombMatchable +data instance Comb CombMatchable repr a where + Conditional :: Eq a => + SomeComb repr a -> + [TermGrammar (a -> Bool)] -> + [SomeComb repr b] -> + SomeComb repr b -> + Comb CombMatchable repr b +instance CombMatchable repr => Trans (Comb CombMatchable repr) repr where + trans = \case + Conditional a ps bs b -> + conditional (trans a) + (H.optimizeTerm Functor.<$> ps) + (trans Functor.<$> bs) (trans b) +instance + ( CombApplicable repr + , CombAlternable repr + , CombLookable repr + , CombSelectable repr + , CombMatchable repr + ) => CombMatchable (SomeComb repr) where + conditional (Comb Empty) _ _ d = d + -- & trace "Conditional Absorption Law" + conditional p _ qs (Comb Empty) + | CombFoldable.all (\case { Comb Empty -> True; _ -> False }) qs = p *> empty + -- & trace "Conditional Weakening Law" + conditional a _ps bs (Comb Empty) + | CombFoldable.all (\case { Comb Empty -> True; _ -> False }) bs = a *> empty + -- & trace "Conditional Weakening Law" + conditional (Comb (Pure (trans -> a))) ps bs d = + CombFoldable.foldr (\(trans -> p, b) next -> + if H.value p (H.value a) then b else next + ) d (List.zip ps bs) + -- & trace "Conditional Pure Law" + conditional a ps bs d = SomeComb (Conditional a ps bs d) + +-- CombSatisfiable +data instance Comb (CombSatisfiable tok) repr a where Satisfy :: - Satisfiable tok repr => + CombSatisfiable tok repr => [ErrorItem tok] -> TermGrammar (tok -> Bool) -> - Comb (Satisfiable tok) repr tok + Comb (CombSatisfiable tok) repr tok Item :: - Satisfiable tok repr => - Comb (Satisfiable tok) repr tok -instance Satisfiable tok repr => Trans (Comb (Satisfiable tok) repr) repr where + CombSatisfiable tok repr => + Comb (CombSatisfiable tok) repr tok +instance CombSatisfiable tok repr => Trans (Comb (CombSatisfiable tok) repr) repr where trans = \case Satisfy es p -> satisfy es (H.optimizeTerm p) Item -> item instance - (Satisfiable tok repr, Typeable tok) => - Satisfiable tok (SomeComb repr) where + (CombSatisfiable tok repr, Typeable tok) => + CombSatisfiable tok (SomeComb repr) where satisfy es = SomeComb . Satisfy es item = SomeComb Item --- Letable -data instance Comb (Letable letName) repr a where - Shareable :: letName -> SomeComb repr a -> Comb (Letable letName) repr a - Ref :: Bool -> letName -> Comb (Letable letName) repr a -instance - Letable letName repr => - Trans (Comb (Letable letName) repr) repr where +-- CombSelectable +data instance Comb CombSelectable repr a where + Branch :: + SomeComb repr (Either a b) -> + SomeComb repr (a -> c) -> + SomeComb repr (b -> c) -> + Comb CombSelectable repr c +instance CombSelectable repr => Trans (Comb CombSelectable repr) repr where trans = \case - Shareable n x -> shareable n (trans x) - Ref isRec n -> ref isRec n + Branch lr l r -> branch (trans lr) (trans l) (trans r) instance - (Letable letName repr, Typeable letName) => - Letable letName (SomeComb repr) where - shareable n = SomeComb . Shareable n - ref isRec = SomeComb . Ref isRec + ( CombApplicable repr + , CombAlternable repr + , CombLookable repr + , CombSelectable repr + , CombMatchable repr + ) => CombSelectable (SomeComb repr) where + branch (Comb Empty) _ _ = empty + -- & trace "Branch Absorption Law" + branch b (Comb Empty) (Comb Empty) = b *> empty + -- & trace "Branch Weakening Law" + branch (Comb (Pure (trans -> lr))) l r = + case H.value lr of + Left value -> l <*> pure (trans H.ValueCode{..}) + where code = [|| case $$(H.code lr) of Left x -> x ||] + Right value -> r <*> pure (trans H.ValueCode{..}) + where code = [|| case $$(H.code lr) of Right x -> x ||] + -- & trace "Branch Pure Left/Right Law" + branch b (Comb (Pure (trans -> l))) (Comb (Pure (trans -> r))) = + trans H.ValueCode{..} <$> b + -- & trace "Branch Generalised Identity Law" + where + value = either (H.value l) (H.value r) + code = [|| either $$(H.code l) $$(H.code r) ||] + branch (Comb (x :*>: y)) p q = x *> branch y p q + -- & trace "Interchange Law" + branch b l (Comb Empty) = + branch (pure (trans (H.ValueCode{..})) <*> b) empty l + -- & trace "Negated Branch Law" + where + value = either Right Left + code = [||either Right Left||] + branch (Comb (Branch b (Comb Empty) (Comb (Pure (trans -> lr))))) (Comb Empty) br = + branch (pure (trans H.ValueCode{..}) <*> b) empty br + -- & trace "Branch Fusion Law" + where + value Left{} = Left () + value (Right r) = case H.value lr r of + Left _ -> Left () + Right rr -> Right rr + code = [|| \case Left{} -> Left () + Right r -> case $$(H.code lr) r of + Left _ -> Left () + Right rr -> Right rr ||] + branch b l r = SomeComb (Branch b l r) --- Letsable -data instance Comb (Letsable letName) repr a where - Lets :: LetBindings letName (SomeComb repr) -> - SomeComb repr a -> Comb (Letsable letName) repr a -instance - Letsable letName repr => - Trans (Comb (Letsable letName) repr) repr where +-- CombThrowable +data instance Comb CombThrowable repr a where + Throw :: + KnownSymbol lbl => Proxy lbl -> + Comb CombThrowable repr a +instance CombThrowable repr => Trans (Comb CombThrowable repr) repr where trans = \case - Lets defs x -> lets ((\(SomeLet sub) -> SomeLet (trans sub)) Functor.<$> defs) (trans x) -instance - (Letsable letName repr, Typeable letName) => - Letsable letName (SomeComb repr) where - lets defs = SomeComb . Lets defs + Throw lbl -> throw lbl +instance CombThrowable repr => CombThrowable (SomeComb repr) where + throw lbl = SomeComb (Throw lbl) diff --git a/src/Symantic/Parser/Grammar/View.hs b/src/Symantic/Parser/Grammar/View.hs index 0012df2..3911966 100644 --- a/src/Symantic/Parser/Grammar/View.hs +++ b/src/Symantic/Parser/Grammar/View.hs @@ -6,6 +6,7 @@ import Data.Ord (Ord(..)) import Data.Semigroup (Semigroup(..)) import Data.String (String) import Data.Tuple (fst) +import GHC.TypeLits (symbolVal) import Text.Show (Show(..)) import qualified Control.Applicative as Fct import qualified Data.Functor as Functor @@ -35,6 +36,19 @@ instance Show (ViewGrammar sN a) where drawTrees (t:ts) = shift "+ " "| " (draw t) <> drawTrees ts shift ind0 ind = List.zipWith (<>) (ind0 : List.repeat ind) +instance CombAlternable (ViewGrammar sN) where + empty = ViewGrammar $ Tree.Node ("empty", "") [] + x <|> y = ViewGrammar $ Tree.Node ("<|>", "") [unViewGrammar x, unViewGrammar y] + try x = ViewGrammar $ Tree.Node ("try", "") [unViewGrammar x] +instance CombApplicable (ViewGrammar sN) where + _f <$> x = ViewGrammar $ Tree.Node ("<$>", "") [unViewGrammar x] + pure a = ViewGrammar $ Tree.Node ("pure "<>showsPrec 10 a "", "") [] + x <*> y = ViewGrammar $ Tree.Node ("<*>", "") [unViewGrammar x, unViewGrammar y] + x <* y = ViewGrammar $ Tree.Node ("<*", "") [unViewGrammar x, unViewGrammar y] + x *> y = ViewGrammar $ Tree.Node ("*>", "") [unViewGrammar x, unViewGrammar y] +instance CombFoldable (ViewGrammar sN) where + chainPre f x = ViewGrammar $ Tree.Node ("chainPre", "") [unViewGrammar f, unViewGrammar x] + chainPost x f = ViewGrammar $ Tree.Node ("chainPost", "") [unViewGrammar x, unViewGrammar f] instance ShowLetName sN letName => Letable letName (ViewGrammar sN) where @@ -56,31 +70,20 @@ instance (\name (SomeLet val) -> (Tree.Node ("let", " "<>showLetName @sN name) [unViewGrammar val] :)) [] defs -instance Applicable (ViewGrammar sN) where - _f <$> x = ViewGrammar $ Tree.Node ("<$>", "") [unViewGrammar x] - pure a = ViewGrammar $ Tree.Node ("pure "<>showsPrec 10 a "", "") [] - x <*> y = ViewGrammar $ Tree.Node ("<*>", "") [unViewGrammar x, unViewGrammar y] - x <* y = ViewGrammar $ Tree.Node ("<*", "") [unViewGrammar x, unViewGrammar y] - x *> y = ViewGrammar $ Tree.Node ("*>", "") [unViewGrammar x, unViewGrammar y] -instance Alternable (ViewGrammar sN) where - empty = ViewGrammar $ Tree.Node ("empty", "") [] - x <|> y = ViewGrammar $ Tree.Node ("<|>", "") [unViewGrammar x, unViewGrammar y] - try x = ViewGrammar $ Tree.Node ("try", "") [unViewGrammar x] -instance Satisfiable tok (ViewGrammar sN) where - satisfy _es _p = ViewGrammar $ Tree.Node ("satisfy", "") [] -instance Selectable (ViewGrammar sN) where - branch lr l r = ViewGrammar $ Tree.Node ("branch", "") - [ unViewGrammar lr, unViewGrammar l, unViewGrammar r ] -instance Matchable (ViewGrammar sN) where +instance CombLookable (ViewGrammar sN) where + look x = ViewGrammar $ Tree.Node ("look", "") [unViewGrammar x] + negLook x = ViewGrammar $ Tree.Node ("negLook", "") [unViewGrammar x] + eof = ViewGrammar $ Tree.Node ("eof", "") [] +instance CombMatchable (ViewGrammar sN) where conditional a _ps bs b = ViewGrammar $ Tree.Node ("conditional", "") [ unViewGrammar a , Tree.Node ("branches", "") (unViewGrammar Fct.<$> bs) , unViewGrammar b ] -instance Lookable (ViewGrammar sN) where - look x = ViewGrammar $ Tree.Node ("look", "") [unViewGrammar x] - negLook x = ViewGrammar $ Tree.Node ("negLook", "") [unViewGrammar x] - eof = ViewGrammar $ Tree.Node ("eof", "") [] -instance Foldable (ViewGrammar sN) where - chainPre f x = ViewGrammar $ Tree.Node ("chainPre", "") [unViewGrammar f, unViewGrammar x] - chainPost x f = ViewGrammar $ Tree.Node ("chainPost", "") [unViewGrammar x, unViewGrammar f] +instance CombSatisfiable tok (ViewGrammar sN) where + satisfy _es _p = ViewGrammar $ Tree.Node ("satisfy", "") [] +instance CombSelectable (ViewGrammar sN) where + branch lr l r = ViewGrammar $ Tree.Node ("branch", "") + [ unViewGrammar lr, unViewGrammar l, unViewGrammar r ] +instance CombThrowable (ViewGrammar sN) where + throw lbl = ViewGrammar $ Tree.Node ("throw "<>symbolVal lbl, "") [] diff --git a/src/Symantic/Parser/Grammar/Write.hs b/src/Symantic/Parser/Grammar/Write.hs index e9eab38..fff1ed7 100644 --- a/src/Symantic/Parser/Grammar/Write.hs +++ b/src/Symantic/Parser/Grammar/Write.hs @@ -8,7 +8,8 @@ import Data.Maybe (Maybe(..), fromMaybe, catMaybes) import Data.Monoid (Monoid(..)) import Data.Semigroup (Semigroup(..)) import Data.String (IsString(..)) -import qualified Data.Functor as Pre +import GHC.TypeLits (symbolVal) +import qualified Data.Functor as Functor import qualified Data.HashMap.Strict as HM import qualified Data.List as List import qualified Data.Text.Lazy as TL @@ -56,37 +57,7 @@ pairWriteGrammarInh inh op s = else s where (o,c) = writeGrammarInh_pair inh -instance - ShowLetName sN letName => - Letable letName (WriteGrammar sN) where - shareable name x = WriteGrammar $ \inh -> - pairWriteGrammarInh inh op $ - Just "shareable " - <> Just (fromString (showLetName @sN name)) - <> unWriteGrammar x inh - where - op = infixN 9 - ref rec name = WriteGrammar $ \inh -> - pairWriteGrammarInh inh op $ - Just (if rec then "rec " else "ref ") <> - Just (fromString (showLetName @sN name)) - where - op = infixN 9 -instance - ShowLetName sN letName => - Letsable letName (WriteGrammar sN) where - lets defs x = WriteGrammar $ \inh -> - pairWriteGrammarInh inh op $ - Just "let " - <> HM.foldMapWithKey - (\name (SomeLet val) -> - Just (fromString (showLetName @sN name)) - <> unWriteGrammar val inh) - defs - <> unWriteGrammar x inh - where - op = infixN 9 -instance Applicable (WriteGrammar sN) where +instance CombApplicable (WriteGrammar sN) where pure _ = WriteGrammar $ return Nothing -- pure _ = "pure" WriteGrammar x <*> WriteGrammar y = WriteGrammar $ \inh -> @@ -104,7 +75,7 @@ instance Applicable (WriteGrammar sN) where Just $ xt <> ", " <> yt where op = infixN 1 -instance Alternable (WriteGrammar sN) where +instance CombAlternable (WriteGrammar sN) where empty = "empty" try x = WriteGrammar $ \inh -> pairWriteGrammarInh inh op $ @@ -123,31 +94,50 @@ instance Alternable (WriteGrammar sN) where , writeGrammarInh_pair = pairParen } where op = infixB SideL 3 -instance Satisfiable tok (WriteGrammar sN) where - satisfy _es _f = "satisfy" -instance Selectable (WriteGrammar sN) where - branch lr l r = WriteGrammar $ \inh -> +instance CombFoldable (WriteGrammar sN) where + chainPre f x = WriteGrammar $ \inh -> pairWriteGrammarInh inh op $ - Just "branch " <> - unWriteGrammar lr inh <> Just " " <> - unWriteGrammar l inh <> Just " " <> - unWriteGrammar r inh + Just "chainPre " <> + unWriteGrammar f inh <> Just " " <> + unWriteGrammar x inh + where op = infixN 9 + chainPost f x = WriteGrammar $ \inh -> + pairWriteGrammarInh inh op $ + Just "chainPost " <> + unWriteGrammar f inh <> Just " " <> + unWriteGrammar x inh + where op = infixN 9 +instance + ShowLetName sN letName => + Letable letName (WriteGrammar sN) where + shareable name x = WriteGrammar $ \inh -> + pairWriteGrammarInh inh op $ + Just "shareable " + <> Just (fromString (showLetName @sN name)) + <> unWriteGrammar x inh where op = infixN 9 -instance Matchable (WriteGrammar sN) where - conditional a _ps bs d = WriteGrammar $ \inh -> + ref rec name = WriteGrammar $ \inh -> pairWriteGrammarInh inh op $ - Just "conditional " <> - unWriteGrammar a inh <> - Just " [" <> - Just (mconcat (List.intersperse ", " $ - catMaybes $ (Pre.<$> bs) $ \x -> - unWriteGrammar x inh{writeGrammarInh_op=(infixN 0, SideL)})) <> - Just "] " <> - unWriteGrammar d inh + Just (if rec then "rec " else "ref ") <> + Just (fromString (showLetName @sN name)) + where + op = infixN 9 +instance + ShowLetName sN letName => + Letsable letName (WriteGrammar sN) where + lets defs x = WriteGrammar $ \inh -> + pairWriteGrammarInh inh op $ + Just "let " + <> HM.foldMapWithKey + (\name (SomeLet val) -> + Just (fromString (showLetName @sN name)) + <> unWriteGrammar val inh) + defs + <> unWriteGrammar x inh where op = infixN 9 -instance Lookable (WriteGrammar sN) where +instance CombLookable (WriteGrammar sN) where look x = WriteGrammar $ \inh -> pairWriteGrammarInh inh op $ Just "look " <> unWriteGrammar x inh @@ -157,16 +147,33 @@ instance Lookable (WriteGrammar sN) where Just "negLook " <> unWriteGrammar x inh where op = infixN 9 eof = "eof" -instance Foldable (WriteGrammar sN) where - chainPre f x = WriteGrammar $ \inh -> +instance CombMatchable (WriteGrammar sN) where + conditional a _ps bs d = WriteGrammar $ \inh -> pairWriteGrammarInh inh op $ - Just "chainPre " <> - unWriteGrammar f inh <> Just " " <> - unWriteGrammar x inh - where op = infixN 9 - chainPost f x = WriteGrammar $ \inh -> + Just "conditional " <> + unWriteGrammar a inh <> + Just " [" <> + Just (mconcat (List.intersperse ", " $ + catMaybes $ (Functor.<$> bs) $ \x -> + unWriteGrammar x inh{writeGrammarInh_op=(infixN 0, SideL)})) <> + Just "] " <> + unWriteGrammar d inh + where + op = infixN 9 +instance CombSatisfiable tok (WriteGrammar sN) where + satisfy _es _f = "satisfy" +instance CombSelectable (WriteGrammar sN) where + branch lr l r = WriteGrammar $ \inh -> pairWriteGrammarInh inh op $ - Just "chainPost " <> - unWriteGrammar f inh <> Just " " <> - unWriteGrammar x inh - where op = infixN 9 + Just "branch " <> + unWriteGrammar lr inh <> Just " " <> + unWriteGrammar l inh <> Just " " <> + unWriteGrammar r inh + where + op = infixN 9 +instance CombThrowable (WriteGrammar sN) where + throw lbl = WriteGrammar $ \inh -> + pairWriteGrammarInh inh op $ + Just ("throw "<>fromString (symbolVal lbl)) + where + op = infixN 9 diff --git a/src/Symantic/Parser/Machine/Program.hs b/src/Symantic/Parser/Machine/Program.hs index ac7adb1..232c1fd 100644 --- a/src/Symantic/Parser/Machine/Program.hs +++ b/src/Symantic/Parser/Machine/Program.hs @@ -48,14 +48,6 @@ optimizeMachine :: IO (repr inp '[] a) optimizeMachine (Program f) = trans Functor.<$> f @'[] ret -instance - InstrValuable repr => - Applicable (Program repr inp) where - pure x = Program $ return . pushValue (trans x) - Program f <*> Program x = Program $ (f <=< x) . applyValue - liftA2 f (Program x) (Program y) = Program $ (x <=< y) . lift2Value (trans f) - Program x *> Program y = Program (x <=< return . popValue <=< y) - Program x <* Program y = Program (x <=< y <=< return . popValue) instance ( Cursorable (Cursor inp) , InstrBranchable repr @@ -63,7 +55,7 @@ instance , InstrInputable repr , InstrJoinable repr , InstrValuable repr - ) => Alternable (Program repr inp) where + ) => CombAlternable (Program repr inp) where empty = Program $ \_next -> return $ fail [] Program l <|> Program r = joinNext $ Program $ \next -> liftM2 (catchException (Proxy @"fail")) @@ -121,33 +113,45 @@ joinNext (Program m) = Program $ \case Functor.<$> m (refJoin (LetName joinName)) instance - InstrExceptionable repr => - Throwable (Program repr inp) where - type ThrowableLabel (Program repr inp) lbl = - () - throw lbl = Program $ \_next -> return $ raiseException lbl [] -instance - ( tok ~ InputToken inp - , InstrReadable tok repr - , Typeable tok - ) => Satisfiable tok (Program repr inp) where - satisfy es p = Program $ return . read es (trans p) + InstrValuable repr => + CombApplicable (Program repr inp) where + pure x = Program $ return . pushValue (trans x) + Program f <*> Program x = Program $ (f <=< x) . applyValue + liftA2 f (Program x) (Program y) = Program $ (x <=< y) . lift2Value (trans f) + Program x *> Program y = Program (x <=< return . popValue <=< y) + Program x <* Program y = Program (x <=< y <=< return . popValue) instance - ( InstrBranchable repr + ( Cursorable (Cursor inp) + , InstrBranchable repr + , InstrExceptionable repr + , InstrInputable repr , InstrJoinable repr , InstrValuable repr - ) => Selectable (Program repr inp) where - branch (Program lr) (Program l) (Program r) = joinNext $ Program $ \next -> - lr =<< liftM2 caseBranch - (l (swapValue (applyValue next))) - (r (swapValue (applyValue next))) + ) => CombFoldable (Program repr inp) where + {- + chainPre op p = go <*> p + where go = (H..) <$> op <*> go <|> pure H.id + chainPost p op = p <**> go + where go = (H..) <$> op <*> go <|> pure H.id + -} instance - ( InstrBranchable repr - , InstrJoinable repr - ) => Matchable (Program repr inp) where - conditional (Program a) ps bs (Program d) = joinNext $ Program $ \next -> do - bs' <- Control.Monad.sequence $ (\(Program b) -> b next) Functor.<$> bs - a =<< liftM (choicesBranch (trans Functor.<$> ps) bs') (d next) + InstrCallable repr => + Letable TH.Name (Program repr inp) where + shareable n (Program sub) = Program $ \next -> do + sub' <- sub ret + return $ defLet (HM.singleton n (SomeLet sub')) (call (LetName n) next) + ref _isRec n = Program $ \case + -- Returning just after a 'call' is useless: + -- using 'jump' lets the 'ret' of the 'defLet' + -- directly return where it would in two 'ret's. + Instr Ret{} -> return $ jump (LetName n) + next -> return $ call (LetName n) next +instance + InstrCallable repr => + Letsable TH.Name (Program repr inp) where + lets defs (Program x) = Program $ \next -> do + defs' <- Traversable.traverse (\(SomeLet (Program val)) -> liftM SomeLet (val ret)) defs + liftM (defLet defs') (x next) instance ( Ord (InputToken inp) , Cursorable (Cursor inp) @@ -158,7 +162,7 @@ instance , InstrReadable (InputToken inp) repr , Typeable (InputToken inp) , InstrValuable repr - ) => Lookable (Program repr inp) where + ) => CombLookable (Program repr inp) where look (Program x) = Program $ \next -> liftM pushInput (x (swapValue (loadInput next))) eof = negLook (satisfy [{-discarded by negLook-}] (H.lam1 (\_x -> H.bool True))) @@ -185,34 +189,28 @@ instance -- and go on with the next 'Instr'uctions. (return $ loadInput $ pushValue H.unit next) instance - InstrCallable repr => - Letable TH.Name (Program repr inp) where - shareable n (Program sub) = Program $ \next -> do - sub' <- sub ret - return $ defLet (HM.singleton n (SomeLet sub')) (call (LetName n) next) - ref _isRec n = Program $ \case - -- Returning just after a 'call' is useless: - -- using 'jump' lets the 'ret' of the 'defLet' - -- directly return where it would in two 'ret's. - Instr Ret{} -> return $ jump (LetName n) - next -> return $ call (LetName n) next + ( InstrBranchable repr + , InstrJoinable repr + ) => CombMatchable (Program repr inp) where + conditional (Program a) ps bs (Program d) = joinNext $ Program $ \next -> do + bs' <- Control.Monad.sequence $ (\(Program b) -> b next) Functor.<$> bs + a =<< liftM (choicesBranch (trans Functor.<$> ps) bs') (d next) instance - InstrCallable repr => - Letsable TH.Name (Program repr inp) where - lets defs (Program x) = Program $ \next -> do - defs' <- Traversable.traverse (\(SomeLet (Program val)) -> liftM SomeLet (val ret)) defs - liftM (defLet defs') (x next) + ( tok ~ InputToken inp + , InstrReadable tok repr + , Typeable tok + ) => CombSatisfiable tok (Program repr inp) where + satisfy es p = Program $ return . read es (trans p) instance - ( Cursorable (Cursor inp) - , InstrBranchable repr - , InstrExceptionable repr - , InstrInputable repr + ( InstrBranchable repr , InstrJoinable repr , InstrValuable repr - ) => Foldable (Program repr inp) where - {- - chainPre op p = go <*> p - where go = (H..) <$> op <*> go <|> pure H.id - chainPost p op = p <**> go - where go = (H..) <$> op <*> go <|> pure H.id - -} + ) => CombSelectable (Program repr inp) where + branch (Program lr) (Program l) (Program r) = joinNext $ Program $ \next -> + lr =<< liftM2 caseBranch + (l (swapValue (applyValue next))) + (r (swapValue (applyValue next))) +instance + InstrExceptionable repr => + CombThrowable (Program repr inp) where + throw lbl = Program $ \_next -> return $ raiseException lbl [] diff --git a/test/Grammar/Playground.hs b/test/Grammar/Playground.hs index 3a0f2aa..df15f3c 100644 --- a/test/Grammar/Playground.hs +++ b/test/Grammar/Playground.hs @@ -5,7 +5,7 @@ module Grammar.Playground where import Symantic.Parser import qualified Symantic.Parser.Haskell as H -boom :: Applicable repr => repr () +boom :: CombApplicable repr => repr () boom = let foo = (-- newRegister_ unit (\r0 -> let goo = (-- newRegister_ unit (\r1 -> -- 2.44.1 From 5283c722c963e49cbad0372ed31a671592cd83be Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Tue, 30 Mar 2021 07:54:53 +0200 Subject: [PATCH 06/16] more on failures --- .envrc | 7 +- flake.lock | 10 +- src/Language/Haskell/TH/HideName.hs | 2 +- src/Symantic/Parser/Grammar.hs | 1 - src/Symantic/Parser/Grammar/Combinators.hs | 257 +- src/Symantic/Parser/Grammar/ObserveSharing.hs | 3 - src/Symantic/Parser/Grammar/Optimize.hs | 86 +- src/Symantic/Parser/Grammar/View.hs | 12 +- src/Symantic/Parser/Grammar/Write.hs | 54 +- src/Symantic/Parser/Machine/Generate.hs | 242 +- src/Symantic/Parser/Machine/Instructions.hs | 50 +- src/Symantic/Parser/Machine/Optimize.hs | 44 +- src/Symantic/Parser/Machine/Program.hs | 80 +- src/Symantic/Parser/Machine/View.hs | 24 +- .../Grammar/OptimizeGrammar/G13.expected.txt | 2 +- .../Grammar/ViewGrammar/G13.expected.txt | 2 +- test/Golden/Machine/G1.expected.txt | 10 +- test/Golden/Machine/G10.expected.txt | 32 +- test/Golden/Machine/G11.expected.txt | 48 +- test/Golden/Machine/G12.expected.txt | 80 +- test/Golden/Machine/G13.expected.txt | 150 +- test/Golden/Machine/G14.expected.txt | 1458 +-- test/Golden/Machine/G15.expected.txt | 44 +- test/Golden/Machine/G16.expected.txt | 70 +- test/Golden/Machine/G2.expected.txt | 52 +- test/Golden/Machine/G3.expected.txt | 28 +- test/Golden/Machine/G4.expected.txt | 82 +- test/Golden/Machine/G5.expected.txt | 140 +- test/Golden/Machine/G6.expected.txt | 64 +- test/Golden/Machine/G7.expected.txt | 92 +- test/Golden/Machine/G8.expected.txt | 86 +- test/Golden/Machine/G9.expected.txt | 58 +- test/Golden/Splice/G1.expected.txt | 179 +- test/Golden/Splice/G10.expected.txt | 400 +- test/Golden/Splice/G11.expected.txt | 421 +- test/Golden/Splice/G12.expected.txt | 544 +- test/Golden/Splice/G13.expected.txt | 1727 ++-- test/Golden/Splice/G14.expected.txt | 7822 ++++++++--------- test/Golden/Splice/G15.expected.txt | 522 +- test/Golden/Splice/G16.expected.txt | 708 +- test/Golden/Splice/G2.expected.txt | 336 +- test/Golden/Splice/G3.expected.txt | 301 +- test/Golden/Splice/G4.expected.txt | 569 +- test/Golden/Splice/G5.expected.txt | 792 +- test/Golden/Splice/G6.expected.txt | 533 +- test/Golden/Splice/G7.expected.txt | 590 +- test/Golden/Splice/G8.expected.txt | 544 +- test/Golden/Splice/G9.expected.txt | 301 +- test/Grammar/Brainfuck.hs | 12 +- test/Grammar/Nandlang.hs | 5 - 50 files changed, 9995 insertions(+), 9681 deletions(-) diff --git a/.envrc b/.envrc index e2edb56..324cf67 100644 --- a/.envrc +++ b/.envrc @@ -3,9 +3,10 @@ use_flake() { watch_file flake.lock watch_file default.nix watch_file shell.nix + profile="$(direnv_layout_dir)"/flake-profile mkdir -p "$(direnv_layout_dir)" - eval "$(nix print-dev-env --option allow-import-from-derivation true -L --show-trace --profile "$(direnv_layout_dir)/flake-profile" || echo false)" && - nix-store --add-root "shell.root" \ - --indirect --realise "$(direnv_layout_dir)/flake-profile" + eval "$(time nix print-dev-env --show-trace --profile "$profile" || echo false)" && + nix-store --add-root "shell.root" --indirect --realise "$profile" && + nix-env --delete-generations +1 --profile "$profile" } use flake diff --git a/flake.lock b/flake.lock index 27a0952..fab85af 100644 --- a/flake.lock +++ b/flake.lock @@ -2,11 +2,11 @@ "nodes": { "flake-utils": { "locked": { - "lastModified": 1614513358, - "narHash": "sha256-LakhOx3S1dRjnh0b5Dg3mbZyH0ToC9I8Y2wKSkBaTzU=", + "lastModified": 1619345332, + "narHash": "sha256-qHnQkEp1uklKTpx3MvKtY6xzgcqXDsz5nLilbbuL+3A=", "owner": "numtide", "repo": "flake-utils", - "rev": "5466c5bbece17adaab2d82fae80b46e807611bf3", + "rev": "2ebf2558e5bf978c7fb8ea927dfaed8fefab2e28", "type": "github" }, "original": { @@ -17,8 +17,8 @@ }, "nixpkgs": { "locked": { - "narHash": "sha256-XAXD5xcPEId0B+EBm37/+vuLes/uIE7fPQf6ek3fqUU=", - "path": "/nix/store/ib1v3n4kfzaj0p9ixf2wlmg6msp7dlyr-nixpkgs-patched", + "narHash": "sha256-yQc43UuOdsXUPgYAwEONCfq7JxK9c7uacl91TXkQ8cc=", + "path": "/nix/store/2fq9al19cn3v4hn35i9l2lhhbg7bvgim-nixpkgs-patched", "type": "path" }, "original": { diff --git a/src/Language/Haskell/TH/HideName.hs b/src/Language/Haskell/TH/HideName.hs index 55b04f5..e3a06af 100644 --- a/src/Language/Haskell/TH/HideName.hs +++ b/src/Language/Haskell/TH/HideName.hs @@ -22,7 +22,7 @@ instance HideName Dec where hideName _ = undefined instance HideName Exp where hideName (AppE e1 e2) = AppE (hideName e1) (hideName e2) - hideName (AppTypeE e t) = AppTypeE (hideName e) t + hideName (AppTypeE e t) = AppTypeE (hideName e) (hideName t) hideName (ArithSeqE d) = ArithSeqE (hideName d) hideName (CaseE e ms) = CaseE (hideName e) (hideName <$> ms) hideName (CompE ss) = CompE (hideName <$> ss) diff --git a/src/Symantic/Parser/Grammar.hs b/src/Symantic/Parser/Grammar.hs index 011570a..b21ad54 100644 --- a/src/Symantic/Parser/Grammar.hs +++ b/src/Symantic/Parser/Grammar.hs @@ -34,7 +34,6 @@ type Grammar tok repr = , CombMatchable repr , CombSatisfiable tok repr , CombSelectable repr - , CombThrowable repr ) -- | A usual pipeline to interpret 'Comb'inators: diff --git a/src/Symantic/Parser/Grammar/Combinators.hs b/src/Symantic/Parser/Grammar/Combinators.hs index 47ad381..e3cd7f6 100644 --- a/src/Symantic/Parser/Grammar/Combinators.hs +++ b/src/Symantic/Parser/Grammar/Combinators.hs @@ -5,27 +5,36 @@ -- of the type class. This is almost as explained in: -- https://ro-che.info/articles/2016-02-03-finally-tagless-boilerplate {-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveLift #-} -- For TH.Lift (ErrorItem tok) -{-# LANGUAGE StandaloneDeriving #-} -- For Show (ErrorItem (InputToken inp)) +{-# LANGUAGE DeriveLift #-} -- For TH.Lift (Exception tok) +{-# LANGUAGE PatternSynonyms #-} -- For Failure +{-# LANGUAGE StandaloneDeriving #-} -- For Show (Exception (InputToken inp)) +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} -- For unSomeFailure -- | Semantic of the grammar combinators used to express parsers, -- in the convenient tagless-final encoding. module Symantic.Parser.Grammar.Combinators where +import Data.Proxy (Proxy(..)) +import Control.Monad (Monad(..)) +-- import Data.Set (Set) +-- import GHC.TypeLits (KnownSymbol) import Data.Bool (Bool(..), not, (||)) import Data.Char (Char) import Data.Either (Either(..)) import Data.Eq (Eq(..)) +import Data.Ord (Ord(..)) import Data.Function ((.), flip, const) import Data.Int (Int) +import Data.Kind (Type, Constraint) import Data.Maybe (Maybe(..)) -import Data.Ord (Ord) -import Data.Proxy (Proxy(..)) +import Data.Set (Set) import Data.String (String) -import GHC.TypeLits (KnownSymbol) import Text.Show (Show(..)) +import Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..), SomeTypeRep(..)) import qualified Data.Functor as Functor import qualified Data.List as List +import qualified Data.Set as Set import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH @@ -35,35 +44,120 @@ import qualified Symantic.Parser.Haskell as H -- * Type 'TermGrammar' type TermGrammar = H.Term H.ValueCode +-- * Type 'ReprComb' +type ReprComb = Type -> Type + +code :: TH.Lift a => a -> TermGrammar a +code x = H.Term (H.ValueCode x [||x||]) + -- * Class 'CombAlternable' class CombAlternable repr where - -- | @(rl '<|>' rr)@ parses @(rl)@ and return its return value or, - -- if it fails, parses @(rr)@ from where @(rl)@ has left the input stream, - -- and returns its return value. - (<|>) :: repr a -> repr a -> repr a - -- | @(empty)@ parses nothing, always failing to return a value. - empty :: repr a + -- | @('alt' es l r)@ parses @(l)@ and return its return value or, + -- if it fails with an 'Exception' within @(es)@, + -- parses @(r)@ from where @(l)@ has left the input stream, + -- and returns its return value, + -- otherwise throw the 'Exception' again. + alt :: Exception -> repr a -> repr a -> repr a + throw :: ExceptionLabel -> repr a -- | @('try' ra)@ records the input stream position, -- then parses like @(ra)@ and either returns its value it it succeeds or fails -- if it fails but with a reset of the input stream to the recorded position. -- Generally used on the first alternative: @('try' rl '<|>' rr)@. try :: repr a -> repr a - default (<|>) :: + default alt :: Sym.Liftable2 repr => CombAlternable (Sym.Output repr) => - repr a -> repr a -> repr a - default empty :: + Exception -> repr a -> repr a -> repr a + default throw :: Sym.Liftable repr => CombAlternable (Sym.Output repr) => - repr a + ExceptionLabel -> repr a default try :: Sym.Liftable1 repr => CombAlternable (Sym.Output repr) => repr a -> repr a - (<|>) = Sym.lift2 (<|>) - empty = Sym.lift empty + alt = Sym.lift2 . alt + throw = Sym.lift . throw try = Sym.lift1 try - -- | Like @('<|>')@ but with different returning types for the alternatives, - -- and a return value wrapped in an 'Either' accordingly. - (<+>) :: CombApplicable repr => CombAlternable repr => repr a -> repr b -> repr (Either a b) - p <+> q = H.left <$> p <|> H.right <$> q + + failure :: SomeFailure -> repr a + default failure :: + Sym.Liftable repr => CombAlternable (Sym.Output repr) => + SomeFailure -> repr a + failure = Sym.lift . failure + + -- | @(empty)@ parses nothing, always failing to return a value. + empty :: repr a + empty = failure (SomeFailure FailureEmpty) + +data instance Failure CombAlternable + = FailureEmpty + deriving (Eq, Ord, Show, TH.Lift) + +-- ** Data family 'Failure' +-- | 'Failure's of the 'Grammar'. +-- This is an extensible data-type. +data family Failure + (comb :: ReprComb -> Constraint) + :: Type + +{- +-- | Convenient utility to pattern-match a 'SomeFailure'. +pattern Failure :: Typeable comb => Failure comb -> SomeFailure +pattern Failure x <- (unSomeFailure -> Just x) +-} + +-- ** Type 'SomeFailure' +data SomeFailure = + forall comb. + ({-Trans (Failure comb repr) repr,-} + Eq (Failure comb) + , Show (Failure comb) + , TH.Lift (Failure comb) + , Typeable comb + ) => + SomeFailure (Failure comb {-repr a-}) +instance Eq SomeFailure where + SomeFailure (_x::Failure x) == SomeFailure (_y::Failure y) = + case typeRep @x `eqTypeRep` typeRep @y of + Just HRefl -> True + Nothing -> False +instance Ord SomeFailure where + SomeFailure (_x::Failure x) `compare` SomeFailure (_y::Failure y) = + SomeTypeRep (typeRep @x) `compare` + SomeTypeRep (typeRep @y) +instance Show SomeFailure where + showsPrec p (SomeFailure x) = showsPrec p x +instance TH.Lift SomeFailure where + liftTyped (SomeFailure x) = [|| SomeFailure $$(TH.liftTyped x) ||] + +{- +instance Trans (SomeFailure repr) repr where + trans (SomeFailure x) = trans x +-} + +-- | @(unSomeFailure c :: 'Maybe' ('Failure' comb repr a))@ +-- extract the data-constructor from the given 'SomeFailure' +-- iif. it belongs to the @('Failure' comb repr a)@ data-instance. +unSomeFailure :: forall comb. Typeable comb => SomeFailure -> Maybe (Failure comb) +unSomeFailure (SomeFailure (c::Failure c)) = + case typeRep @comb `eqTypeRep` typeRep @c of + Just HRefl -> Just c + Nothing -> Nothing + +-- ** Type 'Exception' +data Exception + = ExceptionLabel ExceptionLabel + | ExceptionFailure + deriving (Eq, Ord, Show, TH.Lift) +type ExceptionLabel = String +-- type Exceptions = Set Exception + +-- | Like @('<|>')@ but with different returning types for the alternatives, +-- and a return value wrapped in an 'Either' accordingly. +(<+>) :: CombApplicable repr => CombAlternable repr => repr a -> repr b -> repr (Either a b) +p <+> q = H.left <$> p <|> H.right <$> q + +(<|>) :: CombAlternable repr => repr a -> repr a -> repr a +(<|>) = alt ExceptionFailure + infixl 3 <|>, <+> optionally :: CombApplicable repr => CombAlternable repr => repr a -> TermGrammar b -> repr b @@ -151,6 +245,7 @@ class CombApplicable repr where (<**>) = liftA2 (\a f -> f a) -} infixl 4 <$>, <&>, <$, $>, <*>, <*, *>, <**> +data instance Failure CombApplicable {-# INLINE (<:>) #-} infixl 4 <:> @@ -205,6 +300,7 @@ class CombFoldable repr where chainPre op p = flip (foldr ($)) <$> many op <*> p chainPost p op = foldl' (flip ($)) <$> p <*> many op -} +data instance Failure CombFoldable {- conditional :: CombSelectable repr => [(TermGrammar (a -> Bool), repr b)] -> repr a -> repr b -> repr b @@ -344,23 +440,68 @@ class CombMatchable repr where default conditional :: Sym.Unliftable repr => Sym.Liftable1 repr => CombMatchable (Sym.Output repr) => Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b - conditional a ps bs = Sym.lift1 (conditional (Sym.trans a) ps (Sym.trans Functor.<$> bs)) + conditional a ps bs = Sym.lift1 (conditional (Sym.unlift a) ps (Sym.unlift Functor.<$> bs)) match :: Eq a => repr a -> [TermGrammar a] -> (TermGrammar a -> repr b) -> repr b -> repr b match a as a2b = conditional a ((H.eq H..@) Functor.<$> as) (a2b Functor.<$> as) -- match a as a2b = conditional a (((H.eq H..@ H.qual) H..@) Functor.<$> as) (a2b Functor.<$> as) +data instance Failure CombMatchable -- * Class 'CombSatisfiable' class CombSatisfiable tok repr where - satisfy :: [ErrorItem tok] -> TermGrammar (tok -> Bool) -> repr tok - default satisfy :: + satisfy :: TermGrammar (tok -> Bool) -> repr tok + satisfy = satisfyOrFail Set.empty + satisfyOrFail :: + Set SomeFailure -> + TermGrammar (tok -> Bool) -> repr tok + default satisfyOrFail :: Sym.Liftable repr => CombSatisfiable tok (Sym.Output repr) => - [ErrorItem tok] -> + Set SomeFailure -> TermGrammar (tok -> Bool) -> repr tok - satisfy es = Sym.lift . satisfy es + satisfyOrFail fs = Sym.lift . satisfyOrFail fs + +data instance Failure (CombSatisfiable tok) + = FailureAny + | FailureHorizon Int -- FIXME: use Natural? + | FailureLabel String + | FailureToken tok + deriving (Eq, Show, Typeable) +inputTokenProxy :: TH.Name +inputTokenProxy = TH.mkName "inputToken" +instance TH.Lift tok => TH.Lift (Failure (CombSatisfiable tok)) where + liftTyped :: forall m. TH.Quote m => Failure (CombSatisfiable tok) -> TH.Code m (Failure (CombSatisfiable tok)) + liftTyped x = [|| + case + $$(let inputToken :: TH.Code m (Proxy tok) = + TH.unsafeCodeCoerce (return (TH.VarE inputTokenProxy)) + in inputToken) of + (Proxy :: Proxy tok') -> + $$(case x of + FailureAny -> [|| FailureAny @tok' ||] + FailureHorizon h -> [|| FailureHorizon @tok' h ||] + FailureLabel lbl -> [|| FailureLabel @tok' lbl ||] + FailureToken tok -> [|| FailureToken $$(TH.liftTyped tok) ||] + ) + ||] + +char :: + CombApplicable repr => + CombSatisfiable Char repr => + Char -> repr Char +char c = satisfyOrFail (Set.singleton (SomeFailure (FailureToken c))) + (H.eq H..@ H.char c) $> H.char c - item :: repr tok - item = satisfy [] (H.const H..@ H.bool True) +item :: forall tok repr. + Eq tok => Show tok => Typeable tok => TH.Lift tok => + CombSatisfiable tok repr => repr tok +item = satisfyOrFail (Set.singleton (SomeFailure (FailureAny @tok))) + (H.const H..@ H.bool True) + +anyChar :: + CombAlternable repr => + CombSatisfiable Char repr => + repr Char +anyChar = item string :: CombApplicable repr => CombAlternable repr => @@ -369,10 +510,11 @@ string :: string = try . traverse char oneOf :: - TH.Lift tok => Eq tok => + Eq tok => Show tok => Typeable tok => TH.Lift tok => CombSatisfiable tok repr => [tok] -> repr tok -oneOf ts = satisfy [ErrorItemLabel "oneOf"] +oneOf ts = satisfyOrFail + (Set.fromList (SomeFailure . FailureToken Functor.<$> ts)) (Sym.trans H.ValueCode { value = (`List.elem` ts) , code = [||\t -> $$(ofChars ts [||t||])||] }) @@ -381,7 +523,7 @@ noneOf :: TH.Lift tok => Eq tok => CombSatisfiable tok repr => [tok] -> repr tok -noneOf cs = satisfy (ErrorItemToken Functor.<$> cs) (Sym.trans H.ValueCode +noneOf cs = satisfy (Sym.trans H.ValueCode { value = not . (`List.elem` cs) , code = [||\c -> not $$(ofChars cs [||c||])||] }) @@ -391,28 +533,25 @@ ofChars :: {-alternatives-}[tok] -> {-input-}TH.CodeQ tok -> TH.CodeQ Bool -ofChars = List.foldr (\alt acc -> - \inp -> [|| alt == $$inp || $$(acc inp) ||]) +ofChars = List.foldr (\tok acc -> + \inp -> [|| tok == $$inp || $$(acc inp) ||]) (const [||False||]) -more :: CombApplicable repr => CombSatisfiable Char repr => CombLookable repr => repr () +more :: + CombAlternable repr => + CombApplicable repr => + CombSatisfiable Char repr => + CombLookable repr => repr () more = look (void (item @Char)) -char :: - CombApplicable repr => CombSatisfiable Char repr => - Char -> repr Char -char c = satisfy [ErrorItemToken c] (H.eq H..@ H.char c) $> H.char c --- char c = satisfy [ErrorItemToken c] (H.eq H..@ H.qual H..@ H.char c) $> H.char c - -anyChar :: CombSatisfiable Char repr => repr Char -anyChar = satisfy [] (H.const H..@ H.bool True) - token :: TH.Lift tok => Show tok => Eq tok => - CombApplicable repr => CombSatisfiable tok repr => + CombAlternable repr => + CombApplicable repr => + CombSatisfiable tok repr => tok -> repr tok -token tok = satisfy [ErrorItemToken tok] (H.eq H..@ H.char tok) $> H.char tok --- token tok = satisfy [ErrorItemToken tok] (H.eq H..@ H.qual H..@ H.char tok) $> H.char tok +token tok = satisfy (H.eq H..@ H.char tok) $> H.char tok +-- token tok = satisfy [ExceptionToken tok] (H.eq H..@ H.qual H..@ H.char tok) $> H.char tok tokens :: TH.Lift tok => Eq tok => Show tok => @@ -427,26 +566,7 @@ class CombSelectable repr where Sym.Liftable3 repr => CombSelectable (Sym.Output repr) => repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c branch = Sym.lift3 branch - --- * Class 'CombThrowable' -class CombThrowable repr where - throw :: KnownSymbol lbl => Proxy lbl -> repr a - default throw :: - forall lbl a. - Sym.Liftable repr => CombThrowable (Sym.Output repr) => - KnownSymbol lbl => Proxy lbl -> repr a - throw lbl = Sym.lift (throw lbl) - --- ** Type 'ErrorItem' -data ErrorItem tok - = ErrorItemToken tok - | ErrorItemLabel String - | ErrorItemHorizon Int - | ErrorItemEnd -deriving instance Eq tok => Eq (ErrorItem tok) -deriving instance Ord tok => Ord (ErrorItem tok) -deriving instance Show tok => Show (ErrorItem tok) -deriving instance TH.Lift tok => TH.Lift (ErrorItem tok) +data instance Failure CombSelectable -- * Class 'CombLookable' class CombLookable repr where @@ -460,8 +580,11 @@ class CombLookable repr where eof :: repr () eof = Sym.lift eof default eof :: Sym.Liftable repr => CombLookable (Sym.Output repr) => repr () - -- eof = negLook (satisfy @Char [ErrorItemAny] (H.const H..@ H.bool True)) + -- eof = negLook (satisfy @Char (H.const H..@ H.bool True)) -- (item @Char) +data instance Failure CombLookable + = FailureEnd + deriving (Eq, Show, Typeable, TH.Lift) -- Composite Combinators -- someTill :: repr a -> repr b -> repr [a] diff --git a/src/Symantic/Parser/Grammar/ObserveSharing.hs b/src/Symantic/Parser/Grammar/ObserveSharing.hs index 20af3d1..fa8ddfa 100644 --- a/src/Symantic/Parser/Grammar/ObserveSharing.hs +++ b/src/Symantic/Parser/Grammar/ObserveSharing.hs @@ -61,8 +61,6 @@ instance (Letable TH.Name repr, CombSelectable repr) => CombSelectable (ObserveSharing TH.Name repr) instance (Letable TH.Name repr, CombSatisfiable tok repr) => CombSatisfiable tok (ObserveSharing TH.Name repr) -instance (Letable TH.Name repr, CombThrowable repr) => - CombThrowable (ObserveSharing TH.Name repr) -- Combinators semantics for the 'FinalizeSharing' interpreter. instance CombApplicable repr => CombApplicable (FinalizeSharing TH.Name repr) @@ -80,4 +78,3 @@ instance CombMatchable repr => CombMatchable (FinalizeSharing TH.Name repr) wher Functor.<*> unFinalizeSharing b instance CombSatisfiable tok repr => CombSatisfiable tok (FinalizeSharing TH.Name repr) instance CombSelectable repr => CombSelectable (FinalizeSharing TH.Name repr) -instance CombThrowable repr => CombThrowable (FinalizeSharing TH.Name repr) diff --git a/src/Symantic/Parser/Grammar/Optimize.hs b/src/Symantic/Parser/Grammar/Optimize.hs index d5c6033..e4e33f8 100644 --- a/src/Symantic/Parser/Grammar/Optimize.hs +++ b/src/Symantic/Parser/Grammar/Optimize.hs @@ -10,16 +10,15 @@ import Data.Bool (Bool(..)) import Data.Either (Either(..), either) import Data.Eq (Eq(..)) import Data.Function ((.)) -import Data.Kind (Constraint, Type) +import Data.Kind (Constraint) import Data.Maybe (Maybe(..)) -import Data.Proxy (Proxy(..)) -import GHC.TypeLits (KnownSymbol) +import Data.Set (Set) import Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..)) -import qualified Data.Foldable as CombFoldable +import qualified Data.Foldable as Foldable import qualified Data.Functor as Functor import qualified Data.List as List -import Symantic.Parser.Grammar.Combinators as Comb +import Symantic.Parser.Grammar.Combinators hiding (code) import Symantic.Parser.Haskell () import Symantic.Univariant.Letable import Symantic.Univariant.Trans @@ -50,14 +49,9 @@ data family Comb :: ReprComb -- | Convenient utility to pattern-match a 'SomeComb'. -pattern Comb :: Typeable comb => - Comb comb repr a -> - SomeComb repr a +pattern Comb :: Typeable comb => Comb comb repr a -> SomeComb repr a pattern Comb x <- (unSomeComb -> Just x) --- ** Type 'ReprComb' -type ReprComb = Type -> Type - -- ** Type 'SomeComb' -- | Some 'Comb'inator existentialized over the actual combinator symantic class. -- Useful to handle a list of 'Comb'inators @@ -91,14 +85,17 @@ unSomeComb (SomeComb (c::Comb c repr a)) = -- CombAlternable data instance Comb CombAlternable repr a where + Alt :: Exception -> SomeComb repr a -> SomeComb repr a -> Comb CombAlternable repr a Empty :: Comb CombAlternable repr a - (:<|>:) :: SomeComb repr a -> SomeComb repr a -> Comb CombAlternable repr a + Failure :: SomeFailure -> Comb CombAlternable repr a + Throw :: ExceptionLabel -> Comb CombAlternable repr a Try :: SomeComb repr a -> Comb CombAlternable repr a -infixl 3 :<|>: instance CombAlternable repr => Trans (Comb CombAlternable repr) repr where trans = \case + Alt exn x y -> alt exn (trans x) (trans y) Empty -> empty - f :<|>: x -> trans f <|> trans x + Failure sf -> failure sf + Throw exn -> throw exn Try x -> try (trans x) instance ( CombAlternable repr @@ -108,18 +105,23 @@ instance , CombSelectable repr ) => CombAlternable (SomeComb repr) where empty = SomeComb Empty + failure sf = SomeComb (Failure sf) - p@(Comb Pure{}) <|> _ = p + alt _exn p@(Comb Pure{}) _ = p -- & trace "Left Catch Law" - Comb Empty <|> u = u + alt _exn (Comb Empty) u = u -- & trace "Left Neutral Law" - u <|> Comb Empty = u + alt _exn u (Comb Empty) = u -- & trace "Right Neutral Law" - Comb (u :<|>: v) <|> w = u <|> (v <|> w) + alt exn (Comb (Alt exn' u v)) w | exn' == exn = u <|> (v <|> w) + -- See Lemma 1 (Associativity of choice for labeled PEGs) + -- in https://doi.org/10.1145/2851613.2851750 -- & trace "Associativity Law" - Comb (Look p) <|> Comb (Look q) = look (try p <|> q) + alt exn (Comb (Look p)) (Comb (Look q)) = look (alt exn (try p) q) -- & trace "Distributivity Law" - x <|> y = SomeComb (x :<|>: y) + alt exn x y = SomeComb (Alt exn x y) + + throw exn = SomeComb (Throw exn) try (Comb (p :$>: x)) = try p $> x -- & trace "Try Interchange Law" @@ -308,7 +310,8 @@ instance -- & trace "Zero Consumption Law" negLook (Comb (Look x)) = negLook x -- & trace "Right Identity Law" - negLook (Comb (Comb (Try p) :<|>: q)) = negLook p *> negLook q + negLook (Comb (Alt _exn (Comb (Try p)) q)) = negLook p *> negLook q + -- FIXME: see if this really holds for all exceptions. -- & trace "Transparency Law" negLook (Comb (p :$>: _)) = negLook p -- & trace "NegLook Idempotence Law" @@ -340,13 +343,13 @@ instance conditional (Comb Empty) _ _ d = d -- & trace "Conditional Absorption Law" conditional p _ qs (Comb Empty) - | CombFoldable.all (\case { Comb Empty -> True; _ -> False }) qs = p *> empty + | Foldable.all (\case { Comb Empty -> True; _ -> False }) qs = p *> empty -- & trace "Conditional Weakening Law" conditional a _ps bs (Comb Empty) - | CombFoldable.all (\case { Comb Empty -> True; _ -> False }) bs = a *> empty + | Foldable.all (\case { Comb Empty -> True; _ -> False }) bs = a *> empty -- & trace "Conditional Weakening Law" conditional (Comb (Pure (trans -> a))) ps bs d = - CombFoldable.foldr (\(trans -> p, b) next -> + Foldable.foldr (\(trans -> p, b) next -> if H.value p (H.value a) then b else next ) d (List.zip ps bs) -- & trace "Conditional Pure Law" @@ -354,23 +357,27 @@ instance -- CombSatisfiable data instance Comb (CombSatisfiable tok) repr a where - Satisfy :: + -- | To include the @('Set' 'SomeFailure')@ is a little kludge + -- it would be cleaner to be able to pattern-match + -- on @(alt exn (Comb 'Satisfy'{}) (Failure{}))@ + -- when generating 'Program', but this is not easily possible then + -- because data types have already been converted back to class methods, + -- hence pattern-matching is no longer possible + -- (at least not without reintroducing data types). + SatisfyOrFail :: CombSatisfiable tok repr => - [ErrorItem tok] -> + Set SomeFailure -> TermGrammar (tok -> Bool) -> Comb (CombSatisfiable tok) repr tok - Item :: - CombSatisfiable tok repr => - Comb (CombSatisfiable tok) repr tok -instance CombSatisfiable tok repr => Trans (Comb (CombSatisfiable tok) repr) repr where +instance + CombSatisfiable tok repr => + Trans (Comb (CombSatisfiable tok) repr) repr where trans = \case - Satisfy es p -> satisfy es (H.optimizeTerm p) - Item -> item + SatisfyOrFail fs p -> satisfyOrFail fs (H.optimizeTerm p) instance (CombSatisfiable tok repr, Typeable tok) => CombSatisfiable tok (SomeComb repr) where - satisfy es = SomeComb . Satisfy es - item = SomeComb Item + satisfyOrFail fs = SomeComb . SatisfyOrFail fs -- CombSelectable data instance Comb CombSelectable repr a where @@ -427,14 +434,3 @@ instance Left _ -> Left () Right rr -> Right rr ||] branch b l r = SomeComb (Branch b l r) - --- CombThrowable -data instance Comb CombThrowable repr a where - Throw :: - KnownSymbol lbl => Proxy lbl -> - Comb CombThrowable repr a -instance CombThrowable repr => Trans (Comb CombThrowable repr) repr where - trans = \case - Throw lbl -> throw lbl -instance CombThrowable repr => CombThrowable (SomeComb repr) where - throw lbl = SomeComb (Throw lbl) diff --git a/src/Symantic/Parser/Grammar/View.hs b/src/Symantic/Parser/Grammar/View.hs index 3911966..0999df1 100644 --- a/src/Symantic/Parser/Grammar/View.hs +++ b/src/Symantic/Parser/Grammar/View.hs @@ -1,12 +1,12 @@ module Symantic.Parser.Grammar.View where import Data.Bool (Bool) +import Data.Eq (Eq(..)) import Data.Function (($), (.), id, on) import Data.Ord (Ord(..)) import Data.Semigroup (Semigroup(..)) import Data.String (String) import Data.Tuple (fst) -import GHC.TypeLits (symbolVal) import Text.Show (Show(..)) import qualified Control.Applicative as Fct import qualified Data.Functor as Functor @@ -38,7 +38,11 @@ instance Show (ViewGrammar sN a) where instance CombAlternable (ViewGrammar sN) where empty = ViewGrammar $ Tree.Node ("empty", "") [] - x <|> y = ViewGrammar $ Tree.Node ("<|>", "") [unViewGrammar x, unViewGrammar y] + alt exn x y = ViewGrammar $ Tree.Node + ("<|>" <> if exn == ExceptionFailure then "" else ("^"<>show exn), "") + [unViewGrammar x, unViewGrammar y] + throw exn = ViewGrammar $ Tree.Node ("throw "<>show exn, "") [] + failure _sf = ViewGrammar $ Tree.Node ("failure", "") [] try x = ViewGrammar $ Tree.Node ("try", "") [unViewGrammar x] instance CombApplicable (ViewGrammar sN) where _f <$> x = ViewGrammar $ Tree.Node ("<$>", "") [unViewGrammar x] @@ -81,9 +85,7 @@ instance CombMatchable (ViewGrammar sN) where , unViewGrammar b ] instance CombSatisfiable tok (ViewGrammar sN) where - satisfy _es _p = ViewGrammar $ Tree.Node ("satisfy", "") [] + satisfyOrFail _fs _p = ViewGrammar $ Tree.Node ("satisfy", "") [] instance CombSelectable (ViewGrammar sN) where branch lr l r = ViewGrammar $ Tree.Node ("branch", "") [ unViewGrammar lr, unViewGrammar l, unViewGrammar r ] -instance CombThrowable (ViewGrammar sN) where - throw lbl = ViewGrammar $ Tree.Node ("throw "<>symbolVal lbl, "") [] diff --git a/src/Symantic/Parser/Grammar/Write.hs b/src/Symantic/Parser/Grammar/Write.hs index fff1ed7..36da738 100644 --- a/src/Symantic/Parser/Grammar/Write.hs +++ b/src/Symantic/Parser/Grammar/Write.hs @@ -8,7 +8,7 @@ import Data.Maybe (Maybe(..), fromMaybe, catMaybes) import Data.Monoid (Monoid(..)) import Data.Semigroup (Semigroup(..)) import Data.String (IsString(..)) -import GHC.TypeLits (symbolVal) +import Text.Show (Show(..)) import qualified Data.Functor as Functor import qualified Data.HashMap.Strict as HM import qualified Data.List as List @@ -57,6 +57,31 @@ pairWriteGrammarInh inh op s = else s where (o,c) = writeGrammarInh_pair inh +instance CombAlternable (WriteGrammar sN) where + alt exn x y = WriteGrammar $ \inh -> + pairWriteGrammarInh inh op $ + unWriteGrammar x inh + { writeGrammarInh_op = (op, SideL) + , writeGrammarInh_pair = pairParen + } <> + Just (" |^"<>fromString (show exn)<>" ") <> + unWriteGrammar y inh + { writeGrammarInh_op = (op, SideR) + , writeGrammarInh_pair = pairParen + } + where op = infixB SideL 3 + throw exn = WriteGrammar $ \inh -> + pairWriteGrammarInh inh op $ + Just ("throw "<>fromString (show exn)) + where + op = infixN 9 + failure _sf = "failure" + empty = "empty" + try x = WriteGrammar $ \inh -> + pairWriteGrammarInh inh op $ + Just "try " <> unWriteGrammar x inh + where + op = infixN 9 instance CombApplicable (WriteGrammar sN) where pure _ = WriteGrammar $ return Nothing -- pure _ = "pure" @@ -75,25 +100,6 @@ instance CombApplicable (WriteGrammar sN) where Just $ xt <> ", " <> yt where op = infixN 1 -instance CombAlternable (WriteGrammar sN) where - empty = "empty" - try x = WriteGrammar $ \inh -> - pairWriteGrammarInh inh op $ - Just "try " <> unWriteGrammar x inh - where - op = infixN 9 - x <|> y = WriteGrammar $ \inh -> - pairWriteGrammarInh inh op $ - unWriteGrammar x inh - { writeGrammarInh_op = (op, SideL) - , writeGrammarInh_pair = pairParen - } <> - Just " | " <> - unWriteGrammar y inh - { writeGrammarInh_op = (op, SideR) - , writeGrammarInh_pair = pairParen - } - where op = infixB SideL 3 instance CombFoldable (WriteGrammar sN) where chainPre f x = WriteGrammar $ \inh -> pairWriteGrammarInh inh op $ @@ -161,7 +167,7 @@ instance CombMatchable (WriteGrammar sN) where where op = infixN 9 instance CombSatisfiable tok (WriteGrammar sN) where - satisfy _es _f = "satisfy" + satisfyOrFail _fs _f = "satisfy" instance CombSelectable (WriteGrammar sN) where branch lr l r = WriteGrammar $ \inh -> pairWriteGrammarInh inh op $ @@ -171,9 +177,3 @@ instance CombSelectable (WriteGrammar sN) where unWriteGrammar r inh where op = infixN 9 -instance CombThrowable (WriteGrammar sN) where - throw lbl = WriteGrammar $ \inh -> - pairWriteGrammarInh inh op $ - Just ("throw "<>fromString (symbolVal lbl)) - where - op = infixN 9 diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs index 2b7a364..e76a209 100644 --- a/src/Symantic/Parser/Machine/Generate.hs +++ b/src/Symantic/Parser/Machine/Generate.hs @@ -1,9 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE StandaloneDeriving #-} -- For Show (ParsingError inp) +{-# LANGUAGE ConstraintKinds #-} -- For Dict {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UnboxedTuples #-} -- For nextInput {-# LANGUAGE UndecidableInstances #-} -- For Show (ParsingError inp) +{-# OPTIONS_GHC -fno-warn-orphans #-} module Symantic.Parser.Machine.Generate where import Control.Monad (Monad(..)) @@ -12,17 +14,19 @@ import Data.Char (Char) import Data.Either (Either(..), either) import Data.Function (($), (.), id, const, on) import Data.Functor (Functor, (<$>), (<$)) -import Data.Foldable (foldMap', toList) +import Data.Foldable (foldMap', toList, null) import Data.Int (Int) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) import Data.Maybe (Maybe(..)) +import Data.Eq (Eq(..)) import Data.Ord (Ord(..), Ordering(..)) +import Data.Proxy (Proxy(..)) import Data.Semigroup (Semigroup(..)) import Data.Set (Set) import Data.String (String) import Data.Traversable (Traversable(..)) -import GHC.TypeLits (symbolVal) +import Data.Typeable (Typeable) import Language.Haskell.TH (CodeQ) import Prelude ((+), (-), error) import Text.Show (Show(..)) @@ -31,6 +35,7 @@ import qualified Data.HashMap.Strict as HM import qualified Data.List as List import qualified Data.List.NonEmpty as NE import qualified Data.Map.Internal as Map_ +import qualified Data.Set.Internal as Set_ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Language.Haskell.TH as TH @@ -38,7 +43,7 @@ import qualified Language.Haskell.TH.Syntax as TH import Symantic.Univariant.Letable import Symantic.Univariant.Trans -import Symantic.Parser.Grammar.Combinators (ErrorItem(..)) +import Symantic.Parser.Grammar.Combinators (Exception(..), Failure(..), SomeFailure(..), inputTokenProxy) import Symantic.Parser.Machine.Input import Symantic.Parser.Machine.Instructions import qualified Language.Haskell.TH.HideName as TH @@ -66,6 +71,7 @@ data Gen inp vs a = Gen generateCode :: Ord (InputToken inp) => Show (InputToken inp) => + Typeable (InputToken inp) => TH.Lift (InputToken inp) => -- InputToken inp ~ Char => Input inp => @@ -73,48 +79,62 @@ generateCode :: Gen inp '[] a -> CodeQ (inp -> Either (ParsingError inp) a) generateCode k = [|| \(input :: inp) -> - -- Pattern bindings containing unlifted types - -- should use an outermost bang pattern. - let !(# init, readMore, readNext #) = $$(cursorOf [||input||]) in - let finalRet = \_farInp _farExp v _inp -> Right v in - let finalRaise :: forall b. (Catcher inp b) - = \_failInp !farInp !farExp -> - Left ParsingErrorStandard - { parsingErrorOffset = offset farInp - , parsingErrorUnexpected = - if readMore farInp - then Just (let (# c, _ #) = readNext farInp in c) - else Nothing - , parsingErrorExpecting = Set.fromList farExp - } in - $$(unGen k GenCtx - { valueStack = ValueStackEmpty - , catchStackByLabel = Map.empty - , defaultCatch = [||finalRaise||] - , callStack = [] - , retCode = [||finalRet||] - , input = [||init||] - , nextInput = [||readNext||] - , moreInput = [||readMore||] - -- , farthestError = [||Nothing||] - , farthestInput = [||init||] - , farthestExpecting = [|| [] ||] - , checkedHorizon = 0 - , horizonStack = [] - , finalGenAnalysisByLet = runGenAnalysis (genAnalysisByLet k) - }) - ||] + -- Pattern bindings containing unlifted types + -- should use an outermost bang pattern. + let !(# init, readMore, readNext #) = $$(cursorOf [||input||]) + finalRet = \_farInp _farExp v _inp -> Right v + finalRaise :: forall b. (Catcher inp b) + = \ !exn _failInp !farInp !farExp -> + Left ParsingErrorStandard + { parsingErrorOffset = offset farInp + , parsingErrorException = exn + , parsingErrorUnexpected = + if readMore farInp + then Just (let (# c, _ #) = readNext farInp in c) + else Nothing + , parsingErrorExpecting = farExp + } + in + $$( + let defInputTokenProxy exprCode = + TH.unsafeCodeCoerce $ do + value <- TH.unTypeQ $ TH.examineCode [||Proxy :: Proxy (InputToken inp)||] + expr <- TH.unTypeQ (TH.examineCode exprCode) + return $ TH.LetE [ + TH.FunD inputTokenProxy [TH.Clause [] (TH.NormalB value) []] + ] expr + in defInputTokenProxy $ + unGen k GenCtx + { valueStack = ValueStackEmpty + , catchStackByLabel = Map.empty + , defaultCatch = [||finalRaise||] + , callStack = [] + , retCode = [||finalRet||] + , input = [||init||] + , nextInput = [||readNext||] + , moreInput = [||readMore||] + -- , farthestError = [||Nothing||] + , farthestInput = [||init||] + , farthestExpecting = [||Set.empty||] + , checkedHorizon = 0 + , horizonStack = [] + , finalGenAnalysisByLet = runGenAnalysis (genAnalysisByLet k) + } + ) + ||] + where -- ** Type 'ParsingError' data ParsingError inp = ParsingErrorStandard { parsingErrorOffset :: Offset - -- | Note that if an 'ErrorItemHorizon' greater than 1 - -- is amongst the 'parsingErrorExpecting' - -- then this is only the 'InputToken' - -- at the begining of the expected 'Horizon'. + , parsingErrorException :: Exception + -- | Note that if an 'FailureHorizon' greater than 1 + -- is amongst the 'parsingErrorExpecting' + -- then this is only the 'InputToken' + -- at the begining of the expected 'Horizon'. , parsingErrorUnexpected :: Maybe (InputToken inp) - , parsingErrorExpecting :: Set (ErrorItem (InputToken inp)) + , parsingErrorExpecting :: Set SomeFailure } deriving instance Show (InputToken inp) => Show (ParsingError inp) @@ -123,8 +143,8 @@ type ErrorLabel = String -- * Type 'GenAnalysis' data GenAnalysis = GenAnalysis - { minReads :: Either ErrorLabel Horizon - , mayRaise :: Map ErrorLabel () + { minReads :: Either Exception Horizon + , mayRaise :: Map Exception () } deriving (Show) -- | Tie the knot between mutually recursive 'TH.Name's @@ -186,7 +206,7 @@ altGenAnalysis aas@(a:|as) = GenAnalysis -- *** Type 'FarthestError' data FarthestError inp = FarthestError { farthestInput :: Cursor inp - , farthestExpecting :: [ErrorItem (InputToken inp)] + , farthestExpecting :: [Failure (InputToken inp)] } -} @@ -199,7 +219,7 @@ data GenCtx inp vs a = , Show (InputToken inp) ) => GenCtx { valueStack :: ValueStack vs - , catchStackByLabel :: Map ErrorLabel (NonEmpty (CodeQ (Catcher inp a))) + , catchStackByLabel :: Map Exception (NonEmpty (CodeQ (Catcher inp a))) -- | Default 'Catcher' defined at the begining of the generated 'CodeQ', -- hence a constant within the 'Gen'eration. , defaultCatch :: forall b. CodeQ (Catcher inp b) @@ -210,7 +230,7 @@ data GenCtx inp vs a = , moreInput :: CodeQ (Cursor inp -> Bool) , nextInput :: CodeQ (Cursor inp -> (# InputToken inp, Cursor inp #)) , farthestInput :: CodeQ (Cursor inp) - , farthestExpecting :: CodeQ [ErrorItem (InputToken inp)] + , farthestExpecting :: CodeQ (Set SomeFailure) -- | Remaining horizon already checked. -- Use to factorize 'input' length checks, -- instead of checking the 'input' length @@ -287,54 +307,73 @@ instance InstrBranchable Gen where ||] go ctx _ _ _ = unGen kd ctx instance InstrExceptionable Gen where - raiseException lbl failExp = Gen + raise exn = Gen { genAnalysisByLet = HM.empty , genAnalysis = \_final _ct -> GenAnalysis - { minReads = Left (symbolVal lbl) - , mayRaise = Map.singleton (symbolVal lbl) () + { minReads = Left (ExceptionLabel exn) + , mayRaise = Map.singleton (ExceptionLabel exn) () } - , unGen = \ctx@GenCtx{} -> {-trace ("unGen.raiseException: "<>symbolVal lbl) $-} [|| - let (# farInp, farExp #) = - case $$compareOffset $$(farthestInput ctx) $$(input ctx) of - LT -> (# $$(input ctx), failExp #) - EQ -> (# $$(farthestInput ctx), $$(farthestExpecting ctx) <> failExp #) - GT -> (# $$(farthestInput ctx), $$(farthestExpecting ctx) #) in + , unGen = \ctx@GenCtx{} -> {-trace ("unGen.raise: "<>show exn) $-} [|| $$(NE.head $ Map.findWithDefault (NE.singleton (defaultCatch ctx)) - (symbolVal lbl) - (catchStackByLabel ctx)) - $$(input ctx) farInp farExp + (ExceptionLabel exn) (catchStackByLabel ctx)) + (ExceptionLabel $$(TH.liftTyped exn)) + {-failInp-}$$(input ctx) + {-farInp-}$$(input ctx) + $$(farthestExpecting ctx) ||] } - popException lbl k = k - { unGen = \ctx -> {-trace ("unGen.popException: "<>symbolVal lbl) $-} - unGen k ctx{catchStackByLabel = Map.update (\case - _r0:|(r1:rs) -> Just (r1:|rs) - _ -> Nothing - ) (symbolVal lbl) (catchStackByLabel ctx) + fail fs = Gen + { genAnalysisByLet = HM.empty + , genAnalysis = \_final _ct -> GenAnalysis + { minReads = Left ExceptionFailure + , mayRaise = Map.singleton ExceptionFailure () + } + , unGen = \ctx@GenCtx{} -> {-trace ("unGen.fail: "<>show exn) $-} + if null fs + then [|| + $$(NE.head $ Map.findWithDefault + (NE.singleton (defaultCatch ctx)) + ExceptionFailure (catchStackByLabel ctx)) + ExceptionFailure + {-failInp-}$$(input ctx) + $$(farthestInput ctx) + $$(farthestExpecting ctx) + ||] + else raiseCode ctx [||fs||] + } + commit exn k = k + { unGen = \ctx -> {-trace ("unGen.commit: "<>show exn) $-} + unGen k ctx{catchStackByLabel = + Map.update (\case + _r0:|(r1:rs) -> Just (r1:|rs) + _ -> Nothing + ) + exn (catchStackByLabel ctx) } } - catchException lbl ok ko = Gen + catch exn ok ko = Gen { genAnalysisByLet = genAnalysisByLet ok <> genAnalysisByLet ko , genAnalysis = \final ct -> let ga = altGenAnalysis $ genAnalysis ok final ct :| [ genAnalysis ko final ct ] in - ga { mayRaise = Map.delete (symbolVal lbl) (mayRaise ga) } - , unGen = \ctx@GenCtx{} -> {-trace ("unGen.catchException: "<>symbolVal lbl) $-} [|| - let _ = $$(liftTypedString ("catchException lbl="<>symbolVal lbl)) in - let catchHandler !failInp !farInp !farExp = - let _ = $$(liftTypedString ("catchException.ko lbl="<>symbolVal lbl)) in - $$({-trace ("unGen.catchException.ko: "<>symbolVal lbl) $-} unGen ko ctx + ga { mayRaise = Map.delete exn (mayRaise ga) } + , unGen = \ctx@GenCtx{} -> {-trace ("unGen.catch: "<>show exn) $-} [|| + let _ = $$(liftTypedString ("catch "<>show exn)) in + let catchHandler !_exn !failInp !farInp !farExp = + let _ = $$(liftTypedString ("catch.ko "<>show exn)) in + $$({-trace ("unGen.catch.ko: "<>show exn) $-} unGen ko ctx -- Push 'input' and 'checkedHorizon' - -- as they were when entering 'catchException'. + -- as they were when entering 'catch'. { valueStack = ValueStackCons (H.Term (input ctx)) $ + --ValueStackCons (H.Term [||exn||]) $ valueStack ctx , horizonStack = checkedHorizon ctx : horizonStack ctx -- Note that 'catchStackByLabel' is reset. -- Move the input to the failing position. , input = [||failInp||] - -- The 'checkedHorizon' at the 'raiseException's + -- The 'checkedHorizon' at the 'raise's -- are not known here. -- Nor whether 'failInp' is after -- 'checkedHorizon' 'ctx' or not. @@ -344,18 +383,21 @@ instance InstrExceptionable Gen where , farthestExpecting = [||farExp||] }) in - $$({-trace ("unGen.catchException.ok: "<>symbolVal lbl) $-} unGen ok ctx - { catchStackByLabel = Map.insertWith (<>) (symbolVal lbl) - (NE.singleton [||catchHandler||]) (catchStackByLabel ctx) + $$({-trace ("unGen.catch.ok: "<>show es) $-} unGen ok ctx + { catchStackByLabel = + Map.insertWith (<>) exn + (NE.singleton [||catchHandler||]) + (catchStackByLabel ctx) } ) ||] } -- ** Type 'Catcher' type Catcher inp a = - {-failureInput-}Cursor inp -> - {-farthestInput-}Cursor inp -> - {-farthestExpecting-}[ErrorItem (InputToken inp)] -> + Exception -> + {-failInp-}Cursor inp -> + {-farInp-}Cursor inp -> + {-farExp-}(Set SomeFailure) -> Either (ParsingError inp) a instance InstrInputable Gen where pushInput k = k @@ -509,10 +551,14 @@ liftTypedRaiseByLabel Map_.Tip = [|| Map_.Tip ||] liftTypedRaiseByLabel (Map_.Bin s k (h:|_hs) l r) = [|| Map_.Bin s k $$h $$(liftTypedRaiseByLabel l) $$(liftTypedRaiseByLabel r) ||] +instance TH.Lift a => TH.Lift (Set a) where + liftTyped Set_.Tip = [|| Set_.Tip ||] + liftTyped (Set_.Bin s a l r) = [|| Set_.Bin $$(TH.liftTyped s) $$(TH.liftTyped a) $$(TH.liftTyped l) $$(TH.liftTyped r) ||] + -- ** Type 'Cont' type Cont inp v a = {-farthestInput-}Cursor inp -> - {-farthestExpecting-}[ErrorItem (InputToken inp)] -> + {-farthestExpecting-}(Set SomeFailure) -> v -> Cursor inp -> Either (ParsingError inp) a @@ -606,16 +652,20 @@ instance InstrJoinable Gen where n final (n:ct) } instance InstrReadable Char Gen where - read farExp p = checkHorizon . checkToken farExp p + read fs p = checkHorizon . checkToken fs p checkHorizon :: + forall inp vs a. + Eq (InputToken inp) => + Ord (InputToken inp) => + Typeable (InputToken inp) => TH.Lift (InputToken inp) => {-ok-}Gen inp vs a -> Gen inp vs a checkHorizon ok = ok { genAnalysis = \final ct -> seqGenAnalysis $ GenAnalysis { minReads = Right 1 - , mayRaise = Map.singleton "fail" () + , mayRaise = Map.singleton ExceptionFailure () } :| [ genAnalysis ok final ct ] , unGen = \ctx0@GenCtx{} -> @@ -623,14 +673,14 @@ checkHorizon ok = ok let raiseFail = NE.head (Map.findWithDefault (NE.singleton (defaultCatch ctx0)) - "fail" (catchStackByLabel ctx0)) in + ExceptionFailure (catchStackByLabel ctx0)) in [|| -- Factorize generated code for raising the "fail". let readFail = $$(raiseFail) in $$( let ctx = ctx0{catchStackByLabel = Map.adjust (\(_r:|rs) -> [||readFail||] :| rs) - "fail" (catchStackByLabel ctx0)} in + ExceptionFailure (catchStackByLabel ctx0)} in if checkedHorizon ctx >= 1 then unGen ok ctx0{checkedHorizon = checkedHorizon ctx - 1} else let minHoriz = @@ -644,12 +694,31 @@ checkHorizon ok = ok then $$(unGen ok ctx{checkedHorizon = minHoriz}) else let _ = "checkHorizon.else" in -- TODO: return a resuming continuation (eg. Partial) - $$(unGen (fail [ErrorItemHorizon (minHoriz + 1)]) ctx) + $$(unGen (fail (Set.singleton $ SomeFailure $ FailureHorizon @(InputToken inp) (minHoriz + 1))) ctx) ||] ) ||] } +raiseCode :: + Cursorable (Cursor inp) => + GenCtx inp cs a -> + TH.CodeQ (Set SomeFailure) -> + TH.CodeQ (Either (ParsingError inp) a) +raiseCode ctx fs = [|| + let failExp = $$fs + (# farInp, farExp #) = + case $$compareOffset $$(farthestInput ctx) $$(input ctx) of + LT -> (# $$(input ctx), failExp #) + EQ -> (# $$(farthestInput ctx), failExp <> $$(farthestExpecting ctx) #) + GT -> (# $$(farthestInput ctx), $$(farthestExpecting ctx) #) + in $$(NE.head $ Map.findWithDefault + (NE.singleton (defaultCatch ctx)) + ExceptionFailure (catchStackByLabel ctx)) + ExceptionFailure + {-failInp-}$$(input ctx) farInp farExp + ||] + finalGenAnalysis :: GenCtx inp vs a -> Gen inp cs a -> GenAnalysis finalGenAnalysis ctx k = --(\f -> f (error "callTrace")) $ @@ -661,11 +730,11 @@ finalGenAnalysis ctx k = checkToken :: Ord (InputToken inp) => TH.Lift (InputToken inp) => - [ErrorItem (InputToken inp)] -> + Set SomeFailure -> {-predicate-}TermInstr (InputToken inp -> Bool) -> {-ok-}Gen inp (InputToken inp ': vs) a -> Gen inp vs a -checkToken farExp p ok = ok +checkToken fs p ok = ok { unGen = \ctx -> {-trace "unGen.read" $-} [|| let !(# c, cs #) = $$(nextInput ctx) $$(input ctx) in if $$(genCode p) c @@ -673,6 +742,7 @@ checkToken farExp p ok = ok { valueStack = ValueStackCons (H.Term [||c||]) (valueStack ctx) , input = [||cs||] }) - else let _ = "checkToken.else" in $$(unGen (fail farExp) ctx) + else let _ = "checkToken.else" in + $$(unGen (fail fs) ctx) ||] } diff --git a/src/Symantic/Parser/Machine/Instructions.hs b/src/Symantic/Parser/Machine/Instructions.hs index 5ee80b5..80f3e93 100644 --- a/src/Symantic/Parser/Machine/Instructions.hs +++ b/src/Symantic/Parser/Machine/Instructions.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} -- For Machine +{-# LANGUAGE DeriveLift #-} -- For TH.Lift (Failure tok) {-# LANGUAGE DerivingStrategies #-} -- For Show (LetName a) -- | Semantic of the parsing instructions used -- to make the parsing control-flow explicit, @@ -10,9 +11,8 @@ import Data.Either (Either) import Data.Eq (Eq(..)) import Data.Function ((.)) import Data.Kind (Type) -import GHC.TypeLits (KnownSymbol) +import Data.Set (Set) import Text.Show (Show(..)) -import Data.Proxy (Proxy(..)) import qualified Language.Haskell.TH as TH import qualified Symantic.Parser.Haskell as H @@ -84,34 +84,22 @@ class InstrValuable (repr::ReprInstr) where -- ** Class 'InstrExceptionable' class InstrExceptionable (repr::ReprInstr) where - -- | @('raiseException' lbl es)@ raises labeled error from the 'failStack'. - raiseException :: - KnownSymbol lbl => - Proxy lbl -> - [ErrorItem (InputToken inp)] -> - repr inp vs a - -- | Like using 'raiseException' with the @"fail"@ label. - fail :: - [ErrorItem (InputToken inp)] -> - repr inp vs a - fail = raiseException (Proxy @"fail") - -- | @('popException' lbl k)@ removes a 'Catcher' - -- from the @catchStackByLabel@ at given label, + -- | @('raise' exn)@ raises 'ExceptionLabel' @(exn)@. + raise :: ExceptionLabel -> repr inp vs a + -- | @('fail' fs)@ raises 'ExceptionFailure' @(exn)@. + fail :: Set SomeFailure -> repr inp vs a + -- | @('commit' exn k)@ removes the 'Catcher' + -- from the 'catchStackByLabel' for the given 'Exception' @(exn)@, -- and continues with the next 'Instr'uction @(k)@. - popException :: - KnownSymbol lbl => - Proxy lbl -> - repr inp vs a -> - repr inp vs a - -- | @('catchException' lbl l r)@ tries the @(l)@ 'Instr'uction - -- in a new failure scope such that if @(l)@ raises a failure, it is caught, + commit :: Exception -> repr inp vs a -> repr inp vs a + -- | @('catch' exn l r)@ tries the @(l)@ 'Instr'uction + -- in a new failure scope such that if @(l)@ raises an exception within @(exn)@, it is caught, -- then the input (and its 'Horizon') is pushed as it was before trying @(l)@ on the 'valueStack', -- and the control flow goes on with the @(r)@ 'Instr'uction. - catchException :: - KnownSymbol lbl => - Proxy lbl -> - repr inp vs ret -> - repr inp (Cursor inp ': vs) ret -> + catch :: + Exception -> + {-scope-}repr inp vs ret -> + {-catcher-}repr inp (Cursor inp ': vs) ret -> repr inp vs ret -- ** Class 'InstrBranchable' @@ -183,12 +171,12 @@ class InstrInputable (repr::ReprInstr) where -- ** Class 'InstrReadable' class InstrReadable (tok::Type) (repr::ReprInstr) where - -- | @('read' expected p k)@ reads a 'Char' @(c)@ from the 'inp'ut, - -- if @(p c)@ is 'True' then continues with the next 'Instr'uction @(k)@ on, - -- otherwise 'RaiseException'. + -- | @('read' fs p k)@ reads a 'Char' @(c)@ from the input, + -- if @(p c)@ is 'True' then continues with the next 'Instr'uction @(k)@, + -- otherwise 'fail'. read :: tok ~ InputToken inp => - [ErrorItem tok] -> + Set SomeFailure -> TermInstr (tok -> Bool) -> repr inp (tok ': vs) a -> repr inp vs a diff --git a/src/Symantic/Parser/Machine/Optimize.hs b/src/Symantic/Parser/Machine/Optimize.hs index 5cd39ee..3413b16 100644 --- a/src/Symantic/Parser/Machine/Optimize.hs +++ b/src/Symantic/Parser/Machine/Optimize.hs @@ -9,11 +9,10 @@ module Symantic.Parser.Machine.Optimize where import Data.Bool (Bool(..)) import Data.Either (Either) -import Data.Maybe (Maybe(..)) import Data.Function ((.)) import Data.Kind (Constraint) -import Data.Proxy (Proxy(..)) -import GHC.TypeLits (KnownSymbol) +import Data.Maybe (Maybe(..)) +import Data.Set (Set) import Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..)) import qualified Data.Functor as Functor import qualified Language.Haskell.TH as TH @@ -103,31 +102,32 @@ instance InstrValuable repr => InstrValuable (SomeInstr repr) where -- InstrExceptionable data instance Instr InstrExceptionable repr inp vs a where - RaiseException :: - KnownSymbol lbl => - Proxy lbl -> - [ErrorItem (InputToken inp)] -> + Raise :: + ExceptionLabel -> + Instr InstrExceptionable repr inp vs a + Fail :: + Set SomeFailure -> Instr InstrExceptionable repr inp vs a - PopException :: - KnownSymbol lbl => - Proxy lbl -> + Commit :: + Exception -> SomeInstr repr inp vs ret -> Instr InstrExceptionable repr inp vs ret - CatchException :: - KnownSymbol lbl => - Proxy lbl -> + Catch :: + Exception -> SomeInstr repr inp vs ret -> SomeInstr repr inp (Cursor inp ': vs) ret -> Instr InstrExceptionable repr inp vs ret instance InstrExceptionable repr => Trans (Instr InstrExceptionable repr inp vs) (repr inp vs) where trans = \case - RaiseException lbl err -> raiseException lbl err - PopException lbl k -> popException lbl (trans k) - CatchException lbl l r -> catchException lbl (trans l) (trans r) + Raise exn -> raise exn + Fail fs -> fail fs + Commit exn k -> commit exn (trans k) + Catch exn l r -> catch exn (trans l) (trans r) instance InstrExceptionable repr => InstrExceptionable (SomeInstr repr) where - raiseException lbl = SomeInstr . RaiseException lbl - popException lbl = SomeInstr . PopException lbl - catchException lbl x = SomeInstr . CatchException lbl x + raise = SomeInstr . Raise + fail = SomeInstr . Fail + commit exn = SomeInstr . Commit exn + catch exn x = SomeInstr . Catch exn x -- InstrBranchable data instance Instr InstrBranchable repr inp vs a where @@ -212,7 +212,7 @@ instance InstrInputable repr => InstrInputable (SomeInstr repr) where -- InstrReadable data instance Instr (InstrReadable tok) repr inp vs a where Read :: - [ErrorItem (InputToken inp)] -> + Set SomeFailure -> TermInstr (InputToken inp -> Bool) -> SomeInstr repr inp (InputToken inp ': vs) a -> Instr (InstrReadable tok) repr inp vs a @@ -220,8 +220,8 @@ instance ( InstrReadable tok repr, tok ~ InputToken inp ) => Trans (Instr (InstrReadable tok) repr inp vs) (repr inp vs) where trans = \case - Read es p k -> read es p (trans k) + Read fs p k -> read fs p (trans k) instance ( InstrReadable tok repr, Typeable tok ) => InstrReadable tok (SomeInstr repr) where - read es p = SomeInstr . Read es p + read fs p = SomeInstr . Read fs p diff --git a/src/Symantic/Parser/Machine/Program.hs b/src/Symantic/Parser/Machine/Program.hs index 232c1fd..66a12f1 100644 --- a/src/Symantic/Parser/Machine/Program.hs +++ b/src/Symantic/Parser/Machine/Program.hs @@ -11,11 +11,11 @@ import Control.Monad (Monad(..), (<=<), (=<<), liftM, liftM2, sequence) import Data.Bool (Bool(..)) import Data.Function (($), (.)) import Data.Ord (Ord) -import Data.Proxy (Proxy(..)) import System.IO (IO) import Type.Reflection (Typeable) import qualified Data.Functor as Functor import qualified Data.HashMap.Strict as HM +import qualified Data.Set as Set import qualified Data.Traversable as Traversable import qualified Language.Haskell.TH as TH import qualified Symantic.Parser.Haskell as H @@ -36,7 +36,7 @@ data Program repr inp a = Program { unProgram :: -- This is the next instruction SomeInstr repr inp (a ': vs) ret -> -- This is the current instruction - -- IO is needed for 'TH.qNewName'. + -- IO is needed for 'TH.newName' in 'joinNext'. IO (SomeInstr repr inp vs ret) } @@ -48,6 +48,28 @@ optimizeMachine :: IO (repr inp '[] a) optimizeMachine (Program f) = trans Functor.<$> f @'[] ret +instance + ( Cursorable (Cursor inp) + , InstrBranchable repr + , InstrExceptionable repr + , InstrInputable repr + , InstrJoinable repr + , InstrValuable repr + , InstrReadable (InputToken inp) repr + , Typeable (InputToken inp) + ) => + Trans (Comb CombAlternable (Program repr inp)) (Program repr inp) where + trans = \case + Alt ExceptionFailure + (Comb (SatisfyOrFail _fs p :: Comb (CombSatisfiable (InputToken inp)) (Program repr inp) a)) + (Comb (Failure sf)) -> + Program $ return . read (Set.singleton sf) (trans p) + Alt exn x y -> alt exn (trans x) (trans y) + Empty -> empty + Failure sf -> failure sf + Throw exn -> throw exn + Try x -> try (trans x) + instance ( Cursorable (Cursor inp) , InstrBranchable repr @@ -56,17 +78,18 @@ instance , InstrJoinable repr , InstrValuable repr ) => CombAlternable (Program repr inp) where - empty = Program $ \_next -> return $ fail [] - Program l <|> Program r = joinNext $ Program $ \next -> - liftM2 (catchException (Proxy @"fail")) - (l (popException (Proxy @"fail") next)) - (failIfConsumed Functor.<$> r next) + alt exn (Program l) (Program r) = joinNext $ Program $ \next -> + liftM2 (catch exn) + (l (commit exn next)) + (failIfConsumed exn Functor.<$> r next) + throw exn = Program $ \_next -> return $ raise exn + failure flr = Program $ \_next -> return $ fail (Set.singleton flr) + empty = Program $ \_next -> return $ fail (Set.singleton (SomeFailure FailureEmpty)) try (Program x) = Program $ \next -> - liftM2 (catchException (Proxy @"fail")) - (x (popException (Proxy @"fail") next)) - -- On exception, reset the input, - -- and propagate the failure. - (return $ loadInput (fail [])) + liftM2 (catch ExceptionFailure) + (x (commit ExceptionFailure next)) + -- On exception, reset the input, and propagate the failure. + (return $ loadInput $ fail Set.empty) -- | If no input has been consumed by the failing alternative -- then continue with the given continuation. @@ -77,12 +100,16 @@ failIfConsumed :: InstrExceptionable repr => InstrInputable repr => InstrValuable repr => + Exception -> SomeInstr repr inp vs ret -> SomeInstr repr inp (Cursor inp ': vs) ret -failIfConsumed k = +failIfConsumed exn k = pushInput $ lift2Value (H.Term sameOffset) $ - ifBranch k (fail []) + ifBranch k $ + case exn of + ExceptionLabel lbl -> raise lbl + ExceptionFailure -> fail Set.empty -- | @('joinNext' m)@ factorize the next 'Instr'uction -- to be able to reuse it multiple times without duplication. @@ -165,14 +192,13 @@ instance ) => CombLookable (Program repr inp) where look (Program x) = Program $ \next -> liftM pushInput (x (swapValue (loadInput next))) - eof = negLook (satisfy [{-discarded by negLook-}] (H.lam1 (\_x -> H.bool True))) + eof = negLook (satisfy (H.lam1 (\_x -> H.bool True))) -- This sets a better failure message - <|> (Program $ \_next -> return $ fail [ErrorItemEnd]) + <|> (Program $ \_next -> return $ fail (Set.singleton (SomeFailure FailureEnd))) negLook (Program x) = Program $ \next -> - liftM2 (catchException (Proxy @"fail")) + liftM2 (catch ExceptionFailure) -- On x success, discard the result, - -- and replace this 'CatchException''s failure handler - -- by a failure whose 'farthestExpecting' is negated, + -- and replace this 'Catcher' by a failure whose 'farthestExpecting' is negated, -- then a failure is raised from the input -- when entering 'negLook', to avoid odd cases: -- - where the failure that made (negLook x) @@ -180,11 +206,11 @@ instance -- failure of the grammar. -- - where the overall failure of -- the grammar might be blamed on something in x - -- that, if corrected, still makes x succeed and - -- (negLook x) fail. - (liftM pushInput (x - (popValue (popException (Proxy @"fail") (loadInput - (fail [])))))) + -- that, if corrected, still makes x succeed + -- and (negLook x) fail. + (liftM pushInput $ x $ + popValue $ commit ExceptionFailure $ + loadInput $ fail Set.empty) -- On x failure, reset the input, -- and go on with the next 'Instr'uctions. (return $ loadInput $ pushValue H.unit next) @@ -200,7 +226,7 @@ instance , InstrReadable tok repr , Typeable tok ) => CombSatisfiable tok (Program repr inp) where - satisfy es p = Program $ return . read es (trans p) + satisfyOrFail fs p = Program $ return . read fs (trans p) instance ( InstrBranchable repr , InstrJoinable repr @@ -210,7 +236,3 @@ instance lr =<< liftM2 caseBranch (l (swapValue (applyValue next))) (r (swapValue (applyValue next))) -instance - InstrExceptionable repr => - CombThrowable (Program repr inp) where - throw lbl = Program $ \_next -> return $ raiseException lbl [] diff --git a/src/Symantic/Parser/Machine/View.hs b/src/Symantic/Parser/Machine/View.hs index d0d6a22..e1998f3 100644 --- a/src/Symantic/Parser/Machine/View.hs +++ b/src/Symantic/Parser/Machine/View.hs @@ -11,7 +11,6 @@ import Data.Ord (Ord(..)) import Data.Semigroup (Semigroup(..)) import Data.String (String) import Data.Tuple (fst) -import GHC.TypeLits (symbolVal) import Text.Show (Show(..)) import qualified Data.HashMap.Strict as HM import qualified Data.List as List @@ -101,25 +100,30 @@ instance InstrValuable (ViewMachine sN) where , viewGen = gen } where gen = swapValue (viewGen k) instance InstrExceptionable (ViewMachine sN) where - raiseException lbl err = ViewMachine + raise exn = ViewMachine { unViewMachine = \ct lm next -> - viewInstrCmd (Right gen) ct lm ("raiseException "<>show (symbolVal lbl), "") [] : next + viewInstrCmd (Right gen) ct lm ("raise "<>show exn, "") [] : next , viewGen = gen - } where gen = raiseException lbl err - popException lbl k = ViewMachine + } where gen = raise exn + fail flr = ViewMachine { unViewMachine = \ct lm next -> - viewInstrCmd (Right gen) ct lm ("popException "<>show (symbolVal lbl), "") [] : + viewInstrCmd (Right gen) ct lm ("fail "<>show flr, "") [] : next + , viewGen = gen + } where gen = fail flr + commit exn k = ViewMachine + { unViewMachine = \ct lm next -> + viewInstrCmd (Right gen) ct lm ("commit "<>show exn, "") [] : unViewMachine k ct lm next , viewGen = gen - } where gen = popException lbl (viewGen k) - catchException lbl ok ko = ViewMachine + } where gen = commit exn (viewGen k) + catch exn ok ko = ViewMachine { unViewMachine = \ct lm next -> - viewInstrCmd (Right gen) ct lm ("catchException "<>show (symbolVal lbl), "") + viewInstrCmd (Right gen) ct lm ("catch "<>show exn, "") [ viewInstrArg "ok" (unViewMachine ok ct lm []) , viewInstrArg "ko" (unViewMachine ko ct lm []) ] : next , viewGen = gen - } where gen = catchException lbl (viewGen ok) (viewGen ko) + } where gen = catch exn (viewGen ok) (viewGen ko) instance InstrBranchable (ViewMachine sN) where caseBranch l r = ViewMachine { unViewMachine = \ct lm next -> diff --git a/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt index a51057f..4686c1c 100644 --- a/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt +++ b/test/Golden/Grammar/OptimizeGrammar/G13.expected.txt @@ -44,7 +44,7 @@ lets | | | | | | | ` ref | | | | | | ` rec | | | | | ` satisfy -| | | | ` empty +| | | | ` failure | | | ` ref | | ` rec | ` pure (\u1 -> u1) diff --git a/test/Golden/Grammar/ViewGrammar/G13.expected.txt b/test/Golden/Grammar/ViewGrammar/G13.expected.txt index 0ea3514..39f9f5b 100644 --- a/test/Golden/Grammar/ViewGrammar/G13.expected.txt +++ b/test/Golden/Grammar/ViewGrammar/G13.expected.txt @@ -92,7 +92,7 @@ lets | | | | | | + pure (\u1 -> (\u2 -> u1)) | | | | | | ` pure ']' | | | | | ` satisfy -| | | | ` empty +| | | | ` failure | | | ` ref | | ` rec | ` pure (\u1 -> u1) diff --git a/test/Golden/Machine/G1.expected.txt b/test/Golden/Machine/G1.expected.txt index 13bf6c1..4035721 100644 --- a/test/Golden/Machine/G1.expected.txt +++ b/test/Golden/Machine/G1.expected.txt @@ -1,18 +1,18 @@ pushValue Term minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] pushValue 'a' minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] read ('a' ==) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G10.expected.txt b/test/Golden/Machine/G10.expected.txt index 0f6e18a..18a68f2 100644 --- a/test/Golden/Machine/G10.expected.txt +++ b/test/Golden/Machine/G10.expected.txt @@ -10,26 +10,26 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 1) mayRaise=[] | | | pushValue (\u1 -> (\u2 -> u1)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue 'a' | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | read ('a' ==) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 0) | | mayRaise=[] -| | popException "fail" +| | commit ExceptionFailure | | minReads=(Right 0) | | mayRaise=[] | | refJoin @@ -38,26 +38,26 @@ catchException "fail" | | | pushInput | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value Term | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue 'b' | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | read ('b' ==) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] @@ -65,6 +65,6 @@ catchException "fail" | | | | minReads=(Right 0) | | | | mayRaise=[] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G11.expected.txt b/test/Golden/Machine/G11.expected.txt index f5263f1..eda2356 100644 --- a/test/Golden/Machine/G11.expected.txt +++ b/test/Golden/Machine/G11.expected.txt @@ -1,28 +1,28 @@ let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'a' | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('a' ==) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -38,7 +38,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -47,13 +47,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -62,39 +62,39 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] call minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] pushValue 'b' minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] read ('b' ==) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G12.expected.txt b/test/Golden/Machine/G12.expected.txt index 3ab4d49..9735e32 100644 --- a/test/Golden/Machine/G12.expected.txt +++ b/test/Golden/Machine/G12.expected.txt @@ -1,19 +1,19 @@ let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read Term | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -26,7 +26,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -35,13 +35,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -50,9 +50,9 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) mayRaise=[] @@ -83,32 +83,32 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 0) mayRaise=[] | -| | catchException "fail" +| | catch ExceptionFailure | | minReads=(Right 0) | | mayRaise=[] | | | | | | | pushInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | read (\u1 -> Term) -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | popValue -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | popException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | commit ExceptionFailure +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | loadInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | | | | loadInput | | | | minReads=(Right 0) @@ -116,7 +116,7 @@ catchException "fail" | | | | pushValue Term | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | refJoin @@ -124,19 +124,19 @@ catchException "fail" | | | | mayRaise=[] | | | pushInput -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | lift2Value Term -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [FailureEnd] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G13.expected.txt b/test/Golden/Machine/G13.expected.txt index b4faeb3..f0c4dda 100644 --- a/test/Golden/Machine/G13.expected.txt +++ b/test/Golden/Machine/G13.expected.txt @@ -16,25 +16,25 @@ let let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read Term | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -47,7 +47,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -56,13 +56,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -71,25 +71,25 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | join | | | minReads=(Right 0) | | | mayRaise=[] @@ -114,7 +114,7 @@ let | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | ret @@ -122,32 +122,32 @@ let | | | | mayRaise=[] | | | pushInput | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ((\u1 -> (\u2 -> u1)) Term) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | swapValue | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | loadInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)] | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue Term | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ((\u1 -> (\u2 -> u1)) Term) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 0) | | | | | mayRaise=[] @@ -157,16 +157,16 @@ let | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue Term | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ((\u1 -> (\u2 -> u1)) Term) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 0) | | | | | mayRaise=[] @@ -176,16 +176,16 @@ let | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue Term | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ((\u1 -> (\u2 -> u1)) Term) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 0) | | | | | mayRaise=[] @@ -195,16 +195,16 @@ let | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue Term | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ((\u1 -> (\u2 -> u1)) Term) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 0) | | | | | mayRaise=[] @@ -214,16 +214,16 @@ let | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue Term | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ((\u1 -> (\u2 -> u1)) Term) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 0) | | | | | mayRaise=[] @@ -233,16 +233,16 @@ let | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue Term | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ((\u1 -> (\u2 -> u1)) Term) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 0) | | | | | mayRaise=[] @@ -252,61 +252,61 @@ let | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 2) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 2) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 2) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 2) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 2) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ((\u1 -> (\u2 -> u1)) Term) | | | | | minReads=(Right 2) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | call | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue Term | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | call | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue ']' | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read (']' ==) | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 0) | | | | | mayRaise=[] @@ -317,19 +317,19 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [FailureEmpty] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -338,9 +338,9 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G14.expected.txt b/test/Golden/Machine/G14.expected.txt index e6d501a..c6b1afa 100644 --- a/test/Golden/Machine/G14.expected.txt +++ b/test/Golden/Machine/G14.expected.txt @@ -1,25 +1,25 @@ let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -32,7 +32,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -41,13 +41,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -56,31 +56,31 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -93,7 +93,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -102,13 +102,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -117,31 +117,31 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read Term | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -154,7 +154,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -163,13 +163,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -178,13 +178,13 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | @@ -236,244 +236,244 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 18) | | | mayRaise=[] -| | | catchException "fail" +| | | catch ExceptionFailure | | | minReads=(Right 18) | | | mayRaise=[] | | | | | | | | | pushValue cons | | | | | minReads=(Right 18) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 18) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue 'f' | | | | | minReads=(Right 18) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 18) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ('f' ==) | | | | | minReads=(Right 18) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 17) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 17) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue cons | | | | | minReads=(Right 17) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 17) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue 'u' | | | | | minReads=(Right 17) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 17) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ('u' ==) | | | | | minReads=(Right 17) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 16) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 16) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue cons | | | | | minReads=(Right 16) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 16) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue 'n' | | | | | minReads=(Right 16) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 16) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ('n' ==) | | | | | minReads=(Right 16) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 15) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 15) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue cons | | | | | minReads=(Right 15) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 15) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue 'c' | | | | | minReads=(Right 15) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 15) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ('c' ==) | | | | | minReads=(Right 15) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 14) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 14) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue cons | | | | | minReads=(Right 14) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 14) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue 't' | | | | | minReads=(Right 14) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 14) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ('t' ==) | | | | | minReads=(Right 14) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 13) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 13) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue cons | | | | | minReads=(Right 13) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 13) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue 'i' | | | | | minReads=(Right 13) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 13) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ('i' ==) | | | | | minReads=(Right 13) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 12) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 12) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue cons | | | | | minReads=(Right 12) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 12) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue 'o' | | | | | minReads=(Right 12) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 12) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ('o' ==) | | | | | minReads=(Right 12) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 11) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 11) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue cons | | | | | minReads=(Right 11) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 11) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue 'n' | | | | | minReads=(Right 11) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 11) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | read ('n' ==) | | | | | minReads=(Right 11) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue Term | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] -| | | | | popException "fail" +| | | | | mayRaise=[ExceptionFailure] +| | | | | commit ExceptionFailure | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | call | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | call | | | | | minReads=(Right 10) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 8) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 8) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 8) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 8) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 8) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 8) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | call | | | | | minReads=(Right 8) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 6) | | | | | mayRaise=[] @@ -494,31 +494,31 @@ let | | | | | mayRaise=[] | | | | | join | | | | | minReads=(Right 6) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 6) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 6) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 6) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | call | | | | | | minReads=(Right 6) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 4) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 4) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 4) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | call | | | | | | minReads=(Right 4) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] @@ -534,58 +534,58 @@ let | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] -| | | | | | popException "fail" +| | | | | | commit ExceptionFailure | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] | | | | | | ret | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] -| | | | | catchException "fail" +| | | | | catch ExceptionFailure | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue Term | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> u1) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue ':' | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | read (':' ==) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | call | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] @@ -601,7 +601,7 @@ let | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] -| | | | | | | popException "fail" +| | | | | | | commit ExceptionFailure | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] | | | | | | | refJoin @@ -610,13 +610,13 @@ let | | | | | | | | | | | | | pushInput | | | | | | | minReads=(Right 0) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value Term | | | | | | | minReads=(Right 0) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | choicesBranch [(\u1 -> u1)] | | | | | | | minReads=(Right 0) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | call | | | | | | | | | minReads=(Right 0) @@ -625,26 +625,26 @@ let | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] | | | | | | | | -| | | | | | | | | raiseException "fail" -| | | | | | | | | minReads=(Left "fail") -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | fail fromList [] +| | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | loadInput -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -653,13 +653,13 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | @@ -690,39 +690,39 @@ let | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | ret | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | catchException "fail" +| | | catch ExceptionFailure | | | minReads=(Right 2) | | | mayRaise=[] | | | | | | | | | join | | | | | minReads=(Right 0) | | | | | mayRaise=[] -| | | | | | popException "fail" +| | | | | | commit ExceptionFailure | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] | | | | | | refJoin | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] -| | | | | catchException "fail" +| | | | | catch ExceptionFailure | | | | | minReads=(Right 2) | | | | | mayRaise=[] | | | | | | | | | | | | | join | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] -| | | | | | | | popException "fail" +| | | | | | | | commit ExceptionFailure | | | | | | | | minReads=(Right 0) | | | | | | | | mayRaise=[] | | | | | | | | refJoin | | | | | | | | minReads=(Right 0) | | | | | | | | mayRaise=[] -| | | | | | | catchException "fail" +| | | | | | | catch ExceptionFailure | | | | | | | minReads=(Right 2) | | | | | | | mayRaise=[] | | | | | | | | @@ -735,46 +735,46 @@ let | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 2) | | | | | | | | | mayRaise=[] -| | | | | | | | | catchException "fail" +| | | | | | | | | catch ExceptionFailure | | | | | | | | | minReads=(Right 2) | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue 'i' | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | read ('i' ==) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue cons | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue 'f' | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | read ('f' ==) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] @@ -790,7 +790,7 @@ let | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] -| | | | | | | | | | | popException "fail" +| | | | | | | | | | | commit ExceptionFailure | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) @@ -802,7 +802,7 @@ let | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] -| | | | | | | | | | | popException "fail" +| | | | | | | | | | | commit ExceptionFailure | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | refJoin @@ -810,21 +810,21 @@ let | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | | | | | | | loadInput -| | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | mayRaise=["fail"] -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | mayRaise=[ExceptionFailure] +| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | pushInput | | | | | | | | | minReads=(Right 11) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value Term | | | | | | | | | minReads=(Right 11) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | choicesBranch [(\u1 -> u1)] | | | | | | | | | minReads=(Right 11) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 11) @@ -853,160 +853,160 @@ let | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 11) | | | | | | | | | | | mayRaise=[] -| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | catch ExceptionFailure | | | | | | | | | | | minReads=(Right 11) | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue 'w' | | | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | read ('w' ==) | | | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 10) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 10) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | minReads=(Right 10) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | minReads=(Right 10) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue 'h' | | | | | | | | | | | | | minReads=(Right 10) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 10) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | read ('h' ==) | | | | | | | | | | | | | minReads=(Right 10) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 9) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 9) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | minReads=(Right 9) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | minReads=(Right 9) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue 'i' | | | | | | | | | | | | | minReads=(Right 9) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 9) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | read ('i' ==) | | | | | | | | | | | | | minReads=(Right 9) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue 'l' | | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | read ('l' ==) | | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 7) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 7) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | minReads=(Right 7) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | minReads=(Right 7) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue 'e' | | | | | | | | | | | | | minReads=(Right 7) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 7) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | read ('e' ==) | | | | | | | | | | | | | minReads=(Right 7) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue Term | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] -| | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] +| | | | | | | | | | | | | commit ExceptionFailure | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | call | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | call | | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | call | | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | mayRaise=[] @@ -1015,27 +1015,27 @@ let | | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | | | mayRaise=["fail"] -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] +| | | | | | | | | | | | | fail fromList [] +| | | | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushInput | | | | | | | minReads=(Right 8) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value Term | | | | | | | minReads=(Right 8) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | choicesBranch [(\u1 -> u1)] | | | | | | | minReads=(Right 8) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | -| | | | | | | | | catchException "fail" +| | | | | | | | | catch ExceptionFailure | | | | | | | | | minReads=(Right 8) | | | | | | | | | mayRaise=[] | | | | | | | | | | @@ -1071,40 +1071,40 @@ let | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | join | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | call | | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | call | | | | | | | | | | | | minReads=(Right 6) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | mayRaise=[] @@ -1122,40 +1122,40 @@ let | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue '=' | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | read ('=' ==) | | | | | | | | | | | | minReads=(Right 4) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | call | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 2) | | | | | | | | | | | | mayRaise=[] @@ -1212,29 +1212,29 @@ let | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | call | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | mayRaise=[] -| | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | commit ExceptionFailure | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | refJoin | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | mayRaise=[] -| | | | | | | | | | | catchException "fail" +| | | | | | | | | | | catch ExceptionFailure | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | @@ -1256,67 +1256,67 @@ let | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 3) | | | | | | | | | | | | | mayRaise=[] -| | | | | | | | | | | | | catchException "fail" +| | | | | | | | | | | | | catch ExceptionFailure | | | | | | | | | | | | | minReads=(Right 3) | | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | | | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | pushValue 'v' | | | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | read ('v' ==) | | | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | pushValue 'a' | | | | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | read ('a' ==) | | | | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | pushValue 'r' | | | | | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | read ('r' ==) | | | | | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | | | mayRaise=[] @@ -1335,7 +1335,7 @@ let | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | | | mayRaise=[] -| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | commit ExceptionFailure | | | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) @@ -1350,7 +1350,7 @@ let | | | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | | | mayRaise=[] -| | | | | | | | | | | | | | | popException "fail" +| | | | | | | | | | | | | | | commit ExceptionFailure | | | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | refJoin @@ -1358,21 +1358,21 @@ let | | | | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | | | | | | | | | | | | | | | loadInput -| | | | | | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | | | | | mayRaise=["fail"] -| | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] +| | | | | | | | | | | | | | | fail fromList [] +| | | | | | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | | | | | pushInput | | | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value Term | | | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | choicesBranch [(\u1 -> u1)] | | | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | | | | | | | | | call | | | | | | | | | | | | | | | minReads=(Right 0) @@ -1381,43 +1381,43 @@ let | | | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | | | fail fromList [] +| | | | | | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | loadInput -| | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | mayRaise=["fail"] -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | mayRaise=[ExceptionFailure] +| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | -| | | | | | | | | raiseException "fail" -| | | | | | | | | minReads=(Left "fail") -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | fail fromList [] +| | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | pushInput | | | | | minReads=(Right 4) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value Term | | | | | minReads=(Right 4) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | choicesBranch [(\u1 -> u1)] | | | | | minReads=(Right 4) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | call | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | call | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] @@ -1425,19 +1425,19 @@ let | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] | | | | | | -| | | | | | | raiseException "fail" -| | | | | | | minReads=(Left "fail") -| | | | | | | mayRaise=["fail"] +| | | | | | | fail fromList [] +| | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | mayRaise=[ExceptionFailure] | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -1446,34 +1446,34 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) | | | mayRaise=[] @@ -1495,7 +1495,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -1504,13 +1504,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -1519,34 +1519,34 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) | | | mayRaise=[] @@ -1568,7 +1568,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -1577,13 +1577,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -1592,34 +1592,34 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) | | | mayRaise=[] @@ -1641,7 +1641,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -1650,13 +1650,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -1665,34 +1665,34 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) | | | mayRaise=[] @@ -1714,7 +1714,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -1723,13 +1723,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -1738,61 +1738,61 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue '!' | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('!' ==) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) | | | mayRaise=[] @@ -1817,7 +1817,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -1826,13 +1826,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -1841,13 +1841,13 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | @@ -1914,7 +1914,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -1923,21 +1923,21 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | jump | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) mayRaise=[] @@ -1973,19 +1973,19 @@ let | mayRaise=[] let minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -2030,19 +2030,19 @@ let | mayRaise=[] let minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read Term | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -2057,40 +2057,40 @@ let | mayRaise=[] let minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | read Term | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | ret | minReads=(Right 0) | mayRaise=[] let minReads=(Right 2) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue '(' | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read ('(' ==) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -2099,31 +2099,31 @@ let | mayRaise=[] let minReads=(Right 2) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue ')' | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read (')' ==) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -2132,31 +2132,31 @@ let | mayRaise=[] let minReads=(Right 2) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue ',' | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read (',' ==) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -2165,31 +2165,31 @@ let | mayRaise=[] let minReads=(Right 2) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue ';' | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read (';' ==) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -2199,20 +2199,20 @@ let let minReads=(Right 2) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 2) | mayRaise=[] | | | | | join | | | minReads=(Right 0) | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | ret | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | catchException "fail" +| | | catch ExceptionFailure | | | minReads=(Right 2) | | | mayRaise=[] | | | | @@ -2227,42 +2227,42 @@ let | | | | | mayRaise=[] | | | | | join | | | | | minReads=(Right 1) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | call | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] -| | | | | | popException "fail" +| | | | | | commit ExceptionFailure | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] | | | | | | refJoin | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] -| | | | | catchException "fail" +| | | | | catch ExceptionFailure | | | | | minReads=(Right 1) | | | | | mayRaise=[] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue '0' | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | read ('0' ==) | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] -| | | | | | | popException "fail" +| | | | | | | commit ExceptionFailure | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] | | | | | | | refJoin @@ -2271,26 +2271,26 @@ let | | | | | | | | | | | | | pushInput | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value Term | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | choicesBranch [(\u1 -> u1)] | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | minReads=(Right 1) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue '1' | | | | | | | | | minReads=(Right 1) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 1) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | read ('1' ==) | | | | | | | | | minReads=(Right 1) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] @@ -2298,44 +2298,44 @@ let | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] | | | | | | | | -| | | | | | | | | raiseException "fail" -| | | | | | | | | minReads=(Left "fail") -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | fail fromList [] +| | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | pushInput | | | | | minReads=(Right 4) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value Term | | | | | minReads=(Right 4) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | choicesBranch [(\u1 -> u1)] | | | | | minReads=(Right 4) -| | | | | mayRaise=["fail"] +| | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> u1) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue '\'' | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | read ('\'' ==) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 3) | | | | | | | mayRaise=[] @@ -2344,37 +2344,37 @@ let | | | | | | | mayRaise=[] | | | | | | | join | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | minReads=(Right 2) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | minReads=(Right 2) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | minReads=(Right 2) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | minReads=(Right 2) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | pushValue '\'' | | | | | | | | minReads=(Right 2) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | minReads=(Right 2) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | read ('\'' ==) | | | | | | | | minReads=(Right 2) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | minReads=(Right 1) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | minReads=(Right 1) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | call | | | | | | | | minReads=(Right 1) -| | | | | | | | mayRaise=["fail"] +| | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | minReads=(Right 0) | | | | | | | | mayRaise=[] @@ -2384,22 +2384,22 @@ let | | | | | | | | refJoin | | | | | | | | minReads=(Right 0) | | | | | | | | mayRaise=[] -| | | | | | | catchException "fail" +| | | | | | | catch ExceptionFailure | | | | | | | minReads=(Right 1) | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | minReads=(Right 1) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | minReads=(Right 1) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 1) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | read Term | | | | | | | | | minReads=(Right 1) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] @@ -2409,7 +2409,7 @@ let | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] -| | | | | | | | | popException "fail" +| | | | | | | | | commit ExceptionFailure | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] | | | | | | | | | refJoin @@ -2418,53 +2418,53 @@ let | | | | | | | | | | | | | | | | | pushInput | | | | | | | | | minReads=(Right 2) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value Term | | | | | | | | | minReads=(Right 2) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | choicesBranch [(\u1 -> u1)] | | | | | | | | | minReads=(Right 2) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue '\\' | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | read ('\\' ==) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | read Term | | | | | | | | | | | minReads=(Right 1) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] @@ -2481,23 +2481,23 @@ let | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] | | | | | | | | | | -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | -| | | | | | | raiseException "fail" -| | | | | | | minReads=(Left "fail") -| | | | | | | mayRaise=["fail"] +| | | | | | | fail fromList [] +| | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | mayRaise=[ExceptionFailure] | | | | | pushInput | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 2) @@ -2523,7 +2523,7 @@ let | | | | | | ret | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] -| | | | | catchException "fail" +| | | | | catch ExceptionFailure | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | | | @@ -2542,56 +2542,56 @@ let | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | minReads=(Right 0) | | | | | | | | mayRaise=[] -| | | | | | | | popException "fail" +| | | | | | | | commit ExceptionFailure | | | | | | | | minReads=(Right 0) | | | | | | | | mayRaise=[] | | | | | | | | refJoin | | | | | | | | minReads=(Right 0) | | | | | | | | mayRaise=[] -| | | | | | | catchException "fail" +| | | | | | | catch ExceptionFailure | | | | | | | minReads=(Right 4) | | | | | | | mayRaise=[] | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | minReads=(Right 4) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | minReads=(Right 4) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | minReads=(Right 4) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 4) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | call | | | | | | | | | minReads=(Right 4) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 2) | | | | | | | | | mayRaise=[] | | | | | | | | | join | | | | | | | | | minReads=(Right 2) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | call | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | mayRaise=[] -| | | | | | | | | | popException "fail" +| | | | | | | | | | commit ExceptionFailure | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | mayRaise=[] | | | | | | | | | | refJoin | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | mayRaise=[] -| | | | | | | | | catchException "fail" +| | | | | | | | | catch ExceptionFailure | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] | | | | | | | | | | @@ -2658,7 +2658,7 @@ let | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] -| | | | | | | | | | | popException "fail" +| | | | | | | | | | | commit ExceptionFailure | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | refJoin @@ -2667,13 +2667,13 @@ let | | | | | | | | | | | | | | | | | | | | | pushInput | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value Term | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | choicesBranch [(\u1 -> u1)] | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | | | | | call | | | | | | | | | | | | | minReads=(Right 0) @@ -2682,40 +2682,40 @@ let | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | -| | | | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | | | fail fromList [] +| | | | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | pushInput | | | | | | | | | minReads=(Right 5) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value Term | | | | | | | | | minReads=(Right 5) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | choicesBranch [(\u1 -> u1)] | | | | | | | | | minReads=(Right 5) -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | call | | | | | | | | | | | minReads=(Right 5) -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | refJoin | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] | | | | | | | | | | -| | | | | | | | | | | raiseException "fail" -| | | | | | | | | | | minReads=(Left "fail") -| | | | | | | | | | | mayRaise=["fail"] +| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushInput | | | | | | | minReads=(Right 0) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value Term | | | | | | | minReads=(Right 0) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | choicesBranch [(\u1 -> u1)] | | | | | | | minReads=(Right 0) -| | | | | | | mayRaise=["fail"] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | call | | | | | | | | | minReads=(Right 0) @@ -2724,13 +2724,13 @@ let | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] | | | | | | | | -| | | | | | | | | raiseException "fail" -| | | | | | | | | minReads=(Left "fail") -| | | | | | | | | mayRaise=["fail"] +| | | | | | | | | fail fromList [] +| | | | | | | | | minReads=(Left ExceptionFailure) +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 2) mayRaise=[] @@ -2758,26 +2758,26 @@ let | | ret | | minReads=(Right 0) | | mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 5) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue Term | | | minReads=(Right 5) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 5) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 5) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | refJoin @@ -2786,13 +2786,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | call | | | | | minReads=(Right 0) @@ -2801,9 +2801,9 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 2) mayRaise=[] @@ -2873,40 +2873,40 @@ let | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) | mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 2) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read Term | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -2924,19 +2924,19 @@ let | | | mayRaise=[] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] -| | | popException "fail" +| | | mayRaise=[ExceptionFailure] +| | | commit ExceptionFailure | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -2945,71 +2945,71 @@ let | | | mayRaise=[] | | | | | loadInput -| | | minReads=(Left "fail") -| | | mayRaise=["fail"] -| | | raiseException "fail" -| | | minReads=(Left "fail") -| | | mayRaise=["fail"] +| | | minReads=(Left ExceptionFailure) +| | | mayRaise=[ExceptionFailure] +| | | fail fromList [] +| | | minReads=(Left ExceptionFailure) +| | | mayRaise=[ExceptionFailure] let minReads=(Right 4) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue '{' | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read ('{' ==) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 3) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 3) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 3) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -3027,28 +3027,28 @@ let | mayRaise=[] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue '}' | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read ('}' ==) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -3069,121 +3069,121 @@ let | mayRaise=[] let minReads=(Right 5) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 5) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 5) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 5) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 5) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 5) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 5) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue '[' | minReads=(Right 5) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 5) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read ('[' ==) | minReads=(Right 5) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 4) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 2) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue Term | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue Term | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue ']' | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read (']' ==) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -3204,22 +3204,22 @@ let | mayRaise=[] pushValue Term minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] pushValue (\u1 -> u1) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] call minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] @@ -3274,32 +3274,32 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 0) mayRaise=[] | -| | catchException "fail" +| | catch ExceptionFailure | | minReads=(Right 0) | | mayRaise=[] | | | | | | | pushInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | read (\u1 -> Term) -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | popValue -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | popException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | commit ExceptionFailure +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | loadInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | | | | loadInput | | | | minReads=(Right 0) @@ -3307,7 +3307,7 @@ catchException "fail" | | | | pushValue Term | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | refJoin @@ -3315,19 +3315,19 @@ catchException "fail" | | | | mayRaise=[] | | | pushInput -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | lift2Value Term -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [FailureEnd] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G15.expected.txt b/test/Golden/Machine/G15.expected.txt index e04827e..ab66d2a 100644 --- a/test/Golden/Machine/G15.expected.txt +++ b/test/Golden/Machine/G15.expected.txt @@ -6,22 +6,22 @@ pushValue (\u1 -> (\u2 -> u1)) mayRaise=[] join minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue 'c' | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read ('c' ==) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -34,26 +34,26 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 1) mayRaise=[] | | | pushValue (\u1 -> (\u2 -> u1)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue 'a' | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | read ('a' ==) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 0) | | mayRaise=[] -| | popException "fail" +| | commit ExceptionFailure | | minReads=(Right 0) | | mayRaise=[] | | refJoin @@ -62,26 +62,26 @@ catchException "fail" | | | pushInput | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value Term | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue 'b' | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | read ('b' ==) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] @@ -89,6 +89,6 @@ catchException "fail" | | | | minReads=(Right 0) | | | | mayRaise=[] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G16.expected.txt b/test/Golden/Machine/G16.expected.txt index 442113d..9c7bbd4 100644 --- a/test/Golden/Machine/G16.expected.txt +++ b/test/Golden/Machine/G16.expected.txt @@ -6,22 +6,22 @@ pushValue (\u1 -> (\u2 -> u1)) mayRaise=[] join minReads=(Right 1) - mayRaise=["fail"] + mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | pushValue 'd' | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | read ('d' ==) | minReads=(Right 1) -| mayRaise=["fail"] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -34,39 +34,39 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 1) mayRaise=[] | | | join | | minReads=(Right 1) -| | mayRaise=["fail"] -| | | popException "fail" +| | mayRaise=[ExceptionFailure] +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | refJoin | | | minReads=(Right 0) | | | mayRaise=[] -| | catchException "fail" +| | catch ExceptionFailure | | minReads=(Right 1) | | mayRaise=[] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue 'a' | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | read ('a' ==) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | refJoin @@ -75,26 +75,26 @@ catchException "fail" | | | | | | | pushInput | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value Term | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | choicesBranch [(\u1 -> u1)] | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | pushValue 'b' | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | read ('b' ==) | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] @@ -102,32 +102,32 @@ catchException "fail" | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] | | | | | -| | | | | | raiseException "fail" -| | | | | | minReads=(Left "fail") -| | | | | | mayRaise=["fail"] +| | | | | | fail fromList [] +| | | | | | minReads=(Left ExceptionFailure) +| | | | | | mayRaise=[ExceptionFailure] | | | pushInput | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value Term | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue 'c' | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | read ('c' ==) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] @@ -135,6 +135,6 @@ catchException "fail" | | | | minReads=(Right 0) | | | | mayRaise=[] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G2.expected.txt b/test/Golden/Machine/G2.expected.txt index 5d9b057..c8bf11c 100644 --- a/test/Golden/Machine/G2.expected.txt +++ b/test/Golden/Machine/G2.expected.txt @@ -1,67 +1,67 @@ pushValue Term minReads=(Right 3) mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 3) mayRaise=[] | | | pushValue cons | | minReads=(Right 3) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue (\u1 -> (\u2 -> u1)) | | minReads=(Right 3) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue 'a' | | minReads=(Right 3) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 3) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | read ('a' ==) | | minReads=(Right 3) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue cons | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue (\u1 -> (\u2 -> u1)) | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue 'b' | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | read ('b' ==) | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue cons | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue (\u1 -> (\u2 -> u1)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue 'c' | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | read ('c' ==) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 0) | | mayRaise=[] @@ -80,7 +80,7 @@ catchException "fail" | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 0) | | mayRaise=[] -| | popException "fail" +| | commit ExceptionFailure | | minReads=(Right 0) | | mayRaise=[] | | lift2Value (\u1 -> (\u2 -> u1 u2)) @@ -91,8 +91,8 @@ catchException "fail" | | mayRaise=[] | | | loadInput -| | minReads=(Left "fail") -| | mayRaise=["fail"] -| | raiseException "fail" -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] +| | fail fromList [] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G3.expected.txt b/test/Golden/Machine/G3.expected.txt index cc1773b..91cb518 100644 --- a/test/Golden/Machine/G3.expected.txt +++ b/test/Golden/Machine/G3.expected.txt @@ -1,28 +1,28 @@ let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'a' | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('a' ==) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -38,7 +38,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -47,13 +47,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -62,9 +62,9 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G4.expected.txt b/test/Golden/Machine/G4.expected.txt index 046a9c5..012cf54 100644 --- a/test/Golden/Machine/G4.expected.txt +++ b/test/Golden/Machine/G4.expected.txt @@ -1,7 +1,7 @@ let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | @@ -26,7 +26,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -35,13 +35,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -50,94 +50,94 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 4) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 4) | mayRaise=[] | | | | | pushValue cons | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'a' | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('a' ==) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'b' | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('b' ==) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'c' | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('c' ==) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'd' | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('d' ==) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -159,7 +159,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -167,11 +167,11 @@ let | | | mayRaise=[] | | | | | loadInput -| | | minReads=(Left "fail") -| | | mayRaise=["fail"] -| | | raiseException "fail" -| | | minReads=(Left "fail") -| | | mayRaise=["fail"] +| | | minReads=(Left ExceptionFailure) +| | | mayRaise=[ExceptionFailure] +| | | fail fromList [] +| | | minReads=(Left ExceptionFailure) +| | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 4) mayRaise=[] diff --git a/test/Golden/Machine/G5.expected.txt b/test/Golden/Machine/G5.expected.txt index 63f8788..ce747f0 100644 --- a/test/Golden/Machine/G5.expected.txt +++ b/test/Golden/Machine/G5.expected.txt @@ -1,7 +1,7 @@ let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | @@ -26,7 +26,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -35,13 +35,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -50,94 +50,94 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] let minReads=(Right 4) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 4) | mayRaise=[] | | | | | pushValue cons | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'a' | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('a' ==) | | | minReads=(Right 4) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'b' | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('b' ==) | | | minReads=(Right 3) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'c' | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('c' ==) | | | minReads=(Right 2) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'd' | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('d' ==) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -159,7 +159,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -167,11 +167,11 @@ let | | | mayRaise=[] | | | | | loadInput -| | | minReads=(Left "fail") -| | | mayRaise=["fail"] -| | | raiseException "fail" -| | | minReads=(Left "fail") -| | | mayRaise=["fail"] +| | | minReads=(Left ExceptionFailure) +| | | mayRaise=[ExceptionFailure] +| | | fail fromList [] +| | | minReads=(Left ExceptionFailure) +| | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 4) mayRaise=[] @@ -214,32 +214,32 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 0) mayRaise=[] | -| | catchException "fail" +| | catch ExceptionFailure | | minReads=(Right 0) | | mayRaise=[] | | | | | | | pushInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | read (\u1 -> Term) -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | popValue -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | popException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | commit ExceptionFailure +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | loadInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | | | | loadInput | | | | minReads=(Right 0) @@ -247,7 +247,7 @@ catchException "fail" | | | | pushValue Term | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | refJoin @@ -255,19 +255,19 @@ catchException "fail" | | | | mayRaise=[] | | | pushInput -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | lift2Value Term -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [FailureEnd] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G6.expected.txt b/test/Golden/Machine/G6.expected.txt index 3be8baa..4110d2c 100644 --- a/test/Golden/Machine/G6.expected.txt +++ b/test/Golden/Machine/G6.expected.txt @@ -10,46 +10,46 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 2) mayRaise=[] | | | pushValue cons | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue (\u1 -> (\u2 -> u1)) | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue 'a' | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | read ('a' ==) | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue cons | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue (\u1 -> (\u2 -> u1)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | pushValue 'a' | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | read ('a' ==) | | minReads=(Right 1) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 0) | | mayRaise=[] @@ -65,7 +65,7 @@ catchException "fail" | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | minReads=(Right 0) | | mayRaise=[] -| | popException "fail" +| | commit ExceptionFailure | | minReads=(Right 0) | | mayRaise=[] | | refJoin @@ -74,50 +74,50 @@ catchException "fail" | | | pushInput | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value Term | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | | | | | | pushValue cons | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue 'a' | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | read ('a' ==) | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue cons | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue 'b' | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | read ('b' ==) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] @@ -137,6 +137,6 @@ catchException "fail" | | | | minReads=(Right 0) | | | | mayRaise=[] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G7.expected.txt b/test/Golden/Machine/G7.expected.txt index d02eab8..de295fa 100644 --- a/test/Golden/Machine/G7.expected.txt +++ b/test/Golden/Machine/G7.expected.txt @@ -10,50 +10,50 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 2) mayRaise=[] | -| | catchException "fail" +| | catch ExceptionFailure | | minReads=(Right 2) | | mayRaise=[] | | | | | | | pushValue cons | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue 'a' | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | read ('a' ==) | | | | minReads=(Right 2) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue cons | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | pushValue 'a' | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | read ('a' ==) | | | | minReads=(Right 1) -| | | | mayRaise=["fail"] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] @@ -69,10 +69,10 @@ catchException "fail" | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | refJoin @@ -80,62 +80,62 @@ catchException "fail" | | | | mayRaise=[] | | | | | | | loadInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | pushInput | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | lift2Value Term | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] | | minReads=(Right 2) -| | mayRaise=["fail"] +| | mayRaise=[ExceptionFailure] | | | -| | | | catchException "fail" +| | | | catch ExceptionFailure | | | | minReads=(Right 2) | | | | mayRaise=[] | | | | | | | | | | | pushValue cons | | | | | | minReads=(Right 2) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | minReads=(Right 2) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | pushValue 'a' | | | | | | minReads=(Right 2) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 2) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | read ('a' ==) | | | | | | minReads=(Right 2) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | pushValue cons | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | pushValue 'b' | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | read ('b' ==) | | | | | | minReads=(Right 1) -| | | | | | mayRaise=["fail"] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] @@ -151,7 +151,7 @@ catchException "fail" | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] -| | | | | | popException "fail" +| | | | | | commit ExceptionFailure | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] | | | | | | refJoin @@ -159,12 +159,12 @@ catchException "fail" | | | | | | mayRaise=[] | | | | | | | | | | | loadInput -| | | | | | minReads=(Left "fail") -| | | | | | mayRaise=["fail"] -| | | | | | raiseException "fail" -| | | | | | minReads=(Left "fail") -| | | | | | mayRaise=["fail"] +| | | | | | minReads=(Left ExceptionFailure) +| | | | | | mayRaise=[ExceptionFailure] +| | | | | | fail fromList [] +| | | | | | minReads=(Left ExceptionFailure) +| | | | | | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G8.expected.txt b/test/Golden/Machine/G8.expected.txt index 1a87cc1..a64abda 100644 --- a/test/Golden/Machine/G8.expected.txt +++ b/test/Golden/Machine/G8.expected.txt @@ -1,28 +1,28 @@ let minReads=(Right 0) mayRaise=[] -| catchException "fail" +| catch ExceptionFailure | minReads=(Right 0) | mayRaise=[] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | pushValue 'r' | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | read ('r' ==) | | | minReads=(Right 1) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -38,7 +38,7 @@ let | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] -| | | popException "fail" +| | | commit ExceptionFailure | | | minReads=(Right 0) | | | mayRaise=[] | | | ret @@ -47,13 +47,13 @@ let | | | | | pushInput | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | lift2Value Term | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | choicesBranch [(\u1 -> u1)] | | | minReads=(Right 0) -| | | mayRaise=["fail"] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 0) @@ -62,9 +62,9 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | raiseException "fail" -| | | | | minReads=(Left "fail") -| | | | | mayRaise=["fail"] +| | | | | fail fromList [] +| | | | | minReads=(Left ExceptionFailure) +| | | | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) mayRaise=[] @@ -95,32 +95,32 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 0) mayRaise=[] | -| | catchException "fail" +| | catch ExceptionFailure | | minReads=(Right 0) | | mayRaise=[] | | | | | | | pushInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | read (\u1 -> Term) -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | popValue -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | popException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | commit ExceptionFailure +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | loadInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | | | | loadInput | | | | minReads=(Right 0) @@ -128,7 +128,7 @@ catchException "fail" | | | | pushValue Term | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | refJoin @@ -136,19 +136,19 @@ catchException "fail" | | | | mayRaise=[] | | | pushInput -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | lift2Value Term -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [FailureEnd] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G9.expected.txt b/test/Golden/Machine/G9.expected.txt index e321a20..5b4ea7f 100644 --- a/test/Golden/Machine/G9.expected.txt +++ b/test/Golden/Machine/G9.expected.txt @@ -10,32 +10,32 @@ join | ret | minReads=(Right 0) | mayRaise=[] -catchException "fail" +catch ExceptionFailure minReads=(Right 0) mayRaise=[] | -| | catchException "fail" +| | catch ExceptionFailure | | minReads=(Right 0) | | mayRaise=[] | | | | | | | pushInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | read (\u1 -> Term) -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | popValue -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | popException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | commit ExceptionFailure +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | loadInput -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | | | | | loadInput | | | | minReads=(Right 0) @@ -43,7 +43,7 @@ catchException "fail" | | | | pushValue Term | | | | minReads=(Right 0) | | | | mayRaise=[] -| | | | popException "fail" +| | | | commit ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | | refJoin @@ -51,19 +51,19 @@ catchException "fail" | | | | mayRaise=[] | | | pushInput -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | lift2Value Term -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | choicesBranch [(\u1 -> u1)] -| | minReads=(Left "fail") -| | mayRaise=["fail"] +| | minReads=(Left ExceptionFailure) +| | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [FailureEnd] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] | | | -| | | | raiseException "fail" -| | | | minReads=(Left "fail") -| | | | mayRaise=["fail"] +| | | | fail fromList [] +| | | | minReads=(Left ExceptionFailure) +| | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Splice/G1.expected.txt b/test/Golden/Splice/G1.expected.txt index 259d668..b5a7fc2 100644 --- a/test/Golden/Splice/G1.expected.txt +++ b/test/Golden/Splice/G1.expected.txt @@ -27,83 +27,106 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let + in let readFail = finalRaise + in if readMore init + then + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let - in let readFail = finalRaise - in if readMore init - then - let !(# c, cs #) = readNext init - in if ('a' GHC.Classes.==) c - then - let _ = "resume" - in finalRet init GHC.Types - . [] - ( let _ = "resume.genCode" - in GHC.Show.show 'a' + let _ = "resume" + in finalRet + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in GHC.Show.show 'a' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in finalRaise init farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in finalRaise init farInp farExp + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G10.expected.txt b/test/Golden/Splice/G10.expected.txt index 5e461b5..e669c0e 100644 --- a/test/Golden/Splice/G10.expected.txt +++ b/test/Golden/Splice/G10.expected.txt @@ -27,193 +27,217 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let - in let join = \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show v - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - init - failInp - then - let _ = "choicesBranch.then" - in let readFail = finalRaise - in if readMore failInp - then - let !(# - c, - cs - #) = readNext failInp - in if ('b' GHC.Classes.==) c - then - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in 'b' - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let readFail = finalRaise + in if readMore failInp + then + let !(# + c, + cs + #) = readNext failInp + in if ('b' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore init - then - let !(# c, cs #) = readNext init - in if ('a' GHC.Classes.==) c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' + ( let _ = "resume.genCode" + in 'b' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore init + then + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in 'a' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G11.expected.txt b/test/Golden/Splice/G11.expected.txt index c4d033b..951a9d6 100644 --- a/test/Golden/Splice/G11.expected.txt +++ b/test/Golden/Splice/G11.expected.txt @@ -27,208 +27,231 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if ('a' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> 'a' GHC.Types.: v x + ) + inp ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if ('a' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> 'a' GHC.Types.: v x - ) - inp + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let readFail = finalRaise + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if ('b' GHC.Classes.==) c + then + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show (v GHC.Types . []) ) cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let readFail = finalRaise - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if ('b' GHC.Classes.==) c - then - let _ = "resume" - in finalRet - farInp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, farExp - ( let _ = "resume.genCode" - in GHC.Show.show (v GHC.Types . []) - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise inp farInp farExp - ) - init - Data.Map.Internal.Tip + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + ) + init + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G12.expected.txt b/test/Golden/Splice/G12.expected.txt index d4a412b..f15487c 100644 --- a/test/Golden/Splice/G12.expected.txt +++ b/test/Golden/Splice/G12.expected.txt @@ -27,300 +27,256 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\t -> ('a' GHC.Classes.== t) GHC.Classes.|| (('b' GHC.Classes.== t) GHC.Classes.|| (('c' GHC.Classes.== t) GHC.Classes.|| (('d' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> c GHC.Types.: v x + ) + inp ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'd' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\t -> ('a' GHC.Classes.== t) GHC.Classes.|| (('b' GHC.Classes.== t) GHC.Classes.|| (('c' GHC.Classes.== t) GHC.Classes.|| (('d' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> c GHC.Types.: v x - ) - inp - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let join = \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show (v GHC.Types . []) - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> GHC.Types.True) c - then - let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler inp farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - ) - init - Data.Map.Internal.Tip + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show (v GHC.Types . []) + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\x -> GHC.Types.True) c + then catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkToken.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + ) + init + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G13.expected.txt b/test/Golden/Splice/G13.expected.txt index 0ee1d9f..beec063 100644 --- a/test/Golden/Splice/G13.expected.txt +++ b/test/Golden/Splice/G13.expected.txt @@ -27,874 +27,997 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let name = \(!ok) (!inp) (!koByLabel) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v GHC.Types . [] ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let name = \(!ok) (!inp) (!koByLabel) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in v GHC.Types . [] - ) - inp - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ + inp + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v GHC.Types.: v x + ) + inp ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let join = \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v GHC.Types.: v x - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> \x -> x) GHC.Types.True c + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c + then + if '>' GHC.Classes.== c then - if '>' GHC.Classes.== c - then - let _ = "choicesBranch.then" - in let readFail = readFail - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> \x -> x) GHC.Types.True c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in Grammar.Brainfuck.RightPointer - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "choicesBranch.else" - in if '<' GHC.Classes.== c + let _ = "choicesBranch.then" + in let readFail = readFail + in if readMore inp then - let _ = "choicesBranch.then" - in let readFail = readFail - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> \x -> x) GHC.Types.True c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in Grammar.Brainfuck.LeftPointer - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp + let !(# + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in Grammar.Brainfuck.RightPointer + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureAny @tok' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else - let _ = "choicesBranch.else" - in if '+' GHC.Classes.== c + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "choicesBranch.else" + in if '<' GHC.Classes.== c + then + let _ = "choicesBranch.then" + in let readFail = readFail + in if readMore inp then - let _ = "choicesBranch.then" - in let readFail = readFail - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> \x -> x) GHC.Types.True c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in Grammar.Brainfuck.Increment - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp + let !(# + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in Grammar.Brainfuck.LeftPointer + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureAny @tok' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else - let _ = "choicesBranch.else" - in if '-' GHC.Classes.== c + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "choicesBranch.else" + in if '+' GHC.Classes.== c + then + let _ = "choicesBranch.then" + in let readFail = readFail + in if readMore inp then - let _ = "choicesBranch.then" - in let readFail = readFail - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> \x -> x) GHC.Types.True c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in Grammar.Brainfuck.Decrement - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp + let !(# + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Increment + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureAny @tok' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else - let _ = "choicesBranch.else" - in if '.' GHC.Classes.== c + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "choicesBranch.else" + in if '-' GHC.Classes.== c + then + let _ = "choicesBranch.then" + in let readFail = readFail + in if readMore inp then - let _ = "choicesBranch.then" - in let readFail = readFail - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> \x -> x) GHC.Types.True c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in Grammar.Brainfuck.Output - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp + let !(# + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Decrement + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureAny @tok' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else - let _ = "choicesBranch.else" - in if ',' GHC.Classes.== c + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "choicesBranch.else" + in if '.' GHC.Classes.== c + then + let _ = "choicesBranch.then" + in let readFail = readFail + in if readMore inp then - let _ = "choicesBranch.then" - in let readFail = readFail - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> \x -> x) GHC.Types.True c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in Grammar.Brainfuck.Input - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp + let !(# + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Output + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureAny @tok' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else - let _ = "choicesBranch.else" - in if '[' GHC.Classes.== c + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "choicesBranch.else" + in if ',' GHC.Classes.== c + then + let _ = "choicesBranch.then" + in let readFail = readFail + in if readMore inp then - let _ = "choicesBranch.then" - in let readFail = readFail - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> \x -> x) GHC.Types.True c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let readFail = readFail - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (']' GHC.Classes.==) c - then - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in Grammar.Brainfuck.Loop v - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - ) - inp - Data.Map.Internal.Tip - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp + let !(# + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Input + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureAny @tok' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else - let _ = "choicesBranch.else" - in let (# + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# farInp, farExp #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# inp, - [] + failExp #) GHC.Types.EQ -> (# init, - GHC.Types . [] GHC.Base.<> [] + failExp GHC.Base.<> Data.Set.Internal.empty #) GHC.Types.GT -> (# init, - GHC.Types . [] + Data.Set.Internal.empty #) - in readFail inp farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\c -> GHC.Classes.not (('<' GHC.Classes.== c) GHC.Classes.|| (('>' GHC.Classes.== c) GHC.Classes.|| (('+' GHC.Classes.== c) GHC.Classes.|| (('-' GHC.Classes.== c) GHC.Classes.|| (('[' GHC.Classes.== c) GHC.Classes.|| ((']' GHC.Classes.== c) GHC.Classes.|| ((',' GHC.Classes.== c) GHC.Classes.|| (('.' GHC.Classes.== c) GHC.Classes.|| (('$' GHC.Classes.== c) GHC.Classes.|| GHC.Types.False)))))))))) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v x - ) - inp - ) - cs - Data.Map.Internal.Tip + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "choicesBranch.else" + in if '[' GHC.Classes.== c + then + let _ = "choicesBranch.then" + in let readFail = readFail + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if (\x -> \x -> x) GHC.Types.True c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let readFail = readFail + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (']' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in Grammar.Brainfuck.Loop v + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ']' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + ) + inp + Data.Map.Internal.Tip + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureAny @tok' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "choicesBranch.else" + in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEmpty) Data.Set.Internal.Tip Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkToken.else" - in let (# + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureAny @tok' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# farInp, farExp #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# inp, - [ Symantic.Parser.Grammar.Combinators.ErrorItemToken '<', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '>', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '+', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '-', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '[', - Symantic.Parser.Grammar.Combinators.ErrorItemToken ']', - Symantic.Parser.Grammar.Combinators.ErrorItemToken ',', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '.', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '$' - ] + failExp #) GHC.Types.EQ -> (# init, - GHC.Types . [] - GHC.Base.<> [ Symantic.Parser.Grammar.Combinators.ErrorItemToken '<', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '>', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '+', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '-', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '[', - Symantic.Parser.Grammar.Combinators.ErrorItemToken ']', - Symantic.Parser.Grammar.Combinators.ErrorItemToken ',', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '.', - Symantic.Parser.Grammar.Combinators.ErrorItemToken '$' - ] + failExp GHC.Base.<> Data.Set.Internal.empty #) GHC.Types.GT -> (# init, - GHC.Types . [] + Data.Set.Internal.empty #) - in readFail inp farInp farExp + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" - in let (# + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# farInp, farExp #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of GHC.Types.LT -> (# inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + failExp #) GHC.Types.EQ -> (# init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] + failExp GHC.Base.<> Data.Set.Internal.empty #) GHC.Types.GT -> (# init, - GHC.Types . [] + Data.Set.Internal.empty #) - in readFail inp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok farInp farExp ( let _ = "resume.genCode" - in GHC.Show.show v + in \x -> x ) - inp - ) - inp - Data.Map.Internal.Tip - ) - init - Data.Map.Internal.Tip + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\c -> GHC.Classes.not (('<' GHC.Classes.== c) GHC.Classes.|| (('>' GHC.Classes.== c) GHC.Classes.|| (('+' GHC.Classes.== c) GHC.Classes.|| (('-' GHC.Classes.== c) GHC.Classes.|| (('[' GHC.Classes.== c) GHC.Classes.|| ((']' GHC.Classes.== c) GHC.Classes.|| ((',' GHC.Classes.== c) GHC.Classes.|| (('.' GHC.Classes.== c) GHC.Classes.|| (('$' GHC.Classes.== c) GHC.Classes.|| GHC.Types.False)))))))))) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp init Data.Set.Internal.empty + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + init + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G14.expected.txt b/test/Golden/Splice/G14.expected.txt index 51db5ad..b327612 100644 --- a/test/Golden/Splice/G14.expected.txt +++ b/test/Golden/Splice/G14.expected.txt @@ -27,2243 +27,2238 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let name = \(!ok) (!inp) (!koByLabel) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let name = \(!ok) (!inp) (!koByLabel) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - (Data.Map.Internal.Bin 1 "fail" (Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) - name = \(!ok) (!inp) (!koByLabel) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let join = \farInp farExp v (!inp) -> + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> let _ = "resume" in ok farInp farExp ( let _ = "resume.genCode" - in v + in GHC.Tuple . () ) inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - failInp - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if GHC.Unicode.isSpace c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "space"] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "space"] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\t -> ('0' GHC.Classes.== t) GHC.Classes.|| (('1' GHC.Classes.== t) GHC.Classes.|| (('2' GHC.Classes.== t) GHC.Classes.|| (('3' GHC.Classes.== t) GHC.Classes.|| (('4' GHC.Classes.== t) GHC.Classes.|| (('5' GHC.Classes.== t) GHC.Classes.|| (('6' GHC.Classes.== t) GHC.Classes.|| (('7' GHC.Classes.== t) GHC.Classes.|| (('8' GHC.Classes.== t) GHC.Classes.|| (('9' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))))))))) c - then - let _ = "resume" - in ok init GHC.Types - . [] - ( let _ = "resume.genCode" - in c - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('(' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in '(' - ) - inp - ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '('] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '('] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if (')' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in ')' - ) - inp - ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ')'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ')'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) + name = \(!ok) (!inp) (!koByLabel) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if (',' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in ',' - ) - inp + ( let _ = "resume.genCode" + in v ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ','] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ','] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if (';' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in ';' + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ ) - inp - ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ';'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ';'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('{' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let readFail = readFail - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if ('}' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '}'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '}'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v ) inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if GHC.Unicode.isSpace c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v ) inp - Data.Map.Internal.Tip + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp init Data.Set.Internal.empty + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\t -> ('0' GHC.Classes.== t) GHC.Classes.|| (('1' GHC.Classes.== t) GHC.Classes.|| (('2' GHC.Classes.== t) GHC.Classes.|| (('3' GHC.Classes.== t) GHC.Classes.|| (('4' GHC.Classes.== t) GHC.Classes.|| (('5' GHC.Classes.== t) GHC.Classes.|| (('6' GHC.Classes.== t) GHC.Classes.|| (('7' GHC.Classes.== t) GHC.Classes.|| (('8' GHC.Classes.== t) GHC.Classes.|| (('9' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))))))))) c + then + let _ = "resume" + in ok + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in c ) cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '{'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '{'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise "fail" koByLabel - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 4 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('[' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let readFail = readFail - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (']' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ']'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - ) - inp - Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '9' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('(' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in '(' ) inp - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '['] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '['] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 5] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 5] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in name + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '(' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if (')' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in ')' + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ')' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if (',' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in ',' + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ',' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if (';' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in ';' + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ';' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('{' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name ( let _ = "suspend" in \farInp farExp v (!inp) -> - let join = \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in v + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let readFail = readFail + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if ('}' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '}' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in name + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '{' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 4 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('[' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let readFail = readFail + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (']' GHC.Classes.==) c + then + name ( let _ = "suspend" in \farInp farExp v (!inp) -> let _ = "resume" - in join + in ok farInp farExp ( let _ = "resume.genCode" - in v + in GHC.Tuple . () ) inp ) - failInp - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ']' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '[' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 5 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if Grammar.Nandlang.nandIdentStart c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp init Data.Set.Internal.empty + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp farExp - #) - in finalRaise failInp farInp farExp - in let join = \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () + ( let _ = "resume.genCode" + in v + ) + inp ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + failInp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip ) inp - ) - failInp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let join = \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('\'' GHC.Classes.==) c + then + let join = \farInp farExp v (!inp) -> + let readFail = readFail + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('\'' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '\'' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + cs + failInp + then + let _ = "choicesBranch.then" + in let readFail = readFail + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('\\' GHC.Classes.==) c then - let _ = "choicesBranch.then" - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - failInp - Data.Map.Internal.Tip + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if (\t -> ('0' GHC.Classes.== t) GHC.Classes.|| (('t' GHC.Classes.== t) GHC.Classes.|| (('n' GHC.Classes.== t) GHC.Classes.|| (('v' GHC.Classes.== t) GHC.Classes.|| (('f' GHC.Classes.== t) GHC.Classes.|| (('r' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))))) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'r' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else - let _ = "choicesBranch.else" - in let (# + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '\\' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# farInp, farExp #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# failInp, - [] + failExp #) GHC.Types.EQ -> (# farInp, - farExp GHC.Base.<> [] + failExp GHC.Base.<> farExp #) GHC.Types.GT -> (# farInp, farExp #) - in catchHandler failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in let !(# + c, + cs + #) = readNext cs + in if Grammar.Nandlang.nandStringLetter c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '\'' + ) ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp ) - failInp - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let join = \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 failInp) - then - let !(# - c, - cs - #) = readNext failInp - in if ('\'' GHC.Classes.==) c + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) then - let join = \farInp farExp v (!inp) -> - let readFail = readFail - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('\'' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp + let !(# + c, + cs + #) = readNext failInp + in if ('1' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in '1' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '1' ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# farInp, farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - cs - failInp - then - let _ = "choicesBranch.then" - in let readFail = readFail - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 failInp) - then - let !(# - c, - cs - #) = readNext failInp - in if ('\\' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if (\t -> ('0' GHC.Classes.== t) GHC.Classes.|| (('t' GHC.Classes.== t) GHC.Classes.|| (('n' GHC.Classes.== t) GHC.Classes.|| (('v' GHC.Classes.== t) GHC.Classes.|| (('f' GHC.Classes.== t) GHC.Classes.|| (('r' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))))) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "oneOf"] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\\'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\\'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - in let readFail = catchHandler - in let !(# - c, - cs - #) = readNext cs - in if Grammar.Nandlang.nandStringLetter c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "Char"] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "Char"] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler cs farInp farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else - let _ = "checkToken.else" - in let (# + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# farInp, farExp #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + failExp #) GHC.Types.EQ -> (# farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '\''] + failExp GHC.Base.<> farExp #) GHC.Types.GT -> (# farInp, farExp #) - in readFail failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('0' GHC.Classes.==) c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in '0' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '0' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip (# farInp, farExp - #) - in catchHandler failInp farInp farExp - in let join = \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) - then - let !(# - c, - cs - #) = readNext failInp - in if ('1' GHC.Classes.==) c - then - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in '1' - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '1'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '1'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('0' GHC.Classes.==) c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in '0' - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '0'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '0'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "jump" + in name ok failInp Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "jump" - in name ok failInp Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v v (v x) - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v v (v x) + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v v (v x) - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v v (v x) + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v v (v x) - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v v (v x) + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v v (v x) - ) - inp - ) - inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v v (v x) + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x ) inp - Data.Map.Internal.Tip - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v x - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v x - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) + ) inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let join = \farInp farExp v (!inp) -> + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -2278,1905 +2273,1824 @@ ) inp Data.Map.Internal.Tip - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + inp + Data.Map.Internal.Tip + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) inp - failInp - then - let _ = "choicesBranch.then" - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp failInp - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let join = \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let join = \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('=' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - inp - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip + then + let _ = "choicesBranch.then" + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('=' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '=' ) - inp - Data.Map.Internal.Tip - ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '='] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '='] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + failInp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v ) inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - failInp - failInp - then - let _ = "choicesBranch.then" - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 10 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('v' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('r' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'r' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'v' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - failInp - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 10 failInp) - then - let !(# + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 11 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 10 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('w' GHC.Classes.==) c + then + let readFail = readFail + in let !(# c, cs - #) = readNext failInp - in if ('v' GHC.Classes.==) c + #) = readNext cs + in if ('h' GHC.Classes.==) c then let readFail = readFail in let !(# c, cs #) = readNext cs - in if ('a' GHC.Classes.==) c + in if ('i' GHC.Classes.==) c then let readFail = readFail in let !(# c, cs #) = readNext cs - in if ('r' GHC.Classes.==) c + in if ('l' GHC.Classes.==) c then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - ) - cs - Data.Map.Internal.Tip + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('e' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'e' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" - in let (# + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'l' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# farInp, farExp #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of GHC.Types.LT -> (# cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] + failExp #) GHC.Types.EQ -> (# farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] + failExp GHC.Base.<> farExp #) GHC.Types.GT -> (# farInp, farExp #) - in readFail cs farInp farExp + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" - in let (# + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'i' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# farInp, farExp #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of GHC.Types.LT -> (# cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + failExp #) GHC.Types.EQ -> (# farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] + failExp GHC.Base.<> farExp #) GHC.Types.GT -> (# farInp, farExp #) - in readFail cs farInp farExp + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" - in let (# + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'h' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# farInp, farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of GHC.Types.LT -> (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'v'] + cs, + failExp #) GHC.Types.EQ -> (# farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'v'] + failExp GHC.Base.<> farExp #) GHC.Types.GT -> (# farInp, farExp #) - in readFail failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'w' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 11 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('i' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('f' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let join = \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 10 failInp) - then - let !(# - c, - cs - #) = readNext failInp - in if ('w' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('h' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('i' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('l' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('e' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp - Data.Map.Internal.Tip - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'e'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'e'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'l'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'l'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'h'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'h'] - #) - GHC.Types.GT -> + ( let _ = "resume.genCode" + in v + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'f' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'i' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if Grammar.Nandlang.nandIdentLetter c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp init Data.Set.Internal.empty + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('!' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '!' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 17 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('f' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('u' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('n' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('c' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('t' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('i' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('o' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('n' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v x + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + ) + failInp + Data.Map.Internal.Tip + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) + then + let !(# + c, + cs + #) = readNext inp + in if (':' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + cs + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ':' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + ) + inp + Data.Map.Internal.Tip + ) + inp + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) + ) + inp + Data.Map.Internal.Tip + ) + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'n' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'o' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip (# farInp, farExp - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'w'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'w'] - #) - GHC.Types.GT -> + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'i' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip (# farInp, farExp - #) - in readFail failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 11] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler inp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('i' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('f' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if Grammar.Nandlang.nandIdentLetter c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v x + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 't' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'n' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'u' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'f' + ) ) - inp - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identLetter"] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identLetter"] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('!' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v x - ) - inp - ) - inp - Data.Map.Internal.Tip + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 18 ) - inp - Data.Map.Internal.Tip - ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken '!'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken '!'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler inp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 17 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('f' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('u' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('n' GHC.Classes.==) c + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "resume" + in ok + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "resume" + in ok + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "resume" + in ok + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in \x -> \x -> x + ) + inp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('c' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('t' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('i' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('o' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('n' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let join = \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v x - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - failInp - Data.Map.Internal.Tip - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if (':' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - cs - (Data.Map.Internal.Bin 1 "fail" readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken ':'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken ':'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - ) - inp - Data.Map.Internal.Tip - ) - inp - (Data.Map.Internal.Bin 1 "fail" catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) - ) - inp - Data.Map.Internal.Tip - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'o'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'o'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'i'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 't'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 't'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# + let _ = "choicesBranch.then" + in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip + (# farInp, farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + failInp, + failExp #) GHC.Types.EQ -> (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'n'] + farInp, + failExp GHC.Base.<> farExp #) GHC.Types.GT -> (# - init, - GHC.Types . [] + farInp, + farExp #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'u'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'u'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'f'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 18] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 18] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise inp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) - then - let !(# - c, - cs - #) = readNext inp - in if Grammar.Nandlang.nandIdentStart c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\x -> GHC.Types.True) c + then catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkToken.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) - cs + inp Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identStart"] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemLabel "identStart"] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "resume" - in ok init GHC.Types - . [] - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "resume" - in ok init GHC.Types - . [] - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "resume" - in ok init GHC.Types - . [] - ( let _ = "resume.genCode" - in \x -> \x -> x - ) - inp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let join = \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show v - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> GHC.Types.True) c - then - let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler inp farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - ) - init - Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + ) + init + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G15.expected.txt b/test/Golden/Splice/G15.expected.txt index 7ece61e..d097e37 100644 --- a/test/Golden/Splice/G15.expected.txt +++ b/test/Golden/Splice/G15.expected.txt @@ -27,246 +27,290 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let - in let join = \farInp farExp v (!inp) -> - let readFail = finalRaise - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if ('c' GHC.Classes.==) c - then - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show v - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let + in let join = \farInp farExp v (!inp) -> + let readFail = finalRaise + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if ('c' GHC.Classes.==) c + then + let _ = "resume" + in finalRet + farInp farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise inp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - init - failInp - then - let _ = "choicesBranch.then" - in let readFail = finalRaise - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) - then - let !(# - c, - cs - #) = readNext failInp - in if ('b' GHC.Classes.==) c - then - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in 'b' - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let readFail = finalRaise + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('b' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) - then - let !(# c, cs #) = readNext init - in if ('a' GHC.Classes.==) c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' + ( let _ = "resume.genCode" + in 'b' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) + then + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in 'a' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G16.expected.txt b/test/Golden/Splice/G16.expected.txt index e5e7732..69e7e6c 100644 --- a/test/Golden/Splice/G16.expected.txt +++ b/test/Golden/Splice/G16.expected.txt @@ -27,359 +27,401 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let - in let join = \farInp farExp v (!inp) -> - let readFail = finalRaise - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if ('d' GHC.Classes.==) c - then - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show v - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let + in let join = \farInp farExp v (!inp) -> + let readFail = finalRaise + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if ('d' GHC.Classes.==) c + then + let _ = "resume" + in finalRet + farInp farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise inp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'd' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - init - failInp - then - let _ = "choicesBranch.then" - in let readFail = finalRaise - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) - then - let !(# - c, - cs - #) = readNext failInp - in if ('c' GHC.Classes.==) c - then - let _ = "resume" - in join - farInp + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let readFail = finalRaise + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('c' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in 'c' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, farExp - ( let _ = "resume.genCode" - in 'c' - ) - cs + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in v + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('b' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in 'b' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else - let _ = "checkToken.else" - in let (# + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# farInp, farExp #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + failExp #) GHC.Types.EQ -> (# farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] + failExp GHC.Base.<> farExp #) GHC.Types.GT -> (# farInp, farExp #) - in finalRaise failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) + then + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in 'a' + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip (# farInp, farExp - #) - in finalRaise failInp farInp farExp - in let join = \farInp farExp v (!inp) -> - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in v - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - init - failInp - then - let _ = "choicesBranch.then" - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) - then - let !(# - c, - cs - #) = readNext failInp - in if ('b' GHC.Classes.==) c - then - let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in 'b' - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler failInp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) - then - let !(# - c, - cs - #) = readNext init - in if ('a' GHC.Classes.==) c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G2.expected.txt b/test/Golden/Splice/G2.expected.txt index f721ae3..fb92475 100644 --- a/test/Golden/Splice/G2.expected.txt +++ b/test/Golden/Splice/G2.expected.txt @@ -27,161 +27,185 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 2 init) then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp init of - GHC.Types.LT -> - (# - init, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise init farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 2 init) - then - let !(# c, cs #) = readNext init - in if ('a' GHC.Classes.==) c - then - let readFail = readFail - in let !(# c, cs #) = readNext cs - in if ('b' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('c' GHC.Classes.==) c - then - let _ = "resume" - in finalRet init GHC.Types - . [] - ( let _ = "resume.genCode" - in GHC.Show.show ('a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: GHC.Types . []))) + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# c, cs #) = readNext cs + in if ('b' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('c' GHC.Classes.==) c + then + let _ = "resume" + in finalRet + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in GHC.Show.show ('a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: GHC.Types . []))) + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c' + ) ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 3] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 3] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 3 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G3.expected.txt b/test/Golden/Splice/G3.expected.txt index 2f1efe2..e0882a1 100644 --- a/test/Golden/Splice/G3.expected.txt +++ b/test/Golden/Splice/G3.expected.txt @@ -27,155 +27,158 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if ('a' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> 'a' GHC.Types.: v x + ) + inp ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if ('a' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> 'a' GHC.Types.: v x - ) - inp - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show (v GHC.Types . []) - ) - inp - ) - init - Data.Map.Internal.Tip + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show (v GHC.Types . []) + ) + inp + ) + init + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G4.expected.txt b/test/Golden/Splice/G4.expected.txt index 1dc43db..5a4c634 100644 --- a/test/Golden/Splice/G4.expected.txt +++ b/test/Golden/Splice/G4.expected.txt @@ -27,285 +27,300 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v GHC.Types.: v x - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise inp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('a' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('b' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('c' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('d' GHC.Classes.==) c - then - let _ = "resume" - in ok init GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: ('d' GHC.Types.: GHC.Types . []))) + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('b' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('c' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('d' GHC.Classes.==) c + then + let _ = "resume" + in ok + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: ('d' GHC.Types.: GHC.Types . []))) + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'd' + ) ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok farInp farExp ( let _ = "resume.genCode" - in GHC.Show.show (v GHC.Types.: v GHC.Types . []) + in \x -> x ) - inp - ) - inp - Data.Map.Internal.Tip - ) - init - Data.Map.Internal.Tip + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v GHC.Types.: v x + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show (v GHC.Types.: v GHC.Types . []) + ) + inp + ) + inp + Data.Map.Internal.Tip + ) + init + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G5.expected.txt b/test/Golden/Splice/G5.expected.txt index ac117ad..970d806 100644 --- a/test/Golden/Splice/G5.expected.txt +++ b/test/Golden/Splice/G5.expected.txt @@ -27,430 +27,398 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) + then + let !(# + c, + cs + #) = readNext inp + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('b' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('c' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('d' GHC.Classes.==) c + then + let _ = "resume" + in ok + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: ('d' GHC.Types.: GHC.Types . []))) + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'd' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> v GHC.Types.: v x + ) + inp + ) inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x - ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> v GHC.Types.: v x - ) - inp - ) - inp - Data.Map.Internal.Tip - ) - inp - Data.Map.Internal.Tip - name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, + Data.Map.Internal.Tip + ) + inp + Data.Map.Internal.Tip + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp farExp - #) - in finalRaise inp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) - then - let !(# - c, - cs - #) = readNext inp - in if ('a' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('b' GHC.Classes.==) c + ( let _ = "resume.genCode" + in GHC.Show.show (v GHC.Types.: v GHC.Types . []) + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('c' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('d' GHC.Classes.==) c - then - let _ = "resume" - in ok init GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: ('d' GHC.Types.: GHC.Types . []))) - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'd'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'c'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# + let _ = "choicesBranch.then" + in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip + (# farInp, farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of GHC.Types.LT -> (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + failInp, + failExp #) GHC.Types.EQ -> (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] + farInp, + failExp GHC.Base.<> farExp #) GHC.Types.GT -> (# - init, - GHC.Types . [] + farInp, + farExp #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 4] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let join = \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show (v GHC.Types.: v GHC.Types . []) - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> GHC.Types.True) c - then - let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler inp farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - ) - inp - Data.Map.Internal.Tip - ) - init - Data.Map.Internal.Tip + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\x -> GHC.Types.True) c + then catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkToken.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + ) + inp + Data.Map.Internal.Tip + ) + init + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G6.expected.txt b/test/Golden/Splice/G6.expected.txt index b8c34d7..ec66571 100644 --- a/test/Golden/Splice/G6.expected.txt +++ b/test/Golden/Splice/G6.expected.txt @@ -27,251 +27,292 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let - in let join = \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show v - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - init - failInp - then - let _ = "choicesBranch.then" - in let readFail = finalRaise - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) - then - let !(# - c, - cs - #) = readNext failInp - in if ('a' GHC.Classes.==) c - then - let readFail = finalRaise - in let !(# - c, - cs - #) = readNext cs - in if ('b' GHC.Classes.==) c - then - let _ = "resume" - in join - farInp + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let readFail = finalRaise + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('a' GHC.Classes.==) c + then + let readFail = finalRaise + in let !(# + c, + cs + #) = readNext cs + in if ('b' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, farExp - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) - then - let !(# c, cs #) = readNext init - in if ('a' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('a' GHC.Classes.==) c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) + then + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# c, cs #) = readNext cs + in if ('a' GHC.Classes.==) c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G7.expected.txt b/test/Golden/Splice/G7.expected.txt index 9eb5cc6..e0c3a5f 100644 --- a/test/Golden/Splice/G7.expected.txt +++ b/test/Golden/Splice/G7.expected.txt @@ -27,297 +27,303 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let - in let join = \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show v - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - init - failInp - then - let _ = "choicesBranch.then" - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) - then - let !(# - c, - cs - #) = readNext failInp - in if ('a' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('b' GHC.Classes.==) c - then - let _ = "resume" - in join - farInp + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 failInp) + then + let !(# + c, + cs + #) = readNext failInp + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('b' GHC.Classes.==) c + then + let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, farExp - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('b' GHC.Types.: GHC.Types . []) - ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'b'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp init of - GHC.Types.LT -> - (# - init, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler init farInp farExp - in let readFail = catchHandler - in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) - then - let !(# c, cs #) = readNext init - in if ('a' GHC.Classes.==) c - then - let readFail = readFail - in let !(# - c, - cs - #) = readNext cs - in if ('a' GHC.Classes.==) c - then - let _ = "resume" - in join init GHC.Types - . [] - ( let _ = "resume.genCode" - in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let readFail = catchHandler + in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 init) + then + let !(# c, cs #) = readNext init + in if ('a' GHC.Classes.==) c + then + let readFail = readFail + in let !(# + c, + cs + #) = readNext cs + in if ('a' GHC.Classes.==) c + then + let _ = "resume" + in join + init + Data.Set.Internal.empty + ( let _ = "resume.genCode" + in 'a' GHC.Types.: ('a' GHC.Types.: GHC.Types . []) + ) + cs + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) ) - cs - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail cs farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'a'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 2] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G8.expected.txt b/test/Golden/Splice/G8.expected.txt index 1a85469..ee724a2 100644 --- a/test/Golden/Splice/G8.expected.txt +++ b/test/Golden/Splice/G8.expected.txt @@ -27,300 +27,256 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let name = \(!ok) (!inp) (!koByLabel) -> + let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let name = \(!ok) (!inp) (!koByLabel) -> - let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> x + ) + failInp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if ('r' GHC.Classes.==) c + then + name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let _ = "resume" + in ok + farInp + farExp + ( let _ = "resume.genCode" + in \x -> 'r' GHC.Types.: v x + ) + inp ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> x + cs + Data.Map.Internal.Tip + else + let _ = "checkToken.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'r' + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 ) - failInp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if ('r' GHC.Classes.==) c - then - name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let _ = "resume" - in ok - farInp - farExp - ( let _ = "resume.genCode" - in \x -> 'r' GHC.Types.: v x - ) - inp - ) - cs - Data.Map.Internal.Tip - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemToken 'r'] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail inp farInp farExp - in name - ( let _ = "suspend" - in \farInp farExp v (!inp) -> - let join = \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show (v GHC.Types . []) - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - inp - failInp - then - let _ = "choicesBranch.then" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - inp - in let readFail = catchHandler - in if readMore inp - then - let !(# - c, - cs - #) = readNext inp - in if (\x -> GHC.Types.True) c - then - let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in catchHandler inp farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail inp farInp farExp - ) - init - Data.Map.Internal.Tip + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in name + ( let _ = "suspend" + in \farInp farExp v (!inp) -> + let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show (v GHC.Types . []) + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + inp + failInp + then + let _ = "choicesBranch.then" + in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + inp + in let readFail = catchHandler + in if readMore inp + then + let !(# + c, + cs + #) = readNext inp + in if (\x -> GHC.Types.True) c + then catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkToken.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + ) + init + Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G9.expected.txt b/test/Golden/Splice/G9.expected.txt index 187466a..e5c5d65 100644 --- a/test/Golden/Splice/G9.expected.txt +++ b/test/Golden/Splice/G9.expected.txt @@ -27,176 +27,131 @@ unconsumed ) = unconsumed GHC.Classes.> 0 in (# input, more, next #) - in let finalRet = \_farInp _farExp v _inp -> Data.Either.Right v - in let finalRaise :: - forall b. - Symantic.Parser.Machine.Generate.Catcher - inp - b = \_failInp (!farInp) (!farExp) -> - Data.Either.Left - Symantic.Parser.Machine.Generate.ParsingErrorStandard - { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, - Symantic.Parser.Machine.Generate.parsingErrorUnexpected = - if readMore farInp - then - GHC.Maybe.Just - ( let (# - c, - _ - #) = readNext farInp - in c - ) - else GHC.Maybe.Nothing, - Symantic.Parser.Machine.Generate.parsingErrorExpecting = Data.Set.Internal.fromList farExp - } - in let - in let join = \farInp farExp v (!inp) -> - let _ = "resume" - in finalRet - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Show.show v - ) - inp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in if ( \( Data.Text.Internal.Text - _ - i - _ - ) - ( Data.Text.Internal.Text - _ - j - _ - ) -> i GHC.Classes.== j - ) - init - failInp - then - let _ = "choicesBranch.then" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemEnd] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - else - let _ = "choicesBranch.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - [] - #) - GHC.Types.EQ -> - (# - farInp, - farExp GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise failInp farInp farExp - in let _ = "catchException lbl=fail" - in let catchHandler (!failInp) (!farInp) (!farExp) = - let _ = "catchException.ko lbl=fail" - in let _ = "resume" - in join - farInp - farExp - ( let _ = "resume.genCode" - in GHC.Tuple . () - ) - init - in let readFail = catchHandler - in if readMore init - then - let !(# c, cs #) = readNext init - in if (\x -> GHC.Types.True) c - then - let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in catchHandler init farInp farExp - else - let _ = "checkToken.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp - else - let _ = "checkHorizon.else" - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.EQ -> - (# - init, - GHC.Types . [] GHC.Base.<> [Symantic.Parser.Grammar.Combinators.ErrorItemHorizon 1] - #) - GHC.Types.GT -> - (# - init, - GHC.Types . [] - #) - in readFail init farInp farExp + finalRet = \_farInp _farExp v _inp -> Data.Either.Right v + finalRaise :: + forall b. + Symantic.Parser.Machine.Generate.Catcher + inp + b = \(!exn) _failInp (!farInp) (!farExp) -> + Data.Either.Left + Symantic.Parser.Machine.Generate.ParsingErrorStandard + { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp, + Symantic.Parser.Machine.Generate.parsingErrorException = exn, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = + if readMore farInp + then + GHC.Maybe.Just + ( let (# + c, + _ + #) = readNext farInp + in c + ) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp + } + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp) + in let + in let join = \farInp farExp v (!inp) -> + let _ = "resume" + in finalRet + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Show.show v + ) + inp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in if ( \( Data.Text.Internal.Text + _ + i + _ + ) + ( Data.Text.Internal.Text + _ + j + _ + ) -> i GHC.Classes.== j + ) + init + failInp + then + let _ = "choicesBranch.then" + in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + else + let _ = "choicesBranch.else" + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let _ = "catch ExceptionFailure" + in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = + let _ = "catch.ko ExceptionFailure" + in let _ = "resume" + in join + farInp + farExp + ( let _ = "resume.genCode" + in GHC.Tuple . () + ) + init + in let readFail = catchHandler + in if readMore init + then + let !(# c, cs #) = readNext init + in if (\x -> GHC.Types.True) c + then catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure init init Data.Set.Internal.empty + else + let _ = "checkToken.else" + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init init Data.Set.Internal.empty + else + let _ = "checkHorizon.else" + in let failExp = + Data.Set.Internal.Bin + 1 + ( Symantic.Parser.Grammar.Combinators.SomeFailure + ( case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1 + ) + ) + Data.Set.Internal.Tip + Data.Set.Internal.Tip + (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Grammar/Brainfuck.hs b/test/Grammar/Brainfuck.hs index 00cbaea..b3e70d7 100644 --- a/test/Grammar/Brainfuck.hs +++ b/test/Grammar/Brainfuck.hs @@ -41,11 +41,11 @@ grammar = whitespace P.*> bf bf = P.many (lexeme (P.match (P.look P.anyChar) (haskell Prelude.<$> "><+-.,[") op P.empty)) op :: H.Term H.ValueCode Char -> repr Operator op (trans -> H.ValueCode c _) = case c of - '>' -> P.anyChar P.$> H.Term (H.ValueCode RightPointer [||RightPointer||]) - '<' -> P.anyChar P.$> H.Term (H.ValueCode LeftPointer [||LeftPointer||]) - '+' -> P.anyChar P.$> H.Term (H.ValueCode Increment [||Increment||]) - '-' -> P.anyChar P.$> H.Term (H.ValueCode Decrement [||Decrement||]) - '.' -> P.anyChar P.$> H.Term (H.ValueCode Output [||Output||]) - ',' -> P.anyChar P.$> H.Term (H.ValueCode Input [||Input||]) + '>' -> P.anyChar P.$> P.code RightPointer + '<' -> P.anyChar P.$> P.code LeftPointer + '+' -> P.anyChar P.$> P.code Increment + '-' -> P.anyChar P.$> P.code Decrement + '.' -> P.anyChar P.$> P.code Output + ',' -> P.anyChar P.$> P.code Input '[' -> P.between (lexeme P.anyChar) (P.char ']') (H.Term (H.ValueCode Loop [||Loop||]) P.<$> bf) _ -> Prelude.undefined diff --git a/test/Grammar/Nandlang.hs b/test/Grammar/Nandlang.hs index 8e96f21..8787178 100644 --- a/test/Grammar/Nandlang.hs +++ b/test/Grammar/Nandlang.hs @@ -50,7 +50,6 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof charLit = P.between (P.char '\'') (symbol '\'') charChar charChar :: repr () charChar = P.void (P.satisfy - [P.ErrorItemLabel "Char"] (trans (H.ValueCode nandStringLetter [||nandStringLetter||]))) P.<|> esc esc :: repr () esc = P.char '\\' P.*> P.void (P.oneOf "0tnvfr") @@ -63,7 +62,6 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof identifier :: repr () identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace identStart = P.satisfy - [P.ErrorItemLabel "identStart"] (trans (H.ValueCode nandIdentStart [||nandIdentStart||])) exprlist = commaSep expr @@ -95,7 +93,6 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof -- keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace notIdentLetter = P.negLook identLetter identLetter = P.satisfy - [P.ErrorItemLabel "identLetter"] (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||])) -- hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9'])) @@ -120,7 +117,6 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof space :: repr () space = P.void (P.satisfy - [P.ErrorItemLabel "space"] (trans (H.ValueCode isSpace [||isSpace||]))) whitespace :: repr () whitespace = spaces @@ -129,5 +125,4 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof spaces = P.skipSome space oneLineComment :: repr () oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy - [P.ErrorItemLabel "oneLineComment"] (trans (H.ValueCode (/= '\n') [||(/= '\n')||])))) -- 2.44.1 From 68afc96f0d70baf14448a036dca10a129e44f2e0 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 30 Apr 2021 12:34:42 +0200 Subject: [PATCH 07/16] machine: fix mayRaise analysis of catch --- src/Symantic/Parser/Machine/Generate.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs index e76a209..58bd5f2 100644 --- a/src/Symantic/Parser/Machine/Generate.hs +++ b/src/Symantic/Parser/Machine/Generate.hs @@ -355,8 +355,10 @@ instance InstrExceptionable Gen where catch exn ok ko = Gen { genAnalysisByLet = genAnalysisByLet ok <> genAnalysisByLet ko , genAnalysis = \final ct -> - let ga = altGenAnalysis $ genAnalysis ok final ct :| [ genAnalysis ko final ct ] in - ga { mayRaise = Map.delete exn (mayRaise ga) } + let okGA = genAnalysis ok final ct in + altGenAnalysis $ + okGA{ mayRaise = Map.delete exn (mayRaise okGA) } :| + [ genAnalysis ko final ct ] , unGen = \ctx@GenCtx{} -> {-trace ("unGen.catch: "<>show exn) $-} [|| let _ = $$(liftTypedString ("catch "<>show exn)) in let catchHandler !_exn !failInp !farInp !farExp = -- 2.44.1 From 06d164133822a3f2166ed7c63e4a1a78430920f0 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 30 Apr 2021 12:36:23 +0200 Subject: [PATCH 08/16] machine: fix factorize out raiseException --- src/Symantic/Parser/Machine/Generate.hs | 55 +++++++++++++------------ 1 file changed, 29 insertions(+), 26 deletions(-) diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs index 58bd5f2..a44676f 100644 --- a/src/Symantic/Parser/Machine/Generate.hs +++ b/src/Symantic/Parser/Machine/Generate.hs @@ -314,13 +314,11 @@ instance InstrExceptionable Gen where , mayRaise = Map.singleton (ExceptionLabel exn) () } , unGen = \ctx@GenCtx{} -> {-trace ("unGen.raise: "<>show exn) $-} [|| - $$(NE.head $ Map.findWithDefault - (NE.singleton (defaultCatch ctx)) - (ExceptionLabel exn) (catchStackByLabel ctx)) - (ExceptionLabel $$(TH.liftTyped exn)) - {-failInp-}$$(input ctx) - {-farInp-}$$(input ctx) - $$(farthestExpecting ctx) + $$(raiseException ctx (ExceptionLabel exn)) + (ExceptionLabel $$(TH.liftTyped exn)) + {-failInp-}$$(input ctx) + {-farInp-}$$(input ctx) + $$(farthestExpecting ctx) ||] } fail fs = Gen @@ -332,15 +330,13 @@ instance InstrExceptionable Gen where , unGen = \ctx@GenCtx{} -> {-trace ("unGen.fail: "<>show exn) $-} if null fs then [|| - $$(NE.head $ Map.findWithDefault - (NE.singleton (defaultCatch ctx)) - ExceptionFailure (catchStackByLabel ctx)) - ExceptionFailure - {-failInp-}$$(input ctx) - $$(farthestInput ctx) - $$(farthestExpecting ctx) + $$(raiseException ctx ExceptionFailure) + ExceptionFailure + {-failInp-}$$(input ctx) + $$(farthestInput ctx) + $$(farthestExpecting ctx) ||] - else raiseCode ctx [||fs||] + else raiseFailure ctx [||fs||] } commit exn k = k { unGen = \ctx -> {-trace ("unGen.commit: "<>show exn) $-} @@ -672,10 +668,7 @@ checkHorizon ok = ok [ genAnalysis ok final ct ] , unGen = \ctx0@GenCtx{} -> {-trace "unGen.checkHorizon" $-} - let raiseFail = - NE.head (Map.findWithDefault - (NE.singleton (defaultCatch ctx0)) - ExceptionFailure (catchStackByLabel ctx0)) in + let raiseFail = raiseException ctx0 ExceptionFailure in [|| -- Factorize generated code for raising the "fail". let readFail = $$(raiseFail) in @@ -702,24 +695,34 @@ checkHorizon ok = ok ||] } -raiseCode :: +-- | @('raiseFailure' ctx fs)@ raises 'ExceptionFailure' +-- with farthest parameters set to or updated with @(fs)@ +-- according to the relative position of 'input' wrt. 'farthestInput'. +raiseFailure :: Cursorable (Cursor inp) => GenCtx inp cs a -> TH.CodeQ (Set SomeFailure) -> TH.CodeQ (Either (ParsingError inp) a) -raiseCode ctx fs = [|| - let failExp = $$fs - (# farInp, farExp #) = +raiseFailure ctx fs = [|| + let failExp = $$fs in + let (# farInp, farExp #) = case $$compareOffset $$(farthestInput ctx) $$(input ctx) of LT -> (# $$(input ctx), failExp #) EQ -> (# $$(farthestInput ctx), failExp <> $$(farthestExpecting ctx) #) GT -> (# $$(farthestInput ctx), $$(farthestExpecting ctx) #) - in $$(NE.head $ Map.findWithDefault - (NE.singleton (defaultCatch ctx)) - ExceptionFailure (catchStackByLabel ctx)) + in $$(raiseException ctx ExceptionFailure) ExceptionFailure {-failInp-}$$(input ctx) farInp farExp ||] +-- | @('raiseException' ctx exn)@ raises exception @(exn)@ +-- using any entry in 'catchStackByLabel', or 'defaultCatch' if none. +raiseException :: + GenCtx inp vs a -> Exception -> + CodeQ (Exception -> Cursor inp -> Cursor inp -> Set SomeFailure -> Either (ParsingError inp) a) +raiseException ctx exn = + NE.head $ Map.findWithDefault + (NE.singleton (defaultCatch ctx)) + exn (catchStackByLabel ctx) finalGenAnalysis :: GenCtx inp vs a -> Gen inp cs a -> GenAnalysis finalGenAnalysis ctx k = -- 2.44.1 From 413e8a445ab646fcce5b7599ea0c0112e35a2589 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 30 Apr 2021 12:40:58 +0200 Subject: [PATCH 09/16] machine: fix view and output --- src/Symantic/Parser/Machine/View.hs | 3 ++- test/Golden/Parser.hs | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Symantic/Parser/Machine/View.hs b/src/Symantic/Parser/Machine/View.hs index e1998f3..feb1a64 100644 --- a/src/Symantic/Parser/Machine/View.hs +++ b/src/Symantic/Parser/Machine/View.hs @@ -15,6 +15,7 @@ import Text.Show (Show(..)) import qualified Data.HashMap.Strict as HM import qualified Data.List as List import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import qualified Data.Tree as Tree import qualified Language.Haskell.TH.Syntax as TH import Prelude (error) @@ -107,7 +108,7 @@ instance InstrExceptionable (ViewMachine sN) where } where gen = raise exn fail flr = ViewMachine { unViewMachine = \ct lm next -> - viewInstrCmd (Right gen) ct lm ("fail "<>show flr, "") [] : next + viewInstrCmd (Right gen) ct lm ("fail "<>show (Set.toList flr), "") [] : next , viewGen = gen } where gen = fail flr commit exn k = ViewMachine diff --git a/test/Golden/Parser.hs b/test/Golden/Parser.hs index 67ac6ed..95c77fc 100644 --- a/test/Golden/Parser.hs +++ b/test/Golden/Parser.hs @@ -60,7 +60,7 @@ goldens = testGroup "Parser" $ return $ fromString $ case p input of Left err -> show err - Right a -> show a + Right a -> a parsers :: [Text -> Either (P.ParsingError Text) String] parsers = -- 2.44.1 From 4f5c6ad897facc7a7f01211e272657f13d7c324c Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 30 Apr 2021 12:46:06 +0200 Subject: [PATCH 10/16] machine: improve comments --- src/Symantic/Parser/Grammar/Combinators.hs | 2 ++ src/Symantic/Parser/Machine/Generate.hs | 25 ++++++++++++---------- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/src/Symantic/Parser/Grammar/Combinators.hs b/src/Symantic/Parser/Grammar/Combinators.hs index e3cd7f6..b07875b 100644 --- a/src/Symantic/Parser/Grammar/Combinators.hs +++ b/src/Symantic/Parser/Grammar/Combinators.hs @@ -449,8 +449,10 @@ data instance Failure CombMatchable -- * Class 'CombSatisfiable' class CombSatisfiable tok repr where + -- | Like 'satisfyOrFail' but with no custom failure. satisfy :: TermGrammar (tok -> Bool) -> repr tok satisfy = satisfyOrFail Set.empty + -- | Like 'satisfy' but with a custom set of 'SomeFailure's. satisfyOrFail :: Set SomeFailure -> TermGrammar (tok -> Bool) -> repr tok diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs index a44676f..a268294 100644 --- a/src/Symantic/Parser/Machine/Generate.hs +++ b/src/Symantic/Parser/Machine/Generate.hs @@ -156,10 +156,12 @@ runGenAnalysis :: runGenAnalysis ga = (($ []) <$>) $ polyfix ga -- | Poly-variadic fixpoint combinator. --- Used to express mutual recursion and to transparently introduce memoization. --- Used to "tie the knot" between observed sharing ('defLet', 'call', 'jump') --- and join points ('defJoin', 'refJoin'). --- All mutually dependent functions are restricted to the same polymorphic type @(a)@. +-- Used to express mutual recursion and to transparently introduce memoization, +-- more precisely to "tie the knot" +-- between observed sharing ('defLet', 'call', 'jump') +-- and also between join points ('defJoin', 'refJoin'). +-- Because it's enough for its usage here, +-- all mutually dependent functions are restricted to the same polymorphic type @(a)@. -- See http://okmij.org/ftp/Computation/fixed-point-combinators.html#Poly-variadic polyfix :: Functor f => f (f a -> a) -> f a polyfix fs = fix $ \finals -> ($ finals) <$> fs @@ -181,8 +183,8 @@ type Offset = Int -- | Minimal input length required for a successful parsing. type Horizon = Offset --- seqGenAnalysis = -- altGenAnalysis = List.foldl' (\acc x -> either Left (\h -> Right (either (const h) (min h) acc)) x) +-- | Merge given 'GenAnalysis' as sequences. seqGenAnalysis :: NonEmpty GenAnalysis -> GenAnalysis seqGenAnalysis aas@(a:|as) = GenAnalysis { minReads = List.foldl' (\acc x -> @@ -190,6 +192,7 @@ seqGenAnalysis aas@(a:|as) = GenAnalysis ) (minReads a) as , mayRaise = sconcat (mayRaise <$> aas) } +-- | Merge given 'GenAnalysis' as alternatives. altGenAnalysis :: NonEmpty GenAnalysis -> GenAnalysis altGenAnalysis aas@(a:|as) = GenAnalysis { minReads = List.foldl' (\acc x -> @@ -361,7 +364,8 @@ instance InstrExceptionable Gen where let _ = $$(liftTypedString ("catch.ko "<>show exn)) in $$({-trace ("unGen.catch.ko: "<>show exn) $-} unGen ko ctx -- Push 'input' and 'checkedHorizon' - -- as they were when entering 'catch'. + -- as they were when entering 'catch', + -- they will be available to 'loadInput', if any. { valueStack = ValueStackCons (H.Term (input ctx)) $ --ValueStackCons (H.Term [||exn||]) $ @@ -371,12 +375,11 @@ instance InstrExceptionable Gen where -- Note that 'catchStackByLabel' is reset. -- Move the input to the failing position. , input = [||failInp||] - -- The 'checkedHorizon' at the 'raise's - -- are not known here. - -- Nor whether 'failInp' is after - -- 'checkedHorizon' 'ctx' or not. + -- The 'checkedHorizon' at the 'raise's are not known here. + -- Nor whether 'failInp' is after 'checkedHorizon' or not. + -- Hence fallback to a safe value. , checkedHorizon = 0 - -- Set the farthestInput to the farthest computed by 'fail'. + -- Set the farthestInput to the farthest computed in 'fail'. , farthestInput = [||farInp||] , farthestExpecting = [||farExp||] }) -- 2.44.1 From 30a3888e0143488056d91b33ce9f8686f35ce8e2 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 30 Apr 2021 12:46:53 +0200 Subject: [PATCH 11/16] test: update --- test/Golden/Machine/G10.expected.txt | 6 +- test/Golden/Machine/G11.expected.txt | 14 +- test/Golden/Machine/G12.expected.txt | 32 +- test/Golden/Machine/G13.expected.txt | 68 +- test/Golden/Machine/G14.expected.txt | 820 ++++---- test/Golden/Machine/G15.expected.txt | 8 +- test/Golden/Machine/G16.expected.txt | 12 +- test/Golden/Machine/G2.expected.txt | 6 +- test/Golden/Machine/G3.expected.txt | 18 +- test/Golden/Machine/G4.expected.txt | 34 +- test/Golden/Machine/G5.expected.txt | 52 +- test/Golden/Machine/G6.expected.txt | 6 +- test/Golden/Machine/G7.expected.txt | 14 +- test/Golden/Machine/G8.expected.txt | 34 +- test/Golden/Machine/G9.expected.txt | 10 +- test/Golden/Splice/G1.expected.txt | 80 +- test/Golden/Splice/G10.expected.txt | 160 +- test/Golden/Splice/G11.expected.txt | 164 +- test/Golden/Splice/G12.expected.txt | 164 +- test/Golden/Splice/G13.expected.txt | 818 ++++---- test/Golden/Splice/G14.expected.txt | 2586 +++++++++++++------------- test/Golden/Splice/G15.expected.txt | 240 +-- test/Golden/Splice/G16.expected.txt | 320 ++-- test/Golden/Splice/G2.expected.txt | 160 +- test/Golden/Splice/G3.expected.txt | 84 +- test/Golden/Splice/G4.expected.txt | 208 +-- test/Golden/Splice/G5.expected.txt | 288 +-- test/Golden/Splice/G6.expected.txt | 240 +-- test/Golden/Splice/G7.expected.txt | 240 +-- test/Golden/Splice/G8.expected.txt | 164 +- test/Golden/Splice/G9.expected.txt | 80 +- 31 files changed, 3565 insertions(+), 3565 deletions(-) diff --git a/test/Golden/Machine/G10.expected.txt b/test/Golden/Machine/G10.expected.txt index 18a68f2..f8d3523 100644 --- a/test/Golden/Machine/G10.expected.txt +++ b/test/Golden/Machine/G10.expected.txt @@ -1,6 +1,6 @@ pushValue Term minReads=(Right 1) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 0) mayRaise=[] @@ -12,7 +12,7 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 1) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | minReads=(Right 1) @@ -65,6 +65,6 @@ catch ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G11.expected.txt b/test/Golden/Machine/G11.expected.txt index eda2356..9582e37 100644 --- a/test/Golden/Machine/G11.expected.txt +++ b/test/Golden/Machine/G11.expected.txt @@ -1,9 +1,9 @@ let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) @@ -25,16 +25,16 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -62,7 +62,7 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] pushValue Term diff --git a/test/Golden/Machine/G12.expected.txt b/test/Golden/Machine/G12.expected.txt index 9735e32..2161cb4 100644 --- a/test/Golden/Machine/G12.expected.txt +++ b/test/Golden/Machine/G12.expected.txt @@ -1,9 +1,9 @@ let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) @@ -16,13 +16,13 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -50,27 +50,27 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 0) mayRaise=[] @@ -85,7 +85,7 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | catch ExceptionFailure | | minReads=(Right 0) @@ -106,7 +106,7 @@ catch ExceptionFailure | | | | loadInput | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | @@ -133,10 +133,10 @@ catch ExceptionFailure | | minReads=(Left ExceptionFailure) | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [FailureEnd] +| | | | fail [FailureEnd] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G13.expected.txt b/test/Golden/Machine/G13.expected.txt index f0c4dda..ae731e0 100644 --- a/test/Golden/Machine/G13.expected.txt +++ b/test/Golden/Machine/G13.expected.txt @@ -1,9 +1,9 @@ let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | call | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue Term | minReads=(Right 0) | mayRaise=[] @@ -15,10 +15,10 @@ let | mayRaise=[] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) @@ -37,13 +37,13 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -71,15 +71,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) @@ -92,25 +92,25 @@ let | | | mayRaise=[ExceptionFailure] | | | join | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | call | | | | minReads=(Right 0) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | call | | | | minReads=(Right 0) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] @@ -317,7 +317,7 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [FailureEmpty] +| | | | | fail [FailureEmpty] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] | | @@ -338,33 +338,33 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue Term | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -382,25 +382,25 @@ let | mayRaise=[] pushValue Term minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue (\u1 -> u1) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G14.expected.txt b/test/Golden/Machine/G14.expected.txt index c6b1afa..8b9a7f7 100644 --- a/test/Golden/Machine/G14.expected.txt +++ b/test/Golden/Machine/G14.expected.txt @@ -1,9 +1,9 @@ let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) @@ -22,13 +22,13 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -56,15 +56,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) @@ -83,13 +83,13 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -117,15 +117,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) @@ -144,13 +144,13 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -178,67 +178,67 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | catch ExceptionFailure | | | minReads=(Right 18) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue cons | | | | | minReads=(Right 18) @@ -476,22 +476,22 @@ let | | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 6) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 6) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 6) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 6) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | call | | | | | minReads=(Right 6) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 2) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | join | | | | | minReads=(Right 6) | | | | | mayRaise=[ExceptionFailure] @@ -521,16 +521,16 @@ let | | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) -| | | | | | mayRaise=[] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) -| | | | | | mayRaise=[] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) -| | | | | | mayRaise=[] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | call | | | | | | minReads=(Right 0) -| | | | | | mayRaise=[] +| | | | | | mayRaise=[ExceptionFailure] | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] @@ -542,7 +542,7 @@ let | | | | | | mayRaise=[] | | | | | catch ExceptionFailure | | | | | minReads=(Right 0) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 2) @@ -625,14 +625,14 @@ let | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] | | | | | | | | -| | | | | | | | | fail fromList [] +| | | | | | | | | fail [] | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | loadInput | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] | | @@ -653,40 +653,40 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | join | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | call | | | | minReads=(Right 0) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | minReads=(Right 0) | | | | mayRaise=[] @@ -698,11 +698,11 @@ let | | | | mayRaise=[] | | | catch ExceptionFailure | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | join | | | | | minReads=(Right 0) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | | commit ExceptionFailure | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] @@ -711,11 +711,11 @@ let | | | | | | mayRaise=[] | | | | | catch ExceptionFailure | | | | | minReads=(Right 2) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | join | | | | | | | minReads=(Right 0) -| | | | | | | mayRaise=[] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | commit ExceptionFailure | | | | | | | | minReads=(Right 0) | | | | | | | | mayRaise=[] @@ -724,20 +724,20 @@ let | | | | | | | | mayRaise=[] | | | | | | | catch ExceptionFailure | | | | | | | minReads=(Right 2) -| | | | | | | mayRaise=[] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | minReads=(Right 2) -| | | | | | | | | mayRaise=[] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | minReads=(Right 2) -| | | | | | | | | mayRaise=[] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 2) -| | | | | | | | | mayRaise=[] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | catch ExceptionFailure | | | | | | | | | minReads=(Right 2) -| | | | | | | | | mayRaise=[] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | minReads=(Right 2) @@ -812,7 +812,7 @@ let | | | | | | | | | | | loadInput | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | mayRaise=[ExceptionFailure] -| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | fail [] | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | @@ -828,34 +828,34 @@ let | | | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | catch ExceptionFailure | | | | | | | | | | | minReads=(Right 11) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | minReads=(Right 11) @@ -1017,11 +1017,11 @@ let | | | | | | | | | | | | | loadInput | | | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | | | mayRaise=[ExceptionFailure] -| | | | | | | | | | | | | fail fromList [] +| | | | | | | | | | | | | fail [] | | | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | -| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | fail [] | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | @@ -1037,38 +1037,38 @@ let | | | | | | | | | | | | | | | | | catch ExceptionFailure | | | | | | | | | minReads=(Right 8) -| | | | | | | | | mayRaise=[] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 8) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | join | | | | | | | | | | | minReads=(Right 8) | | | | | | | | | | | mayRaise=[ExceptionFailure] @@ -1107,10 +1107,10 @@ let | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | call | | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | mayRaise=[] @@ -1158,25 +1158,25 @@ let | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | call | | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | mayRaise=[] @@ -1197,10 +1197,10 @@ let | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | call | | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | mayRaise=[] @@ -1236,29 +1236,29 @@ let | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | catch ExceptionFailure | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue Term | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | catch ExceptionFailure | | | | | | | | | | | | | minReads=(Right 3) -| | | | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | | | | | | | | | pushValue cons | | | | | | | | | | | | | | | minReads=(Right 3) @@ -1360,7 +1360,7 @@ let | | | | | | | | | | | | | | | loadInput | | | | | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] -| | | | | | | | | | | | | | | fail fromList [] +| | | | | | | | | | | | | | | fail [] | | | | | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | @@ -1381,18 +1381,18 @@ let | | | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | | | -| | | | | | | | | | | | | | | fail fromList [] +| | | | | | | | | | | | | | | fail [] | | | | | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | loadInput | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | mayRaise=[ExceptionFailure] -| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | fail [] | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | -| | | | | | | | | fail fromList [] +| | | | | | | | | fail [] | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | mayRaise=[ExceptionFailure] | | | | @@ -1425,7 +1425,7 @@ let | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] | | | | | | -| | | | | | | fail fromList [] +| | | | | | | fail [] | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | mayRaise=[ExceptionFailure] | | @@ -1446,15 +1446,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) @@ -1476,22 +1476,22 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -1519,15 +1519,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) @@ -1549,22 +1549,22 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -1592,15 +1592,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) @@ -1622,22 +1622,22 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -1665,15 +1665,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) @@ -1695,22 +1695,22 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -1738,15 +1738,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) @@ -1795,25 +1795,25 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -1841,61 +1841,61 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue Term | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> u1) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -1935,7 +1935,7 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let @@ -1988,28 +1988,28 @@ let | mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue Term | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -2067,141 +2067,9 @@ let let minReads=(Right 2) mayRaise=[ExceptionFailure] -| pushValue (\u1 -> (\u2 -> u1)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| pushValue (\u1 -> (\u2 -> u1)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| pushValue '(' -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| read ('(' ==) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| call -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 0) -| mayRaise=[] -| ret -| minReads=(Right 0) -| mayRaise=[] -let - minReads=(Right 2) - mayRaise=[ExceptionFailure] -| pushValue (\u1 -> (\u2 -> u1)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| pushValue (\u1 -> (\u2 -> u1)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| pushValue ')' -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| read (')' ==) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| call -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 0) -| mayRaise=[] -| ret -| minReads=(Right 0) -| mayRaise=[] -let - minReads=(Right 2) - mayRaise=[ExceptionFailure] -| pushValue (\u1 -> (\u2 -> u1)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| pushValue (\u1 -> (\u2 -> u1)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| pushValue ',' -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| read (',' ==) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| call -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 0) -| mayRaise=[] -| ret -| minReads=(Right 0) -| mayRaise=[] -let - minReads=(Right 2) - mayRaise=[ExceptionFailure] -| pushValue (\u1 -> (\u2 -> u1)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| pushValue (\u1 -> (\u2 -> u1)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| pushValue ';' -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| read (';' ==) -| minReads=(Right 2) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| call -| minReads=(Right 1) -| mayRaise=[ExceptionFailure] -| lift2Value (\u1 -> (\u2 -> u1 u2)) -| minReads=(Right 0) -| mayRaise=[] -| ret -| minReads=(Right 0) -| mayRaise=[] -let - minReads=(Right 2) - mayRaise=[] | catch ExceptionFailure | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | join | | | minReads=(Right 0) @@ -2214,17 +2082,17 @@ let | | | | mayRaise=[] | | | catch ExceptionFailure | | | minReads=(Right 2) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 2) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 2) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 2) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | join | | | | | minReads=(Right 1) | | | | | mayRaise=[ExceptionFailure] @@ -2245,7 +2113,7 @@ let | | | | | | mayRaise=[] | | | | | catch ExceptionFailure | | | | | minReads=(Right 1) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 1) @@ -2298,7 +2166,7 @@ let | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] | | | | | | | | -| | | | | | | | | fail fromList [] +| | | | | | | | | fail [] | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | mayRaise=[ExceptionFailure] | | | | @@ -2338,10 +2206,10 @@ let | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 3) -| | | | | | | mayRaise=[] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 3) -| | | | | | | mayRaise=[] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | join | | | | | | | minReads=(Right 2) | | | | | | | mayRaise=[ExceptionFailure] @@ -2386,7 +2254,7 @@ let | | | | | | | | mayRaise=[] | | | | | | | catch ExceptionFailure | | | | | | | minReads=(Right 1) -| | | | | | | mayRaise=[] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | minReads=(Right 1) @@ -2481,11 +2349,11 @@ let | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] | | | | | | | | | | -| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | fail [] | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | -| | | | | | | fail fromList [] +| | | | | | | fail [] | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | mayRaise=[ExceptionFailure] | | @@ -2501,19 +2369,19 @@ let | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | minReads=(Right 2) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> u1) | | | | | minReads=(Right 2) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 2) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | call | | | | | minReads=(Right 2) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | minReads=(Right 0) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | join | | | | | minReads=(Right 0) | | | | | mayRaise=[] @@ -2525,17 +2393,17 @@ let | | | | | | mayRaise=[] | | | | | catch ExceptionFailure | | | | | minReads=(Right 0) -| | | | | mayRaise=[] +| | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=[] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | pushValue Term | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=[] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=[] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | join | | | | | | | minReads=(Right 0) | | | | | | | mayRaise=[] @@ -2550,7 +2418,7 @@ let | | | | | | | | mayRaise=[] | | | | | | | catch ExceptionFailure | | | | | | | minReads=(Right 4) -| | | | | | | mayRaise=[] +| | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | minReads=(Right 4) @@ -2569,7 +2437,7 @@ let | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | minReads=(Right 2) -| | | | | | | | | mayRaise=[] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | join | | | | | | | | | minReads=(Right 2) | | | | | | | | | mayRaise=[ExceptionFailure] @@ -2593,53 +2461,53 @@ let | | | | | | | | | | mayRaise=[] | | | | | | | | | catch ExceptionFailure | | | | | | | | | minReads=(Right 0) -| | | | | | | | | mayRaise=[] +| | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue Term | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | call | | | | | | | | | | | minReads=(Right 2) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue (\u1 -> u1) | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | call | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | call | | | | | | | | | | | minReads=(Right 0) -| | | | | | | | | | | mayRaise=[] +| | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] @@ -2682,7 +2550,7 @@ let | | | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | | | mayRaise=[] | | | | | | | | | | | | -| | | | | | | | | | | | | fail fromList [] +| | | | | | | | | | | | | fail [] | | | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | | | @@ -2703,7 +2571,7 @@ let | | | | | | | | | | | minReads=(Right 0) | | | | | | | | | | | mayRaise=[] | | | | | | | | | | -| | | | | | | | | | | fail fromList [] +| | | | | | | | | | | fail [] | | | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | | | mayRaise=[ExceptionFailure] | | | | | | @@ -2724,31 +2592,163 @@ let | | | | | | | | | minReads=(Right 0) | | | | | | | | | mayRaise=[] | | | | | | | | -| | | | | | | | | fail fromList [] +| | | | | | | | | fail [] | | | | | | | | | minReads=(Left ExceptionFailure) | | | | | | | | | mayRaise=[ExceptionFailure] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=[] -| pushValue (\u1 -> u1) +| mayRaise=[ExceptionFailure] +| pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] +| pushValue '(' +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| read ('(' ==) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| call +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) | mayRaise=[] +let + minReads=(Right 2) + mayRaise=[ExceptionFailure] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| pushValue ')' +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| read (')' ==) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] | call +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 2) + mayRaise=[ExceptionFailure] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| pushValue ',' | minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| read (',' ==) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| call +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[] +| ret +| minReads=(Right 0) | mayRaise=[] +let + minReads=(Right 2) + mayRaise=[ExceptionFailure] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| pushValue ';' +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| read (';' ==) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] +| call +| minReads=(Right 1) +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] +| ret +| minReads=(Right 0) +| mayRaise=[] +let + minReads=(Right 2) + mayRaise=[ExceptionFailure] +| pushValue (\u1 -> (\u2 -> u1)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| pushValue (\u1 -> u1) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| call +| minReads=(Right 2) +| mayRaise=[ExceptionFailure] +| lift2Value (\u1 -> (\u2 -> u1 u2)) +| minReads=(Right 0) +| mayRaise=[ExceptionFailure] | join | minReads=(Right 0) | mayRaise=[] @@ -2760,7 +2760,7 @@ let | | mayRaise=[] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 5) @@ -2801,48 +2801,48 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -2863,19 +2863,19 @@ let | mayRaise=[] let minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] | pushValue (\u1 -> (\u2 -> u1)) | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | pushValue (\u1 -> u1) | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 2) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | minReads=(Right 2) @@ -2909,10 +2909,10 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -2947,7 +2947,7 @@ let | | | loadInput | | | minReads=(Left ExceptionFailure) | | | mayRaise=[ExceptionFailure] -| | | fail fromList [] +| | | fail [] | | | minReads=(Left ExceptionFailure) | | | mayRaise=[ExceptionFailure] let @@ -3012,10 +3012,10 @@ let | mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | call | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | lift2Value (\u1 -> (\u2 -> u1 u2)) | minReads=(Right 0) | mayRaise=[] @@ -3222,28 +3222,28 @@ call mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue (\u1 -> u1) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2))) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) mayRaise=[] @@ -3255,13 +3255,13 @@ call mayRaise=[] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 0) mayRaise=[] @@ -3276,7 +3276,7 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | catch ExceptionFailure | | minReads=(Right 0) @@ -3297,7 +3297,7 @@ catch ExceptionFailure | | | | loadInput | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | @@ -3324,10 +3324,10 @@ catch ExceptionFailure | | minReads=(Left ExceptionFailure) | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [FailureEnd] +| | | | fail [FailureEnd] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G15.expected.txt b/test/Golden/Machine/G15.expected.txt index ab66d2a..f1c1f5a 100644 --- a/test/Golden/Machine/G15.expected.txt +++ b/test/Golden/Machine/G15.expected.txt @@ -1,9 +1,9 @@ pushValue Term minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 1) mayRaise=[ExceptionFailure] @@ -36,7 +36,7 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 1) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | pushValue (\u1 -> (\u2 -> u1)) | | minReads=(Right 1) @@ -89,6 +89,6 @@ catch ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G16.expected.txt b/test/Golden/Machine/G16.expected.txt index 9c7bbd4..71f61af 100644 --- a/test/Golden/Machine/G16.expected.txt +++ b/test/Golden/Machine/G16.expected.txt @@ -1,9 +1,9 @@ pushValue Term minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 1) mayRaise=[ExceptionFailure] @@ -36,7 +36,7 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 1) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | join | | minReads=(Right 1) @@ -49,7 +49,7 @@ catch ExceptionFailure | | | mayRaise=[] | | catch ExceptionFailure | | minReads=(Right 1) -| | mayRaise=[] +| | mayRaise=[ExceptionFailure] | | | | | | | pushValue (\u1 -> (\u2 -> u1)) | | | | minReads=(Right 1) @@ -102,7 +102,7 @@ catch ExceptionFailure | | | | | | minReads=(Right 0) | | | | | | mayRaise=[] | | | | | -| | | | | | fail fromList [] +| | | | | | fail [] | | | | | | minReads=(Left ExceptionFailure) | | | | | | mayRaise=[ExceptionFailure] | @@ -135,6 +135,6 @@ catch ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G2.expected.txt b/test/Golden/Machine/G2.expected.txt index c8bf11c..1bf78f4 100644 --- a/test/Golden/Machine/G2.expected.txt +++ b/test/Golden/Machine/G2.expected.txt @@ -1,9 +1,9 @@ pushValue Term minReads=(Right 3) - mayRaise=[] + mayRaise=[ExceptionFailure] catch ExceptionFailure minReads=(Right 3) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | pushValue cons | | minReads=(Right 3) @@ -93,6 +93,6 @@ catch ExceptionFailure | | loadInput | | minReads=(Left ExceptionFailure) | | mayRaise=[ExceptionFailure] -| | fail fromList [] +| | fail [] | | minReads=(Left ExceptionFailure) | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G3.expected.txt b/test/Golden/Machine/G3.expected.txt index 91cb518..7424548 100644 --- a/test/Golden/Machine/G3.expected.txt +++ b/test/Golden/Machine/G3.expected.txt @@ -1,9 +1,9 @@ let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) @@ -25,16 +25,16 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -62,15 +62,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G4.expected.txt b/test/Golden/Machine/G4.expected.txt index 012cf54..b868bd6 100644 --- a/test/Golden/Machine/G4.expected.txt +++ b/test/Golden/Machine/G4.expected.txt @@ -1,28 +1,28 @@ let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 4) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -50,15 +50,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 4) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 4) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue cons | | | minReads=(Right 4) @@ -169,24 +169,24 @@ let | | | loadInput | | | minReads=(Left ExceptionFailure) | | | mayRaise=[ExceptionFailure] -| | | fail fromList [] +| | | fail [] | | | minReads=(Left ExceptionFailure) | | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 4) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue cons minReads=(Right 4) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 4) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) mayRaise=[] diff --git a/test/Golden/Machine/G5.expected.txt b/test/Golden/Machine/G5.expected.txt index ce747f0..b34ee89 100644 --- a/test/Golden/Machine/G5.expected.txt +++ b/test/Golden/Machine/G5.expected.txt @@ -1,28 +1,28 @@ let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 4) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | pushValue cons | | | minReads=(Right 4) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 4) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -50,15 +50,15 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] let minReads=(Right 4) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 4) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue cons | | | minReads=(Right 4) @@ -169,39 +169,39 @@ let | | | loadInput | | | minReads=(Left ExceptionFailure) | | | mayRaise=[ExceptionFailure] -| | | fail fromList [] +| | | fail [] | | | minReads=(Left ExceptionFailure) | | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 4) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 4) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue cons minReads=(Right 4) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 4) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 0) mayRaise=[] @@ -216,7 +216,7 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | catch ExceptionFailure | | minReads=(Right 0) @@ -237,7 +237,7 @@ catch ExceptionFailure | | | | loadInput | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | @@ -264,10 +264,10 @@ catch ExceptionFailure | | minReads=(Left ExceptionFailure) | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [FailureEnd] +| | | | fail [FailureEnd] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G6.expected.txt b/test/Golden/Machine/G6.expected.txt index 4110d2c..98f14a7 100644 --- a/test/Golden/Machine/G6.expected.txt +++ b/test/Golden/Machine/G6.expected.txt @@ -1,6 +1,6 @@ pushValue Term minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 0) mayRaise=[] @@ -12,7 +12,7 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | pushValue cons | | minReads=(Right 2) @@ -137,6 +137,6 @@ catch ExceptionFailure | | | | minReads=(Right 0) | | | | mayRaise=[] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G7.expected.txt b/test/Golden/Machine/G7.expected.txt index de295fa..09e149d 100644 --- a/test/Golden/Machine/G7.expected.txt +++ b/test/Golden/Machine/G7.expected.txt @@ -1,6 +1,6 @@ pushValue Term minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 0) mayRaise=[] @@ -12,11 +12,11 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 2) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | catch ExceptionFailure | | minReads=(Right 2) -| | mayRaise=[] +| | mayRaise=[ExceptionFailure] | | | | | | | pushValue cons | | | | minReads=(Right 2) @@ -82,7 +82,7 @@ catch ExceptionFailure | | | | loadInput | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | @@ -98,7 +98,7 @@ catch ExceptionFailure | | | | | | | catch ExceptionFailure | | | | minReads=(Right 2) -| | | | mayRaise=[] +| | | | mayRaise=[ExceptionFailure] | | | | | | | | | | | pushValue cons | | | | | | minReads=(Right 2) @@ -161,10 +161,10 @@ catch ExceptionFailure | | | | | | loadInput | | | | | | minReads=(Left ExceptionFailure) | | | | | | mayRaise=[ExceptionFailure] -| | | | | | fail fromList [] +| | | | | | fail [] | | | | | | minReads=(Left ExceptionFailure) | | | | | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G8.expected.txt b/test/Golden/Machine/G8.expected.txt index a64abda..8c9f98e 100644 --- a/test/Golden/Machine/G8.expected.txt +++ b/test/Golden/Machine/G8.expected.txt @@ -1,9 +1,9 @@ let minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | catch ExceptionFailure | minReads=(Right 0) -| mayRaise=[] +| mayRaise=[ExceptionFailure] | | | | | pushValue (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3)))) | | | minReads=(Right 1) @@ -25,16 +25,16 @@ let | | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | call | | | minReads=(Right 0) -| | | mayRaise=[] +| | | mayRaise=[ExceptionFailure] | | | lift2Value (\u1 -> (\u2 -> u1 u2)) | | | minReads=(Right 0) | | | mayRaise=[] @@ -62,27 +62,27 @@ let | | | | | minReads=(Right 0) | | | | | mayRaise=[] | | | | -| | | | | fail fromList [] +| | | | | fail [] | | | | | minReads=(Left ExceptionFailure) | | | | | mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue (\u1 -> (\u2 -> u1)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] call minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] pushValue Term minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] lift2Value (\u1 -> (\u2 -> u1 u2)) minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 0) mayRaise=[] @@ -97,7 +97,7 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | catch ExceptionFailure | | minReads=(Right 0) @@ -118,7 +118,7 @@ catch ExceptionFailure | | | | loadInput | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | @@ -145,10 +145,10 @@ catch ExceptionFailure | | minReads=(Left ExceptionFailure) | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [FailureEnd] +| | | | fail [FailureEnd] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Machine/G9.expected.txt b/test/Golden/Machine/G9.expected.txt index 5b4ea7f..fbf05fc 100644 --- a/test/Golden/Machine/G9.expected.txt +++ b/test/Golden/Machine/G9.expected.txt @@ -1,6 +1,6 @@ pushValue Term minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] join minReads=(Right 0) mayRaise=[] @@ -12,7 +12,7 @@ join | mayRaise=[] catch ExceptionFailure minReads=(Right 0) - mayRaise=[] + mayRaise=[ExceptionFailure] | | | catch ExceptionFailure | | minReads=(Right 0) @@ -33,7 +33,7 @@ catch ExceptionFailure | | | | loadInput | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | @@ -60,10 +60,10 @@ catch ExceptionFailure | | minReads=(Left ExceptionFailure) | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [FailureEnd] +| | | | fail [FailureEnd] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] | | | -| | | | fail fromList [] +| | | | fail [] | | | | minReads=(Left ExceptionFailure) | | | | mayRaise=[ExceptionFailure] diff --git a/test/Golden/Splice/G1.expected.txt b/test/Golden/Splice/G1.expected.txt index b5a7fc2..357d156 100644 --- a/test/Golden/Splice/G1.expected.txt +++ b/test/Golden/Splice/G1.expected.txt @@ -78,26 +78,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -110,23 +110,23 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G10.expected.txt b/test/Golden/Splice/G10.expected.txt index e669c0e..aaedb7c 100644 --- a/test/Golden/Splice/G10.expected.txt +++ b/test/Golden/Splice/G10.expected.txt @@ -108,26 +108,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -140,26 +140,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -189,26 +189,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -221,23 +221,23 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G11.expected.txt b/test/Golden/Splice/G11.expected.txt index 951a9d6..424395f 100644 --- a/test/Golden/Splice/G11.expected.txt +++ b/test/Golden/Splice/G11.expected.txt @@ -80,7 +80,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let readFail = catchHandler in if readMore inp then @@ -103,7 +103,7 @@ inp ) cs - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "checkToken.else" in let failExp = @@ -116,26 +116,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -148,26 +148,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -200,26 +200,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -232,26 +232,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G12.expected.txt b/test/Golden/Splice/G12.expected.txt index f15487c..e1989e6 100644 --- a/test/Golden/Splice/G12.expected.txt +++ b/test/Golden/Splice/G12.expected.txt @@ -80,7 +80,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let readFail = catchHandler in if readMore inp then @@ -103,7 +103,7 @@ inp ) cs - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "checkToken.else" in let failExp = @@ -116,26 +116,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -148,26 +148,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -199,26 +199,26 @@ then let _ = "choicesBranch.then" in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -257,26 +257,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G13.expected.txt b/test/Golden/Splice/G13.expected.txt index beec063..a2f0b97 100644 --- a/test/Golden/Splice/G13.expected.txt +++ b/test/Golden/Splice/G13.expected.txt @@ -65,7 +65,7 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) name = \(!ok) (!inp) (!koByLabel) -> name ( let _ = "suspend" @@ -80,7 +80,7 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -110,7 +110,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let join = \farInp farExp v (!inp) -> name ( let _ = "suspend" @@ -128,10 +128,10 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) in let readFail = catchHandler in if readMore inp then @@ -173,26 +173,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -205,26 +205,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" in if '<' GHC.Classes.== c @@ -259,26 +259,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -291,26 +291,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" in if '+' GHC.Classes.== c @@ -345,26 +345,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -377,26 +377,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" in if '-' GHC.Classes.== c @@ -431,26 +431,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -463,26 +463,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" in if '.' GHC.Classes.== c @@ -517,26 +517,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -549,26 +549,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" in if ',' GHC.Classes.== c @@ -603,26 +603,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -635,26 +635,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" in if '[' GHC.Classes.== c @@ -704,26 +704,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -736,32 +736,32 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) ) cs - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "checkToken.else" in let failExp = @@ -774,26 +774,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -806,49 +806,49 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEmpty) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkToken.else" in let failExp = @@ -861,26 +861,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -893,26 +893,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -942,7 +942,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let readFail = catchHandler in if readMore inp then @@ -965,7 +965,7 @@ inp ) cs - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "checkToken.else" in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp init Data.Set.Internal.empty @@ -981,26 +981,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> diff --git a/test/Golden/Splice/G14.expected.txt b/test/Golden/Splice/G14.expected.txt index b327612..9167ac6 100644 --- a/test/Golden/Splice/G14.expected.txt +++ b/test/Golden/Splice/G14.expected.txt @@ -77,13 +77,13 @@ Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) name = \(!ok) (!inp) (!koByLabel) -> name ( let _ = "suspend" @@ -101,7 +101,7 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -152,7 +152,7 @@ Data.Map.Internal.Tip else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -169,7 +169,7 @@ (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) name = \(!ok) (!inp) (!koByLabel) -> let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel in if readMore inp @@ -209,26 +209,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel in if readMore inp @@ -259,26 +259,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -291,26 +291,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) @@ -347,26 +347,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -379,26 +379,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) @@ -435,26 +435,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -467,26 +467,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) @@ -523,26 +523,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -555,26 +555,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) @@ -611,26 +611,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -643,26 +643,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) @@ -720,26 +720,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -752,32 +752,32 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) inp Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp Data.Map.Internal.Tip @@ -796,26 +796,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -828,26 +828,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let readFail = Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel in if readMore (Symantic.Parser.Machine.Input.shiftRightText 4 inp) @@ -902,26 +902,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -934,29 +934,29 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -975,26 +975,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -1007,31 +1007,31 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = let _ = "catch.ko ExceptionFailure" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in let readFail = catchHandler in if readMore (Symantic.Parser.Machine.Input.shiftRightText 1 inp) then @@ -1063,13 +1063,13 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) ) cs Data.Map.Internal.Tip @@ -1088,26 +1088,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -1173,7 +1173,7 @@ Data.Map.Internal.Tip else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let join = \farInp farExp v (!inp) -> let _ = "resume" in join @@ -1296,22 +1296,22 @@ Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) failInp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let join = \farInp farExp v (!inp) -> let _ = "resume" in ok @@ -1384,26 +1384,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -1416,26 +1416,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = let _ = "catch.ko ExceptionFailure" @@ -1496,26 +1496,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -1528,26 +1528,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -1560,26 +1560,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -1619,26 +1619,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -1651,26 +1651,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -1736,26 +1736,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -1768,26 +1768,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -1820,26 +1820,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -1852,26 +1852,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -1895,7 +1895,7 @@ in name ok failInp Data.Map.Internal.Tip else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -1921,13 +1921,13 @@ Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -1957,7 +1957,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -1980,10 +1980,10 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -2019,7 +2019,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -2042,10 +2042,10 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -2081,7 +2081,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -2104,10 +2104,10 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -2143,7 +2143,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -2166,10 +2166,10 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -2205,7 +2205,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -2222,7 +2222,7 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -2255,7 +2255,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -2272,7 +2272,7 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -2305,7 +2305,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let join = \farInp farExp v (!inp) -> name ( let _ = "suspend" @@ -2320,7 +2320,7 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) in let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = let _ = "catch.ko ExceptionFailure" @@ -2358,7 +2358,7 @@ (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) failInp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "choicesBranch.else" in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -2449,13 +2449,13 @@ Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) ) cs (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -2471,26 +2471,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -2503,38 +2503,38 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) inp Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp Data.Map.Internal.Tip ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) in let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = let _ = "catch.ko ExceptionFailure" @@ -2623,26 +2623,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -2655,26 +2655,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -2687,26 +2687,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -2719,26 +2719,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -2832,7 +2832,7 @@ (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) cs Data.Map.Internal.Tip @@ -2848,26 +2848,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -2880,27 +2880,27 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp - else + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + else let _ = "checkToken.else" in let failExp = Data.Set.Internal.Bin @@ -2912,26 +2912,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -2944,26 +2944,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -2976,26 +2976,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -3008,26 +3008,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -3077,26 +3077,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -3109,26 +3109,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -3141,26 +3141,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -3190,7 +3190,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let readFail = catchHandler in if readMore inp then @@ -3213,7 +3213,7 @@ inp ) cs - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "checkToken.else" in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp init Data.Set.Internal.empty @@ -3229,26 +3229,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -3278,7 +3278,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let readFail = catchHandler in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) then @@ -3307,10 +3307,10 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) ) cs (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -3326,26 +3326,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -3358,26 +3358,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -3407,7 +3407,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = let _ = "catch.ko ExceptionFailure" @@ -3502,7 +3502,7 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -3569,7 +3569,7 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) ) cs (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) @@ -3585,26 +3585,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -3617,35 +3617,35 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) cs Data.Map.Internal.Tip @@ -3661,26 +3661,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -3693,26 +3693,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -3725,26 +3725,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -3757,26 +3757,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -3789,26 +3789,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -3821,26 +3821,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -3853,26 +3853,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -3885,26 +3885,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -3917,26 +3917,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "resume" in ok @@ -4004,26 +4004,26 @@ then let _ = "choicesBranch.then" in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -4062,26 +4062,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) inp Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G15.expected.txt b/test/Golden/Splice/G15.expected.txt index d097e37..ff5b3d8 100644 --- a/test/Golden/Splice/G15.expected.txt +++ b/test/Golden/Splice/G15.expected.txt @@ -82,26 +82,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -114,26 +114,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = let _ = "catch.ko ExceptionFailure" @@ -181,26 +181,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -213,26 +213,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -262,26 +262,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -294,23 +294,23 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G16.expected.txt b/test/Golden/Splice/G16.expected.txt index 69e7e6c..06b6029 100644 --- a/test/Golden/Splice/G16.expected.txt +++ b/test/Golden/Splice/G16.expected.txt @@ -82,26 +82,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -114,26 +114,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = let _ = "catch.ko ExceptionFailure" @@ -181,26 +181,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -213,26 +213,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -292,26 +292,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -324,26 +324,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in catchHandler Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -373,26 +373,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -405,23 +405,23 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G2.expected.txt b/test/Golden/Splice/G2.expected.txt index fb92475..1595b78 100644 --- a/test/Golden/Splice/G2.expected.txt +++ b/test/Golden/Splice/G2.expected.txt @@ -93,26 +93,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -125,26 +125,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -157,26 +157,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -189,23 +189,23 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G3.expected.txt b/test/Golden/Splice/G3.expected.txt index e0882a1..e69f26a 100644 --- a/test/Golden/Splice/G3.expected.txt +++ b/test/Golden/Splice/G3.expected.txt @@ -80,7 +80,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let readFail = catchHandler in if readMore inp then @@ -103,7 +103,7 @@ inp ) cs - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "checkToken.else" in let failExp = @@ -116,26 +116,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -148,26 +148,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> diff --git a/test/Golden/Splice/G4.expected.txt b/test/Golden/Splice/G4.expected.txt index 5a4c634..1fa2c08 100644 --- a/test/Golden/Splice/G4.expected.txt +++ b/test/Golden/Splice/G4.expected.txt @@ -55,7 +55,7 @@ let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = let _ = "catch.ko ExceptionFailure" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in let readFail = catchHandler in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) then @@ -106,26 +106,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -138,26 +138,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -170,26 +170,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -202,26 +202,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -234,26 +234,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -283,7 +283,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -300,10 +300,10 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) in name ( let _ = "suspend" in \farInp farExp v (!inp) -> diff --git a/test/Golden/Splice/G5.expected.txt b/test/Golden/Splice/G5.expected.txt index 970d806..c8dda7c 100644 --- a/test/Golden/Splice/G5.expected.txt +++ b/test/Golden/Splice/G5.expected.txt @@ -55,7 +55,7 @@ let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = let _ = "catch.ko ExceptionFailure" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in let readFail = catchHandler in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp) then @@ -106,26 +106,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -138,26 +138,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -170,26 +170,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -202,26 +202,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -234,26 +234,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp name = \(!ok) (!inp) (!koByLabel) -> let _ = "catch ExceptionFailure" in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) = @@ -283,7 +283,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -300,10 +300,10 @@ inp ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) ) inp - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler Data.Map.Internal.Tip Data.Map.Internal.Tip) in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -338,26 +338,26 @@ then let _ = "choicesBranch.then" in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -396,26 +396,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) inp Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G6.expected.txt b/test/Golden/Splice/G6.expected.txt index ec66571..63b6938 100644 --- a/test/Golden/Splice/G6.expected.txt +++ b/test/Golden/Splice/G6.expected.txt @@ -115,26 +115,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -147,26 +147,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -179,26 +179,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -232,26 +232,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -264,26 +264,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -296,23 +296,23 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G7.expected.txt b/test/Golden/Splice/G7.expected.txt index e0c3a5f..a1b37e6 100644 --- a/test/Golden/Splice/G7.expected.txt +++ b/test/Golden/Splice/G7.expected.txt @@ -119,26 +119,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -151,26 +151,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -183,26 +183,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -243,26 +243,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of - GHC.Types.LT -> - (# - cs, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of + GHC.Types.LT -> + (# + cs, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp else let _ = "checkToken.else" in let failExp = @@ -275,26 +275,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -307,23 +307,23 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp diff --git a/test/Golden/Splice/G8.expected.txt b/test/Golden/Splice/G8.expected.txt index ee724a2..4b19076 100644 --- a/test/Golden/Splice/G8.expected.txt +++ b/test/Golden/Splice/G8.expected.txt @@ -80,7 +80,7 @@ failInp else let _ = "choicesBranch.else" - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in Data.Map.Strict.Internal.findWithDefault finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp in let readFail = catchHandler in if readMore inp then @@ -103,7 +103,7 @@ inp ) cs - Data.Map.Internal.Tip + (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "checkToken.else" in let failExp = @@ -116,26 +116,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -148,26 +148,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp in name ( let _ = "suspend" in \farInp farExp v (!inp) -> @@ -199,26 +199,26 @@ then let _ = "choicesBranch.then" in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -257,26 +257,26 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of + GHC.Types.LT -> + (# + inp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp ) init Data.Map.Internal.Tip diff --git a/test/Golden/Splice/G9.expected.txt b/test/Golden/Splice/G9.expected.txt index e5c5d65..4dd551d 100644 --- a/test/Golden/Splice/G9.expected.txt +++ b/test/Golden/Splice/G9.expected.txt @@ -80,26 +80,26 @@ then let _ = "choicesBranch.then" in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of - GHC.Types.LT -> - (# - failInp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp failInp of + GHC.Types.LT -> + (# + failInp, + failExp + #) + GHC.Types.EQ -> + (# + farInp, + failExp GHC.Base.<> farExp + #) + GHC.Types.GT -> + (# + farInp, + farExp + #) + in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp else let _ = "choicesBranch.else" in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp @@ -135,23 +135,23 @@ ) Data.Set.Internal.Tip Data.Set.Internal.Tip - (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of - GHC.Types.LT -> - (# - init, - failExp - #) - GHC.Types.EQ -> - (# - init, - failExp GHC.Base.<> Data.Set.Internal.empty - #) - GHC.Types.GT -> - (# - init, - Data.Set.Internal.empty - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp + in let (# + farInp, + farExp + #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init init of + GHC.Types.LT -> + (# + init, + failExp + #) + GHC.Types.EQ -> + (# + init, + failExp GHC.Base.<> Data.Set.Internal.empty + #) + GHC.Types.GT -> + (# + init, + Data.Set.Internal.empty + #) + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure init farInp farExp -- 2.44.1 From 9e1ccd0887e5aa75a31ec2e352c61dd17c48d110 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 30 Apr 2021 12:49:02 +0200 Subject: [PATCH 12/16] nix: cleanup --- default.nix | 27 ++++++--------------------- symantic-parser.cabal | 4 +++- 2 files changed, 9 insertions(+), 22 deletions(-) diff --git a/default.nix b/default.nix index 532e292..98636f8 100644 --- a/default.nix +++ b/default.nix @@ -7,29 +7,13 @@ let if ghc == null then pkgs.haskellPackages else pkgs.haskell.packages.${ghc}; - hs = haskellPackages.extend (with pkgs.haskell.lib; - hself: hsuper: + hs = haskellPackages.extend (with pkgs.haskell.lib; hself: hsuper: { - data-fix = doJailbreak hsuper.data-fix; - primitive = doJailbreak hsuper.primitive; - assoc = doJailbreak hsuper.assoc; - these = doJailbreak hsuper.these; - dump-core = dontCheck (unmarkBroken hsuper.dump-core); - #profunctors = doJailbreak (unmarkBroken hsuper.profunctors); - #th-expand-syns = doJailbreak (unmarkBroken hsuper.th-expand-syns); - profunctors = dontCheck (unmarkBroken (doJailbreak (hsuper.callHackageDirect - { pkg = "profunctors"; - ver = "5.6.2"; - sha256 = "sha256-Vrlp6lvMNi+Bk+AHBMbnQE9NVzdASrcrFaWbkJew9qU="; - } {}))); - system-fileio = doJailbreak hsuper.system-fileio; - turtle = doJailbreak hsuper.turtle; - #symantic-parser = enableExecutableProfiling (doCheck ( hself.callCabal2nix "symantic-parser" ./. {})); - } // - packageSourceOverrides { - symantic-parser = ./.; - } hself hsuper + # FIXME: this should not be necessary, but haskellPackages.ormolu is currently broken. + ormolu = pkgs.ormolu; + symantic-parser = buildFromSdist (hself.callCabal2nix "symantic-parser" ./. {}); + } ); in hs.symantic-parser // { shell = hs.shellFor { @@ -45,6 +29,7 @@ in hs.symantic-parser // { buildInputs = [ #hs.ghcid pkgs.ormolu + pkgs.cabal2nix #hs.hlint #pkgs.nixpkgs-fmt ]; diff --git a/symantic-parser.cabal b/symantic-parser.cabal index b1fc2d5..e6e37bc 100644 --- a/symantic-parser.cabal +++ b/symantic-parser.cabal @@ -153,11 +153,13 @@ test-suite symantic-parser-test text >= 1.2, -- time >= 1.9, transformers >= 0.4, - turtle >= 1.5, -- QuickCheck >= 2.0, -- tasty-quickcheck, unix >= 2.7, unordered-containers + -- FIXME: add when haskellPackages.ormolu has been unbroken + -- build-tool-depends: + -- ormolu:ormolu >= 1.5 if flag(dump-core) build-depends: dump-core ghc-options: -fplugin=DumpCore -- 2.44.1 From 4ae33b960e3c80f980f6efc7ebde81935ca6cb8a Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Tue, 4 May 2021 16:45:52 +0200 Subject: [PATCH 13/16] add benchmarks --- .gitignore | 4 + HackMe.md | 36 + Makefile | 75 +- benchmarks/.gitignore | 1 + benchmarks/Brainfuck.hs | 79 ++ benchmarks/Main.hs | 11 + default.nix | 14 +- parsers/Parsers/Brainfuck/Attoparsec.hs | 29 + parsers/Parsers/Brainfuck/Handrolled.hs | 49 ++ parsers/Parsers/Brainfuck/SymanticParser.hs | 51 ++ parsers/Parsers/Brainfuck/Types.hs | 20 + parsers/Parsers/Brainfuck/inputs/compiler.bf | 749 ++++++++++++++++++ parsers/Parsers/Brainfuck/inputs/hanoi.bf | 713 +++++++++++++++++ .../Parsers/Brainfuck/inputs/helloworld.bf | 22 + .../Brainfuck/inputs/helloworld_golfed.bf | 1 + {test/Grammar => parsers/Parsers}/Nandlang.hs | 16 +- .../Grammar => parsers/Parsers}/Playground.hs | 2 +- parsers/Parsers/Tiny.hs | 76 ++ parsers/Parsers/Utils.hs | 25 + parsers/Parsers/Utils/Attoparsec.hs | 107 +++ parsers/Parsers/Utils/Attoparsec/Text.hs | 20 + parsers/Parsers/Utils/Handrolled.hs | 27 + src/Symantic/Parser.hs | 18 +- src/Symantic/Parser/Grammar.hs | 26 +- src/Symantic/Parser/Grammar/Combinators.hs | 21 +- src/Symantic/Parser/Machine.hs | 18 +- src/Symantic/Parser/Machine/Generate.hs | 44 +- src/Symantic/Parser/Machine/Input.hs | 36 +- src/Symantic/Parser/Machine/Instructions.hs | 15 +- src/Symantic/Parser/Machine/Program.hs | 34 +- symantic-parser.cabal | 99 ++- test/Golden/Grammar.hs | 4 +- test/Golden/Machine.hs | 4 +- test/Golden/Parser.hs | 2 +- test/Golden/Parser/G1/P1.expected.txt | 1 + test/Golden/Parser/G1/P1.input.txt | 1 + test/Golden/Parser/G10/P1.expected.txt | 1 + test/Golden/Parser/G10/P1.input.txt | 1 + test/Golden/Parser/G11/P1.expected.txt | 1 + test/Golden/Parser/G11/P1.input.txt | 1 + test/Golden/Parser/G12/P1.expected.txt | 1 + test/Golden/Parser/G12/P1.input.txt | 1 + test/Golden/Parser/G13/P1.expected.txt | 1 + test/Golden/Parser/G13/P1.input.txt | 1 + test/Golden/Parser/G13/P2.expected.txt | 1 + test/Golden/Parser/G13/P2.input.txt | 3 + test/Golden/Parser/G2/P1.expected.txt | 1 + test/Golden/Parser/G2/P1.input.txt | 1 + test/Golden/Parser/G2/P2.expected.txt | 1 + test/Golden/Parser/G2/P2.input.txt | 1 + test/Golden/Parser/G3/P1.expected.txt | 1 + test/Golden/Parser/G3/P1.input.txt | 1 + test/Golden/Parser/G4/P1.expected.txt | 1 + test/Golden/Parser/G4/P1.input.txt | 1 + test/Golden/Parser/G4/P2.expected.txt | 1 + test/Golden/Parser/G4/P2.input.txt | 1 + test/Golden/Parser/G4/P3.expected.txt | 1 + test/Golden/Parser/G4/P3.input.txt | 1 + test/Golden/Parser/G5/P1.expected.txt | 1 + test/Golden/Parser/G5/P1.input.txt | 1 + test/Golden/Parser/G5/P2.expected.txt | 1 + test/Golden/Parser/G5/P2.input.txt | 1 + test/Golden/Parser/G5/P3.expected.txt | 1 + test/Golden/Parser/G5/P3.input.txt | 1 + test/Golden/Parser/G6/P1.expected.txt | 1 + test/Golden/Parser/G6/P1.input.txt | 1 + test/Golden/Parser/G7/P1.expected.txt | 1 + test/Golden/Parser/G7/P1.input.txt | 1 + test/Golden/Parser/G7/P2.expected.txt | 1 + test/Golden/Parser/G7/P2.input.txt | 1 + test/Golden/Parser/G8/P1.expected.txt | 1 + test/Golden/Parser/G8/P1.input.txt | 1 + test/Golden/Parser/G9/P1.expected.txt | 1 + test/Golden/Parser/G9/P1.input.txt | 0 test/Golden/Parser/G9/P2.expected.txt | 1 + test/Golden/Parser/G9/P2.input.txt | 1 + test/Golden/Parser/left-right.txt | 1 + test/Golden/Splice.hs | 9 +- test/Golden/Splice/G13.expected.txt | 55 +- test/Golden/Splice/G14.expected.txt | 6 +- test/Golden/Utils.hs | 6 + test/Grammar.hs | 12 +- test/Grammar/Brainfuck.hs | 51 -- test/Parser.hs | 24 + 84 files changed, 2423 insertions(+), 232 deletions(-) create mode 100644 HackMe.md create mode 100644 benchmarks/.gitignore create mode 100644 benchmarks/Brainfuck.hs create mode 100644 benchmarks/Main.hs create mode 100644 parsers/Parsers/Brainfuck/Attoparsec.hs create mode 100644 parsers/Parsers/Brainfuck/Handrolled.hs create mode 100644 parsers/Parsers/Brainfuck/SymanticParser.hs create mode 100644 parsers/Parsers/Brainfuck/Types.hs create mode 100644 parsers/Parsers/Brainfuck/inputs/compiler.bf create mode 100644 parsers/Parsers/Brainfuck/inputs/hanoi.bf create mode 100644 parsers/Parsers/Brainfuck/inputs/helloworld.bf create mode 100644 parsers/Parsers/Brainfuck/inputs/helloworld_golfed.bf rename {test/Grammar => parsers/Parsers}/Nandlang.hs (95%) rename {test/Grammar => parsers/Parsers}/Playground.hs (92%) create mode 100644 parsers/Parsers/Tiny.hs create mode 100644 parsers/Parsers/Utils.hs create mode 100644 parsers/Parsers/Utils/Attoparsec.hs create mode 100644 parsers/Parsers/Utils/Attoparsec/Text.hs create mode 100644 parsers/Parsers/Utils/Handrolled.hs create mode 100644 test/Golden/Parser/G1/P1.expected.txt create mode 100644 test/Golden/Parser/G1/P1.input.txt create mode 100644 test/Golden/Parser/G10/P1.expected.txt create mode 100644 test/Golden/Parser/G10/P1.input.txt create mode 100644 test/Golden/Parser/G11/P1.expected.txt create mode 100644 test/Golden/Parser/G11/P1.input.txt create mode 100644 test/Golden/Parser/G12/P1.expected.txt create mode 100644 test/Golden/Parser/G12/P1.input.txt create mode 100644 test/Golden/Parser/G13/P1.expected.txt create mode 100644 test/Golden/Parser/G13/P1.input.txt create mode 100644 test/Golden/Parser/G13/P2.expected.txt create mode 100644 test/Golden/Parser/G13/P2.input.txt create mode 100644 test/Golden/Parser/G2/P1.expected.txt create mode 100644 test/Golden/Parser/G2/P1.input.txt create mode 100644 test/Golden/Parser/G2/P2.expected.txt create mode 100644 test/Golden/Parser/G2/P2.input.txt create mode 100644 test/Golden/Parser/G3/P1.expected.txt create mode 100644 test/Golden/Parser/G3/P1.input.txt create mode 100644 test/Golden/Parser/G4/P1.expected.txt create mode 100644 test/Golden/Parser/G4/P1.input.txt create mode 100644 test/Golden/Parser/G4/P2.expected.txt create mode 100644 test/Golden/Parser/G4/P2.input.txt create mode 100644 test/Golden/Parser/G4/P3.expected.txt create mode 100644 test/Golden/Parser/G4/P3.input.txt create mode 100644 test/Golden/Parser/G5/P1.expected.txt create mode 100644 test/Golden/Parser/G5/P1.input.txt create mode 100644 test/Golden/Parser/G5/P2.expected.txt create mode 100644 test/Golden/Parser/G5/P2.input.txt create mode 100644 test/Golden/Parser/G5/P3.expected.txt create mode 100644 test/Golden/Parser/G5/P3.input.txt create mode 100644 test/Golden/Parser/G6/P1.expected.txt create mode 100644 test/Golden/Parser/G6/P1.input.txt create mode 100644 test/Golden/Parser/G7/P1.expected.txt create mode 100644 test/Golden/Parser/G7/P1.input.txt create mode 100644 test/Golden/Parser/G7/P2.expected.txt create mode 100644 test/Golden/Parser/G7/P2.input.txt create mode 100644 test/Golden/Parser/G8/P1.expected.txt create mode 100644 test/Golden/Parser/G8/P1.input.txt create mode 100644 test/Golden/Parser/G9/P1.expected.txt create mode 100644 test/Golden/Parser/G9/P1.input.txt create mode 100644 test/Golden/Parser/G9/P2.expected.txt create mode 100644 test/Golden/Parser/G9/P2.input.txt create mode 100644 test/Golden/Parser/left-right.txt delete mode 100644 test/Grammar/Brainfuck.hs create mode 100644 test/Parser.hs diff --git a/.gitignore b/.gitignore index ebe1d38..886d3f4 100644 --- a/.gitignore +++ b/.gitignore @@ -1,11 +1,15 @@ *.actual.* *.eventlog +*.eventlog +*.eventlog.html +*.eventlog.json *.hi *.hp *.o *.prof *.root .direnv/ +.ghc.environment.* .stack-work/ dist-newstyle/ dump-core/ diff --git a/HackMe.md b/HackMe.md new file mode 100644 index 0000000..6400cbf --- /dev/null +++ b/HackMe.md @@ -0,0 +1,36 @@ +# Hacking `symantic-parser` + +## Typing +```bash +make repl +make parsers/repl +make tests/repl +make benchmarks/repl +``` + +## Testing +```bash +make tests +``` + +### Profiling +```bash +make tests/prof +make tests/prof t=.Golden.Parsers.G13 +``` + +## Benchmarking + +### Profiling + +#### Time +```bash +make benchmarks/prof-time b=Brainfuck/ByteString/hanoi/'*' BENCHMARK_OPTIONS=-n1 +``` +Then open `symantic-parser-benchmakrs.eventlog.json` with [`speedscope`](https://www.speedscope.app). + +#### Heap +```bash +make benchmarks/prof-heap b=Brainfuck/ByteString/hanoi/'*' BENCHMARK_OPTIONS=-n1 +``` +Then open `symantic-parser-benchmakrs.eventlog.html`. diff --git a/Makefile b/Makefile index a888609..3baf631 100644 --- a/Makefile +++ b/Makefile @@ -1,30 +1,73 @@ -cabal = $(wildcard *.cabal) -package = $(notdir ./$(cabal:.cabal=)) -version = $(shell sed -ne 's/^version: *\(.*\)/\1/p' $(cabal)) +override RTS_OPTIONS += -L100 +override TEST_OPTIONS += --color always --size-cutoff 1000000 $(addprefix -p ,$t) +override GHC_PROF_OPTIONS += -fprof-auto -fprof-auto-calls +override BENCHMARK_OPTIONS += --output benchmarks/html/$(version).html --match glob $b + +cabal := $(wildcard *.cabal) +package := $(notdir ./$(cabal:.cabal=)) +version := $(shell sed -ne 's/^version: *\(.*\)/\1/p' $(cabal)) +project := $(patsubst %.cabal,%,$(cabal)) + all: build build: cabal build clean c: cabal clean repl: - cabal repl + cabal repl $(project) +parsers/repl: + cabal repl $(project):parsers -t: - cabal test $(TESTFLAGS) --test-show-details always --test-options "$(TESTOPTIONS) --color always --size-cutoff 1000000 $${p:+-p $$p}" -%/accept: TESTOPTIONS+=--accept +tests: + cabal test $(CABAL_TEST_FLAGS) \ + --test-show-details always --test-options "$(TEST_OPTIONS)" +tests/prof-time: $(project)-test.eventlog.json +tests/prof-heap: $(project)-test.eventlog.html +.PHONY: $(project)-test.eventlog +$(project)-test.eventlog $(project)-test.prof: + cabal test $(CABAL_TEST_FLAGS) \ + --test-show-details always --test-options "$(TEST_OPTIONS) +RTS $(RTS_OPTIONS)" \ + --enable-profiling $(GHC_PROF_OPTIONS) || true +tests/prof-th: + cabal v2-build lib:$(project) --enable-profiling $(GHC_PROF_OPTIONS) --write-ghc-environment-files=always + cabal test $(CABAL_TEST_FLAGS) \ + --test-show-details always --test-options "$(TEST_OPTIONS) +RTS $(RTS_OPTIONS)" \ + --enable-profiling $(GHC_PROF_OPTIONS) \ + --ghc-options "$(addprefix -opti,+RTS $(RTS_OPTIONS))" +tests/repl: + cabal repl --enable-tests $(project)-test + +%/accept: TEST_OPTIONS += --accept %/accept: % -%/cover: TESTFLAGS+=--enable-coverage +%/cover: CABAL_TEST_FLAGS += --enable-coverage %/cover: % -t/prof: OPTIFLAGS?=-xc -t/prof: - cabal v2-build lib:symantic-parser --enable-profiling --write-ghc-environment-files=always - cabal test $(TESTFLAGS) --enable-profiling -fprof-auto -fprof-auto-calls \ - --test-show-details always --test-options "$(TESTOPTIONS) $${p:+-p $$p}" \ - --ghc-options "-opti+RTS -opti-p -opti-L100 -opti-ls $(addprefix -opti,$(OPTIFLAGS))" -t/repl: - cabal repl --enable-tests symantic-parser-test +%.eventlog.html: RTS_OPTIONS += -hy -l-au +%.eventlog.html: %.eventlog + eventlog2html $< +%.eventlog.json: RTS_OPTIONS += -p -l-au +%.eventlog.json: %.eventlog + hs-speedscope $< + +b benchmarks/html/$(version).html: + mkdir -p benchmarks/html + cabal bench $(CABAL_BENCH_FLAGS) --benchmark-options "$(BENCHMARK_OPTIONS)" +benchmarks/repl: + cabal repl --enable-benchmarks $(project)-benchmark +benchmarks/prof-time: $(project)-benchmark.eventlog.json +benchmarks/prof-heap: $(project)-benchmark.eventlog.html +.PHONY: $(project)-benchmark.eventlog +$(project)-benchmark.eventlog $(project)-benchmark.prof: + cabal bench $(CABAL_BENCH_FLAGS) \ + --benchmark-options "$(BENCHMARK_OPTIONS) +RTS $(RTS_OPTIONS)" \ + --enable-profiling $(GHC_PROF_OPTIONS) +$(project)-benchmark.prof2: + cabal v2-build lib:$(project) --enable-profiling $(GHC_PROF_OPTIONS) --write-ghc-environment-files=always + cabal bench $(CABAL_BENCH_FLAGS) \ + --benchmark-options "$(BENCHMARK_OPTIONS)" \ + --enable-profiling $(GHC_PROF_OPTIONS) \ + --ghc-options "$(addprefix -opti,+RTS $(RTS_OPTIONS))" doc: cabal haddock --haddock-css ocean --haddock-hyperlink-source diff --git a/benchmarks/.gitignore b/benchmarks/.gitignore new file mode 100644 index 0000000..1936cc1 --- /dev/null +++ b/benchmarks/.gitignore @@ -0,0 +1 @@ +html diff --git a/benchmarks/Brainfuck.hs b/benchmarks/Brainfuck.hs new file mode 100644 index 0000000..f5199d1 --- /dev/null +++ b/benchmarks/Brainfuck.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} + -- for Symantic.Parser's TemplateHaskell +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} +module Brainfuck where + +--import qualified Data.Text.Lazy as TL +import Control.Monad ((=<<)) +import Criterion.Main (Benchmark, bench, bgroup, env, nf) +import Data.Function (($)) +import Data.Semigroup (Semigroup(..)) +import Data.String (String) +import Data.Text (Text) +import qualified Data.Attoparsec.ByteString as AP.ByteString +import qualified Data.Attoparsec.Text as AP.Text +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import qualified Data.List as List +import qualified Data.Text.IO as Text +import qualified System.IO as IO + +import qualified Symantic.Parser as SP +import qualified Parsers.Brainfuck.Attoparsec as AP.Brainfuck +import qualified Parsers.Brainfuck.Handrolled as HR.Brainfuck +import qualified Parsers.Brainfuck.SymanticParser as SP.Brainfuck +import Paths_symantic_parser + +inputPath inputName = getDataFileName ("parsers/Parsers/Brainfuck/inputs/"<>inputName<>".bf") +benchBrainfuck inputName = + [ bgroup "Text" + [ env (Text.readFile =<< inputPath inputName) $ \inp -> + bgroup inputName + [ bench "SymanticParser" $ + nf $$(SP.runParser @Text SP.Brainfuck.grammar) inp + , bench "Attoparsec" $ + nf (AP.Text.parse AP.Brainfuck.parser) inp + , bench "Handrolled" $ + nf HR.Brainfuck.parser inp + ] + ] + , bgroup "String" + [ env (IO.readFile =<< inputPath inputName) $ \inp -> + bgroup inputName + [ bench "SymanticParser" $ + nf $$(SP.runParser @String SP.Brainfuck.grammar) inp + ] + ] + , bgroup "ByteString" + [ env (BS.readFile =<< inputPath inputName) $ \inp -> + bgroup inputName + [ bench "SymanticParser" $ + nf $$(SP.runParser @BS.ByteString SP.Brainfuck.grammar) inp + , bench "Attoparsec" $ + nf (AP.ByteString.parse AP.Brainfuck.parser) inp + , bench "Handrolled" $ + nf HR.Brainfuck.parser inp + ] + ] + , bgroup "ByteStringLazy" + [ env (BSL.readFile =<< inputPath inputName) $ \inp -> + bgroup inputName + [ bench "SymanticParser" $ + nf $$(SP.runParser @BSL.ByteString SP.Brainfuck.grammar) inp + ] + ] + ] + +benchmark :: Benchmark +benchmark = bgroup "Brainfuck" $ List.concat + [ benchBrainfuck "helloworld" + , benchBrainfuck "compiler" + , benchBrainfuck "hanoi" + ] diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs new file mode 100644 index 0000000..d79b32b --- /dev/null +++ b/benchmarks/Main.hs @@ -0,0 +1,11 @@ +module Main where + +import Criterion.Main +import Prelude +import qualified Brainfuck + +main :: IO () +main = + defaultMain $ + [ Brainfuck.benchmark + ] diff --git a/default.nix b/default.nix index 98636f8..711121b 100644 --- a/default.nix +++ b/default.nix @@ -12,17 +12,25 @@ let #symantic-parser = enableExecutableProfiling (doCheck ( hself.callCabal2nix "symantic-parser" ./. {})); # FIXME: this should not be necessary, but haskellPackages.ormolu is currently broken. ormolu = pkgs.ormolu; - symantic-parser = buildFromSdist (hself.callCabal2nix "symantic-parser" ./. {}); + text-short = dontCheck hsuper.text-short; + hs-speedscope = doJailbreak (unmarkBroken hsuper.hs-speedscope); + eventlog2html = doJailbreak (unmarkBroken hsuper.eventlog2html); + trie-simple = doJailbreak (unmarkBroken hsuper.trie-simple); + symantic-parser = doBenchmark (buildFromSdist (hself.callCabal2nix "symantic-parser" ./. {})); } ); in hs.symantic-parser // { shell = hs.shellFor { + doBenchmark = true; packages = p: [ p.symantic-parser ]; nativeBuildInputs = [ hs.cabal-install - #hs.ghc-events - #hs.ghc-events-analyze + hs.ghc-events + hs.hs-speedscope + hs.profiteur + hs.eventlog2html #hs.threadscope + #hs.ghc-events-analyze #hs.haskell-language-server #hs.hpc ]; diff --git a/parsers/Parsers/Brainfuck/Attoparsec.hs b/parsers/Parsers/Brainfuck/Attoparsec.hs new file mode 100644 index 0000000..6f43718 --- /dev/null +++ b/parsers/Parsers/Brainfuck/Attoparsec.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +module Parsers.Brainfuck.Attoparsec where + +import Control.Applicative +import Data.Attoparsec.Combinator +import Data.ByteString as BS +import Data.Functor (($>)) +import Data.Text as T +import qualified Data.Attoparsec.Internal.Types as AP + +import Parsers.Utils.Attoparsec as AP +import Parsers.Brainfuck.Types + +parser :: forall inp. AP.Inputable inp => AP.Parser inp [Instruction] +parser = whitespace *> bf <* endOfInput + where + whitespace = skipMany (AP.satisfy (AP.notInClass @inp "<>+-.,[]")) + lexeme :: AP.Parser inp a -> AP.Parser inp a + lexeme p = p <* whitespace + bf = many (lexeme (AP.char '>' $> Forward) + <|> lexeme (AP.char '<' $> Backward) + <|> lexeme (AP.char '+' $> Increment) + <|> lexeme (AP.char '-' $> Decrement) + <|> lexeme (AP.char '.' $> Output) + <|> lexeme (AP.char ',' $> Input) + <|> between (lexeme (AP.char '[')) (lexeme (AP.char ']')) (Loop <$> bf)) +-- Specializing is essential to keep best performances. +{-# SPECIALIZE parser :: AP.Parser T.Text [Instruction] #-} +{-# SPECIALIZE parser :: AP.Parser BS.ByteString [Instruction] #-} diff --git a/parsers/Parsers/Brainfuck/Handrolled.hs b/parsers/Parsers/Brainfuck/Handrolled.hs new file mode 100644 index 0000000..dacc18a --- /dev/null +++ b/parsers/Parsers/Brainfuck/Handrolled.hs @@ -0,0 +1,49 @@ +module Parsers.Brainfuck.Handrolled where + +import Control.Monad (Monad(..), fail) +import Data.ByteString as BS +import Data.Char (Char) +import Data.Maybe (Maybe(..)) +import Data.Text as T +import qualified Data.List as List + +import Parsers.Utils +import qualified Parsers.Utils.Handrolled as HR +import Parsers.Brainfuck.Types + +parser :: forall inp. + CoerceEnum (HR.Token inp) Char => + HR.Inputable inp => + inp -> Maybe [Instruction] +parser input = do + (acc, is) <- walk input [] + if HR.null is + then fail "remaining input" + else Just acc + where + walk :: inp -> [Instruction] -> Maybe ([Instruction], inp) + walk inp acc = + case HR.uncons inp of + Nothing -> Just (List.reverse acc, HR.empty) + Just (i, is) -> + case coerceEnum i of + ']' -> Just (List.reverse acc, inp) + '>' -> walk is (Forward:acc) + '<' -> walk is (Backward:acc) + '+' -> walk is (Increment:acc) + '-' -> walk is (Decrement:acc) + '.' -> walk is (Output:acc) + ',' -> walk is (Input:acc) + '[' -> do + (body, is') <- loop is + walk is' (Loop body:acc) + _ -> walk is acc + loop :: inp -> Maybe ([Instruction], inp) + loop inp = do + (body, rest) <- walk inp [] + case HR.uncons rest of + Just (i, rest') | ']' <- coerceEnum i -> return (body, rest') + _ -> fail "unclosed loop" +-- Specializing is essential to keep best performances. +{-# SPECIALIZE parser :: T.Text -> Maybe [Instruction] #-} +{-# SPECIALIZE parser :: BS.ByteString -> Maybe [Instruction] #-} diff --git a/parsers/Parsers/Brainfuck/SymanticParser.hs b/parsers/Parsers/Brainfuck/SymanticParser.hs new file mode 100644 index 0000000..7db71f5 --- /dev/null +++ b/parsers/Parsers/Brainfuck/SymanticParser.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +module Parsers.Brainfuck.SymanticParser where + +import Data.Char (Char) +import Data.Function ((.)) +import qualified Language.Haskell.TH.Syntax as TH +import qualified Prelude + +import Symantic.Univariant.Trans +import qualified Symantic.Parser as SP +import qualified Symantic.Parser.Haskell as H + +import Parsers.Utils +import Parsers.Brainfuck.Types + +haskell :: TH.Lift a => a -> SP.TermGrammar a +haskell a = H.Term (H.ValueCode a [||a||]) + +-- | Use with @$$(runParser @Text grammar)@, +-- but in another Haskell module to avoid +-- GHC stage restriction on such top-level splice. +grammar :: forall tok repr. + CoerceEnum Char tok => + CoerceEnum tok Char => + SP.Grammarable tok repr => + repr [Instruction] +grammar = whitespace SP.*> bf + where + whitespace = SP.skipMany (SP.noneOf (coerceEnum @_ @tok Prelude.<$> "<>+-,.[]")) + lexeme :: repr a -> repr a + lexeme p = p SP.<* whitespace + bf :: repr [Instruction] + bf = SP.many (lexeme (SP.match (SP.look (SP.item @tok)) + (haskell . coerceEnum Prelude.<$> "<>+-,.[") + op SP.empty)) + op :: H.Term H.ValueCode tok -> repr Instruction + op (trans -> H.ValueCode c _) = case coerceEnum c of + '<' -> SP.item @tok SP.$> SP.code Backward + '>' -> SP.item @tok SP.$> SP.code Forward + '+' -> SP.item @tok SP.$> SP.code Increment + '-' -> SP.item @tok SP.$> SP.code Decrement + ',' -> SP.item @tok SP.$> SP.code Input + '.' -> SP.item @tok SP.$> SP.code Output + '[' -> SP.between (lexeme (SP.item @tok)) + (SP.token (coerceEnum @_ @tok ']')) + (H.Term (H.ValueCode Loop [||Loop||]) SP.<$> bf) + _ -> Prelude.undefined diff --git a/parsers/Parsers/Brainfuck/Types.hs b/parsers/Parsers/Brainfuck/Types.hs new file mode 100644 index 0000000..bdabdef --- /dev/null +++ b/parsers/Parsers/Brainfuck/Types.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} +module Parsers.Brainfuck.Types where + +import Control.DeepSeq (NFData) +import Data.Eq (Eq(..)) +import GHC.Generics (Generic) +import Text.Show (Show(..)) +import qualified Language.Haskell.TH.Syntax as TH + +data Instruction + = Forward + | Backward + | Increment + | Decrement + | Input + | Output + | Loop [Instruction] + deriving (Show, Eq, TH.Lift, Generic, NFData) diff --git a/parsers/Parsers/Brainfuck/inputs/compiler.bf b/parsers/Parsers/Brainfuck/inputs/compiler.bf new file mode 100644 index 0000000..522029e --- /dev/null +++ b/parsers/Parsers/Brainfuck/inputs/compiler.bf @@ -0,0 +1,749 @@ +Thanks to: https://github.com/matslina/awib +# This is the awib frontend +# Please refer to the documentation in the full source distribution +# of awib for details regarding this file +## Phase 1 +## Target identification +## +% *T (where T = index of target platform) +# read bytes until EOF or bf instruction or '@' is reached +>>>>+[>[-],+ +% T 0 0 0 1 *inc(X) 0 0 0 (where X is byte read) +[->+>+<<]>>[-<<+>>]+< +% T 0 0 0 1 inc(X) *inc(X) 1 0 +[-[>+++++[-<------->]+<-[-[-[-[--------------[--[-->>+<<[>>-<++ +[-<--------->]+<[--[>+++++++++[-<++++++++++>]<[-]]]]]]]]]]]<->] +>[-<<<->>>]<<<] +% T 0 0 0 *0 X 0 0 d +% if( X=='@' ) d=1 else if(EOF) X=0 else X = a bf instruction +# if '@' was encountered then read a string at most 20 bytes long +# whitespace and EOF and bf all terminate the string when read +>>>>[->++++++++++++++++++++<<<<[-]>>>+[ +% T 0 0 0 0 (target) 0 0 0 *1 C (where C = sub(20 strlen(target))) +-<,+[-<+<+>>]+<<-> +% T 0 0 0 0 (target) X *X 1 0 C +[-[---------[-[---[>++++[-<---->]+<+[-----------[-[-[-[-------------- +[--[>++[-<--------->]+<--[--[>+++++++++[-<++++++++++>]<[-]]]]]]]]]]]]]]] ++>[-<->] +% T 0 0 0 0 (target) X c *0 0 C (where c=(X EOF or bf or whitespace ? 0 : 1)) +>>[->+<] +<<<[->>>+>->+<[>-]>[>]<[-<<->>]<<<<<]>>> +% T 0 0 0 0 (target) X 0 0 0 *c D +% where c=(string terminated ? 0 : 1) and D=(c==1 ? sub(C 1) : C) +] +# if string was ended due to strlen exceeding limit then read one char extra ++>[<-]<[<]>[-<<<,>>>>] +% T 0 0 0 0 (target) X 0 0 0 *0 D +# now check if the read target string matches any known target string +# and overwrite the target index T accordingly +# we take care not to overwrite the last read X as it may be bf and should +# be passed on to the bytecode compiler below +<<<<+[->+<]>[-<<[<]<<<+>>>>[>]>]++++++++++++++++++++>>>>[-<<<<->>>>]<<<++++++++ +<<<[<]<<<->>>>[>]>> +% T X 0 0 0 (target) 0 s *8 0 0 (where s = strlen(target)) +[[->+>+<<]>[-<+>]+>-[-[-[-[-[-[-[-[<->[-]] +<[- +# build target string for backend index 8 +% T X 0 0 0 (target) 0 s 8 *0 0 +>+++++++++[->+>++++++++++++<<]>>[->+>+>+>+>+>+>+>+>+<<<<<<<<<] +>>----------->++>----->------------->-->----------->++++++++++>----------- +<<<<<<<<<<<< +% T X 0 0 0 (target) 0 s 8 *0 0 9 0 "lang_java" 0 +]>] +<[- +# build target string for backend index 7 +% T X 0 0 0 (target) 0 s 7 *0 0 +>+++++++++[->+>++++++++++++<<]>->[->+>+>+>+>+>+>+>+<<<<<<<<]>>----------->++ +>----->------------->++++++++>--------- +<<<<<<<<<< +% T X 0 0 0 (target) 0 s 7 *0 0 8 0 "lang_tcl" 0 +]>] +<[- +# build target string for backend index 6 +% T X 0 0 0 (target) 0 s 6 *0 0 +>+++++++++[->+>++++++++++++<<]>>[->+>+>+>+>+>+>+>+>+<<<<<<<<<]>>----------->++ +>----->------------->++++++>+++++++++>---------->+++++++++++++ +<<<<<<<<<<<< +% T X 0 0 0 (target) 0 s 6 *0 0 9 0 "lang_ruby" 0 +]>] +<[- +# build target string for backend index 5 +% T X 0 0 0 (target) 0 s 5 *0 0 +>+++++++++++[->+>++++++++++<<]>>[->+>+>+>+>+>+>+>+>+>+>+<<<<<<<<<<<] +>-->------------->>------->--------------->++>+++++++++++>++++++>------>+ +<<<<<<<<<<<<< +% T X 0 0 0 (target) 0 s 5 *0 0 11 0 "lang_python" 0 +]>] +<[- +# build target string for backend index 4 +% T X 0 0 0 (target) 0 s 4 *0 0 +>>+++++++[->+++++++<]+++++++> +[->++>++>++>++>++>++>++<<<<<<<]> +++++++++++>->++++++++++++>+++++>--->+++++>+++++++++++++ +<<<<<<<<<< +% T X 0 0 0 (target) 0 s 4 *0 0 7 0 "lang_go" 0 +]>] +<[- +# build target string for backend index 3 +% T X 0 0 0 (target) 0 s 3 *0 0 +>>+++++++[->+++++++<]++++++++++> +[->++>++>++>++>++>++>++>++>++>++<<<<<<<<<<]> +++++++++++>->++++++++++++>+++++>--->++>+++++++++++++++++++>+++++++++++> ++++++++++++>+++++++++++++++++++++++<<<<<<<<<<<<< +% T X 0 0 0 (target) 0 s 3 *0 0 10 0 "lang_dummy" 0 +]>] +<[- +# build target string for backend index 2 +% T X 0 0 0 (target) 0 s 2 *0 0 +>>+++++++[->+++++++<]++++++>[->++>++>++>++>++>++<<<<<<] +>++++++++++>->++++++++++++>+++++>--->+<<<<<<<<< +% T X 0 0 0 (target) 0 s 2 *0 0 6 0 "lang_c" 0 +]>] +<[- +# build target string for backend index 1 +% T X 0 0 0 (target) 0 s 1 *0 0 +>>+++++++[->+++++++<]+++++++++>[->+>+>+>++>++>++>++>++>++<<<<<<<<<] +>++>+++++++>+++++>--->++++++++++>+++++++>++++++++++++>+++ +++++++++++++++++>++++++++++++++++++++++<<<<<<<<<<<< +% T X 0 0 0 (target) 0 s 1 *0 0 9 0 "386_linux" 0 +] +% T X 0 0 0 (target) 0 s i *0 0 S 0 (string) 0 +% where S = strlen(string) and i is the backend index of the target (string) +# if (target) equals (string) then set T=i and break else decrease s and retry +<<[->>+>>-<<<<]>>[-<<+>>]>+>[<++++[->++++<]>[-]]< +% T X 0 0 0 (target) 0 s i 0 *e 0 0 (string) 0 (where e=(S==s ? 1 : 0)) +[- +<+<<<<[<]> +% T X 0 0 0 *(target) 0 s i 1 0 0 0 (string) 0 +[ +% T X 0 (target) 0 0 *(F target) 0 s i c 0 (1sled) 0 0 (G string) 0 +% where c = (strings equal so far ? 1 : 0 ) and (1sled) is a (initially empty) +% sequence of cells holding 1 and F/G first cells of respective block +[-<+<+>>]<[>>[>]>>>>>[>]>+>[<-]<[<]>[-<<[<]<[-]<<<<[<]<[-]+>>[>]>>>>>[>]>>+<]>-<<<[<]<<<<<[<]<-] +% T X 0 (target F) *0 0 (target) 0 s i c 0 (1sled) 0 0 sub(G F) (string) 0 +>>[>]>>>>>[>]>>[[-]<<<[<]<[-]>>[>]>>]<<+[<]<<<<<[<]> +% T X 0 (target F) 0 0 *(target) 0 s i c 0 (1sled) 1 0 0 (string) +] +% T X 0 (target) 0 0 *0 s i c 0 (1sled) 0 +<<<[[->>+<<]<]>>>[>]>>>>>[>]<[-<]< +% T X 0 0 0 (target) 0 s i *c 0 +# if c==1 then we have a match and write T=i and set i=1 +[-<<<<[<]<<<<[-]>>>>>[>]>>[-<<<[<]<<<<+>>>>>[>]>>]+>]> +% T X 0 0 0 (target) 0 s i 0 *0 +] +# remove (string) if string lengths didn't match and then sub 1 from i +>>>[>]<[[-]<]<< +<<-] +% T X 0 0 0 (target) 0 s *0 0 0 +<[-]<<[[-]<]<<<+[->>>>+<<<<]>>>>->>> +% T 0 0 0 0 X 0 0 *0 +] +% T 0 0 0 0 X 0 0 *0 +<<<+[->>>>>>>+<<<<<<<]>>>>>>>- +% T 11(0) *X 0 0 +## Phase 2 +## Bytecode compilation +## +% T 11(0) *X (where X is user input) +# if read char X is not EOF then enter main loop ++[[-<+>]>+<]>[-<<->>]<< +[ +% T 8(0) (code) 0 0 *X (cells left of code ignored for a while hereafter) +# check if X is brainfuck +[->+>+<<]>[-<+>]++++++[->-------<]+>- +[-[-[-[--------------[--[<+++[->----- +--<]+>-[--[<->>+++++++[-<++++++++++++ ++>]<++[-]]]]]]]]]<< +% (code) 0 0 *X isbf(X) 0 0 +# if bf then add to bytecode +>[- +++++++[-<------->]+< +% (code) 0 0 *sub(X 42) 1 0 0 +[-[-[-[-[--------------[--[-----------------------------[ +# CLOSING BRACKET +# if this closes OPEN SUB(1) or OPEN ADD(1) then overwrite with SET(0) +# else append CLOSE +--<< ++<<<<-------[>>>>-]>>>>[>>>>]<<<<<<<<+++++++>>>> +% (code) P i Q j *c 0 0 1 0 (where c = (P(i) == OPEN(0))) +[<<---[>>-]>>[>>]<<[->>>>+<<<<]+ + << ++[>>-]>>[>>]<<[->>>>+<<<<]<<+>>>>>> + % (code) OPEN 0 Q j 0 0 0 1 *d (where d = (Q == ADD or Q == SUB)) + [-<<<<+<-[>-]>[>]<<+> + % (code) OPEN 0 Q j *e 0 0 1 0 (where e = (j == 1) == overwrite SET(0)) + [->>>-<<<<-<[-]<<++>>]>>>>]<<<<]> +% (code) 0 *0 0 f 0 (where f = 1 if append CLOSE) +>>[-<<<++++++++>>>>>]<< +% (code) CLOSE()/SET(0) 0 *0 0 0 +] +# OPENING BRACKET +# if previous op was SET(0) or CLOSE or if this is the first op +# then ignore this loop +>[- +% (code) 0 0 0 *0 0 0 ++++<<<<< +[>>>>>-<<<<<[->>>+<<<]]>>> +--------[++++++++[-<+>]<-------->>>-<<]< +-[+++++++++[-<<+>>]<<--------->>>>>-<<<]<<+++++++++>> ++<[>-]>[>]<[->>>[-<+>]<<<]>>>[-]<<<+++++++>> +% (code) OPEN *c 0 0 0 (where c = (should this loop be ignored ? 1 : 0)) +[[-]+>>>>>+<<<<<[ +% (code) OPEN *1 0 0 0 L l +>>+<,[>-]>[>]<[-<<->>]+<+[>-]>[>]<[-<<->>]<- +% (code) OPEN c *X 0 0 L l (where c = (EOF reached ? 0 : 1) and X = byte read) +>+++++++++[-<---------->]+<-[>-]>[>]<[->> +{ 16b inc >>>++++++++[-<++++++++>]<[->++++<]< + [->+>-<<]>+[-<+>]+>-[<->[-]]<[-<[-]<+>>]<< } +<<]+<--[>-]>[>]<[->> +{ 16b dec >>+<[>-<[->>+<<]]>>[-<<+>>]<<->[-<+ + <->++++++++[->++++++++<]>[-<++++>]<->]<< } +<<]+++++++++[-<++++++++++>]<++++[-] +>>> +{ 16b iszero >>+<[>-]>[>]<<<[[->>>+<<<]>>[-]<<]>>>[-<<<+>>>]<<< } +# if Ll=0 then delete OPEN and set c=0 to break +>>[-<<<<<<[-]<<------->>>>>>]<<<<<< +]] +% (code) *0 0 0 0 L l (where Ll is nonzero iff EOF occurred prematurely) +>>>>[-]>[-]<<< +% (code) 0 0 *0 0 +]<] +# MOVE RIGHT +# if previous op is RIGHT(i) and i is not 255 then overwrite with RIGHT(inc(i)) +# else append RIGHT(1) +>[ +-<<<<<[->>+>+<<<]>>[-<<+>>]<[->+>>+<<<]>[-<+>] +% (code) *0 P i 0 (where P(i) = previous op) +++++++++++++++++[->>----------------<<]>>+ +[<<++++++++++++++++[->>++++++++++++++++<<]+>>[-]]<------[<[-]>++++++[-]] +<[->>+<<]++++++>+>[-<-<------<+>]>> +]< +% (code) RIGHT(?) 0 *0 0 0 +] +# MOVE LEFT +# if previous op is LEFT(i) and i is not 255 then overwrite with LEFT(inc(i)) +# else append LEFT(1) +>[ +-<<<<<[->>+>+<<<]>>[-<<+>>]<[->+>>+<<<]>[-<+>] +% (code) *0 P i 0 (where P(i) = previous op) +++++++++++++++++[->>----------------<<]>>+ +[<<++++++++++++++++[->>++++++++++++++++<<]+>>[-]]<-----[<[-]>+++++[-]] +<[->>+<<]+++++>+>[-<-<-----<+>]>> +]< +% (code) LEFT(?) 0 *0 0 0 +] +# OUTPUT +>[ +<<<++++>>>-> +]< +% (code) OUTPUT 0 *0 0 0 +] +# SUB +#if previous op is SUB(i) +# if i is 255 then remove previous op +# else overwrite with SUB(inc(i)) +#else append SUB(1) +>[ +-<<<<<[->>+>+<<<]>>[-<<+>>]<[->+>>+<<<]>[-<+>] +% (code) *0 P i 0 (where P(i) = previous op) +>---[<+++>+++[-]+>[-]>]> +[<++++++++++++++++[->----------------<]>+>+< +[<<<+>>++++++++++++++++[->++++++++++++++++<]>[-]>-<] +>[-<<<<[-]<--->>>]<] + ]< +% (code) SET/SUB(?) 0 *0 0 0 +] +# INPUT +>[ +<<<++>>>-> +]< +% (code) INPUT 0 *0 0 0 +] +# ADD +#if previous op is ADD(i) +# if i is 255 then remove previous op +# else overwrite with ADD(inc(i)) +#else append ADD(1) +>[ +-<<<<<[->>+>+<<<]>>[-<<+>>]<[->+>>+<<<]>[-<+>] +% (code) *0 P i 0 (where P(i) = previous op) +>-[<+>+[-]+>[-]>]> +[<++++++++++++++++[->----------------<]>+>+< +[<<<+>>++++++++++++++++[->++++++++++++++++<]>[-]>-<] +>[-<<<<[-]<->>>]<] +]< +% (code) ADD(?) 0 *0 0 0 +] +# Cancellation +% (code P i Q j) 0 *0 (where P(i) and Q(j) are the two most recent ops) +# if P/Q in (LEFT/RIGHT RIGHT/LEFT ADD/SUB SUB/ADD) and j == 1 +# remove Q(j) and decrement i +# if dec(i) == 0 then remove P(i) +>>+<<<+<-[>-]>[>]<<+>[ + # j == 1 + % P i Q 1 *1 0 0 1 + <<<[>>-]>>[>>]<<[->-<]+>[- + # i != 0 + <-<[->+<<<+>>] + % add(P Q) i *0 Q 0 0 0 1 + +<<----[>>-]>>[>>]<<[->>>+<<<]+<<-------[>>-]>>[>>]<<[->>>+<<<] + >[-<+<<->>>]+<<<+++++++++++>>>>> + % P i Q 1 0 *c 0 1 (where c = add(P Q) in (add(LEFT RIGHT) add(ADD SUB))) + [->>-<<<<-<[-]+<-[>-]>[>]<[-<<[-]]>]<]]>>> +% (code) 0 0 0 *z (where z = 1 if we should attempt further optimizations) +#if P in (ADD SUB) and Q == SET then remove P +[>+<-<<<+<<---------[>>-]>>[>>]<<[ + # Q == SET + >>>>-<<<< + -<<+<<-[>>-]>>[>>]<<[->>>+<<<]+<<--[>>-]>>[>>]<<[->>>+<<<]<<+++>>>>> + % P i 0 j 0 *c 0 0 0 (where c = P in (ADD SUB)) + [-<<<<<[-]>[-]>>[-<<+>>]]<]<<+++++++++>>>>>] +% (code) 0 0 0 *0 z (where z = 1 if we should attempt further optimizations) +# if P == SET and Q(j) in (ADD(1) SUB(1)) then inc/dec i and remove Q(j) ++>[- +<<<<+<<<<---------[>>>>-]>>>>[>>>>]<<<<<<<<+++++++++>>>>[ + # P == SET + % 9 i Q j *1 0 0 1 0 + <-[>-]>[>]<<+>[ + # j == 1 + <<-[>>-]>>[>>]<<<<+>>[- + # Q == ADD + >>>-<<<<-<<<+++++++[->----------------<]>+[>-]>[>]+<[->-<]> + [-<++++++++++++++++[-<++++++++++++++++>]>] + <<<+++++++++>>] + +<<---[>>-]>>[>>]<<<<+++>>[- + # Q == SUB + >>>-<<<<-<-- + <[>-]>[>]<[+++++++++++++++[-<++++++++++++++++>]]<-> +]]]>>>>]< +% (code) 0 0 0 *z 0 (where z = 1 if we should attempt further optimizations) +# if P == CLOSE then try the copy loop optimization +[ + -<<<+<<--------[>>-]>>[>>]<<<<++++++++>>[# P == CLOSE + ->>>>>>>++++++++<<++++++++[-<++++++++++++++++>]<-[-<+<+>>] + <<<<<+<------- + % (code) Q j *1 1 0 0 128 128 *0 0 0 P + <<[>>-]>>[>>]<<[->-<]>[-<+>]< + [ # determine if loop can be optimized + % (code) *k 0 0 0 l r a 0 0 (code) + % where k = 1 iff next op should be inspected + % l = sub(127 num_left) + % r = sub(127 num_right) + % a = 1 iff SUB(1) on cell 0 processed + <<-[>>-]>>[>>]<<[# P == ADD + >>>>[->->>+<<<]+>[<-]<[<]>[ # l == r: kill l ->>>[-<<+>>]<<<] + >>>[-<<+<+>>>]<<<<<<+<-]+ + <<--[>>-]>>[>>]<<[# P == SUB + >>>>[->->>+<<<]+>[<-]<[<]>[ # l == r + >>[<<-]<<[<<]>+>[-<<<<<-[>-]>[>]<<+>[->>>->>>+<<<<<<]+>>>>] + <[->>>>[-<<+>>]<<<<]>] + >>>[-<<+<+>>>]<<<<<<+<-]+ + <<--[>>-]>>[>>]<<[# P == LEFT + -<[->+>>>+>-[<-]<[<]>[-<<<<[->+<]>>>>]<<<<]>[-<+>]>+<]+ + <<-[>>-]>>[>>]<<[ # P == RIGHT + -<[->+>>>+>>-[<<-]<<[<<]>>[-<<<<[->+<]>>>>]<<<<]>[-<+>]>+<] + % (code) sub(P 6) i *0 q 0 0 l r a 0 0 (code) 0 + % where q = P in (ADD SUB LEFT RIGHT) + # keep going if q==1 && l!=0 && r!=0 && next op exists + <[->>>>>>>>>+<<<<<<<<<]<++++++[->>>>>>>>>+<<<<<<<<<] + +<<[>>->>>+<<<]>>[>>]<<[-]>>>>>> + [[-<<+>>]>[[-<<+>>]<<<<+>>>>]<]>[-<<+>>]>[-<<+>>]<<<<< + ---[<<<->>>+++[-]]<<<+ + % (code) *k 0 0 0 l r a 0 0 P i (code) + ] + >>>>>>>>+>-------[<-]<[<]>>+++++++ + <<<[->>+<<]+<<[-<+>>-<]>[>-]>[>]<[->>+<<]>+>---[<-]<[<]>>+++[-] + <<<<<[->>+<<]>>[-]>+> + % (code) 0 0 0 0 0 0 1 *w 0 (loop) + % where w = 1 iff copy loop optimization can be applied + [<->->>[-]>[-]<<<<<<<<<+>+>+>+>+>>>>>> + [ # replace loop with LMUL/RMUL + % (code) 0 1 ::: 1 0 0 n d 0 *P i (loop) + % where d = offset to current cell + % n = 1 iff offset is negative + <+>-[--[--[-[++++++[-]<->]<[ # RIGHT(i) + ->>[<<+<[>-]>[>]<[-<<[-]>>]<+>>>-]<< + ]>]<[ # LEFT(i) + ->>[<<+<[>-]>[>]<[-<<[-]+>>]<->>>-]<< + ]>]<[ # SUB(i) + % (code) 0 1 ::: 1 0 0 n d *1 0 i (loop) + <[>-]>[>]+<[->-<]>[ # d != 0 + +++++++++++++++[-<<<<++++++++++++++++>>>>]>[-<<<<<->>>>>]<]< + % (code) 0 1 ::: 1 0 sub(256 i) n d *0 0 0 (loop) + ]>]<[ # ADD(i) + % (code) 0 1 ::: 1 0 0 n d *1 0 i (loop) + <[>-]>[>]+<[->-<]>[ # d != 0 + ->[-<<<<<+>>>>>]<]< + % (code) 0 1 ::: 1 0 i n d *0 0 0 (loop) + ] + % (code) 0 1 ::: 1 0 y n d *0 0 i (loop) + % where y!=0 iff MUL op should be appended to code + % and y is the second op argument + <<<[ # y!=0 + <+>>[ # n=1 so d negative + <<-<[<]++++++++++>->++++++++++>->->[>] + >>>[+<<<<[<]<<<+>>>>[>]>>>>>-<<]>+<<-] + <<[ # n=0 so d positive + -<[<]++++++++++++>->++++++++++++>->->[>] + >>>[->>+<<<<<<[<]<<<+>>>>[>]>>>] + <<<] + >[-<<[<]<+>>[>]>] + % (code) LMUL/RMUL y 0 1 ::: 1 0 *0 0 0 n d 0? (loop) + ] + % (code) 0 1 ::: 1 0 *0 n d 0 0 i (loop) + >[>[+>>-<<]>+<<-]>[->>+<<] + <<+<+>>>>>>> + % (code) 0 1 ::: 1 0 0 n d 0 *(loop) + ] + % (code) 0 1 ::: 1 0 0 n 0 0 *0 + <<<[-]<<<[-<]+++++++++>>>>>>>>> + % (code) SET(0) 0 0 0 0 0 0 0 *0 + ] + % (code) 0 0 0 0 0 0 v *0 0 (loop) + % where v = 1 iff copy loop optimization was not applied + <[->>>[[-<<<<<<<<<+>>>>>>>>>]>[-<<<<<<<<<+>>>>>>>>>]>] + <<<]<<<<<< + ]>>> + % (code) 0 0 0 *0 0 + ] +] +% 8(0) (code) 0 0 X *0 (where X may be the last byte read) +# read next byte and and break if EOF +<[-]> +,+[[-<+>]>+<]>[-<<->>]<< +] +<<<<[<<] +% 6(0) *0 0 (code) +## Phase 3 +## Code verification +## +# move code leftwards and ensure that all OPEN/CLOSE are balanced +# in the process we calculate the maximum loop (ie OPEN/CLOSE) depth +% 6(0) *0 0 (code) +<+<<+>>>>>[ +% 0 0 (code) M m D d 0 0 *P p (code) 0 c +% where Pp is first op of right code block +% Dd holds current loop depth (starting at 1) +% Mm holds the max loop depth yet encountered +% c = (unbalanced code ? 1 : 0) +<<<[->>+<<]<[->>+<<]<[->>+<<]<[->>+<<]>>>>>>>[-<<<<<<+>>>>>>]< +[->+<<<<<<<+>>>>>>]+> +% 0 0 (code) P p M m D d 1 *P (code) 0 c +-------[-[<->++++++++[-]] +<[-<< +# P is CLOSE; decrease Dd and leave Mm as it was + { 16b dec >>+<[>-<[->>+<<]]>>[-<<+>>]<<->[-<+<->++++++ + ++[->++++++++<]>[-<++++>]<->]<< } +>>]>] +<[ +# P is OPEN; if Mm==Dd then Mm=Dd=inc(Dd) else Dd=inc(Dd) +% (code) P p M m D d *1 0 (code) 0 c (note: p=0 since P=OPEN) +<<[-<<->>>>>+<<<]<<[[->>+<<]>>>>-<<<<] +% (code) P p *0 m sub(M D) d e D (code) 0 c (where e=(M==D ? 1 : 0)) +>>>[-<<-<+>>>]<<[[->>+<<]>>>[-]<<<] +% (code) P p d *0 sub(M D) sub(m d) e D (code) 0 c (where e=(Mm==Dd ? 1 : 0)) +>>[-<<+>>]<<<[->+>>+<<<]>>[-<<+>>]>>>[-<<<+<<+>>>>>]<[-<<<<<+>>>>>]<< +% (code) P e M m *D d 0 0 (code) 0 c (where e = (Mm==Dd ? 1 : 0)) + { 16b inc >>>++++++++[-<++++++++>]<[->++++<]<[->+>-<<] + >+[-<+>]+>-[<->[-]]<[-<[-]<+>>]<< } +<<<[->[-]>[-]>[-<+<+>>]<[->+<]>>[->+<<<+>>]>[-<+>]<<<<<]>>>>> +] +% 0 0 (code P p) M m D d *0 0 (code) 0 c (where Dd is properly updated) +<< { 16b iszero [[->>+<<]>>>+<<<]>>[-<<+>>]<[[->+<]>>+<<]>[-<+>]+>[<->[-]]<<< } +>>[-<+>>>[>>]>[-]+<<<[<<]]>> +% 0 0 (code P p) M m D d 0 0 *(code) 0 c (where c is properly updated) +] +% 0 0 (code) M m D d 0 0 *0 c +<<<< +{ 16b dec >>+<[>-<[->>+<<]]>>[-<<+>>]<<->[-<+<->++++++ + ++[->++++++++<]>[-<++++>]<->]<< } +{ 16b isnonzero >[>>+<]>[<]<<[[->>+<<]>>>+<<<]>>[-<<+>>]>[[-]<+>]<<< } +>>[->>>[-]+<<<]<[-]<[-]<[->+<]<[->+<]>>>>>>>[-<<<<+>>>>]<<<< +<<<<<[<<]>+>[>>]>>> +% 0 1 (code) 0 M m *c 0 0 0 +# if c==1 output string "Error: unbalanced brackets!\n" +[-<[-]<[-]<<<[<<]>->[>>] ++++++++++++[->++++++>++++++++++>+++<<<]> +% (code) 0 *66 110 33 ++++.>++++..---.+++.<-----------.>>-.<+++.-------. +------------.-.+++++++++++.-----------.+++++++++++++. +-----------.++.-.>.<--.++++++++++++++++.-----------------. +++.++++++++.------.+++++++++++++++.-.>+.---[--->+<]>.[-]<<[-]<[-]>>>] +<<<<<[<<] +% T *0 b (code) 0 M m +% where b = (bytecode OK ? 1 : 0) and Mm = maximum loop depth + +# This is the Java language backend for awib +# Please refer to the documentation in the full source code distribution +# of awib for additional details +% 23(0) *8 (code) 0 M m +# print Java header +++[-<++++++++<++++++++<++++++++++<++++++++++<+++<++++++++++<++++++++++<+ ++++++++++<+++<++++++<++<+++++++++++>>>>>>>>>>>>]<<<+++++.++++.+++.-.+++. +++.<<++.>++++++.<<---.>>>++.<<<.>++++++++++++++.>-.++++++.<.>>>-------.< +<-.++.>-.-.>>+++.<<.--.<<<<+.>.>>---.<<<<<<-.<----------.<-----.++++.+++ +.-.+++.++.>>>++.>>+++++.>.>>>++++.<<<.>.<<-.>>>++.<.>>>>----.<<-.-.<+.>+ +.-.>>++++.<<.--.<<<<<+.>>.>>---.<<<<<<.<.>>>>.>>>.>--.-.+++.++.<<<<<<.>> ++.>.>>>++.<<<.>.<<-.>>>++.<.>>>.>----.<----.<++.<<<++.++.>>+.++++.<<<.++ +++++.-.<<<.<..<----.+++++.>>>>---.>--.---.<+.<.>.>+++.<--.>>>>-..<<<<<.< ++++++++.>>>>+.<<<.>>>>>>+++.<<<<<<<<.>>....>+.>>>>>--.<+.<<-.<<-------.+ ++.<.>>+.<<<-------.<.>>....>>----.+++++.>>>.<<<<<.>>++.<<<.<.>>....>>>>> +>>++++.<<<<<--.++.>>>+.-.>>>++++.<<<.--.<<.----.<---.<<.>>----.<<<.<.>>. +...>>>>>>>>----.<<----.-.<--.>+.-.>>++++.<<.--.<<<++++.----.>>---.<<<<<. +>>>>>++.<<<<<<.<..>>....>>>>>+.>+++.<<<+.<+++.---.>+.<<<.<+++++++.>>>--- +.>>------.>>>.<<--.++.>.-.>>.<<.--.<<<++.----.>>---.<<<<<.>>+++.>>++++.< +<<<.>>>>>>>>----.<<+++.-.----.+++++.-.>>++++.<<.--.<<<++++.----.>>.<<<<< +.>>>>>++.<---.<<<<.<<<++++++.>.>>........>>++++.<<<-----.>>>+.>++++.>>>+ +++++.<<<<<<.>>>---.>>>++.-----.<<<+++.<<--.>>>+++++++.>>++++.<<+.-.+.-.. +<<<++.<<--.<.>>........>>++.<<<++.>>>>>+.+.+++++.++++.<<<<<<.>>........> +>++++.>+++.+.<-.>>-------------.<.<<<<.>>>>.<<<<--.<.>>........>>+.>-.+. +<-.>>.>.<<<<<<++.>>>>>>.<<<<<<--.<.>>....<<<++.>..>>....>>---.+++++.<+++ +++.>>+++.---.<<+.<.>>+.>>>.<<.<<+.<.>>----.+++.>>>-.<<<<<.++++++++.+.--- +------.<<<--.>.>>........>>-.>-.+.<-.>>.<<<-----.>>>++.--------.+.<<<<<. +<.>>....<<<++.>..>>....>>---.+++++.<+++.>>+++.---.<<+.<.>>--.+.<--.>.>.< +<++.<.>>++.>>>+.<<.<<+.<.>>>>>--.<<<<---.>>.>>+.<-.>>>>.<<----.--.<<<.>> +.<<--.<<------.++.<.>++++.>>>>>.<<<.>>>+.<<+.<<<<.<<<--.>.>>........>>>> +>.<<--.<+.<<.<+++++++.>>>>+.>-.>>>>.<<++++++.------.+.<<<-.>>-.<++++++.> +----.+++++.<--.>>>>.<<+++++.------.+.<<<.>>-.<++.>++.>+.-.<<-----.+++++. +>>--.+++.<-.<------.+.<<<<<-------.<.>>....<<<++.>..>>....>>>>>++.++.<<+ ++++.<-.<.>--.>----.<<<.>>++.>>>---.------.<<-.<<<.>>----.>>-.+.<<<<.<<<- +-.>.>>........>>++.--.+++++++.<<.<<<.>.>>............>>>>>.<+++++.>>---. +<<<+.<<.>>-.>------.>++++.<++++.>>--.<<.+++++.--------.<<<<<.<.>>....... +.<<<++.>>>.>++.--.>-----.>-.+++++.<<<.>>>>-.>>>.>----.<----.<++++++++.<< +<<<++.++.>----.++++.>+.>>++.-.<<<<<.>.>>>+.<<<<.<<<--.++.>.>>....<<<.>.. +>>....>>----.++.>.>>>--.<<<<<----.>++.>----.<<<.>>++.>>>+.------.<<-.<<< +.>>+.>>-.+.<<<<.<<<--.>.>>........>>---.--.>>>>+++.<<<<<<.<<<.>.>>...... +......>>---.>>+++++.>>--.-----.<.>++.<<<+.>------.<<--.<------.>+++.<++. +>>>+.<<<<<.<.>>............>>-.>>+++++.<+.<---.>>>>+.--.<-.<------.+.<<< +<<.<.>>........<<<++.>>>.>>>---.--.>>>+.<<<++.>>.<<<<<.>>>>-.>>>++++.>.< +----.<++++.<<<.++.<++++.++++.>>>+.++++++.-.<<<<<.>>>.>+.<<<<.<<<--.++.>. +>>....<<<.>..>>....>>----.++.>++++.>>>--.<<<<<++++.>++.>----.<<<.>>++.>> +>+.------.<<-.<<<.>--.>>>+++++++.--------.+.<<<<.<<<--.>.[<]>[[-]>] +% 23(0) *0 (code) 0 M m +++++++++++++++++[-<++++++++++++++++>]<-[-<<<<<<<<<<<<<<<+<+>>>>>>>>>>>>>>>>] +<<<<<<<<<<<<<<<<<<+<+>>>>>>>>>>>>>>>>>>>> +% 4(0) 1 0 255 255 15(0) *0 (code) 0 M m +>[<+> +% ::: (stack) 0 1:::1 0 c d 15(0) 1 *P i (code) 0 M m +% (where c and d form a two cell counter +% P(i) is the next op code) +# the stack segment is a sequence of adjacent C and D; these values +# are previous values of the cd counter that have been pushed to stack +# on OPEN; they are in turn popped on CLOSE +-[-[-[-[-[-[-[-[-[-[-[-[[-] +<[ +# RMUL2 +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m ++++++[->+++++++++++++++<]>+++.-[--<+>]<---.-[-->+++<]>--.------[-<++>]<-.- +-----------------.+[---->+++++<]>---.+++[-----<++++>]<+.-[-->+<]>----.[-] +<<<+<<+>>>> +% ::: (stack) 0 1:::1 0 c d 11(0) 1 0 1 0 *0 0 i (code) 0 M m +]>] +<[ +# RMUL1 +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m +++++++++.---[->++++++++++++++++++<]>+.------------------.+[----<+++++>]<---. +--[----->++<]>-.[-]<<<+>> +% ::: (stack) 0 1:::1 0 c d 11(0) 0 0 1 0 *0 0 i (code) 0 M m +]>] +<[ +# LMUL2 +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m ++++++[->+++++++++++++++<]>+++.-[--<+>]<---.-[-->+++<]>--.------[-<++>]<-.- +-----------------.+[---->+++++<]>---.+++[-----<++++>]<+.-[-->+<]>----.[-] +<<<+<<+>>>> +% ::: (stack) 0 1:::1 0 c d 11(0) 1 0 1 0 *0 0 i (code) 0 M m +]>] +<[ +# LMUL1 +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m +++++++++.---[->++++++++++++++++++<]>+.------------------.+[----<+++++>]<---. +--[----->++<]>+.[-]< +<<+>> +% ::: (stack) 0 1:::1 0 c d 11(0) 0 0 1 0 *0 0 i (code) 0 M m +]>] +<[ +# SET +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m +++++[->++++++<]>[-<++++<+++<+<++>>>>]<-----------.<+.>+++.<++. +<<+.>++++++++++.>+++++.>+++++++++.-----.<+++.<+.>>[[-]<]+>>+>> +% ::: (stack) 0 1:::1 0 c d 11(0) 1 0 1 0 *0 0 i (code) 0 M m +]>] +<[- +# CLOSE +% ::: (stack) 0 1:::1 0 c d 15(0) *0 0 0 (code) 0 M m +# output: ' }\n\n private void ' ++++++++++++++++++++++++++[-<+<+++++<++++<++<+++>>>>>]<+++++++....<. +>>++++++++++..<....<-------------.++.<+++++.>++++.<--------.>--.<++++ +.>>.<++.-------.<++++.-----.>>.>[[-]<]<<<<<<<<<<<< +% ::: (stack) 0 1:::1 *0 c d 15(0) 0 0 0 (code) 0 M m +# fetch xy from top of stack +<[<]<[->>[>]>>>>+<<<<<[<]<]<[->>>[>]>>>>>+<<<<<<[<]<<]>+>+[>] +% ::: (stack) 0 1:::1 *0 c d 0 y x 12(0) 0 0 0 (code) 0 M m +# output: '_x_y' +>>>>>[ +>++++++++[->++++++++++++<]>-.[-] +# itoa +++++++++++<<[->>->+<[>-]>[>]<[-<++++++++++<+>>]<<<]++++++++++>>[-<<->>] +>++++++++++<<[->>->+<[>-]>[>]<[-<++++++++++<+>>]<<<]++++++++++>>[-<<->>] +>++++++[-<++++++++>]<<[>[-<+<+>>]<.[-]<.[-]>] +<[>>[-<<+>>]<<.[-]]>>[-]<<++++++[-<++++++++>]<.[-]< +] +% ::: (stack) 0 1:::1 0 c d *0 14(0) 0 0 0 (code) 0 M m +# output: '() {' ++++++++++++++++++++++++++++++++++++++++++[->+++>+>++<<<] +>>-.+.---------.<.<++++++++++.[[-]>]>>>>>>>>>>> +% ::: (stack) 0 1:::1 0 c d 15(0) *0 0 0 (code) 0 M m +]>] +<[- +# OPEN +% ::: (stack) 0 1:::1 0 c d 15(0) *0 0 0 (code) 0 M m +# build ef = dec(cd) +<<<<<<<<<<<<<<<<[[->>+>>>>>>>>+<<<<<<<<<<]<] +>>>>>+<-[>-]>[>]<[+++++++++++++++[-<++++++++++++++++>]<-<->>]< +% ::: (stack) 0 1:::1 0 0 0 e *f 6(0) c d 5(0) *0 0 0 (code) 0 M m +# push a copy of ef to stack +<<<<<[<]>->->[>]>>> +[-<<<<[<]<<+>>>[>]>>>>>>>>>+<<<<<<]> +[-<<<<<[<]<+>>[>]>>>>>>>>>>+<<<<<<]>>>>>>>> +% ::: (stack ef) 0 1:::1 9(0) e f c *d 5(0) 0 0 0 (code) 0 M m +# construct decimal representations of e f c and d +[ +% 0 (counters) *n 5(0) 0 0 0 +% (where n is the rightmost counter) +# itoa +% (counters) *n 5(0) 0 0 0 +>>++++++++++<<[->>->+<[>-]>[>]<[-<++++++++++<+>>]<<<]++++++++++>>[-<<->>] +>++++++++++<<[->>->+<[>-]>[>]<[-<++++++++++<+>>]<<<]++++++++++>>[-<<->>] +>++++++[-<++++++++>]<<[>[-<+<+>>]<:[->>>>+<<<<]<:[->>>>>>+<<<<<<]>] +<[>>[-<<+>>]<<[->>>>>>+<<<<<<]]>>[-]<<++++++[-<++++++++>]<[->>>>>>>>+<<<<<<<<] +% (counters) *0 5(0) n2 n1 n0 +% (where n2n1n0 is n in base 10 +% ni is 0 if not significant) +# move down remaining counters to make room for next base 10 rep +<[<]>[[-<<+>>]>]<<< +] +% ::: (stack) 0 1:::1 *0 8(0) e2 e1 e0 f2 f1 f0 c2 c1 c0 *d2 d1 d0 (code) 0 M m +# output: ' while(m{p}!=0){_' +# but with brackets instead of braces +++++++++++++++++++++++++++++++[->++>+>++++>+++<<<<]>>++........>-. +---------------.+.+++.-------.<++++++++.>++++++++.>+.<+++.>++. +<<-------.<+.-------------.-------.>>+++++++++++.>++.> +% 0 41 33 123 95 *0 0 0 0 e2 e1 e0 f2 f1 f0 c2 c1 c0 d2 d1 d0 +# output: '_c_d();}' +# replace c and d with the corresponding decimal representation +>>>>>>>>> +>[.[-<<<<<<<<<+>>>>>>>>>]]>[.[-<<<<<<<<<+>>>>>>>>>]]>[.[-<<<<<<<<<+>>>>>>>>>]] +<<<<<<<<<<<<<.>>>>>>>>>>>>> +>[.[-<<<+>>>]]>[.[-<<<+>>>]]>[.[-<<<+>>>]] +<<<<<<<<<<<<<<<<<<<-.+.++++++++++++++++++.------------------>>++. +<<<++++++++++.>->- +% 10 40 *32 125 95 0 c2 c1 c0 e2 e1 e0 f2 f1 f0 d2 d1 d0 0 0 0 +# output: ' _e_f();\n }\n\n private void _c_d' +# again with e f c and d replaced by their base 10 reps +........>>.>>>> +>[.[->>>>>>>>>+<<<<<<<<<]] +>[.[->>>>>>>>>+<<<<<<<<<]] +>[.[->>>>>>>>>+<<<<<<<<<]] +<<<<<<<.>>>>>>> +>[.[-<<<+>>>]] +>[.[-<<<+>>>]] +>[.[-<<<+>>>]] +% 10 40 32 125 95 0 c2 c1 c0 f2 f1 f0 0 0 *0 d2 d1 d0 e2 e1 e0 +<<<<<<<<< +<<<<.+.++++++++++++++++++.<.>>....>.<<<..>>....>-------------.++.---------. ++++++++++++++.>++.<--.>++++.<<.>++.-------.>++++.-----.<<.>>-----.<<<< +% *10 59 32 111 95 0 c2 c1 c0 f2 f1 f0 0 0 0 d2 d1 d0 e2 e1 e0 +>>>>> +>[.[-]]>[.[-]]>[.[-]] +<<<<.>>>>>>>>>> +>[.[-]]>[.[-]]>[.[-]] +% 10 59 32 111 95 0 0 0 0 f2 f1 f0 0 0 0 0 0 *0 e2 e1 e0 +# restore ef +>[[-<+>]++++++[-<-------->]] +>[[-<+>]++++++[-<-------->]] +>[[-<+>]++++++[-<-------->]] +<<[->++++++++++<] +<[->++++++++++[->++++++++++<]<] +<<<<< +<[[->+<]++++++[->--------<]] +<[[->+<]++++++[->--------<]] +<[[->+<]++++++[->--------<]] +>>[->++++++++++<]<[->++++++++++[->++++++++++<]<] +% 10 59 32 111 95 0 0 0 0 0 *0 0 f 0 0 0 0 0 0 e 0 +# output: '() {' +# and move ef into position +<<<<<<<<++++++++.+.---------.>++++++++++++.<<<. +[[-]>] +>>>>>>>[-<<<<<<<<<<+>>>>>>>>>>] +>>>>>>>[-<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>] +% 0 e f 15(0) 0 *0 0 +# leave behind gh = dec(dec(cd)) = dec(ef) +<<<<<<<<<<<<<<<<+<-[>-]>[>]<[+++++++++++++++[-<++++++++++++++++>]<-<->>] +>>>>>>>>>>>>>>> +% ::: (stack) 0 1:::1 0 g h 15(0) *0 0 0 (code) 0 M m +]>] +<[ +# RIGHT +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m +++++++++.---[->+++++++++++++++++++<]>--.--[-----<++>]<-.-[-->+++<]>--.[-]< +<<+<<+>>>> +% ::: (stack) 0 1:::1 0 c d 11(0) 1 0 1 0 *0 0 i (code) 0 M m +]>] +<[ +# LEFT +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m +++++++++.---[->+++++++++++++++++++<]>--.--[-----<++>]<+.[--->++++<]>+.[-]< +<<+<<+>>>> +% ::: (stack) 0 1:::1 0 c d 11(0) 1 0 1 0 *0 0 i (code) 0 M m +]>] +<[ +# OUTPUT +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m +++++++++.---[->++++++++++++++++++++<]>-.+[---<+>]<.+.[-] +<<<<+>>>> +% ::: (stack) 0 1:::1 0 c d 11(0) 1 0 0 0 *0 0 i (code) 0 M m +]>] +<[ +# SUB +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m +++++++++.---[->++++++++++++++++++<]>+.------------------.+[----<+++++>]<---. ++++[----->++++<]>+.-[--<+>]<-.[--->++++<]>+.[-]< +<<+<<+>>>> +% ::: (stack) 0 1:::1 0 c d 11(0) 1 0 1 0 *0 0 i (code) 0 M m +]>] +<[ +# INPUT +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m +++++++++.---[->+++++++++++++++++++<]>.[---<+>]<++.+.[-] +<<<<+>>>> +% ::: (stack) 0 1:::1 0 c d 11(0) 1 0 0 0 *0 0 i (code) 0 M m +]>] +<[ +# ADD +% ::: (stack) 0 1:::1 0 c d 15(0) *1 0 i (code) 0 M m +++++++++.---[->++++++++++++++++++<]>+.------------------.+[----<+++++>]<---. ++++[----->++++<]>+.-[--<+>]<---.-[-->+++<]>--.[-]< +<<+<<+>>>> +% ::: (stack) 0 1:::1 0 c d 11(0) 1 0 1 0 *0 0 i (code) 0 M m +] +# optionally append ; and/or itoa(i) +% ::: (stack) 0 1:::1 0 c d 11(0) b 0 a 0 *0 0 i (code) 0 M m +% (where a==1 iff i should be output +% b==1 iff ';\n' should be output) +<<[->> +% ::: b 0 0 0 *0 0 i (code) 0 M m +# itoa +++++++++++>>[-<<-<+>[<-]<[<]>[->++++++++++>+<<]>>>]++++++++++<<[->>-<<] +<++++++++++>>[-<<-<+>[<-]<[<]>[->++++++++++>+<<]>>>]++++++++++<<[->>-<<] +<++++++[->++++++++<]>>[<[->+>+<<]>.[-]>.[-]<] +>[<<[->>+<<]>>.[-]]<<[-]>>++++++[->++++++++<]>.[-] +<<<<] +<<[+++++[->++++++++++<]>-.[-]++++++++++.[-]<]>>>>>>[-] +% ::: (stack) 0 1:::1 0 c d 15(0) 0 0 *0 (code) 0 M m +# copy up cd; extend the 1 sled; process next operation +<<<<<<<<<<<<<<<<<<[->>+<<]<[->>+<<]+<+>>>>>>>>>>>>>>>>>>>> +>] +% ::: 0 0 0 *0 M m +# footer +>[-]>[-]++++[->++++++++<]>....[->++++<]>---.>++++++++++.<.[-]>.[-] +% ::: 0 0 *0 0 0 diff --git a/parsers/Parsers/Brainfuck/inputs/hanoi.bf b/parsers/Parsers/Brainfuck/inputs/hanoi.bf new file mode 100644 index 0000000..36c0036 --- /dev/null +++ b/parsers/Parsers/Brainfuck/inputs/hanoi.bf @@ -0,0 +1,713 @@ +Towers of Hanoi in Brainf*ck +Source: http://www.clifford.at/bfcpu/hanoi.bf +License: GNU GPLv2+ +Copyright: Clifford Wolf +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>[-]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>[-]>[-]+++++++++++++++++++++++++++.++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++.-------------------.------- +--------------------------------------.+++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++.-----------------------------------------.++++++ +++++++++++++++++++.[-]+++++++++++++++++++++++++++.++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++.------------------------------------- +----.+++++++++.---------.+++++.+++++++++++++++++.++++++++++++.++++++++++++++ ++++++++++++++.++++++++.------------------.+++++++++++++.+.------------------ +-----------------------------------------------------------------.++++++++++ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.------ +---.----------------------------------------------------------------------.+ ++++++++++++++++++++++++++++++++++++++++.+++++++++++++++++++++++++.++++++++++ ++++.+.------.--------------------------------------------------------------- +----------.+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++.+++++.------------------------------------------------------------- +-----------------.++++++++++++++++++++++++++++++++++.+++++++++++++++++++++++ ++++++++++++++++++++++++++.-----------------.++++++++.+++++.--------.-------- +----------------------------------------------------.+++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++.++++++++.[-]+++++++++++++++++++++++++++.+ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.------------ +----------------------------.++++++++.----------.++++.+++++++++++++++++++.++ ++++++++++++++.+++++++++++++++++++++++++++.---------.+++++++++++..----------- +----.+++++++++.------------------------------------------------------------- +-----------------.++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++.+++++++++++++++++++++++.------------------------------------------- +----------------------------------------------.+++++++++++++++++++++++++++++ +++++++.+++++++++++++++++++++++++++++++++++++++++.---.---..+++++++++.+++.---- +----------.----------------------------------------------------------------- +---.+++++++++++++++++++++++++++++++++++++++++++++++++++++++.++++++++++++++++ +++++++++.---.------.-------------------------------------------------------- +--------------.++++++++++++++++++++++++++++.++++++++++++++++++++++++++++++++ +++++++++++++.++++++++++++..----.-------------------------------------------- +----------.-----------..++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++...----------------------------------------------------- +--------------------.+++++++++++++++++++++++++++++++++++++++++++++++++++++.+ +++++++++.---.---..+++++++++.+++.--------------.----------------------------- +-------------------------.++++++++++++++++++++++++++++++++++++++++++++++++++ ++.+++++++++++++++++++.------------------------------------------------------ +---------------.+++++++++++++++++++++++++++++++++++++++++++++++++++.++++.--- +.+++++++++++++.+++++.------------------------------------------------------- +---------------.+++++++++++++++.[-]>[-]+++++++++>[-]+++>>[-]>[-]<<<<<[->>>>> ++<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<[-]>>>[-]>[-]<<<[->>>+<<<]>>>[[-<< +<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<] +>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[- +<<+>>]<<<[-]+>>>][-]<[->+<]>[[-<+>]<<<[-]+>>>]<<<[>[-]++++++++++++++++++++++ ++++++++++++++++++++++++>[-]<<<<<[->>>>>+<<<<<]>>>>>[[-<<<<<+>>>>>]<+++++++++ +++++++++++++++++++++++++++++++++++>]<<<[>>>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<< +->>>][-]++++++++++++++++>[-]++++++++++++++>>>>[-]>[-]<<<<<<<<<[->>>>>>>>>+<< +<<<<<<<]>>>>>>>>>[-<+<<<<<<<<+>>>>>>>>>][-]<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[ +[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+ +<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]> +>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<<[[-]<<<<+++++>>>>]>[-]>[- +]<<<<<<<<<[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>[-<+<<<<<<<<+>>>>>>>>>][-]+<<[-]+>> +>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]< +]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<< +[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<< +[[-]<<<++++++++++>>>][-]>[-]<<<<<<<<[->>>>>>>>+<<<<<<<<]>>>>>>>>[-<+<<<<<<<+ +>>>>>>>>][-]+++++++++++++++++++++++++<<<[-]>>[>>[-]<[->+<]>[-<+<<<+>>>>]<<-] +[-]<<[->>+<<]>>[-<<+<<+>>>>][-]<<<<<<<<[->>>>>>>>+<<<<<<<<]>>>>>>>>[-<<<<<<< +<+>>>>->>>>][-]<<<<<<<<[->>>>>>>>+<<<<<<<<]>>>>>>>>[-<<<<<<<<+>>>>->>>>]>[-] +>[-]<<<<<<<<<[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>[-<+<<<<<<<<+>>>>>>>>>][-]++<<[- +]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+ +>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>> +>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>> +]<<<[[-]<<<<----->>>>][-]<<<<<<<<<[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>[-<<<<<<<<< ++>>>>>>->>>][-]+++++++++++++++++++++++++++.+++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++.>[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>> +>>]>>>[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++>[-]<<[>>>[ +-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[-> +>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<< ++>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<<<[-]>>>>>>[-]<[->+<] +>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<<+>>>>>>>]<<[-<<<<<->>>>>]>]<<<[-]>[-]< +<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>>>>[>>>[-]<<[->> ++<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]> +>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[ +-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]>>[[-<<+>>]<[-]> +]<[[-]<<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]+ ++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[- +<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[-> +>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<< +[-]>>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<+>>>>>>]<<[-<<<<->>>> +]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>>> +>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-] +<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[ +[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]>> +[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+< +<<<+>>>>>][-]++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>> +>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>-> +[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-] ++>>]<]<]<<<]<[-]>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<+>>>>>]<<[ +-<<<->>>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<< +<<[-]>>>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+> +>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<< +<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[- +>>+<<]>>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]<[->+<]>>[-]+<[[-<+>]<+++ ++++++++++++++++++++++++++++++++++++++++++++++.<+++++++++++++++++++++++++++++ ++++++++++++++++++++.<++++++++++++++++++++++++++++++++++++++++++++++++.>>>>-< +]>[[-]>[-]<<<<[->>>>+<<<<]>>>>>[-]+<[[-<<<<+>>>>]<<<<+++++++++++++++++++++++ ++++++++++++++++++++++++++.<++++++++++++++++++++++++++++++++++++++++++++++++. +>>>>>>-<]>[[-]<<<<<<++++++++++++++++++++++++++++++++++++++++++++++++.>>>>>>] +<<]<<<<<<--------------------------------.>[-]>[-]<<<<<<[->>>>>>+<<<<<<]>>>> +>>[-<+<<<<<+>>>>>>]>>>[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]+++++ ++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<< ++>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+ +<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<<<[-] +>>>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<<+>>>>>>>]<<[-<<<<<->>> +>>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]> +>>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[ +-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>> +>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<] +>>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-< ++<<<<+>>>>>][-]++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[-> +>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->> +->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[ +-]+>>]<]<]<<<]<<[-]>>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<+>>>> +>>]<<[-<<<<->>>>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]+++++ ++++++<<<<<[-]>>>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[ +[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[ +->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+ +>[-]<<[->>+<<]>>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+ +<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>] +[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-] ++>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>> +[[-<<<+>>>]<<[-]+>>]<]<]<<<]<[-]>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[- +<<<+<<+>>>>>]<<[-<<<->>>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>] +[-]++++++++++<<<<<[-]>>>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<< +<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]> +[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>] +<]<][-]+>[-]<<[->>+<<]>>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]<[->+<]>> +[-]+<[[-<+>]<++++++++++++++++++++++++++++++++++++++++++++++++.<+++++++++++++ ++++++++++++++++++++++++++++++++++++.<+++++++++++++++++++++++++++++++++++++++ ++++++++++.>>>>-<]>[[-]>[-]<<<<[->>>>+<<<<]>>>>>[-]+<[[-<<<<+>>>>]<<<<+++++++ ++++++++++++++++++++++++++++++++++++++++++.<+++++++++++++++++++++++++++++++++ ++++++++++++++++.>>>>>>-<]>[[-]<<<<<<++++++++++++++++++++++++++++++++++++++++ +++++++++.>>>>>>]<<]<<<<<<+++++++++++++.>[-]>[-]<<<<<<<[->>>>>>>+<<<<<<<]>>>> +>>>[-<+<<<<<<+>>>>>>>][-]+++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+ +>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>> +>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<< ++>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<[-]+<[[-]>>[-]++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++.<-<]>[[-]<<<<<<.>>>>>>]<[-]<<<<<<<<[->>>>>>>>+<<< +<<<<<]>>>>>>[-]>>[-<<<<<<<<+>>>>>>+>>][-]<<[->>+<<]>>[[-<<+>>]<<->>]<<[<<<.. +>>>-]<<<.>>>>>[-]<<<<<<<<[->>>>>>>>+<<<<<<<<]>>>>>>[-]>>[-<<<<<<<<+>>>>>>+>> +][-]<<[->>+<<]>>[[-<<+>>]<<->>]<<[<<<..>>>-]>>>[-]>[-]<<<<<<<[->>>>>>>+<<<<< +<<]>>>>>>>[-<+<<<<<<+>>>>>>>][-]++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>> +[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>> ++<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<] +>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<[-]+<[[-]>>[-]+++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++.<-<]>[[-]<<<<<<.>>>>>>]<<<<<<<<]>>>[-]<<<< +<[->>>>>+<<<<<]>>>>>[[-<<<<<+>>>>>]<<<<<<<[-]<[-]<[-]>>>>>>>>>>[-]<<<<<[->>> +>>+<<<<<]>>>>>[-<<<<<+<<<+>>>>>>>>][-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>+>>>>>>>>>]<<<<<<<<<[<<<[-]<[-]<[-]+>>>>>>[<<<<+>>>>-]<- +[<<<<+>>>>-]<<<<]<<[-]>>>[<<<+>>>-]<<[>>>>]><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<<<<<[->>>>>+<<<< +<]>>>>>[[-<<<<<+>>>>>]<<<<<->>>>>]<]<<<<<+>>[-]+>>[-]>[-]<<<<<[->>>>>+<<<<<] +>>>>>[-<+<<<<+>>>>>][-]++++++++++<<[-]>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]> +[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-< +<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]< +<<[-]+>>>][-]<[->+<]>[[-<+>]<<<[-]+>>>]<<<]<<<[-]>[-]+>[-]++>[-]++++++++>[-] ++>[-]+[>>>[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++<<[-]>>>[-]>[ +-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<- +>->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>> +]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]+>>>][-]<[->+<]>[[-<+>]<<<[-]+>>>]<<<[>[- +]<<<<<[->>>>>+<<<<<]>>>>>[[-<<<<<+>>>>>]>[-]>[-]>[-]>>[-]>[-]<<<<<<<<<<[->>> +>>>>>>>+<<<<<<<<<<]>>>>>>>>>>[-<+<<<<<<<<<+>>>>>>>>>>][-]+<<[-]+>>>[-]>[-]<< +<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[ +-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]< +][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<<[[-]<<<[-] ++>[-]+>>]>[-]>[-]<<<<<<<<<<[->>>>>>>>>>+<<<<<<<<<<]>>>>>>>>>>[-<+<<<<<<<<<+> +>>>>>>>>>][-]+++<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<] +>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[- +>>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[-> ++<]>[[-<+>]<<<[-]>>>]<<<[[-]<<<[-]+>>[-]+>][-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[- +]>>[-]<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>[-]>[-< +<<<<<<<<<<<<<<+>>>>>>>>>>>>>>+>]<[<+>-]>[-]<<<<<<<<<<<<<<[->>>>>>>>>>>>>>+<< +<<<<<<<<<<<<]>>>>>>>>>>>>>[-]>[-<<<<<<<<<<<<<<+>>>>>>>>>>>>>+>]<[<+++>-]>[-] +<<<<<<<<<<<<<[->>>>>>>>>>>>>+<<<<<<<<<<<<<]>>>>>>>>>>>>[-]>[-<<<<<<<<<<<<<+> +>>>>>>>>>>>+>]<[<+++++++++>-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<[-]<[-]<[-]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>[-]<<[->>+<<]>>[-<<+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>][-]<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>+<<<<<<<<< +<<<<<<<]>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<[<<<[-]<[-]<[-]+>>>>>>[<<<<+>>>>-]<-[<<<<+>>>>-]<<<<]<<[-]>>>[<<<+>> +>-]<<[>>>>]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<[-]<[-]>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<[->>>>>>>>>>>>+<<<<<<<<<<<<]>>>>>>>>>>>>[-< +<<<<<<<<<<<+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>][-]<<<<<<<<<<<<<<< +<[->>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<+<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[<<<[-] +<[-]<[-]+>>>>>>[<<<<+>>>>-]<-[<<<<+>>>>-]<<<<]<<[-]>>>[<<<+>>>-]<<[>>>>]>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<[-]<[-]>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<[->>>>>>>>>>>+<<<<<<<<< +<<]>>>>>>>>>>>[-<<<<<<<<<<<+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>][-]<< +<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>[-<<<<<<<< +<<<<<<<<+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[<<<[-]<[-]<[-]+>>>>>>[<<<<+>>>>-]<-[< +<<<+>>>>-]<<<<]<<[-]>>>[<<<+>>>-]<<[>>>>]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>+>>>>>>>>>>>>>][-]<<[->>+<<]>>[[-<<+>>]>[-]<<<<<<<<<<<<[->>>> +>>>>>>>>+<<<<<<<<<<<<]>>>>>[-]>>>>>>>[-<<<<<<<<<<<<+>>>>>+>>>>>>>][-]<<<<<<< +<<<<[->>>>>>>>>>>+<<<<<<<<<<<]<[-]>>>>>>>>>>>>[-<<<<<<<<<<<+<+>>>>>>>>>>>>][ +-]<<<<<<<[->>>>>>>+<<<<<<<]<<<<[-]>>>>>>>>>>>[-<<<<<<<+<<<<+>>>>>>>>>>>]<<<< +<<<<<<->[-]>+>>>>>>>][-]<[->+<]>[[-<+>]>[-]<<<<<<<<<<<<[->>>>>>>>>>>>+<<<<<< +<<<<<<]>>>>>[-]>>>>>>>[-<<<<<<<<<<<<+>>>>>+>>>>>>>][-]<<<<<<<<<<<<<[->>>>>>> +>>>>>>+<<<<<<<<<<<<<]>[-]>>>>>>>>>>>>[-<<<<<<<<<<<<<+>+>>>>>>>>>>>>][-]<<<<< +<<[->>>>>>>+<<<<<<<]<<<<<<[-]>>>>>>>>>>>>>[-<<<<<<<+<<<<<<+>>>>>>>>>>>>>]<<< +<<<<<<<->[-]>+>>>>>>>]<<<<]>[-]>[-]<<<<<<[->>>>>>+<<<<<<]>>>>>>[-<+<<<<<+>>> +>>>][-]++<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-< +<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<< +]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[- +<+>]<<<[-]>>>]<<<[[-]>>>>[-]++>>[-]>[-]<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>+<<<< +<<<<<<<<<<<]>>>>>>>>>>>>>>>[-<+<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>][-]<<[-]+>>>[- +]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[ +<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-] ++>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<<[[- +]>[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[->>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>[-]>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>>>>]<]>[-]>[-]<<<<<<<<<<<<<<<[- +>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>[-<+<<<<<<<<<<<<<<+>>>>>>>>>> +>>>>>][-]+<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[- +<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<< +<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[ +-<+>]<<<[-]>>>]<<<[[-]>[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ++<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]>>>>[-<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>+>>>>]<]>[-]>[-]<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>+<<< +<<<<<<<<<<<<]>>>>>>>>>>>>>>>[-<+<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>][-]++<<[-]+>> +>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]< +]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<< +[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<< +[[-]>[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>[-]>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>>>>]<]>[-] +>[-]<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>[-<+<<<< +<<<<<<<<<<+>>>>>>>>>>>>>>>][-]<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[- +]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<< ++>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<< +[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<<[[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<[-]<[-]>>> +>>>>>>>>>>[-]>>>>>[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<< +<<<[<<<[-]<[-]<[-]+>>>>>-[<<<<+>>>>-]<<<<]<<[->>+>+<<<]>>[-<<+>>]<[>>[->>>>+ +<<<<]<<>>>>]>>[->>>>>>>>>>>+<<<<<<<<<<<]>>>>>>>>>>>>>>>]>[-]>[-]<<<<<<<<<<<< +<<<[->>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>[-<+<<<<<<<<<<<<<<+>>>>> +>>>>>>>>>>][-]+<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]> +>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[-> +>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+ +<]>[[-<+>]<<<[-]>>>]<<<[[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<[-]<[-]>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>[-]>>>>>[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[<<<[-]<[-]<[-]+>>>>>-[<<<<+>>>>-] +<<<<]<<[->>+>+<<<]>>[-<<+>>]<[>>[->>>>+<<<<]<<>>>>]>>[->>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]>[-]>[-]<<<<<<<<<<<<<<<[->>>>>>>>>>>>>> +>+<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>[-<+<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>][-]++<<[ +-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-] ++>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+> +>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>> +>]<<<[[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<[- +]<[-]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]>>>>>[-]<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[<<<[-]<[-]<[-]+>>>>>-[<<<<+>>>>-]<<<<]<< +[->>+>+<<<]>>[-<<+>>]<[>>[->>>>+<<<<]<<>>>>]>>[->>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]>[-]>[-]<<<<<<<<< +<<<<[->>>>>>>>>>>>>+<<<<<<<<<<<<<]>>>>>>>>>>>>>[-<+<<<<<<<<<<<<+>>>>>>>>>>>> +>][-]<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+> +>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>> +[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>] +<<<[-]>>>]<<<[[-]<<<<<<<<<<<<<<<[-]<[-]<[-]>>>>>>>>>>>>>>>>>>[-]<<<<<[->>>>> ++<<<<<]>>>>>[-<<<<<+<<<<<<<<<<<+>>>>>>>>>>>>>>>>][-]<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+> +>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<[<<<[-]<[-]<[-]+>>>>>>[<<<<+>>>>-]<-[<<<<+ +>>>>-]<<<<]<<[-]>>>[<<<+>>>-]<<[>>>>]><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]>[-]>[-]<<<<<<<<<< +<<<[->>>>>>>>>>>>>+<<<<<<<<<<<<<]>>>>>>>>>>>>>[-<+<<<<<<<<<<<<+>>>>>>>>>>>>> +][-]+<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+> +>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>> +[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>] +<<<[-]>>>]<<<[[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[-]<[-]<[-]>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-] +<<<<<[->>>>>+<<<<<]>>>>>[-<<<<<+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>][-] +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[->>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<[<<<[-]<[-]<[-]+>>>>>>[<<<<+>>>>-]<-[<<<<+>>>>-]<<<< +]<<[-]>>>[<<<+>>>-]<<[>>>>]><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]>[-]>[-]<<<<<<<<<<<<<[ +->>>>>>>>>>>>>+<<<<<<<<<<<<<]>>>>>>>>>>>>>[-<+<<<<<<<<<<<<+>>>>>>>>>>>>>][-] +++<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>] +<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[- +<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<< +[-]>>>]<<<[[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[-]<[- +]<[-]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<<<<<[->> +>>>+<<<<<]>>>>>[-<<<<<+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+ +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>][-]<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<[<<<[-]<[-]<[-]+>>>>>>[<<<<+>>>>-]<-[<<<<+>>>>-]<< +<<]<<[-]>>>[<<<+>>>-]<<[>>>>]><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>]>[-]>[-]<<<<<<<<<<<<<[->>>>>>>>>>>>>+<<<<<<<<<<<<<]>>>>>>>>>> +>>>[-<+<<<<<<<<<<<<+>>>>>>>>>>>>>][-]<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+ +>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>> +>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<< ++>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<<[[-]>[-]<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]>>>[-<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>+>>>]<]>[-]>[-]<<<<<<<<<<<<<[->>>>>>>>>>>>>+<<<<<<<<<<<<<]>> +>>>>>>>>>>>[-<+<<<<<<<<<<<<+>>>>>>>>>>>>>][-]+<<[-]+>>>[-]>[-]<<<[->>>+<<<]> +>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[-> +>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+< +<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<<[[-]>[-]<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>[-]>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>>>]<]>[-]>[-] +<<<<<<<<<<<<<[->>>>>>>>>>>>>+<<<<<<<<<<<<<]>>>>>>>>>>>>>[-<+<<<<<<<<<<<<+>>> +>>>>>>>>>>][-]++<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<] +>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[- +>>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[-> ++<]>[[-<+>]<<<[-]>>>]<<<[[-]>[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ++<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>+>>>]<]<[->>>>[-]<<<<[->>>>+<<<<]>>>>>[-]+<[[-<<<<+>>>>]>>[-]<< +<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>[-]>>>> +>[-<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>+>>>>>][-]<<<<<<<<[->>>>>>>>+<<<<<<<<]>>> +>[-]>>>>[-<<<<<<<<+>>>>+>>>>]<<<[-]++++++++++++++++++++++++++++++++>>-<]>[[- +]>[-]<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<]>>>>>>>>>>>[-]>>>>> +[-<<<<<<<<<<<<<<<<+>>>>>>>>>>>+>>>>>][-]<<<<<<<[->>>>>>>+<<<<<<<]>>>[-]>>>>[ +-<<<<<<<+>>>+>>>>]<<<[-]++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++>>]<[-]++++++++++++++++>[-]+++++++++++++ ++>>>>[-]>[-]<<<<<<<<<[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>[-<+<<<<<<<<+>>>>>>>>>][ +-]<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>] +<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[- +<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<< +[-]>>>]<<<[[-]<<<<+++++>>>>]>[-]>[-]<<<<<<<<<[->>>>>>>>>+<<<<<<<<<]>>>>>>>>> +[-<+<<<<<<<<+>>>>>>>>>][-]+<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<< +<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>> +>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-] +>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<<[[-]<<<++++++++++>>>][-]>[-]<<<<<<<<[->>> +>>>>>+<<<<<<<<]>>>>>>>>[-<+<<<<<<<+>>>>>>>>][-]+++++++++++++++++++++++++<<<[ +-]>>[>>[-]<[->+<]>[-<+<<<+>>>>]<<-][-]<<[->>+<<]>>[-<<+<<+>>>>][-]<<<<<<<<<< +<[->>>>>>>>>>>+<<<<<<<<<<<]>>>>>>>>>>>[-<<<<<<<<<<<+>>>>>>>->>>>][-]<<<<<<<< +<<<[->>>>>>>>>>>+<<<<<<<<<<<]>>>>>>>>>>>[-<<<<<<<<<<<+>>>>>>>->>>>]>[-]>[-]< +<<<<<<<<[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>[-<+<<<<<<<<+>>>>>>>>>][-]++<<[-]+>>> +[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<] +<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[ +-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<<[ +[-]<<<<----->>>>][-]<<<<<<[->>>>>>+<<<<<<]>>>>>>[-<<<<<<+>>>->>>][-]++++++++ ++++++++++++++++++++.++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++.>[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>]>>>[-]>[-]<<<<<[->>> +>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+> ++>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<< +[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<] +>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<<<[-]>>>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<< +<]>>>[-<<<+<<<<+>>>>>>>]<<[-<<<<<->>>>>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>> +[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>>>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[ +-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]< +]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<< +<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]>>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]< +<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++>[-]<<[>>>[-]< +<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+ +<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>> +>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<<[-]>>>>>[-]<[->+<]>[[-< ++>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<+>>>>>>]<<[-<<<<->>>>]>]<<<[-]>[-]<<<<<[->>> +>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>>>>[>>>[-]<<[->>+<<]>[-]> +[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+ +>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->> +>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]>>[[-<<+>>]<[-]>]<[[-]<<< +<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++ +>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>> +]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<] +>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<[-]>>>>[-] +<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<+>>>>>]<<[-<<<->>>]>]<<<[-]>[-]<< +<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>>>>[>>>[-]<<[->>+ +<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>> +>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[- +]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]>>[[-<<+>>]<[-]>] +<[[-]<<<<<<<+>>>>>>>]<<<][-]<[->+<]>>[-]+<[[-<+>]<++++++++++++++++++++++++++ +++++++++++++++++++++++.<++++++++++++++++++++++++++++++++++++++++++++++++.<++ +++++++++++++++++++++++++++++++++++++++++++++++.>>>>-<]>[[-]>[-]<<<<[->>>>+<< +<<]>>>>>[-]+<[[-<<<<+>>>>]<<<<++++++++++++++++++++++++++++++++++++++++++++++ +++.<++++++++++++++++++++++++++++++++++++++++++++++++.>>>>>>-<]>[[-]<<<<<<+++ ++++++++++++++++++++++++++++++++++++++++++++++.>>>>>>]<<]<<<<<<-------------- +------------------.>[-]>[-]<<<<<<[->>>>>>+<<<<<<]>>>>>>[-<+<<<<<+>>>>>>]>>>[ +-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++>[-]<<[>>>[-]<<[-> +>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<] +>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]> +[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<<<[-]>>>>>>[-]<[->+<]>[[-<+> +]>[-]<<<[->>>+<<<]>>>[-<<<+<<<<+>>>>>>>]<<[-<<<<<->>>>>]>]<<<[-]>[-]<<<<<[-> +>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>>>>[>>>[-]<<[->>+<<]>[- +]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<< +<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[- +>>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]>>[[-<<+>>]<[-]>]<[[-]< +<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++ +++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>> +>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<< +<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<<[-]>>>> +>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<+>>>>>>]<<[-<<<<->>>>]>]<<<[ +-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>>>>[>>>[- +]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->> +>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+ +>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]>>[[-<<+> +>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>> +>>][-]++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<] +>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-] +<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]< +]<<<]<[-]>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<+>>>>>]<<[-<<<->> +>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>> +>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[- +]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>> +[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]> +>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]<[->+<]>>[-]+<[[-<+>]<++++++++++ +++++++++++++++++++++++++++++++++++++++.<++++++++++++++++++++++++++++++++++++ +++++++++++++.<++++++++++++++++++++++++++++++++++++++++++++++++.>>>>-<]>[[-]> +[-]<<<<[->>>>+<<<<]>>>>>[-]+<[[-<<<<+>>>>]<<<<++++++++++++++++++++++++++++++ +++++++++++++++++++.<++++++++++++++++++++++++++++++++++++++++++++++++.>>>>>>- +<]>[[-]<<<<<<++++++++++++++++++++++++++++++++++++++++++++++++.>>>>>>]<<]<<<< +<<+++++++++++++.>[-]>[-]<<<<<<<[->>>>>>>+<<<<<<<]>>>>>>>[-<+<<<<<<+>>>>>>>][ +-]++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++<<[-]+>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>> +>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->> +>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+< +]>[[-<+>]<<<[-]>>>]<<[-]+<[[-]>>[-]+++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++++.<-<]>[[-]<<<<<<.>>>>>>]<[-]<<<<<<<<<<<[->>>>>>>>>>>+<<<<<<<<<<<]>>>>>>>> +>[-]>>[-<<<<<<<<<<<+>>>>>>>>>+>>][-]<<[->>+<<]>>[[-<<+>>]<<->>]<<[<<<..>>>-] +<<<.>>>>>[-]<<<<<<<<<<<[->>>>>>>>>>>+<<<<<<<<<<<]>>>>>>>>>[-]>>[-<<<<<<<<<<< ++>>>>>>>>>+>>][-]<<[->>+<<]>>[[-<<+>>]<<->>]<<[<<<..>>>-]>>>[-]>[-]<<<<<<<[- +>>>>>>>+<<<<<<<]>>>>>>>[-<+<<<<<<+>>>>>>>][-]+++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++<<[-]+>>>[-]>[-]<<< +[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[- +]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<] +[-]<<[->>+<<]>>[[-<<+>>]<<<[-]>>>][-]<[->+<]>[[-<+>]<<<[-]>>>]<<[-]+<[[-]>>[ +-]++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++.<-<]>[[-]<<<<<<.>>>>>>]<<<<<< +<<<]>[-]++++++++++.[-]+>[-]+>[-]+++++++++++++++++++++++++++.++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++.>[-]>[-]<<<[->>>+<<<]>>>[-< ++<<+>>>]>>>[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++>[-]<< +[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]< +<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[ +-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<<<[-]>>>>>>[-]<[ +->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<<+>>>>>>>]<<[-<<<<<->>>>>]>]<<<[-] +>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>>>>[>>>[-]< +<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+ +<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>> +>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]>>[[-<<+>>] +<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>> +][-]++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>> +>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<< +<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]< +<<]<<[-]>>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<+>>>>>>]<<[-<<<< +->>>>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[ +-]>>>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>> +]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<] +>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+ +<<]>>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>> +[-<+<<<<+>>>>>][-]++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<< +[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<< +->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>] +<<[-]+>>]<]<]<<<]<[-]>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<+>>>> +>]<<[-<<<->>>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++ +++<<<<<[-]>>>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-< +<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->> +>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[- +]<<[->>+<<]>>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]<[->+<]>>[-]+<[[-<+> +]<++++++++++++++++++++++++++++++++++++++++++++++++.<++++++++++++++++++++++++ +++++++++++++++++++++++++.<++++++++++++++++++++++++++++++++++++++++++++++++.> +>>>-<]>[[-]>[-]<<<<[->>>>+<<<<]>>>>>[-]+<[[-<<<<+>>>>]<<<<++++++++++++++++++ +++++++++++++++++++++++++++++++.<++++++++++++++++++++++++++++++++++++++++++++ +++++.>>>>>>-<]>[[-]<<<<<<++++++++++++++++++++++++++++++++++++++++++++++++.>> +>>>>]<<]<<<<<<--------------------------------.>[-]>[-]<<<<[->>>>+<<<<]>>>>[ +-<+<<<+>>>>]>>>[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++>[ +-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]> +[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>> +>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<]<<<]<<<[-]>>>>>>[ +-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<<+>>>>>>>]<<[-<<<<<->>>>>]>]<< +<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<<<<<[-]>>>>[>>> +[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[- +>>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<< +<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[->>+<<]>>[[-<< ++>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+> +>>>>][-]++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<< +<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[ +-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]< +]<]<<<]<<[-]>>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<<+>>>>>>]<<[- +<<<<->>>>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++++++++<< +<<<[-]>>>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+ +>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<<[->>>>+< +<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]+>[-]<<[ +->>+<<]>>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]>[-]<<<<<[->>>>>+<<<<<]> +>>>>[-<+<<<<+>>>>>][-]++++++++++>[-]<<[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-] +<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]< +[<<<->>->[-]>[-]<<<<[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+ +>>>]<<[-]+>>]<]<]<<<]<[-]>>>>[-]<[->+<]>[[-<+>]>[-]<<<[->>>+<<<]>>>[-<<<+<<+ +>>>>>]<<[-<<<->>>]>]<<<[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<<<<+>>>>>][-]++++ +++++++<<<<<[-]>>>>[>>>[-]<<[->>+<<]>[-]>[-<<+>+>][-]>[-]<<<<[->>>>+<<<<]>>>> +[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<<->>->[-]>[-]<<<< +[->>>>+<<<<]>>>>[[-<<<<+>>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-] ++>[-]<<[->>+<<]>>[[-<<+>>]<[-]>]<[[-]<<<<<<<+>>>>>>>]<<<][-]<[->+<]>>[-]+<[[ +-<+>]<++++++++++++++++++++++++++++++++++++++++++++++++.<++++++++++++++++++++ +++++++++++++++++++++++++++++.<++++++++++++++++++++++++++++++++++++++++++++++ +++.>>>>-<]>[[-]>[-]<<<<[->>>>+<<<<]>>>>>[-]+<[[-<<<<+>>>>]<<<<++++++++++++++ +++++++++++++++++++++++++++++++++++.<++++++++++++++++++++++++++++++++++++++++ +++++++++.>>>>>>-<]>[[-]<<<<<<+++++++++++++++++++++++++++++++++++++++++++++++ ++.>>>>>>]<<]<<<<<<+++++++++++++.<<[-]+++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++[>[-]++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++[>[-]+++++++++ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++++++[-]<-]<-]<<<<<]<<<<+>>>>[-]>[-]<<<<<[->>>>>+<<<<<]>>>>>[-<+<< +<<+>>>>>][-]++++<<[-]>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]> +>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[-> +>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<<[->>+<<]>>[[-<<+>>]<<<[-]+>>>][-]<[-> ++<]>[[-<+>]<<<[-]+>>>]<<<]<<->>[-]<<[->>+<<]>>[[-<<+>>]<<<<<<<<-<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[-]<[-]<[-]>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]>>>>>>>>[-]<<<<<<<<<[->>>>>>>>>+<<<<<<<<<]> +>>>>>>>>[-<<<<<<<<<+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[<<<[-]<[-]<[-]+>>>>>-[<<<<+> +>>>-]<<<<]<<[->>+>+<<<]>>[-<<+>>]<[>>[->>>>+<<<<]<<>>>>]>>[->>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<[-]<[-]>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>[-]>>>>>[-]<<<<<<<<<[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>[-<<<<<<<<<+<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[<<<[-]<[-]<[-]+>>>>> +-[<<<<+>>>>-]<<<<]<<[->>+>+<<<]>>[-<<+>>]<[>>[->>>>+<<<<]<<>>>>]>>[->>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<[-]<[- +]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]>>>>[-]<<<<<<<<<[ +->>>>>>>>>+<<<<<<<<<]>>>>>>>>>[-<<<<<<<<<+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[<<<[-]<[-]<[-]+>>> +>>-[<<<<+>>>>-]<<<<]<<[->>+>+<<<]>>[-<<+>>]<[>>[->>>>+<<<<]<<>>>>]>>[->>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +[-]>[-]>>>>>>>[-]++++++++>[-]>[-]<<<<<<<<<<<[->>>>>>>>>>>+<<<<<<<<<<<]>>>>>> +>>>>>[-<+<<<<<<<<<<+>>>>>>>>>>>]<<<[-]>>>[-]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]> +[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+<<<]>>>[[-< +<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<[->+<]>[[-<+>]<<<[-]+ +>>>]<<<[<<<<<<<<--------->>+>>>>>>>[-]++++++++>[-]>[-]<<<<<<<<<<<[->>>>>>>>> +>>+<<<<<<<<<<<]>>>>>>>>>>>[-<+<<<<<<<<<<+>>>>>>>>>>>]<<<[-]>>>[-]>[-]<<<[->> +>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[- +]<<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]< +[->+<]>[[-<+>]<<<[-]+>>>]<<<]>[-]++>[-]>[-]<<<<<<<<<<<[->>>>>>>>>>>+<<<<<<<< +<<<]>>>>>>>>>>>[-<+<<<<<<<<<<+>>>>>>>>>>>]<<<[-]>>>[-]>[-]<<<[->>>+<<<]>>>[[ +-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]<<<[->>>+< +<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<[->+<]>[[-< ++>]<<<[-]+>>>]<<<[<<<<<<<<--->+>>>>>>>>[-]++>[-]>[-]<<<<<<<<<<<[->>>>>>>>>>> ++<<<<<<<<<<<]>>>>>>>>>>>[-<+<<<<<<<<<<+>>>>>>>>>>>]<<<[-]>>>[-]>[-]<<<[->>>+ +<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<[<<->->[-]>[-]< +<<[->>>+<<<]>>>[[-<<<+>>>]>[-]<<<[->>>+<<<]>>>[[-<<<+>>>]<<[-]+>>]<]<][-]<[- +>+<]>[[-<+>]<<<[-]+>>>]<<<]<<<<+>>>]<<]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> diff --git a/parsers/Parsers/Brainfuck/inputs/helloworld.bf b/parsers/Parsers/Brainfuck/inputs/helloworld.bf new file mode 100644 index 0000000..6718f05 --- /dev/null +++ b/parsers/Parsers/Brainfuck/inputs/helloworld.bf @@ -0,0 +1,22 @@ +[Taken from https://esolangs.org/wiki/Brainfuck] ++++++ +++++ initialize counter (cell #0) to 10 +[ use loop to set the next four cells to 70/100/30/10 + > +++++ ++ add 7 to cell #1 + > +++++ +++++ add 10 to cell #2 + > +++ add 3 to cell #3 + > + add 1 to cell #4 + <<<< - decrement counter (cell #0) +] +> ++ . print 'H' +> + . print 'e' ++++++ ++ . print 'l' +. print 'l' ++++ . print 'o' +> ++ . print ' ' +<< +++++ +++++ +++++ . print 'W' +> . print 'o' ++++ . print 'r' +----- - . print 'l' +----- --- . print 'd' +> + . print '!' +> . print '\n' diff --git a/parsers/Parsers/Brainfuck/inputs/helloworld_golfed.bf b/parsers/Parsers/Brainfuck/inputs/helloworld_golfed.bf new file mode 100644 index 0000000..265e751 --- /dev/null +++ b/parsers/Parsers/Brainfuck/inputs/helloworld_golfed.bf @@ -0,0 +1 @@ +++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>. diff --git a/test/Grammar/Nandlang.hs b/parsers/Parsers/Nandlang.hs similarity index 95% rename from test/Grammar/Nandlang.hs rename to parsers/Parsers/Nandlang.hs index 8787178..aff8999 100644 --- a/test/Grammar/Nandlang.hs +++ b/parsers/Parsers/Nandlang.hs @@ -6,7 +6,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnboxedTuples #-} -module Grammar.Nandlang where +module Parsers.Nandlang where import Data.Bool import Data.Char (isSpace, isAlpha, isAlphaNum) @@ -38,7 +38,7 @@ nandStringLetter :: Char -> Bool nandStringLetter c = (c /= '"') && (c /= '\\') && (c > '\026') grammar :: forall repr. - P.Grammar Char repr => + P.Grammarable Char repr => repr () grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof where @@ -90,8 +90,10 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof varstmt = P.optional (keyword "var") P.*> varlist1 P.*> symbol '=' P.*> exprlist1 P.<* semi keyword :: String -> repr () keyword k = P.string k P.*> P.pure H.unit - -- keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace + {- + keyword s = P.try (P.string s P.*> notIdentLetter) P.*> whitespace notIdentLetter = P.negLook identLetter + -} identLetter = P.satisfy (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||])) @@ -120,9 +122,11 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof (trans (H.ValueCode isSpace [||isSpace||]))) whitespace :: repr () whitespace = spaces - -- whitespace = P.skipMany (spaces P.<|> oneLineComment) - spaces :: repr () - spaces = P.skipSome space + {- + whitespace = P.skipMany (spaces P.<|> oneLineComment) oneLineComment :: repr () oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy (trans (H.ValueCode (/= '\n') [||(/= '\n')||])))) + -} + spaces :: repr () + spaces = P.skipSome space diff --git a/test/Grammar/Playground.hs b/parsers/Parsers/Playground.hs similarity index 92% rename from test/Grammar/Playground.hs rename to parsers/Parsers/Playground.hs index df15f3c..03dde7b 100644 --- a/test/Grammar/Playground.hs +++ b/parsers/Parsers/Playground.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE TemplateHaskell #-} -module Grammar.Playground where +module Parsers.Playground where import Symantic.Parser import qualified Symantic.Parser.Haskell as H diff --git a/parsers/Parsers/Tiny.hs b/parsers/Parsers/Tiny.hs new file mode 100644 index 0000000..5802bda --- /dev/null +++ b/parsers/Parsers/Tiny.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UnboxedTuples #-} +module Parsers.Tiny where + +import Control.Monad (Monad(..)) +import Data.Char (Char) +import Data.Either (Either(..)) +import Data.Function (($)) +import Data.Semigroup (Semigroup(..)) +import Data.String (String, IsString(..)) +import Data.Text (Text) +import Data.Text.IO (readFile) +import System.IO (IO, FilePath) +import Test.Tasty +import Test.Tasty.Golden +import Text.Show (Show(..)) +import qualified Data.ByteString.Lazy as BSL +import qualified Data.IORef as IORef +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL +import qualified Language.Haskell.TH.Syntax as TH + +import qualified Symantic.Parser as P +import qualified Symantic.Parser.Haskell as H +--import Golden.Utils + + +p_Tiny = p_CmdSeq P.<* P.eof -- (!. / %{eof}) +p_CmdSeq = P.some (p_Cmd p_SEMICOLON{-^cmdSeq-}) +p_Cmd = p_IfCmd <|> p_RepeatCmd / p_ReadCmd / p_WriteCmd / p_AssignCmd + +-- conditional :: Eq a => [H.Haskell (a -> Bool)] -> [repr b] -> repr a -> repr b -> repr b +p_Cmd = P.conditional + [] + [p_IfCmd, p_RepeatCmd, p_ReadCmd, p_WriteCmd, p_AssignCmd] + + empty + + ((\c -> haskell c [||c||]) Prelude.<$> ["", ]) + (look anyChar) op empty + + +p_IfCmd = p_IF p_Exp^ifExp p_THEN^ifThen p_CmdSeq^ifThenCmdSeq (p_ELSE p_CmdSeq^ifElseCmdSeq / '') p_END^ifEnd +p_RepeatCmd = p_REPEAT p_CmdSeq^repeatCmdSeq p_UNTIL^repeatUntil p_Exp^repeatExp +p_AssignCmd = p_NAME p_ASSIGNMENT^assignOp p_Exp^assignExp +p_ReadCmd = p_READ p_NAME^readName +p_WriteCmd = p_WRITE p_Exp^writeExp +p_Exp = p_SimpleExp ((p_LESS / p_EQUAL) p_SimpleExp^simpleExp / '') +p_SimpleExp = p_Term ((p_ADD / p_SUB) p_Term^term)* +p_Term = p_Factor ((p_MUL / p_DIV) p_Factor^factor)* +p_Factor = p_OPENPAR p_Exp^openParExp p_CLOSEPAR^closePar / p_NUMBER / p_NAME +p_ADD = lex "+" +p_ASSIGNMENT = lex ":=" +p_CLOSEPAR = lex ")" +p_DIV = lex "/" +p_IF = lex "if" +p_ELSE = lex "else" +p_END = lex "end" +p_EQUAL = lex "=" +p_LESS = lex "<" +p_MUL = lex "*" +p_NAME = !p_RESERVED lex (some (oneOf ['a' .. 'z'])) +p_NUMBER = lex (some (oneOf ['0' .. '9'])) +p_OPENPAR = lex "(" +p_READ = lex "read" +p_REPEAT = lex "repeat" +p_SEMICOLON = lex ";" +p_SUB = lex "-" +p_THEN = lex "then" +p_UNTIL = lex "until" +p_WRITE = lex "write" +p_RESERVED = (p_IF / p_ELSE / p_END / p_READ / p_REPEAT / p_THEN / p_UNTIL / p_WRITE) ![a-z]+ +p_Sp = (" " P.<|> "\n")* +lex = (p_Sp *>) diff --git a/parsers/Parsers/Utils.hs b/parsers/Parsers/Utils.hs new file mode 100644 index 0000000..ab0dac6 --- /dev/null +++ b/parsers/Parsers/Utils.hs @@ -0,0 +1,25 @@ +module Parsers.Utils + ( module Parsers.Utils + , w2c + ) + where + +import Data.Char (Char) +import Data.Function ((.), id) +import Data.Word (Word8) +import Prelude (Enum(..)) +import Data.ByteString.Internal (w2c, c2w) + +-- * Class 'CoerceEnum' +-- | Convenient helper to write generic grammars +-- consuming either 'Word8' or 'Char'. +class CoerceEnum a b where + coerceEnum :: a -> b + default coerceEnum :: Enum a => Enum b => a -> b + coerceEnum = toEnum . fromEnum +instance CoerceEnum Word8 Char where + coerceEnum = w2c +instance CoerceEnum Char Word8 where + coerceEnum = c2w +instance CoerceEnum Char Char where + coerceEnum = id diff --git a/parsers/Parsers/Utils/Attoparsec.hs b/parsers/Parsers/Utils/Attoparsec.hs new file mode 100644 index 0000000..ea0abde --- /dev/null +++ b/parsers/Parsers/Utils/Attoparsec.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +module Parsers.Utils.Attoparsec where + +import Control.Applicative hiding (some) +import Control.Monad (Monad(..), MonadPlus) +import Data.Attoparsec.Combinator +import Data.Bool (Bool(..)) +import Data.Char (Char) +import Data.Either (Either(..)) +import Data.Eq (Eq(..)) +import Data.Function (flip, ($), id) +import Data.Functor (void) +import Data.Maybe (Maybe(..), maybe) +import Data.String (String) +import Data.Word (Word8) +import qualified Data.List as List +import qualified Data.Text as T +import qualified Data.ByteString as BS +import qualified Data.Attoparsec.Internal.Types as AP +import qualified Data.Attoparsec.ByteString as AP.ByteString +import qualified Data.Attoparsec.ByteString.Char8 as AP.ByteString.Char8 +import qualified Data.Attoparsec.Text as AP.Text + +-- * Class 'Inputable' +class AP.Chunk inp => Inputable inp where + type Token inp + null :: inp -> Bool + empty :: inp + uncons :: inp -> Maybe (Token inp, inp) + satisfy :: (Token inp -> Bool) -> AP.Parser inp (Token inp) + char :: Char -> AP.Parser inp Char + notInClass :: String -> Token inp -> Bool +instance Inputable T.Text where + type Token T.Text = Char + null = T.null + empty = T.empty + uncons = T.uncons + satisfy = AP.Text.satisfy + char = AP.Text.char + notInClass = AP.Text.notInClass +instance Inputable BS.ByteString where + type Token BS.ByteString = Word8 + null = BS.null + empty = BS.empty + uncons = BS.uncons + satisfy = AP.ByteString.satisfy + char = AP.ByteString.Char8.char + notInClass = AP.ByteString.notInClass + +between :: Applicative f => f a -> f b -> f c -> f c +between o c p = o *> p <* c + +match :: (Monad m, Eq a) => [a] -> m a -> (a -> m b) -> m b -> m b +match xs p f def = p >>= (\x -> if List.elem x xs then f x else def) + +skipSome :: Alternative p => p a -> p () +skipSome p = void (some p) + +some :: Alternative p => p a -> p [a] +some = many1 + +maybeP :: Alternative p => p a -> p (Maybe a) +maybeP p = option Nothing (Just <$> p) + +fromMaybeP :: Monad m => m (Maybe a) -> m a -> m a +fromMaybeP mmx d = mmx >>= maybe d return + +(<+>) :: Alternative p => p a -> p b -> p (Either a b) +p <+> q = Left <$> p <|> Right <$> q + +(<:>) :: Applicative p => p a -> p [a] -> p [a] +(<:>) = liftA2 (:) + +(<~>) :: Applicative p => p a -> p b -> p (a, b) +(<~>) = liftA2 (,) + +pfoldl1 :: Alternative p => (b -> a -> b) -> b -> p a -> p b +pfoldl1 f k p = List.foldl' f k <$> some p + +(>?>) :: MonadPlus m => m a -> (a -> Bool) -> m a +m >?> f = m >>= \x -> if f x then return x else Control.Applicative.empty + +chainPre :: Alternative p => p (a -> a) -> p a -> p a +chainPre op p = flip (List.foldr ($)) <$> many op <*> p + +chainPost :: Alternative p => p a -> p (a -> a) -> p a +chainPost p op = List.foldl' (flip ($)) <$> p <*> many op + +chainl1 :: Alternative p => p a -> p (a -> a -> a) -> p a +chainl1 p op = chainPost p (flip <$> op <*> p) + +chainr1 :: Alternative p => p a -> p (a -> a -> a) -> p a +chainr1 p op = let go = p <**> ((flip <$> op <*> go) <|> pure id) in go + +data Level p s a + = InfixL [p (a -> a -> a)] + | InfixR [p (a -> a -> a)] + | Prefix [p (a -> a)] + | Postfix [p (a -> a)] + +precedence :: Alternative p => [Level p s a] -> p a -> p a +precedence levels atom = List.foldl' convert atom levels + where + convert x (InfixL ops) = chainl1 x (choice ops) + convert x (InfixR ops) = chainr1 x (choice ops) + convert x (Prefix ops) = chainPre (choice ops) x + convert x (Postfix ops) = chainPost x (choice ops) diff --git a/parsers/Parsers/Utils/Attoparsec/Text.hs b/parsers/Parsers/Utils/Attoparsec/Text.hs new file mode 100644 index 0000000..f20c72f --- /dev/null +++ b/parsers/Parsers/Utils/Attoparsec/Text.hs @@ -0,0 +1,20 @@ +module Parsers.Utils.Attoparsec.Text + ( module Parsers.Utils.Attoparsec.Text + , module Data.Attoparsec.Text + ) where + +import Data.Attoparsec.Combinator +import Data.Attoparsec.Text +import Data.Char (Char) +import Data.Function ((.)) +import Data.Text (Text) +import qualified Data.Attoparsec.Text as AP.Text + +token :: Text -> AP.Text.Parser Text +token = try . AP.Text.string + +oneOf :: [Char] -> AP.Text.Parser Char +oneOf = AP.Text.satisfy . AP.Text.inClass + +noneOf :: [Char] -> AP.Text.Parser Char +noneOf = AP.Text.satisfy . AP.Text.notInClass diff --git a/parsers/Parsers/Utils/Handrolled.hs b/parsers/Parsers/Utils/Handrolled.hs new file mode 100644 index 0000000..5f619ba --- /dev/null +++ b/parsers/Parsers/Utils/Handrolled.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE TypeFamilies #-} +module Parsers.Utils.Handrolled where + +import Control.Monad (Monad(..), fail) +import Data.Bool (Bool) +import Data.Char (Char) +import Data.Maybe (Maybe(..)) +import Data.Word (Word8) +import qualified Data.ByteString as BS +import qualified Data.Text as T + +-- * Class 'Inputable' +class Inputable inp where + type Token inp + null :: inp -> Bool + empty :: inp + uncons :: inp -> Maybe (Token inp, inp) +instance Inputable T.Text where + type Token T.Text = Char + null = T.null + empty = T.empty + uncons = T.uncons +instance Inputable BS.ByteString where + type Token BS.ByteString = Word8 + null = BS.null + empty = BS.empty + uncons = BS.uncons diff --git a/src/Symantic/Parser.hs b/src/Symantic/Parser.hs index 4428eff..7ef20f3 100644 --- a/src/Symantic/Parser.hs +++ b/src/Symantic/Parser.hs @@ -1,29 +1,23 @@ -{-# LANGUAGE TemplateHaskell #-} module Symantic.Parser ( module Symantic.Parser.Grammar , module Symantic.Parser.Machine , module Symantic.Parser ) where -import Data.Either (Either(..)) +import Data.Either (Either) import Data.Function (($)) -import Data.Ord (Ord) import Language.Haskell.TH (CodeQ) -import Text.Show (Show) -import Type.Reflection (Typeable) import qualified Language.Haskell.TH.Syntax as TH import Symantic.Parser.Grammar import Symantic.Parser.Machine +-- * Type 'Parser' +type Parser inp a = Machine Gen inp a + runParser :: forall inp a. - Ord (InputToken inp) => - Show (InputToken inp) => - TH.Lift (InputToken inp) => - Typeable (InputToken inp) => - -- InputToken inp ~ Char => - Input inp => - InstrReadable (InputToken inp) Gen => + Inputable inp => + Machinable (InputToken inp) Gen => Parser inp a -> CodeQ (inp -> Either (ParsingError inp) a) runParser p = TH.Code $ do diff --git a/src/Symantic/Parser/Grammar.hs b/src/Symantic/Parser/Grammar.hs index b21ad54..9ba1d1c 100644 --- a/src/Symantic/Parser/Grammar.hs +++ b/src/Symantic/Parser/Grammar.hs @@ -1,5 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -- For grammar -{-# LANGUAGE ConstraintKinds #-} -- For Grammar +{-# LANGUAGE ConstraintKinds #-} -- For Grammarable module Symantic.Parser.Grammar ( module Symantic.Parser.Grammar , module Symantic.Parser.Grammar.Combinators @@ -18,13 +18,16 @@ import Symantic.Parser.Grammar.ObserveSharing import Symantic.Parser.Grammar.Optimize import Symantic.Parser.Grammar.Write +import Control.DeepSeq (NFData) +import Data.Eq (Eq(..)) import Data.Function ((.)) import Data.String (String) +import Data.Typeable (Typeable) import Text.Show (Show(..)) import qualified Language.Haskell.TH.Syntax as TH --- * Class 'Grammar' -type Grammar tok repr = +-- * Class 'Grammarable' +type Grammarable tok repr = ( CombAlternable repr , CombApplicable repr , CombFoldable repr @@ -34,12 +37,17 @@ type Grammar tok repr = , CombMatchable repr , CombSatisfiable tok repr , CombSelectable repr + , Eq tok + , TH.Lift tok + , NFData tok + , Show tok + , Typeable tok ) -- | A usual pipeline to interpret 'Comb'inators: -- 'observeSharing' then 'optimizeGrammar' then a polymorphic @(repr)@. grammar :: - Grammar tok repr => + Grammarable tok repr => ObserveSharing TH.Name (OptimizeGrammar repr) a -> repr a @@ -47,9 +55,9 @@ grammar = optimizeGrammar . observeSharing -- | An usual pipeline to show 'Comb'inators: -- 'observeSharing' then 'optimizeGrammar' then 'viewGrammar' then 'show'. -showGrammar :: +showGrammar :: forall showName a tok repr. + repr ~ ObserveSharing TH.Name (OptimizeGrammar (ViewGrammar showName)) => ShowLetName showName TH.Name => - ObserveSharing TH.Name - (OptimizeGrammar (ViewGrammar showName)) a -> - String -showGrammar = show . viewGrammar . grammar + Grammarable tok repr => + repr a -> String +showGrammar = show . viewGrammar . grammar @tok diff --git a/src/Symantic/Parser/Grammar/Combinators.hs b/src/Symantic/Parser/Grammar/Combinators.hs index b07875b..3c8ff59 100644 --- a/src/Symantic/Parser/Grammar/Combinators.hs +++ b/src/Symantic/Parser/Grammar/Combinators.hs @@ -5,6 +5,8 @@ -- of the type class. This is almost as explained in: -- https://ro-che.info/articles/2016-02-03-finally-tagless-boilerplate {-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveGeneric #-} -- For NFData instances +{-# LANGUAGE DeriveAnyClass #-} -- For NFData instances {-# LANGUAGE DeriveLift #-} -- For TH.Lift (Exception tok) {-# LANGUAGE PatternSynonyms #-} -- For Failure {-# LANGUAGE StandaloneDeriving #-} -- For Show (Exception (InputToken inp)) @@ -17,6 +19,8 @@ module Symantic.Parser.Grammar.Combinators where import Data.Proxy (Proxy(..)) import Control.Monad (Monad(..)) +import Control.DeepSeq (NFData(..)) +import GHC.Generics (Generic) -- import Data.Set (Set) -- import GHC.TypeLits (KnownSymbol) import Data.Bool (Bool(..), not, (||)) @@ -89,7 +93,7 @@ class CombAlternable repr where data instance Failure CombAlternable = FailureEmpty - deriving (Eq, Ord, Show, TH.Lift) + deriving (Eq, Ord, Show, TH.Lift, Generic, NFData) -- ** Data family 'Failure' -- | 'Failure's of the 'Grammar'. @@ -111,6 +115,7 @@ data SomeFailure = Eq (Failure comb) , Show (Failure comb) , TH.Lift (Failure comb) + , NFData (Failure comb) , Typeable comb ) => SomeFailure (Failure comb {-repr a-}) @@ -127,6 +132,8 @@ instance Show SomeFailure where showsPrec p (SomeFailure x) = showsPrec p x instance TH.Lift SomeFailure where liftTyped (SomeFailure x) = [|| SomeFailure $$(TH.liftTyped x) ||] +instance NFData SomeFailure where + rnf (SomeFailure x) = rnf x {- instance Trans (SomeFailure repr) repr where @@ -146,7 +153,7 @@ unSomeFailure (SomeFailure (c::Failure c)) = data Exception = ExceptionLabel ExceptionLabel | ExceptionFailure - deriving (Eq, Ord, Show, TH.Lift) + deriving (Eq, Ord, Show, TH.Lift, Generic, NFData) type ExceptionLabel = String -- type Exceptions = Set Exception @@ -467,7 +474,9 @@ data instance Failure (CombSatisfiable tok) | FailureHorizon Int -- FIXME: use Natural? | FailureLabel String | FailureToken tok - deriving (Eq, Show, Typeable) + deriving (Eq, Show, Typeable, Generic, NFData) +-- | Global 'TH.Name' to refer to the @(InputToken inp)@ type +-- from TemplateHaskell code. inputTokenProxy :: TH.Name inputTokenProxy = TH.mkName "inputToken" instance TH.Lift tok => TH.Lift (Failure (CombSatisfiable tok)) where @@ -494,7 +503,7 @@ char c = satisfyOrFail (Set.singleton (SomeFailure (FailureToken c))) (H.eq H..@ H.char c) $> H.char c item :: forall tok repr. - Eq tok => Show tok => Typeable tok => TH.Lift tok => + Eq tok => Show tok => Typeable tok => TH.Lift tok => NFData tok => CombSatisfiable tok repr => repr tok item = satisfyOrFail (Set.singleton (SomeFailure (FailureAny @tok))) (H.const H..@ H.bool True) @@ -512,7 +521,7 @@ string :: string = try . traverse char oneOf :: - Eq tok => Show tok => Typeable tok => TH.Lift tok => + Eq tok => Show tok => Typeable tok => TH.Lift tok => NFData tok => CombSatisfiable tok repr => [tok] -> repr tok oneOf ts = satisfyOrFail @@ -586,7 +595,7 @@ class CombLookable repr where -- (item @Char) data instance Failure CombLookable = FailureEnd - deriving (Eq, Show, Typeable, TH.Lift) + deriving (Eq, Show, Typeable, TH.Lift, Generic, NFData) -- Composite Combinators -- someTill :: repr a -> repr b -> repr [a] diff --git a/src/Symantic/Parser/Machine.hs b/src/Symantic/Parser/Machine.hs index 814f4d4..dc6e0bc 100644 --- a/src/Symantic/Parser/Machine.hs +++ b/src/Symantic/Parser/Machine.hs @@ -8,9 +8,7 @@ module Symantic.Parser.Machine , module Symantic.Parser.Machine.View ) where import Data.Function ((.)) -import Data.Ord (Ord) import System.IO (IO) -import Text.Show (Show) import qualified Language.Haskell.TH.Syntax as TH import Symantic.Parser.Grammar @@ -21,21 +19,15 @@ import Symantic.Parser.Machine.Optimize import Symantic.Parser.Machine.Program import Symantic.Parser.Machine.View --- * Type 'Parser' -type Parser inp = ParserRepr Gen inp - --- | Like a 'Parser' but not bound to the 'Gen' interpreter. -type ParserRepr repr inp = +-- * Type 'Machine' +type Machine repr inp = ObserveSharing TH.Name (OptimizeGrammar (Program repr inp)) -- | Build a 'Machine' able to 'generateCode' for the given 'Parser'. machine :: forall inp repr a. - Ord (InputToken inp) => - Show (InputToken inp) => - TH.Lift (InputToken inp) => - Grammar (InputToken inp) (Program repr inp) => - Machine (InputToken inp) repr => - ParserRepr repr inp a -> + Grammarable (InputToken inp) (Program repr inp) => + Machinable (InputToken inp) repr => + Machine repr inp a -> IO (repr inp '[] a) machine = optimizeMachine . grammar @(InputToken inp) diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs index a268294..b3875a9 100644 --- a/src/Symantic/Parser/Machine/Generate.hs +++ b/src/Symantic/Parser/Machine/Generate.hs @@ -1,4 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveAnyClass #-} -- For NFData instances +{-# LANGUAGE DeriveGeneric #-} -- For NFData instances {-# LANGUAGE StandaloneDeriving #-} -- For Show (ParsingError inp) {-# LANGUAGE ConstraintKinds #-} -- For Dict {-# LANGUAGE TemplateHaskell #-} @@ -8,18 +10,19 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Symantic.Parser.Machine.Generate where +import Control.DeepSeq (NFData(..)) import Control.Monad (Monad(..)) import Data.Bool (Bool) import Data.Char (Char) import Data.Either (Either(..), either) +import Data.Eq (Eq(..)) +import Data.Foldable (foldMap', toList, null) import Data.Function (($), (.), id, const, on) import Data.Functor (Functor, (<$>), (<$)) -import Data.Foldable (foldMap', toList, null) import Data.Int (Int) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) import Data.Maybe (Maybe(..)) -import Data.Eq (Eq(..)) import Data.Ord (Ord(..), Ordering(..)) import Data.Proxy (Proxy(..)) import Data.Semigroup (Semigroup(..)) @@ -27,17 +30,18 @@ import Data.Set (Set) import Data.String (String) import Data.Traversable (Traversable(..)) import Data.Typeable (Typeable) +import Data.Word (Word8) +import GHC.Generics (Generic) import Language.Haskell.TH (CodeQ) import Prelude ((+), (-), error) import Text.Show (Show(..)) --- import qualified Control.Monad.Trans.State.Strict as MT import qualified Data.HashMap.Strict as HM import qualified Data.List as List import qualified Data.List.NonEmpty as NE import qualified Data.Map.Internal as Map_ -import qualified Data.Set.Internal as Set_ import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import qualified Data.Set.Internal as Set_ import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH @@ -69,12 +73,15 @@ data Gen inp vs a = Gen -- | @('generateCode' input mach)@ generates @TemplateHaskell@ code -- parsing the given 'input' according to the given 'Machine'. generateCode :: - Ord (InputToken inp) => + {- + Eq (InputToken inp) => + NFData (InputToken inp) => Show (InputToken inp) => Typeable (InputToken inp) => TH.Lift (InputToken inp) => + -} -- InputToken inp ~ Char => - Input inp => + Inputable inp => Show (Cursor inp) => Gen inp '[] a -> CodeQ (inp -> Either (ParsingError inp) a) @@ -135,8 +142,9 @@ data ParsingError inp -- at the begining of the expected 'Horizon'. , parsingErrorUnexpected :: Maybe (InputToken inp) , parsingErrorExpecting :: Set SomeFailure - } + } deriving (Generic) deriving instance Show (InputToken inp) => Show (ParsingError inp) +deriving instance NFData (InputToken inp) => NFData (ParsingError inp) -- ** Type 'ErrorLabel' type ErrorLabel = String @@ -217,9 +225,14 @@ data FarthestError inp = FarthestError -- | This is an inherited (top-down) context -- only present at compile-time, to build TemplateHaskell splices. data GenCtx inp vs a = - ( TH.Lift (InputToken inp) - , Cursorable (Cursor inp) + ( Cursorable (Cursor inp) + {- + , TH.Lift (InputToken inp) , Show (InputToken inp) + , Eq (InputToken inp) + , Typeable (InputToken inp) + , NFData (InputToken inp) + -} ) => GenCtx { valueStack :: ValueStack vs , catchStackByLabel :: Map Exception (NonEmpty (CodeQ (Catcher inp a))) @@ -332,7 +345,7 @@ instance InstrExceptionable Gen where } , unGen = \ctx@GenCtx{} -> {-trace ("unGen.fail: "<>show exn) $-} if null fs - then [|| + then [|| -- Raise without updating the farthest error. $$(raiseException ctx ExceptionFailure) ExceptionFailure {-failInp-}$$(input ctx) @@ -654,13 +667,18 @@ instance InstrJoinable Gen where } instance InstrReadable Char Gen where read fs p = checkHorizon . checkToken fs p +instance InstrReadable Word8 Gen where + read fs p = checkHorizon . checkToken fs p checkHorizon :: forall inp vs a. + -- Those constraints are not used anyway + -- because (TH.Lift SomeFailure) uses 'inputTokenProxy'. Eq (InputToken inp) => - Ord (InputToken inp) => - Typeable (InputToken inp) => + Show (InputToken inp) => TH.Lift (InputToken inp) => + NFData (InputToken inp) => + Typeable (InputToken inp) => {-ok-}Gen inp vs a -> Gen inp vs a checkHorizon ok = ok @@ -736,8 +754,6 @@ finalGenAnalysis ctx k = finalGenAnalysisByLet ctx checkToken :: - Ord (InputToken inp) => - TH.Lift (InputToken inp) => Set SomeFailure -> {-predicate-}TermInstr (InputToken inp -> Bool) -> {-ok-}Gen inp (InputToken inp ': vs) a -> diff --git a/src/Symantic/Parser/Machine/Input.hs b/src/Symantic/Parser/Machine/Input.hs index 53b208f..eae86ba 100644 --- a/src/Symantic/Parser/Machine/Input.hs +++ b/src/Symantic/Parser/Machine/Input.hs @@ -9,6 +9,7 @@ import Data.Array.Base (UArray(..), listArray) import Data.Bool import Data.ByteString.Internal (ByteString(..)) import Data.Char (Char) +import Data.Word (Word8) import Data.Eq (Eq(..)) import Data.Function (on) import Data.Int (Int) @@ -20,7 +21,8 @@ import Data.Text.Array ({-aBA, empty-}) import Data.Text.Internal (Text(..)) import Data.Text.Unsafe (iter, Iter(..), iter_, reverseIter_) import Text.Show (Show(..)) -import GHC.Exts (Int(..), Char(..){-, RuntimeRep(..)-}) +import GHC.Exts (Int(..), Char(..), {-, RuntimeRep(..)-}) +import GHC.Word (Word8(..)) import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents) import GHC.Prim ({-Int#,-} Addr#, nullAddr#, indexWideCharArray#, {-indexWord16Array#,-} readWord8OffAddr#, word2Int#, chr#, touch#, realWorld#, plusAddr#, (+#)) import Language.Haskell.TH (CodeQ) @@ -84,7 +86,7 @@ shiftRightByteString j !(UnpackedLazyByteString i addr# final off size cs) BSL.Empty -> emptyUnpackedLazyByteString (i + size) shiftLeftByteString :: Int -> UnpackedLazyByteString -> UnpackedLazyByteString -shiftLeftByteString j (UnpackedLazyByteString i addr# final off size cs) = +shiftLeftByteString j !(UnpackedLazyByteString i addr# final off size cs) = UnpackedLazyByteString (i - d) addr# final (off - d) (size + d) cs where d = min off j @@ -140,8 +142,8 @@ emptyUnpackedLazyByteString i = UnpackedLazyByteString i nullAddr# (error "nullForeignPtr") 0 0 BSL.Empty --- * Class 'Input' -class Cursorable (Cursor inp) => Input inp where +-- * Class 'Inputable' +class Cursorable (Cursor inp) => Inputable inp where type Cursor inp :: Type type InputToken inp :: Type cursorOf :: CodeQ inp -> CodeQ @@ -150,23 +152,24 @@ class Cursorable (Cursor inp) => Input inp where , {-next-} Cursor inp -> (# InputToken inp, Cursor inp #) #) -instance Input String where +instance Inputable String where type Cursor String = Int type InputToken String = Char cursorOf input = cursorOf @(UArray Int Char) [|| listArray (0, List.length $$input-1) $$input ||] -instance Input (UArray Int Char) where +instance Inputable (UArray Int Char) where type Cursor (UArray Int Char) = Int type InputToken (UArray Int Char) = Char cursorOf qinput = [|| - let UArray _ _ size input# = $$qinput + -- Pattern bindings containing unlifted types should use an outermost bang pattern. + let !(UArray _ _ size input#) = $$qinput next (I# i#) = (# C# (indexWideCharArray# input# i#) , I# (i# +# 1#) #) in (# 0, (< size), next #) ||] -instance Input Text where +instance Inputable Text where type Cursor Text = Text type InputToken Text = Char cursorOf inp = [|| @@ -177,18 +180,19 @@ instance Input Text where more (Text _ _ unconsumed) = unconsumed > 0 in (# $$inp, more, next #) ||] -instance Input ByteString where +instance Inputable ByteString where type Cursor ByteString = Int - type InputToken ByteString = Char + type InputToken ByteString = Word8 cursorOf qinput = [|| - let PS (ForeignPtr addr# final) off size = $$qinput + -- Pattern bindings containing unlifted types should use an outermost bang pattern. + let !(PS (ForeignPtr addr# final) off size) = $$qinput next i@(I# i#) = case readWord8OffAddr# (addr# `plusAddr#` i#) 0# realWorld# of (# s', x #) -> case touch# final s' of - _ -> (# C# (chr# (word2Int# x)), i + 1 #) + _ -> (# W8# (x), i + 1 #) in (# off, (< size), next #) ||] -instance Input BSL.ByteString where +instance Inputable BSL.ByteString where type Cursor BSL.ByteString = UnpackedLazyByteString type InputToken BSL.ByteString = Char cursorOf qinput = [|| @@ -212,7 +216,7 @@ instance Input BSL.ByteString where in (# init, more, next #) ||] {- -instance Input Text16 where +instance Inputable Text16 where type Cursor Text16 = Int cursorOf qinput = [|| let Text16 (Text arr off size) = $$qinput @@ -222,7 +226,7 @@ instance Input Text16 where , I# (i# +# 1#) #) in (# off, (< size), next #) ||] -instance Input CharList where +instance Inputable CharList where type Cursor CharList = OffWith String cursorOf qinput = [|| let CharList input = $$qinput @@ -233,7 +237,7 @@ instance Input CharList where --more _ = True in (# $$offWith input, more, next #) ||] -instance Input Stream where +instance Inputable Stream where type Cursor Stream = OffWith Stream cursorOf qinput = [|| let next (OffWith o (c :> cs)) = (# c, OffWith (o + 1) cs #) diff --git a/src/Symantic/Parser/Machine/Instructions.hs b/src/Symantic/Parser/Machine/Instructions.hs index 80f3e93..331c0a1 100644 --- a/src/Symantic/Parser/Machine/Instructions.hs +++ b/src/Symantic/Parser/Machine/Instructions.hs @@ -22,18 +22,6 @@ import Symantic.Parser.Machine.Input -- * Type 'TermInstr' type TermInstr = H.Term TH.CodeQ --- * Class 'Machine' --- | All the 'Instr'uctions. -type Machine tok repr = - ( InstrBranchable repr - , InstrExceptionable repr - , InstrInputable repr - , InstrJoinable repr - , InstrCallable repr - , InstrValuable repr - , InstrReadable tok repr - ) - -- ** Type 'ReprInstr' type ReprInstr = {-input-}Type -> {-valueStack-}[Type] -> {-a-}Type -> Type @@ -87,6 +75,9 @@ class InstrExceptionable (repr::ReprInstr) where -- | @('raise' exn)@ raises 'ExceptionLabel' @(exn)@. raise :: ExceptionLabel -> repr inp vs a -- | @('fail' fs)@ raises 'ExceptionFailure' @(exn)@. + -- As a special case, giving an empty 'Set' of failures + -- raises 'ExceptionFailure' without using the current position + -- to update the farthest error. fail :: Set SomeFailure -> repr inp vs a -- | @('commit' exn k)@ removes the 'Catcher' -- from the 'catchStackByLabel' for the given 'Exception' @(exn)@, diff --git a/src/Symantic/Parser/Machine/Program.hs b/src/Symantic/Parser/Machine/Program.hs index 66a12f1..64f9663 100644 --- a/src/Symantic/Parser/Machine/Program.hs +++ b/src/Symantic/Parser/Machine/Program.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE UndecidableInstances #-} -- For Cursorable (Cursor inp) -- | Build the 'Instr'uction 'Program' of a 'Machine' -- from the 'Comb'inators of a 'Grammar'. @@ -8,16 +9,20 @@ module Symantic.Parser.Machine.Program where import Control.Monad (Monad(..), (<=<), (=<<), liftM, liftM2, sequence) -import Data.Bool (Bool(..)) -import Data.Function (($), (.)) -import Data.Ord (Ord) +import Data.Function (($)) import System.IO (IO) import Type.Reflection (Typeable) +import Control.DeepSeq (NFData) +import Data.Bool (Bool(..)) +import Data.Eq (Eq(..)) +import Data.Function ((.)) +import Text.Show (Show(..)) import qualified Data.Functor as Functor import qualified Data.HashMap.Strict as HM import qualified Data.Set as Set import qualified Data.Traversable as Traversable import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH import qualified Symantic.Parser.Haskell as H import Symantic.Parser.Grammar @@ -40,14 +45,31 @@ data Program repr inp a = Program { unProgram :: IO (SomeInstr repr inp vs ret) } --- | Build an interpreter of the 'Program' of the given 'Machine'. +-- | Build an interpreter of the 'Program' of the given 'Machinable'. optimizeMachine :: forall inp repr a. - Machine (InputToken inp) repr => + Machinable (InputToken inp) repr => Program repr inp a -> IO (repr inp '[] a) optimizeMachine (Program f) = trans Functor.<$> f @'[] ret +-- * Class 'Machinable' +-- | All the 'Instr'uctions. +type Machinable tok repr = + ( InstrBranchable repr + , InstrExceptionable repr + , InstrInputable repr + , InstrJoinable repr + , InstrCallable repr + , InstrValuable repr + , InstrReadable tok repr + , Eq tok + , TH.Lift tok + , NFData tok + , Show tok + , Typeable tok + ) + instance ( Cursorable (Cursor inp) , InstrBranchable repr @@ -180,7 +202,7 @@ instance defs' <- Traversable.traverse (\(SomeLet (Program val)) -> liftM SomeLet (val ret)) defs liftM (defLet defs') (x next) instance - ( Ord (InputToken inp) + ( Eq (InputToken inp) , Cursorable (Cursor inp) , InstrBranchable repr , InstrExceptionable repr diff --git a/symantic-parser.cabal b/symantic-parser.cabal index e6e37bc..58d2385 100644 --- a/symantic-parser.cabal +++ b/symantic-parser.cabal @@ -1,4 +1,4 @@ -cabal-version: 2.4 +cabal-version: 3.0 name: symantic-parser version: 0.1.0.20210201 synopsis: Parser combinators statically optimized and staged via typed meta-programming @@ -21,15 +21,17 @@ stability: experimental category: Parsing extra-doc-files: ChangeLog.md + HackMe.md ReadMe.md ToDo.md extra-source-files: - .envrc - Makefile cabal.project default.nix + .envrc flake.lock flake.nix + Makefile + parsers/Parsers/*/inputs/* shell.nix test/Golden/**/*.txt extra-tmp-files: @@ -56,6 +58,8 @@ common boilerplate -Wpartial-fields -fhide-source-paths -freverse-errors + ghc-prof-options: + -eventlog -fprof-auto -fprof-auto-calls library import: boilerplate @@ -104,6 +108,7 @@ library array, bytestring, containers, + deepseq >= 1.4, ghc-prim, hashable, template-haskell >= 2.16, @@ -111,6 +116,55 @@ library transformers, unordered-containers +library parsers + -- visibility: public + import: boilerplate + hs-source-dirs: parsers + exposed-modules: + Parsers.Brainfuck.Attoparsec + Parsers.Brainfuck.Handrolled + Parsers.Brainfuck.SymanticParser + Parsers.Brainfuck.Types + Parsers.Nandlang + Parsers.Playground + Parsers.Utils + Parsers.Utils.Handrolled + Parsers.Utils.Attoparsec + Parsers.Utils.Attoparsec.Text + default-extensions: + BangPatterns, + DefaultSignatures, + FlexibleContexts, + FlexibleInstances, + GeneralizedNewtypeDeriving, + LambdaCase, + MultiParamTypeClasses, + ScopedTypeVariables, + TypeApplications, + TypeFamilies, + TypeOperators + ghc-options: -O2 + build-depends: + symantic-parser, + attoparsec >= 0.13, + base >= 4.10 && < 5, + bytestring >= 0.10, + containers >= 0.5.10.1, + deepseq >= 1.4, + directory >= 1.3, + filepath >= 1.4, + hashable >= 1.2.6, + megaparsec >= 9.0, + process >= 1.6, + strict >= 0.4, + tasty >= 0.11, + tasty-golden >= 2.3, + template-haskell >= 2.16, + text >= 1.2, + transformers >= 0.4, + unix >= 2.7, + unordered-containers + test-suite symantic-parser-test import: boilerplate type: exitcode-stdio-1.0 @@ -124,16 +178,17 @@ test-suite symantic-parser-test Golden.Splice Golden.Utils Grammar - Grammar.Brainfuck - Grammar.Nandlang - Grammar.Playground -- HUnit -- QuickCheck - ghc-options: + Paths_symantic_parser + autogen-modules: + Paths_symantic_parser + ghc-options: -O2 ghc-prof-options: -fexternal-interpreter build-depends: symantic-parser, + symantic-parser:parsers, base >= 4.10 && < 5, bytestring >= 0.10, -- Needed for exported Data.Map.Internal @@ -163,3 +218,33 @@ test-suite symantic-parser-test if flag(dump-core) build-depends: dump-core ghc-options: -fplugin=DumpCore + +benchmark symantic-parser-benchmark + import: boilerplate + type: exitcode-stdio-1.0 + hs-source-dirs: benchmarks + main-is: Main.hs + default-language: Haskell2010 + other-modules: + Brainfuck + Paths_symantic_parser + autogen-modules: + Paths_symantic_parser + default-extensions: + ghc-options: -O2 + ghc-prof-options: + -fexternal-interpreter + build-depends: + base >= 4.6 && < 5, + symantic-parser, + symantic-parser:parsers, + attoparsec >= 0.13, + bytestring >= 0.10, + containers >= 0.5, + criterion >= 1.5, + deepseq >= 1.4, + megaparsec >= 9.0, + random >= 1.1, + text >= 1.2, + template-haskell >= 2.16, + transformers >= 0.5 diff --git a/test/Golden/Grammar.hs b/test/Golden/Grammar.hs index bb57f26..f360a0f 100644 --- a/test/Golden/Grammar.hs +++ b/test/Golden/Grammar.hs @@ -22,14 +22,14 @@ goldens :: TestTree goldens = testGroup "Grammar" $ [ testGroup "ViewGrammar" $ (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \gram g -> - let grammarFile = "test/Golden/Grammar/ViewGrammar/G"<>show g<>".expected.txt" in + let grammarFile = getGoldenDir $ "Grammar/ViewGrammar/G"<>show g<>".expected.txt" in goldenVsStringDiff ("G"<>show g) goldenDiff grammarFile $ do resetTHNameCounter return $ fromString $ show $ P.viewGrammar @'False gram , testGroup "OptimizeGrammar" $ (\f -> List.zipWith f Grammar.grammars [1::Int ..]) $ \gram g -> - let grammarFile = "test/Golden/Grammar/OptimizeGrammar/G"<>show g<>".expected.txt" in + let grammarFile = getGoldenDir $ "Grammar/OptimizeGrammar/G"<>show g<>".expected.txt" in goldenVsStringDiff ("G"<>show g) goldenDiff grammarFile $ do resetTHNameCounter return $ fromString $ show $ diff --git a/test/Golden/Machine.hs b/test/Golden/Machine.hs index 055f15d..46af461 100644 --- a/test/Golden/Machine.hs +++ b/test/Golden/Machine.hs @@ -26,7 +26,7 @@ import qualified Symantic.Parser as P goldens :: TestTree goldens = testGroup "Machine" $ (\f -> List.zipWith f (machines @Text) [1::Int ..]) $ \mach g -> - let machineFile = "test/Golden/Machine/G"<>show g<>".expected.txt" in + let machineFile = getGoldenDir $ "Machine/G"<>show g<>".expected.txt" in goldenVsStringDiff ("G"<>show g) goldenDiff machineFile $ do resetTHNameCounter m <- mach @@ -36,6 +36,6 @@ goldens = testGroup "Machine" $ machines :: P.InputToken inp ~ Char => P.Cursorable (P.Cursor inp) => - P.Machine (P.InputToken inp) repr => + P.Machinable (P.InputToken inp) repr => [IO (repr inp '[] String)] machines = P.optimizeMachine <$> grammars diff --git a/test/Golden/Parser.hs b/test/Golden/Parser.hs index 95c77fc..6de6c1d 100644 --- a/test/Golden/Parser.hs +++ b/test/Golden/Parser.hs @@ -40,7 +40,7 @@ goldens :: TestTree goldens = testGroup "Parser" $ (\f -> List.zipWith f parsers [1::Int ..]) $ \p g -> -- Collect the existing files: test/Golden/Parser/G*.input.txt - let parserDir = "test/Golden/Parser/G"<>show g in + let parserDir = getGoldenDir $ "Parser/G"<>show g in let inputs = ((parserDir ) <$>) $ List.sort $ diff --git a/test/Golden/Parser/G1/P1.expected.txt b/test/Golden/Parser/G1/P1.expected.txt new file mode 100644 index 0000000..7559ead --- /dev/null +++ b/test/Golden/Parser/G1/P1.expected.txt @@ -0,0 +1 @@ +'a' \ No newline at end of file diff --git a/test/Golden/Parser/G1/P1.input.txt b/test/Golden/Parser/G1/P1.input.txt new file mode 100644 index 0000000..2e65efe --- /dev/null +++ b/test/Golden/Parser/G1/P1.input.txt @@ -0,0 +1 @@ +a \ No newline at end of file diff --git a/test/Golden/Parser/G10/P1.expected.txt b/test/Golden/Parser/G10/P1.expected.txt new file mode 100644 index 0000000..629b186 --- /dev/null +++ b/test/Golden/Parser/G10/P1.expected.txt @@ -0,0 +1 @@ +ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorException = ExceptionFailure, parsingErrorUnexpected = Just 'c', parsingErrorExpecting = fromList [FailureToken 'b']} \ No newline at end of file diff --git a/test/Golden/Parser/G10/P1.input.txt b/test/Golden/Parser/G10/P1.input.txt new file mode 100644 index 0000000..3410062 --- /dev/null +++ b/test/Golden/Parser/G10/P1.input.txt @@ -0,0 +1 @@ +c \ No newline at end of file diff --git a/test/Golden/Parser/G11/P1.expected.txt b/test/Golden/Parser/G11/P1.expected.txt new file mode 100644 index 0000000..fd1c6f9 --- /dev/null +++ b/test/Golden/Parser/G11/P1.expected.txt @@ -0,0 +1 @@ +ParsingErrorStandard {parsingErrorOffset = 4, parsingErrorException = ExceptionFailure, parsingErrorUnexpected = Just 'c', parsingErrorExpecting = fromList [FailureToken 'b']} \ No newline at end of file diff --git a/test/Golden/Parser/G11/P1.input.txt b/test/Golden/Parser/G11/P1.input.txt new file mode 100644 index 0000000..d9a79c8 --- /dev/null +++ b/test/Golden/Parser/G11/P1.input.txt @@ -0,0 +1 @@ +aaaac \ No newline at end of file diff --git a/test/Golden/Parser/G12/P1.expected.txt b/test/Golden/Parser/G12/P1.expected.txt new file mode 100644 index 0000000..5ec0128 --- /dev/null +++ b/test/Golden/Parser/G12/P1.expected.txt @@ -0,0 +1 @@ +"baacbccbaa" \ No newline at end of file diff --git a/test/Golden/Parser/G12/P1.input.txt b/test/Golden/Parser/G12/P1.input.txt new file mode 100644 index 0000000..1c1f7a0 --- /dev/null +++ b/test/Golden/Parser/G12/P1.input.txt @@ -0,0 +1 @@ +baacbccbaa \ No newline at end of file diff --git a/test/Golden/Parser/G13/P1.expected.txt b/test/Golden/Parser/G13/P1.expected.txt new file mode 100644 index 0000000..0cf1c8f --- /dev/null +++ b/test/Golden/Parser/G13/P1.expected.txt @@ -0,0 +1 @@ +[Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Loop [Forward,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Forward,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Forward,Increment,Increment,Increment,Forward,Increment,Backward,Backward,Backward,Backward,Decrement],Forward,Increment,Increment,Output,Forward,Increment,Output,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Output,Output,Increment,Increment,Increment,Output,Forward,Increment,Increment,Output,Backward,Backward,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Increment,Output,Forward,Output,Increment,Increment,Increment,Output,Decrement,Decrement,Decrement,Decrement,Decrement,Decrement,Output,Decrement,Decrement,Decrement,Decrement,Decrement,Decrement,Decrement,Decrement,Output,Forward,Increment,Output,Forward,Output] \ No newline at end of file diff --git a/test/Golden/Parser/G13/P1.input.txt b/test/Golden/Parser/G13/P1.input.txt new file mode 100644 index 0000000..265e751 --- /dev/null +++ b/test/Golden/Parser/G13/P1.input.txt @@ -0,0 +1 @@ +++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>. diff --git a/test/Golden/Parser/G13/P2.expected.txt b/test/Golden/Parser/G13/P2.expected.txt new file mode 100644 index 0000000..9fdc0eb --- /dev/null +++ b/test/Golden/Parser/G13/P2.expected.txt @@ -0,0 +1 @@ +[Loop [Decrement]] \ No newline at end of file diff --git a/test/Golden/Parser/G13/P2.input.txt b/test/Golden/Parser/G13/P2.input.txt new file mode 100644 index 0000000..ce665f7 --- /dev/null +++ b/test/Golden/Parser/G13/P2.input.txt @@ -0,0 +1,3 @@ +[ boucle +- enlever 1 à la case courante +] jusqu'à ce que la case soit à zéro diff --git a/test/Golden/Parser/G2/P1.expected.txt b/test/Golden/Parser/G2/P1.expected.txt new file mode 100644 index 0000000..4f44a21 --- /dev/null +++ b/test/Golden/Parser/G2/P1.expected.txt @@ -0,0 +1 @@ +"abc" \ No newline at end of file diff --git a/test/Golden/Parser/G2/P1.input.txt b/test/Golden/Parser/G2/P1.input.txt new file mode 100644 index 0000000..f2ba8f8 --- /dev/null +++ b/test/Golden/Parser/G2/P1.input.txt @@ -0,0 +1 @@ +abc \ No newline at end of file diff --git a/test/Golden/Parser/G2/P2.expected.txt b/test/Golden/Parser/G2/P2.expected.txt new file mode 100644 index 0000000..f6175af --- /dev/null +++ b/test/Golden/Parser/G2/P2.expected.txt @@ -0,0 +1 @@ +ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorException = ExceptionFailure, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [FailureHorizon 3]} \ No newline at end of file diff --git a/test/Golden/Parser/G2/P2.input.txt b/test/Golden/Parser/G2/P2.input.txt new file mode 100644 index 0000000..9ae9e86 --- /dev/null +++ b/test/Golden/Parser/G2/P2.input.txt @@ -0,0 +1 @@ +ab \ No newline at end of file diff --git a/test/Golden/Parser/G3/P1.expected.txt b/test/Golden/Parser/G3/P1.expected.txt new file mode 100644 index 0000000..92302fa --- /dev/null +++ b/test/Golden/Parser/G3/P1.expected.txt @@ -0,0 +1 @@ +"aaaaa" \ No newline at end of file diff --git a/test/Golden/Parser/G3/P1.input.txt b/test/Golden/Parser/G3/P1.input.txt new file mode 100644 index 0000000..e4a7dd9 --- /dev/null +++ b/test/Golden/Parser/G3/P1.input.txt @@ -0,0 +1 @@ +aaaaa \ No newline at end of file diff --git a/test/Golden/Parser/G4/P1.expected.txt b/test/Golden/Parser/G4/P1.expected.txt new file mode 100644 index 0000000..7a343d4 --- /dev/null +++ b/test/Golden/Parser/G4/P1.expected.txt @@ -0,0 +1 @@ +["abcd","abcd","abcd"] \ No newline at end of file diff --git a/test/Golden/Parser/G4/P1.input.txt b/test/Golden/Parser/G4/P1.input.txt new file mode 100644 index 0000000..5ec8a28 --- /dev/null +++ b/test/Golden/Parser/G4/P1.input.txt @@ -0,0 +1 @@ +abcdabcdabcd \ No newline at end of file diff --git a/test/Golden/Parser/G4/P2.expected.txt b/test/Golden/Parser/G4/P2.expected.txt new file mode 100644 index 0000000..7a343d4 --- /dev/null +++ b/test/Golden/Parser/G4/P2.expected.txt @@ -0,0 +1 @@ +["abcd","abcd","abcd"] \ No newline at end of file diff --git a/test/Golden/Parser/G4/P2.input.txt b/test/Golden/Parser/G4/P2.input.txt new file mode 100644 index 0000000..2f055f5 --- /dev/null +++ b/test/Golden/Parser/G4/P2.input.txt @@ -0,0 +1 @@ +abcdabcdabcde diff --git a/test/Golden/Parser/G4/P3.expected.txt b/test/Golden/Parser/G4/P3.expected.txt new file mode 100644 index 0000000..7a343d4 --- /dev/null +++ b/test/Golden/Parser/G4/P3.expected.txt @@ -0,0 +1 @@ +["abcd","abcd","abcd"] \ No newline at end of file diff --git a/test/Golden/Parser/G4/P3.input.txt b/test/Golden/Parser/G4/P3.input.txt new file mode 100644 index 0000000..9398d8b --- /dev/null +++ b/test/Golden/Parser/G4/P3.input.txt @@ -0,0 +1 @@ +abcdabcdabcdefgh diff --git a/test/Golden/Parser/G5/P1.expected.txt b/test/Golden/Parser/G5/P1.expected.txt new file mode 100644 index 0000000..6e0e747 --- /dev/null +++ b/test/Golden/Parser/G5/P1.expected.txt @@ -0,0 +1 @@ +ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorException = ExceptionFailure, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [FailureHorizon 4]} \ No newline at end of file diff --git a/test/Golden/Parser/G5/P1.input.txt b/test/Golden/Parser/G5/P1.input.txt new file mode 100644 index 0000000..f2ba8f8 --- /dev/null +++ b/test/Golden/Parser/G5/P1.input.txt @@ -0,0 +1 @@ +abc \ No newline at end of file diff --git a/test/Golden/Parser/G5/P2.expected.txt b/test/Golden/Parser/G5/P2.expected.txt new file mode 100644 index 0000000..b13b780 --- /dev/null +++ b/test/Golden/Parser/G5/P2.expected.txt @@ -0,0 +1 @@ +ParsingErrorStandard {parsingErrorOffset = 4, parsingErrorException = ExceptionFailure, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [FailureEnd,FailureHorizon 4]} \ No newline at end of file diff --git a/test/Golden/Parser/G5/P2.input.txt b/test/Golden/Parser/G5/P2.input.txt new file mode 100644 index 0000000..a9420db --- /dev/null +++ b/test/Golden/Parser/G5/P2.input.txt @@ -0,0 +1 @@ +abcdabc \ No newline at end of file diff --git a/test/Golden/Parser/G5/P3.expected.txt b/test/Golden/Parser/G5/P3.expected.txt new file mode 100644 index 0000000..9add3dd --- /dev/null +++ b/test/Golden/Parser/G5/P3.expected.txt @@ -0,0 +1 @@ +ParsingErrorStandard {parsingErrorOffset = 4, parsingErrorException = ExceptionFailure, parsingErrorUnexpected = Just 'e', parsingErrorExpecting = fromList [FailureEnd,FailureToken 'a']} \ No newline at end of file diff --git a/test/Golden/Parser/G5/P3.input.txt b/test/Golden/Parser/G5/P3.input.txt new file mode 100644 index 0000000..0e5c23f --- /dev/null +++ b/test/Golden/Parser/G5/P3.input.txt @@ -0,0 +1 @@ +abcdefgh diff --git a/test/Golden/Parser/G6/P1.expected.txt b/test/Golden/Parser/G6/P1.expected.txt new file mode 100644 index 0000000..dbdb6e4 --- /dev/null +++ b/test/Golden/Parser/G6/P1.expected.txt @@ -0,0 +1 @@ +ParsingErrorStandard {parsingErrorOffset = 1, parsingErrorException = ExceptionFailure, parsingErrorUnexpected = Just 'b', parsingErrorExpecting = fromList [FailureToken 'a']} \ No newline at end of file diff --git a/test/Golden/Parser/G6/P1.input.txt b/test/Golden/Parser/G6/P1.input.txt new file mode 100644 index 0000000..9ae9e86 --- /dev/null +++ b/test/Golden/Parser/G6/P1.input.txt @@ -0,0 +1 @@ +ab \ No newline at end of file diff --git a/test/Golden/Parser/G7/P1.expected.txt b/test/Golden/Parser/G7/P1.expected.txt new file mode 100644 index 0000000..b90f7e1 --- /dev/null +++ b/test/Golden/Parser/G7/P1.expected.txt @@ -0,0 +1 @@ +"ab" \ No newline at end of file diff --git a/test/Golden/Parser/G7/P1.input.txt b/test/Golden/Parser/G7/P1.input.txt new file mode 100644 index 0000000..9ae9e86 --- /dev/null +++ b/test/Golden/Parser/G7/P1.input.txt @@ -0,0 +1 @@ +ab \ No newline at end of file diff --git a/test/Golden/Parser/G7/P2.expected.txt b/test/Golden/Parser/G7/P2.expected.txt new file mode 100644 index 0000000..742e221 --- /dev/null +++ b/test/Golden/Parser/G7/P2.expected.txt @@ -0,0 +1 @@ +"aa" \ No newline at end of file diff --git a/test/Golden/Parser/G7/P2.input.txt b/test/Golden/Parser/G7/P2.input.txt new file mode 100644 index 0000000..7ec9a4b --- /dev/null +++ b/test/Golden/Parser/G7/P2.input.txt @@ -0,0 +1 @@ +aa \ No newline at end of file diff --git a/test/Golden/Parser/G8/P1.expected.txt b/test/Golden/Parser/G8/P1.expected.txt new file mode 100644 index 0000000..584cd86 --- /dev/null +++ b/test/Golden/Parser/G8/P1.expected.txt @@ -0,0 +1 @@ +ParsingErrorStandard {parsingErrorOffset = 3, parsingErrorException = ExceptionFailure, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [FailureEnd,FailureToken 'r']} \ No newline at end of file diff --git a/test/Golden/Parser/G8/P1.input.txt b/test/Golden/Parser/G8/P1.input.txt new file mode 100644 index 0000000..6aabf50 --- /dev/null +++ b/test/Golden/Parser/G8/P1.input.txt @@ -0,0 +1 @@ +rrra \ No newline at end of file diff --git a/test/Golden/Parser/G9/P1.expected.txt b/test/Golden/Parser/G9/P1.expected.txt new file mode 100644 index 0000000..dd626a0 --- /dev/null +++ b/test/Golden/Parser/G9/P1.expected.txt @@ -0,0 +1 @@ +() \ No newline at end of file diff --git a/test/Golden/Parser/G9/P1.input.txt b/test/Golden/Parser/G9/P1.input.txt new file mode 100644 index 0000000..e69de29 diff --git a/test/Golden/Parser/G9/P2.expected.txt b/test/Golden/Parser/G9/P2.expected.txt new file mode 100644 index 0000000..5e2955d --- /dev/null +++ b/test/Golden/Parser/G9/P2.expected.txt @@ -0,0 +1 @@ +ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorException = ExceptionFailure, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [FailureEnd]} \ No newline at end of file diff --git a/test/Golden/Parser/G9/P2.input.txt b/test/Golden/Parser/G9/P2.input.txt new file mode 100644 index 0000000..2e65efe --- /dev/null +++ b/test/Golden/Parser/G9/P2.input.txt @@ -0,0 +1 @@ +a \ No newline at end of file diff --git a/test/Golden/Parser/left-right.txt b/test/Golden/Parser/left-right.txt new file mode 100644 index 0000000..7ec9a4b --- /dev/null +++ b/test/Golden/Parser/left-right.txt @@ -0,0 +1 @@ +aa \ No newline at end of file diff --git a/test/Golden/Splice.hs b/test/Golden/Splice.hs index 8cce588..6a99d16 100644 --- a/test/Golden/Splice.hs +++ b/test/Golden/Splice.hs @@ -25,14 +25,15 @@ import qualified Grammar goldens :: TestTree goldens = testGroup "Splice" - [ let spliceFile = "test/Golden/Splice/""G"++show g<.>"expected"<.>"txt" in + [ let spliceFile = getGoldenDir $ "Splice/""G"++show g<.>"expected"<.>"txt" in goldenVsStringDiff (takeBaseName (dropExtensions spliceFile)) goldenDiff spliceFile $ do tExp <- splice fromString <$> Process.readProcess "ormolu" - [ "-o", "-XMagicHash" + [ "-o", "-XBangPatterns" + , "-o", "-XMagicHash" + , "-o", "-XTypeApplications" , "-o", "-XUnboxedTuples" - , "-o", "-XBangPatterns" - , "-o", "-XTypeApplications" ] + ] (show (TH.ppr (TH.hideName (TH.unType tExp)))) | (g, splice) <- List.zip [1::Int ..] splices ] diff --git a/test/Golden/Splice/G13.expected.txt b/test/Golden/Splice/G13.expected.txt index a2f0b97..a03d2bc 100644 --- a/test/Golden/Splice/G13.expected.txt +++ b/test/Golden/Splice/G13.expected.txt @@ -141,7 +141,7 @@ #) = readNext inp in if (\x -> \x -> x) GHC.Types.True c then - if '>' GHC.Classes.== c + if '<' GHC.Classes.== c then let _ = "choicesBranch.then" in let readFail = readFail @@ -158,7 +158,7 @@ init Data.Set.Internal.empty ( let _ = "resume.genCode" - in Grammar.Brainfuck.RightPointer + in Parsers.Brainfuck.Types.Backward ) cs else @@ -227,7 +227,7 @@ in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" - in if '<' GHC.Classes.== c + in if '>' GHC.Classes.== c then let _ = "choicesBranch.then" in let readFail = readFail @@ -244,7 +244,7 @@ init Data.Set.Internal.empty ( let _ = "resume.genCode" - in Grammar.Brainfuck.LeftPointer + in Parsers.Brainfuck.Types.Forward ) cs else @@ -330,7 +330,7 @@ init Data.Set.Internal.empty ( let _ = "resume.genCode" - in Grammar.Brainfuck.Increment + in Parsers.Brainfuck.Types.Increment ) cs else @@ -416,7 +416,7 @@ init Data.Set.Internal.empty ( let _ = "resume.genCode" - in Grammar.Brainfuck.Decrement + in Parsers.Brainfuck.Types.Decrement ) cs else @@ -485,7 +485,7 @@ in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" - in if '.' GHC.Classes.== c + in if ',' GHC.Classes.== c then let _ = "choicesBranch.then" in let readFail = readFail @@ -502,7 +502,7 @@ init Data.Set.Internal.empty ( let _ = "resume.genCode" - in Grammar.Brainfuck.Output + in Parsers.Brainfuck.Types.Input ) cs else @@ -571,7 +571,7 @@ in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "choicesBranch.else" - in if ',' GHC.Classes.== c + in if '.' GHC.Classes.== c then let _ = "choicesBranch.then" in let readFail = readFail @@ -588,7 +588,7 @@ init Data.Set.Internal.empty ( let _ = "resume.genCode" - in Grammar.Brainfuck.Input + in Parsers.Brainfuck.Types.Output ) cs else @@ -689,41 +689,12 @@ farInp farExp ( let _ = "resume.genCode" - in Grammar.Brainfuck.Loop v + in Parsers.Brainfuck.Types.Loop v ) cs else let _ = "checkToken.else" - in let failExp = - Data.Set.Internal.Bin - 1 - ( Symantic.Parser.Grammar.Combinators.SomeFailure - ( case inputToken of - (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ']' - ) - ) - Data.Set.Internal.Tip - Data.Set.Internal.Tip - in let (# - farInp, - farExp - #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of - GHC.Types.LT -> - (# - inp, - failExp - #) - GHC.Types.EQ -> - (# - farInp, - failExp GHC.Base.<> farExp - #) - GHC.Types.GT -> - (# - farInp, - farExp - #) - in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp + in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp else let _ = "checkHorizon.else" in let failExp = @@ -950,7 +921,7 @@ c, cs #) = readNext inp - in if (\c -> GHC.Classes.not (('<' GHC.Classes.== c) GHC.Classes.|| (('>' GHC.Classes.== c) GHC.Classes.|| (('+' GHC.Classes.== c) GHC.Classes.|| (('-' GHC.Classes.== c) GHC.Classes.|| (('[' GHC.Classes.== c) GHC.Classes.|| ((']' GHC.Classes.== c) GHC.Classes.|| ((',' GHC.Classes.== c) GHC.Classes.|| (('.' GHC.Classes.== c) GHC.Classes.|| (('$' GHC.Classes.== c) GHC.Classes.|| GHC.Types.False)))))))))) c + in if (\c -> GHC.Classes.not (('<' GHC.Classes.== c) GHC.Classes.|| (('>' GHC.Classes.== c) GHC.Classes.|| (('+' GHC.Classes.== c) GHC.Classes.|| (('-' GHC.Classes.== c) GHC.Classes.|| ((',' GHC.Classes.== c) GHC.Classes.|| (('.' GHC.Classes.== c) GHC.Classes.|| (('[' GHC.Classes.== c) GHC.Classes.|| ((']' GHC.Classes.== c) GHC.Classes.|| GHC.Types.False))))))))) c then name ( let _ = "suspend" diff --git a/test/Golden/Splice/G14.expected.txt b/test/Golden/Splice/G14.expected.txt index 9167ac6..514cb7e 100644 --- a/test/Golden/Splice/G14.expected.txt +++ b/test/Golden/Splice/G14.expected.txt @@ -1039,7 +1039,7 @@ c, cs #) = readNext inp - in if Grammar.Nandlang.nandIdentStart c + in if Parsers.Nandlang.nandIdentStart c then name ( let _ = "suspend" @@ -1588,7 +1588,7 @@ c, cs #) = readNext cs - in if Grammar.Nandlang.nandStringLetter c + in if Parsers.Nandlang.nandStringLetter c then name ( let _ = "suspend" @@ -3198,7 +3198,7 @@ c, cs #) = readNext inp - in if Grammar.Nandlang.nandIdentLetter c + in if Parsers.Nandlang.nandIdentLetter c then name ( let _ = "suspend" diff --git a/test/Golden/Utils.hs b/test/Golden/Utils.hs index 1538345..17a2fae 100644 --- a/test/Golden/Utils.hs +++ b/test/Golden/Utils.hs @@ -3,14 +3,20 @@ module Golden.Utils where import Control.Monad (Monad(..)) import Data.Either (Either(..)) import Data.Function (($)) +import Data.Semigroup (Semigroup(..)) import Data.String (String) import System.IO (IO, FilePath) +import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString.Lazy as BSL import qualified Data.IORef as IORef import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import qualified Language.Haskell.TH.Syntax as TH +import Paths_symantic_parser + +getGoldenDir :: FilePath -> FilePath +getGoldenDir p = unsafePerformIO $ getDataFileName $ "test/Golden/" <> p goldenDiff :: FilePath -> FilePath -> [String] goldenDiff ref new = ["diff", "-u", "-w", "-B", ref, new] diff --git a/test/Grammar.hs b/test/Grammar.hs index da1d654..0bc5cf2 100644 --- a/test/Grammar.hs +++ b/test/Grammar.hs @@ -9,13 +9,13 @@ import Data.Char (Char) import Data.String (String) import Text.Show (Show(..)) import qualified Data.Functor as Functor -import qualified Grammar.Brainfuck -import qualified Grammar.Nandlang +import qualified Parsers.Nandlang +import qualified Parsers.Brainfuck.SymanticParser import Symantic.Parser import qualified Symantic.Parser.Haskell as H -rawGrammars :: Grammar Char repr => [repr String] +rawGrammars :: Grammarable Char repr => [repr String] rawGrammars = [ H.Term (H.ValueCode show [||show||]) <$> g1 , H.Term (H.ValueCode show [||show||]) <$> g2 @@ -34,7 +34,7 @@ rawGrammars = , H.Term (H.ValueCode show [||show||]) <$> g15 , H.Term (H.ValueCode show [||show||]) <$> g16 ] -grammars :: Grammar Char repr => [repr String] +grammars :: Grammarable Char repr => [repr String] grammars = observeSharing Functor.<$> rawGrammars g1 = char 'a' @@ -49,7 +49,7 @@ g9 = eof g10 = char 'a' <|> char 'b' g11 = many (char 'a') <* char 'b' g12 = many (oneOf ['a', 'b', 'c', 'd']) <* eof -g13 = Grammar.Brainfuck.grammar -g14 = Grammar.Nandlang.grammar +g13 = Parsers.Brainfuck.SymanticParser.grammar @Char @_ +g14 = Parsers.Nandlang.grammar g15 = (char 'a' <|> char 'b') <* char 'c' g16 = (char 'a' <|> char 'b' <|> char 'c') <* char 'd' diff --git a/test/Grammar/Brainfuck.hs b/test/Grammar/Brainfuck.hs deleted file mode 100644 index b3e70d7..0000000 --- a/test/Grammar/Brainfuck.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE DeriveLift #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE ViewPatterns #-} -module Grammar.Brainfuck where - -import Data.Char (Char) -import Data.Eq (Eq(..)) -import Text.Show (Show(..)) -import qualified Prelude -import qualified Language.Haskell.TH.Syntax as TH - -import Symantic.Univariant.Trans -import qualified Symantic.Parser as P -import qualified Symantic.Parser.Haskell as H - -data Operator - = RightPointer - | LeftPointer - | Increment - | Decrement - | Output - | Input - | Loop [Operator] - deriving (Show, Eq, TH.Lift) - -haskell :: TH.Lift a => a -> P.TermGrammar a -haskell a = H.Term (H.ValueCode a [||a||]) - -grammar :: forall repr. - P.Grammar Char repr => - repr [Operator] -grammar = whitespace P.*> bf - where - whitespace = P.skipMany (P.noneOf "<>+-[],.$") - lexeme p = p P.<* whitespace - bf :: repr [Operator] - bf = P.many (lexeme (P.match (P.look P.anyChar) (haskell Prelude.<$> "><+-.,[") op P.empty)) - op :: H.Term H.ValueCode Char -> repr Operator - op (trans -> H.ValueCode c _) = case c of - '>' -> P.anyChar P.$> P.code RightPointer - '<' -> P.anyChar P.$> P.code LeftPointer - '+' -> P.anyChar P.$> P.code Increment - '-' -> P.anyChar P.$> P.code Decrement - '.' -> P.anyChar P.$> P.code Output - ',' -> P.anyChar P.$> P.code Input - '[' -> P.between (lexeme P.anyChar) (P.char ']') (H.Term (H.ValueCode Loop [||Loop||]) P.<$> bf) - _ -> Prelude.undefined diff --git a/test/Parser.hs b/test/Parser.hs new file mode 100644 index 0000000..1594b29 --- /dev/null +++ b/test/Parser.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +-- For TH splices +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +module Parser where + +import Data.Either (Either(..)) +import Data.Text (Text) +import Text.Show (Show) +import Symantic.Parser +import Grammar +import qualified Data.IORef as IORef +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH +import Control.DeepSeq +import System.IO (IO) -- 2.44.1 From 2ab5a0ba2d9637aeb77775ae99a4755540604bf1 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Thu, 6 May 2021 19:50:03 +0200 Subject: [PATCH 14/16] TemplateHaskell: why is PprSplice much faster than DumpSplice? MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit $ make benchmarks/prof-time b=Brainfuck/ByteString/hanoi/SymanticParser.PprSplice benchmarking Brainfuck/ByteString/hanoi/SymanticParser.PprSplice time 71.19 ms (69.66 ms .. 72.58 ms) 0.999 R² (0.999 R² .. 1.000 R²) mean 71.91 ms (71.10 ms .. 73.18 ms) std dev 1.755 ms (973.5 μs .. 2.766 ms) $ make benchmarks/prof-time b=Brainfuck/ByteString/hanoi/SymanticParser.DumpSplice benchmarking Brainfuck/ByteString/hanoi/SymanticParser.DumpSplice time 170.5 ms (169.7 ms .. 171.0 ms) 1.000 R² (1.000 R² .. 1.000 R²) mean 169.4 ms (168.3 ms .. 169.9 ms) std dev 1.046 ms (375.5 μs .. 1.650 ms) variance introduced by outliers: 12% (moderately inflated) --- HackMe.md => Hacking.md | 2 +- Makefile | 5 +- benchmarks/Brainfuck.hs | 18 +- benchmarks/Main.hs | 3 +- .../Brainfuck/SymanticParser/AutoSplice.hs | 23 + .../Brainfuck/SymanticParser/DumpSplice.hs | 1171 +++++++++++++++++ .../Grammar.hs} | 2 +- .../Brainfuck/SymanticParser/PprSplice.hs | 459 +++++++ symantic-parser.cabal | 10 +- 9 files changed, 1683 insertions(+), 10 deletions(-) rename HackMe.md => Hacking.md (89%) create mode 100644 parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.hs create mode 100644 parsers/Parsers/Brainfuck/SymanticParser/DumpSplice.hs rename parsers/Parsers/Brainfuck/{SymanticParser.hs => SymanticParser/Grammar.hs} (97%) create mode 100644 parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs diff --git a/HackMe.md b/Hacking.md similarity index 89% rename from HackMe.md rename to Hacking.md index 6400cbf..18846d9 100644 --- a/HackMe.md +++ b/Hacking.md @@ -27,7 +27,7 @@ make tests/prof t=.Golden.Parsers.G13 ```bash make benchmarks/prof-time b=Brainfuck/ByteString/hanoi/'*' BENCHMARK_OPTIONS=-n1 ``` -Then open `symantic-parser-benchmakrs.eventlog.json` with [`speedscope`](https://www.speedscope.app). +Then open `symantic-parser-benchmarks.eventlog.json` with [`speedscope`](https://www.speedscope.app). #### Heap ```bash diff --git a/Makefile b/Makefile index 3baf631..30694e9 100644 --- a/Makefile +++ b/Makefile @@ -18,6 +18,7 @@ repl: parsers/repl: cabal repl $(project):parsers +.PHONY: tests tests: cabal test $(CABAL_TEST_FLAGS) \ --test-show-details always --test-options "$(TEST_OPTIONS)" @@ -50,7 +51,9 @@ tests/repl: %.eventlog.json: %.eventlog hs-speedscope $< -b benchmarks/html/$(version).html: +.PHONY: benchmarks/html/$(version).html +b benchmarks: benchmarks/html/$(version).html +benchmarks/html/$(version).html: mkdir -p benchmarks/html cabal bench $(CABAL_BENCH_FLAGS) --benchmark-options "$(BENCHMARK_OPTIONS)" benchmarks/repl: diff --git a/benchmarks/Brainfuck.hs b/benchmarks/Brainfuck.hs index f5199d1..c0d3e34 100644 --- a/benchmarks/Brainfuck.hs +++ b/benchmarks/Brainfuck.hs @@ -2,7 +2,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} - -- for Symantic.Parser's TemplateHaskell +-- for Symantic.Parser's TemplateHaskell {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UnboxedTuples #-} @@ -28,7 +28,10 @@ import qualified System.IO as IO import qualified Symantic.Parser as SP import qualified Parsers.Brainfuck.Attoparsec as AP.Brainfuck import qualified Parsers.Brainfuck.Handrolled as HR.Brainfuck -import qualified Parsers.Brainfuck.SymanticParser as SP.Brainfuck +import qualified Parsers.Brainfuck.SymanticParser.Grammar as SP.Brainfuck +import qualified Parsers.Brainfuck.SymanticParser.AutoSplice as SP.Brainfuck.AutoSplice +import qualified Parsers.Brainfuck.SymanticParser.DumpSplice as SP.Brainfuck.DumpSplice +import qualified Parsers.Brainfuck.SymanticParser.PprSplice as SP.Brainfuck.PprSplice import Paths_symantic_parser inputPath inputName = getDataFileName ("parsers/Parsers/Brainfuck/inputs/"<>inputName<>".bf") @@ -54,7 +57,13 @@ benchBrainfuck inputName = , bgroup "ByteString" [ env (BS.readFile =<< inputPath inputName) $ \inp -> bgroup inputName - [ bench "SymanticParser" $ + [ bench "SymanticParser.PprSplice" $ + nf SP.Brainfuck.PprSplice.parserByteString inp + , bench "SymanticParser.DumpSplice" $ + nf SP.Brainfuck.DumpSplice.parserByteString inp + , bench "SymanticParser.AutoSplice" $ + nf SP.Brainfuck.AutoSplice.parserByteString inp + , bench "SymanticParser" $ nf $$(SP.runParser @BS.ByteString SP.Brainfuck.grammar) inp , bench "Attoparsec" $ nf (AP.ByteString.parse AP.Brainfuck.parser) inp @@ -77,3 +86,6 @@ benchmark = bgroup "Brainfuck" $ List.concat , benchBrainfuck "compiler" , benchBrainfuck "hanoi" ] + +init = + SP.Brainfuck.PprSplice.dumpSplice diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs index d79b32b..f71fc7c 100644 --- a/benchmarks/Main.hs +++ b/benchmarks/Main.hs @@ -5,7 +5,8 @@ import Prelude import qualified Brainfuck main :: IO () -main = +main = do + Brainfuck.init defaultMain $ [ Brainfuck.benchmark ] diff --git a/parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.hs b/parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.hs new file mode 100644 index 0000000..67787ca --- /dev/null +++ b/parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +-- for Symantic.Parser's TemplateHaskell +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} +module Parsers.Brainfuck.SymanticParser.AutoSplice where + +import Data.Either (Either) +import qualified Data.ByteString as BS +import qualified Symantic.Parser as SP + +import Parsers.Brainfuck.SymanticParser.Grammar (grammar) +import Parsers.Brainfuck.Types (Instruction) + +parserByteString :: BS.ByteString -> Either (SP.ParsingError BS.ByteString) [Instruction] +parserByteString = $$(SP.runParser @BS.ByteString grammar) diff --git a/parsers/Parsers/Brainfuck/SymanticParser/DumpSplice.hs b/parsers/Parsers/Brainfuck/SymanticParser/DumpSplice.hs new file mode 100644 index 0000000..f03e4e3 --- /dev/null +++ b/parsers/Parsers/Brainfuck/SymanticParser/DumpSplice.hs @@ -0,0 +1,1171 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +-- for Symantic.Parser's TemplateHaskell +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} +module Parsers.Brainfuck.SymanticParser.DumpSplice where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal +import qualified Data.Either +import qualified Data.Function +import qualified Data.Map.Internal +import qualified Data.Map.Strict.Internal +import qualified Data.Proxy +import qualified Data.Set.Internal +import qualified Data.Text.Internal +import qualified Data.Text.Unsafe +import qualified GHC.Base +import qualified GHC.Classes +import qualified GHC.ForeignPtr +import qualified GHC.Maybe +import qualified GHC.Num +import qualified GHC.Prim +import qualified GHC.Show +import qualified GHC.Tuple +import qualified GHC.Types +import qualified GHC.Word +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH +import qualified Prelude +import qualified Symantic.Parser as SP +import qualified Symantic.Parser.Grammar.Combinators +import qualified Symantic.Parser.Haskell +import qualified Symantic.Parser.Machine +import qualified Symantic.Parser.Machine.Generate +import qualified Symantic.Parser.Machine.Input +import qualified System.IO as IO +import Data.Either (Either) + +import qualified Parsers.Brainfuck.Types +import Parsers.Brainfuck.Types (Instruction) + +-- The splice below has been manually paste with: +-- :r dist-newstyle/build/x86_64-linux/ghc-9.0.1/symantic-parser-*/l/parsers/build/parsers/parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.dump-splices +-- :%s/\%x00//g +-- :%s/#\(_[0-9]\+\)/\1#/g +parserByteString :: BS.ByteString -> Either (SP.ParsingError BS.ByteString) [Instruction] +parserByteString = + \ (input_ama8 :: inp_a1S5K) + -> let + !(# init_amaa, readMore_amab, readNext_amac #) + = let + !(Data.ByteString.Internal.PS (GHC.ForeignPtr.ForeignPtr addr_amae# + final_amaf) + off_amag size_amah) + = input_ama8 + next_amai i_amaj@(GHC.Types.I# i_amak#) + = case + ((GHC.Prim.readWord8OffAddr# + (addr_amae# `GHC.Prim.plusAddr#` i_amak#)) + 0#) + GHC.Prim.realWorld# + of { + (# s'_amal, x_amam #) + -> case (GHC.Prim.touch# final_amaf) s'_amal of { + _ -> (# GHC.Word.W8# x_amam, (i_amaj GHC.Num.+ 1) #) } } + in (# off_amag, (GHC.Classes.< size_amah), next_amai #) + finalRet_ama9 + = \ _farInp_aman _farExp_amao v_amap _inp_amaq + -> Data.Either.Right v_amap + finalRaise_amad :: forall b_amar. SP.Catcher inp_a1S5K b_amar + = \ !exn_amas _failInp_amat !farInp_amau !farExp_amav + -> Data.Either.Left + SP.ParsingErrorStandard + {SP.parsingErrorOffset = SP.offset farInp_amau, + SP.parsingErrorException = exn_amas, + SP.parsingErrorUnexpected = if readMore_amab farInp_amau then + GHC.Maybe.Just + (let + (# c_amaw, _ #) + = readNext_amac farInp_amau + in c_amaw) + else + GHC.Maybe.Nothing, + SP.parsingErrorExpecting = farExp_amav} in + let + inputToken + = Data.Proxy.Proxy :: Data.Proxy.Proxy (SP.InputToken inp_a1S5K) in + let + name_1 + = \ !ok_amcU !inp_amcV !koByLabel_amcW + -> ((name_4 + (let _ = "suspend" + in + \ farInp_amcX farExp_amcY v_amcZ !inp_amd0 + -> let _ = "resume" + in + (((ok_amcU farInp_amcX) farExp_amcY) + (let _ = "resume.genCode" in ())) + inp_amd0)) + inp_amcV) + (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) + (((Data.Map.Strict.Internal.findWithDefault finalRaise_amad) + SP.ExceptionFailure) + koByLabel_amcW)) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) + name_2 + = \ !ok_amcN !inp_amcO !koByLabel_amcP + -> ((name_3 + (let _ = "suspend" + in + \ farInp_amcQ farExp_amcR v_amcS !inp_amcT + -> let _ = "resume" + in + (((ok_amcN farInp_amcQ) farExp_amcR) + (let _ = "resume.genCode" in v_amcS [])) + inp_amcT)) + inp_amcO) + (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) + (((Data.Map.Strict.Internal.findWithDefault finalRaise_amad) + SP.ExceptionFailure) + koByLabel_amcP)) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) + name_3 + = \ !ok_amaS !inp_amaT !koByLabel_amaU + -> let _ = "catch ExceptionFailure" in + let + catchHandler_amaV + !_exn_amaW + !failInp_amaX + !farInp_amaY + !farExp_amaZ + = let _ = "catch.ko ExceptionFailure" + in + if (((GHC.Classes.==) @GHC.Types.Int) inp_amaT) failInp_amaX then + let _ = "choicesBranch.then" in + let _ = "resume" + in + (((ok_amaS farInp_amaY) farExp_amaZ) + (let _ = "resume.genCode" in \ x_amb0 -> x_amb0)) + failInp_amaX + else + let _ = "choicesBranch.else" + in + ((((((Data.Map.Strict.Internal.findWithDefault finalRaise_amad) + SP.ExceptionFailure) + koByLabel_amaU) + SP.ExceptionFailure) + failInp_amaX) + farInp_amaY) + farExp_amaZ in + let + join_1s + = \ farInp_amb1 farExp_amb2 v_amb3 !inp_amb4 + -> ((name_1 + (let _ = "suspend" + in + \ farInp_amb5 farExp_amb6 v_amb7 !inp_amb8 + -> ((name_3 + (let _ = "suspend" + in + \ farInp_amb9 farExp_amba v_ambb !inp_ambc + -> let _ = "resume" + in + (((ok_amaS farInp_amb9) farExp_amba) + (let _ = "resume.genCode" + in + \ x_ambd + -> (v_amb3 : v_ambb x_ambd))) + inp_ambc)) + inp_amb8) + (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) + catchHandler_amaV) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip))) + inp_amb4) + (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) + catchHandler_amaV) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) in + let readFail_ambe = catchHandler_amaV + in + if readMore_amab inp_amaT then + let !(# c_ambf, cs_ambg #) = readNext_amac inp_amaT + in + if (\ x_ambh -> GHC.Types.True) c_ambf then + if (60 GHC.Classes.== c_ambf) then + let _ = "choicesBranch.then" in + let readFail_ambi = readFail_ambe + in + if readMore_amab inp_amaT then + let !(# c_ambj, cs_ambk #) = readNext_amac inp_amaT + in + if (\ x_ambl -> GHC.Types.True) c_ambj then + let _ = "resume" + in + (((join_1s init_amaa) Data.Set.Internal.empty) + (let _ = "resume.genCode" + in Parsers.Brainfuck.Types.Backward)) + cs_ambk + else + let _ = "checkToken.else" in + let + failExp_ambm + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> SP.FailureAny @tok'_aLiK }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_ambn, farExp_ambo #) + = case + ((GHC.Classes.compare @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT -> (# inp_amaT, failExp_ambm #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_ambm + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambi SP.ExceptionFailure) inp_amaT) + farInp_ambn) + farExp_ambo + else + let _ = "checkHorizon.else" in + let + failExp_ambp + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon @tok'_aLiK) 1 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_ambq, farExp_ambr #) + = case + ((GHC.Classes.compare @GHC.Types.Int) init_amaa) + inp_amaT + of + GHC.Types.LT -> (# inp_amaT, failExp_ambp #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_ambp + GHC.Base.<> Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, Data.Set.Internal.empty #) + in + (((readFail_ambi SP.ExceptionFailure) inp_amaT) + farInp_ambq) + farExp_ambr + else + let _ = "choicesBranch.else" + in + if (62 GHC.Classes.== c_ambf) then + let _ = "choicesBranch.then" in + let readFail_ambs = readFail_ambe + in + if readMore_amab inp_amaT then + let !(# c_ambt, cs_ambu #) = readNext_amac inp_amaT + in + if (\ x_ambv -> GHC.Types.True) c_ambt then + let _ = "resume" + in + (((join_1s init_amaa) + Data.Set.Internal.empty) + (let _ = "resume.genCode" + in Parsers.Brainfuck.Types.Forward)) + cs_ambu + else + let _ = "checkToken.else" in + let + failExp_ambw + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> SP.FailureAny + @tok'_aLiK }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_ambx, farExp_amby #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, failExp_ambw #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_ambw + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambs SP.ExceptionFailure) + inp_amaT) + farInp_ambx) + farExp_amby + else + let _ = "checkHorizon.else" in + let + failExp_ambz + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon @tok'_aLiK) + 1 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_ambA, farExp_ambB #) + = case + ((GHC.Classes.compare @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT -> (# inp_amaT, failExp_ambz #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_ambz + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambs SP.ExceptionFailure) inp_amaT) + farInp_ambA) + farExp_ambB + else + let _ = "choicesBranch.else" + in + if (43 GHC.Classes.== c_ambf) then + let _ = "choicesBranch.then" in + let readFail_ambC = readFail_ambe + in + if readMore_amab inp_amaT then + let + !(# c_ambD, cs_ambE #) + = readNext_amac inp_amaT + in + if (\ x_ambF -> GHC.Types.True) c_ambD then + let _ = "resume" + in + (((join_1s init_amaa) + Data.Set.Internal.empty) + (let _ = "resume.genCode" + in + Parsers.Brainfuck.Types.Increment)) + cs_ambE + else + let _ = "checkToken.else" in + let + failExp_ambG + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> SP.FailureAny + @tok'_aLiK }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_ambH, farExp_ambI #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_ambG #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_ambG + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambC SP.ExceptionFailure) + inp_amaT) + farInp_ambH) + farExp_ambI + else + let _ = "checkHorizon.else" in + let + failExp_ambJ + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon + @tok'_aLiK) + 1 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_ambK, farExp_ambL #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, failExp_ambJ #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_ambJ + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambC SP.ExceptionFailure) + inp_amaT) + farInp_ambK) + farExp_ambL + else + let _ = "choicesBranch.else" + in + if (45 GHC.Classes.== c_ambf) then + let _ = "choicesBranch.then" in + let readFail_ambM = readFail_ambe + in + if readMore_amab inp_amaT then + let + !(# c_ambN, cs_ambO #) + = readNext_amac inp_amaT + in + if (\ x_ambP -> GHC.Types.True) + c_ambN then + let _ = "resume" + in + (((join_1s init_amaa) + Data.Set.Internal.empty) + (let _ = "resume.genCode" + in + Parsers.Brainfuck.Types.Decrement)) + cs_ambO + else + let _ = "checkToken.else" in + let + failExp_ambQ + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> SP.FailureAny + @tok'_aLiK }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_ambR, farExp_ambS #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_ambQ #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_ambQ + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambM + SP.ExceptionFailure) + inp_amaT) + farInp_ambR) + farExp_ambS + else + let _ = "checkHorizon.else" in + let + failExp_ambT + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon + @tok'_aLiK) + 1 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_ambU, farExp_ambV #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_ambT #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_ambT + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambM SP.ExceptionFailure) + inp_amaT) + farInp_ambU) + farExp_ambV + else + let _ = "choicesBranch.else" + in + if (44 GHC.Classes.== c_ambf) then + let _ = "choicesBranch.then" in + let readFail_ambW = readFail_ambe + in + if readMore_amab inp_amaT then + let + !(# c_ambX, cs_ambY #) + = readNext_amac inp_amaT + in + if (\ x_ambZ -> GHC.Types.True) + c_ambX then + let _ = "resume" + in + (((join_1s init_amaa) + Data.Set.Internal.empty) + (let + _ = "resume.genCode" + in + Parsers.Brainfuck.Types.Input)) + cs_ambY + else + let _ = "checkToken.else" in + let + failExp_amc0 + = (((Data.Set.Internal.Bin + 1) + (SP.SomeFailure + (case + inputToken + of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> SP.FailureAny + @tok'_aLiK }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amc1, + farExp_amc2 #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_amc0 #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amc0 + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambW + SP.ExceptionFailure) + inp_amaT) + farInp_amc1) + farExp_amc2 + else + let _ = "checkHorizon.else" in + let + failExp_amc3 + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon + @tok'_aLiK) + 1 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amc4, farExp_amc5 #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_amc3 #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amc3 + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambW + SP.ExceptionFailure) + inp_amaT) + farInp_amc4) + farExp_amc5 + else + let _ = "choicesBranch.else" + in + if (46 GHC.Classes.== c_ambf) then + let _ = "choicesBranch.then" in + let readFail_amc6 = readFail_ambe + in + if readMore_amab inp_amaT then + let + !(# c_amc7, cs_amc8 #) + = readNext_amac inp_amaT + in + if (\ x_amc9 + -> GHC.Types.True) + c_amc7 then + let _ = "resume" + in + (((join_1s + init_amaa) + Data.Set.Internal.empty) + (let + _ = "resume.genCode" + in + Parsers.Brainfuck.Types.Output)) + cs_amc8 + else + let + _ = "checkToken.else" in + let + failExp_amca + = (((Data.Set.Internal.Bin + 1) + (SP.SomeFailure + (case + inputToken + of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> SP.FailureAny + @tok'_aLiK }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amcb, + farExp_amcc #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_amca #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amca + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_amc6 + SP.ExceptionFailure) + inp_amaT) + farInp_amcb) + farExp_amcc + else + let + _ = "checkHorizon.else" in + let + failExp_amcd + = (((Data.Set.Internal.Bin + 1) + (SP.SomeFailure + (case + inputToken + of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon + @tok'_aLiK) + 1 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amce, + farExp_amcf #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_amcd #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amcd + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_amc6 + SP.ExceptionFailure) + inp_amaT) + farInp_amce) + farExp_amcf + else + let _ = "choicesBranch.else" + in + if (91 + GHC.Classes.== + c_ambf) then + let + _ = "choicesBranch.then" in + let + readFail_amcg + = readFail_ambe + in + if readMore_amab + ((((GHC.Num.+) + @GHC.Types.Int) + 1) + inp_amaT) then + let + !(# c_amch, + cs_amci #) + = readNext_amac + inp_amaT + in + if (\ x_amcj + -> GHC.Types.True) + c_amch then + ((name_1 + (let + _ = "suspend" + in + \ farInp_amck + farExp_amcl + v_amcm + !inp_amcn + -> ((name_2 + (let + _ = "suspend" + in + \ farInp_amco + farExp_amcp + v_amcq + !inp_amcr + -> let + readFail_amcs + = readFail_amcg + in + if readMore_amab + inp_amcr then + let + !(# c_amct, + cs_amcu #) + = readNext_amac + inp_amcr + in + if (93 + GHC.Classes.==) + c_amct then + let + _ = "resume" + in + (((join_1s + farInp_amco) + farExp_amcp) + (let + _ = "resume.genCode" + in + Parsers.Brainfuck.Types.Loop + v_amcq)) + cs_amcu + else + let + _ = "checkToken.else" + in + (((readFail_amcs + SP.ExceptionFailure) + inp_amcr) + farInp_amco) + farExp_amcp + else + let + _ = "checkHorizon.else" in + let + failExp_amcv + = (((Data.Set.Internal.Bin + 1) + (SP.SomeFailure + (case + inputToken + of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon + @tok'_aLiK) + 1 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amcw, + farExp_amcx #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + farInp_amco) + inp_amcr + of + GHC.Types.LT + -> (# inp_amcr, + failExp_amcv #) + GHC.Types.EQ + -> (# farInp_amco, + (failExp_amcv + GHC.Base.<> + farExp_amcp) #) + GHC.Types.GT + -> (# farInp_amco, + farExp_amcp #) + in + (((readFail_amcs + SP.ExceptionFailure) + inp_amcr) + farInp_amcw) + farExp_amcx)) + inp_amcn) + (((((Data.Map.Internal.Bin + 1) + SP.ExceptionFailure) + readFail_amcg) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip))) + cs_amci) + (((((Data.Map.Internal.Bin + 1) + SP.ExceptionFailure) + readFail_amcg) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) + else + let + _ = "checkToken.else" in + let + failExp_amcy + = (((Data.Set.Internal.Bin + 1) + (SP.SomeFailure + (case + inputToken + of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> SP.FailureAny + @tok'_aLiK }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amcz, + farExp_amcA #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_amcy #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amcy + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_amcg + SP.ExceptionFailure) + inp_amaT) + farInp_amcz) + farExp_amcA + else + let + _ = "checkHorizon.else" in + let + failExp_amcB + = (((Data.Set.Internal.Bin + 1) + (SP.SomeFailure + (case + inputToken + of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon + @tok'_aLiK) + 2 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amcC, + farExp_amcD #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_amcB #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amcB + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_amcg + SP.ExceptionFailure) + inp_amaT) + farInp_amcC) + farExp_amcD + else + let + _ = "choicesBranch.else" in + let + failExp_amcE + = (((Data.Set.Internal.Bin + 1) + (SP.SomeFailure + SP.FailureEmpty)) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amcF, + farExp_amcG #) + = case + ((GHC.Classes.compare + @GHC.Types.Int) + init_amaa) + inp_amaT + of + GHC.Types.LT + -> (# inp_amaT, + failExp_amcE #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amcE + GHC.Base.<> + Data.Set.Internal.empty) #) + GHC.Types.GT + -> (# init_amaa, + Data.Set.Internal.empty #) + in + (((readFail_ambe + SP.ExceptionFailure) + inp_amaT) + farInp_amcF) + farExp_amcG + else + let _ = "checkToken.else" in + let + failExp_amcH + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> SP.FailureAny @tok'_aLiK }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amcI, farExp_amcJ #) + = case + ((GHC.Classes.compare @GHC.Types.Int) init_amaa) inp_amaT + of + GHC.Types.LT -> (# inp_amaT, failExp_amcH #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amcH + GHC.Base.<> Data.Set.Internal.empty) #) + GHC.Types.GT -> (# init_amaa, Data.Set.Internal.empty #) + in + (((readFail_ambe SP.ExceptionFailure) inp_amaT) farInp_amcI) + farExp_amcJ + else + let _ = "checkHorizon.else" in + let + failExp_amcK + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon @tok'_aLiK) 1 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amcL, farExp_amcM #) + = case ((GHC.Classes.compare @GHC.Types.Int) init_amaa) inp_amaT of + GHC.Types.LT -> (# inp_amaT, failExp_amcK #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amcK GHC.Base.<> Data.Set.Internal.empty) #) + GHC.Types.GT -> (# init_amaa, Data.Set.Internal.empty #) + in + (((readFail_ambe SP.ExceptionFailure) inp_amaT) farInp_amcL) + farExp_amcM + name_4 + = \ !ok_amax !inp_amay !koByLabel_amaz + -> let _ = "catch ExceptionFailure" in + let + catchHandler_amaA + !_exn_amaB + !failInp_amaC + !farInp_amaD + !farExp_amaE + = let _ = "catch.ko ExceptionFailure" + in + if (((GHC.Classes.==) @GHC.Types.Int) inp_amay) failInp_amaC then + let _ = "choicesBranch.then" in + let _ = "resume" + in + (((ok_amax farInp_amaD) farExp_amaE) + (let _ = "resume.genCode" in \ x_amaF -> x_amaF)) + failInp_amaC + else + let _ = "choicesBranch.else" + in + ((((((Data.Map.Strict.Internal.findWithDefault finalRaise_amad) + SP.ExceptionFailure) + koByLabel_amaz) + SP.ExceptionFailure) + failInp_amaC) + farInp_amaD) + farExp_amaE in + let readFail_amaG = catchHandler_amaA + in + if readMore_amab inp_amay then + let !(# c_amaH, cs_amaI #) = readNext_amac inp_amay + in + if (\ c_amaJ + -> GHC.Classes.not + ((60 GHC.Classes.== c_amaJ) + GHC.Classes.|| + ((62 GHC.Classes.== c_amaJ) + GHC.Classes.|| + ((43 GHC.Classes.== c_amaJ) + GHC.Classes.|| + ((45 GHC.Classes.== c_amaJ) + GHC.Classes.|| + ((44 GHC.Classes.== c_amaJ) + GHC.Classes.|| + ((46 GHC.Classes.== c_amaJ) + GHC.Classes.|| + ((91 GHC.Classes.== c_amaJ) + GHC.Classes.|| + ((93 + GHC.Classes.== c_amaJ) + GHC.Classes.|| + GHC.Types.False))))))))) + c_amaH then + ((name_4 + (let _ = "suspend" + in + \ farInp_amaK farExp_amaL v_amaM !inp_amaN + -> let _ = "resume" + in + (((ok_amax farInp_amaK) farExp_amaL) + (let _ = "resume.genCode" + in \ x_amaO -> v_amaM x_amaO)) + inp_amaN)) + cs_amaI) + (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) readFail_amaG) + Data.Map.Internal.Tip) + Data.Map.Internal.Tip) + else + let _ = "checkToken.else" + in + (((readFail_amaG SP.ExceptionFailure) inp_amay) init_amaa) + Data.Set.Internal.empty + else + let _ = "checkHorizon.else" in + let + failExp_amaP + = (((Data.Set.Internal.Bin 1) + (SP.SomeFailure + (case inputToken of { + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) + -> (SP.FailureHorizon @tok'_aLiK) 1 }))) + Data.Set.Internal.Tip) + Data.Set.Internal.Tip in + let + (# farInp_amaQ, farExp_amaR #) + = case ((GHC.Classes.compare @GHC.Types.Int) init_amaa) inp_amay of + GHC.Types.LT -> (# inp_amay, failExp_amaP #) + GHC.Types.EQ + -> (# init_amaa, + (failExp_amaP GHC.Base.<> Data.Set.Internal.empty) #) + GHC.Types.GT -> (# init_amaa, Data.Set.Internal.empty #) + in + (((readFail_amaG SP.ExceptionFailure) inp_amay) farInp_amaQ) + farExp_amaR + in + ((name_1 + (let _ = "suspend" + in + \ farInp_amd1 farExp_amd2 v_amd3 !inp_amd4 + -> ((name_2 + (let _ = "suspend" + in + \ farInp_amd5 farExp_amd6 v_amd7 !inp_amd8 + -> let _ = "resume" + in + (((finalRet_ama9 farInp_amd5) farExp_amd6) + (let _ = "resume.genCode" in v_amd7)) + inp_amd8)) + inp_amd4) + Data.Map.Internal.Tip)) + init_amaa) + Data.Map.Internal.Tip diff --git a/parsers/Parsers/Brainfuck/SymanticParser.hs b/parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs similarity index 97% rename from parsers/Parsers/Brainfuck/SymanticParser.hs rename to parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs index 7db71f5..aadbece 100644 --- a/parsers/Parsers/Brainfuck/SymanticParser.hs +++ b/parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs @@ -3,7 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -module Parsers.Brainfuck.SymanticParser where +module Parsers.Brainfuck.SymanticParser.Grammar where import Data.Char (Char) import Data.Function ((.)) diff --git a/parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs b/parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs new file mode 100644 index 0000000..4417854 --- /dev/null +++ b/parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs @@ -0,0 +1,459 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +-- for Symantic.Parser's TemplateHaskell +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} +module Parsers.Brainfuck.SymanticParser.PprSplice where + +import Data.Either (Either) +import Data.Text (Text) +import System.IO (IO) +import Text.Show (show) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal +import qualified Data.Either +import qualified Data.Function +import qualified Data.Map.Internal +import qualified Data.Map.Strict.Internal +import qualified Data.Proxy +import qualified Data.Set.Internal +import qualified Data.Text.Internal +import qualified Data.Text.Unsafe +import qualified GHC.Base +import qualified GHC.Classes +import qualified GHC.ForeignPtr +import qualified GHC.Maybe +import qualified GHC.Num +import qualified GHC.Prim +import qualified GHC.Show +import qualified GHC.Tuple +import qualified GHC.Types +import qualified GHC.Word +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH +import qualified Prelude +import qualified Symantic.Parser as SP +import qualified Symantic.Parser.Grammar.Combinators +import qualified Symantic.Parser.Haskell +import qualified Symantic.Parser.Machine +import qualified Symantic.Parser.Machine.Generate +import qualified Symantic.Parser.Machine.Input +import qualified System.IO as IO + +import qualified Parsers.Brainfuck.Types +import Parsers.Brainfuck.Types (Instruction) +import Parsers.Brainfuck.SymanticParser.Grammar (grammar) + +splice :: IO (TH.TExp (BS.ByteString -> Either (SP.ParsingError BS.ByteString) [Instruction])) +splice = TH.runQ (TH.examineCode (SP.runParser grammar)) + +dumpSplice :: IO () +dumpSplice = do + tExp <- splice + IO.writeFile "parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs.ppr" + (show (TH.ppr ((TH.unType tExp)))) + +-- The splice below has been manually paste with: +-- :r parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs.ppr +-- :%s/#\(_[0-9]\+\)/\1# /g +-- :%s/GHC.Tuple.()/()/g +-- :%s/GHC.Types.\[]/[]/g +parserByteString :: BS.ByteString -> Either (SP.ParsingError BS.ByteString) [Instruction] +parserByteString = + \(input_0 :: inp_6989586621679446738) -> let {!(# init_1, + readMore_2, + readNext_3 #) = let {!(Data.ByteString.Internal.PS (GHC.ForeignPtr.ForeignPtr addr_4# + final_5) + off_6 + size_7) = input_0; + next_8 (i_9@(GHC.Types.I# i_10# )) = case GHC.Prim.readWord8OffAddr# (addr_4# `GHC.Prim.plusAddr#` i_10# ) 0# GHC.Prim.realWorld# of + (# s'_11, + x_12 #) -> case GHC.Prim.touch# final_5 s'_11 of + _ -> (# GHC.Word.W8# x_12, + i_9 GHC.Num.+ 1 #)} + in (# off_6, + (GHC.Classes.< size_7), + next_8 #); + finalRet_13 = \_farInp_14 _farExp_15 v_16 _inp_17 -> Data.Either.Right v_16; + finalRaise_18 :: forall b_19 . + Symantic.Parser.Machine.Generate.Catcher inp_6989586621679446738 + b_19 = \(!exn_20) _failInp_21 (!farInp_22) (!farExp_23) -> Data.Either.Left Symantic.Parser.Machine.Generate.ParsingErrorStandard{Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp_22, + Symantic.Parser.Machine.Generate.parsingErrorException = exn_20, + Symantic.Parser.Machine.Generate.parsingErrorUnexpected = if readMore_2 farInp_22 + then GHC.Maybe.Just (let (# c_24, + _ #) = readNext_3 farInp_22 + in c_24) + else GHC.Maybe.Nothing, + Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp_23}} + in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp_6989586621679446738) + in let {name_25 = \(!ok_26) (!inp_27) (!koByLabel_28) -> name_29 (let _ = "suspend" + in \farInp_30 farExp_31 v_32 (!inp_33) -> let _ = "resume" + in ok_26 farInp_30 farExp_31 (let _ = "resume.genCode" + in ()) inp_33) inp_27 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise_18 Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel_28) Data.Map.Internal.Tip Data.Map.Internal.Tip); + name_34 = \(!ok_35) (!inp_36) (!koByLabel_37) -> name_38 (let _ = "suspend" + in \farInp_39 farExp_40 v_41 (!inp_42) -> let _ = "resume" + in ok_35 farInp_39 farExp_40 (let _ = "resume.genCode" + in v_41 []) inp_42) inp_36 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault finalRaise_18 Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel_37) Data.Map.Internal.Tip Data.Map.Internal.Tip); + name_38 = \(!ok_43) (!inp_44) (!koByLabel_45) -> let _ = "catch ExceptionFailure" + in let catchHandler_46 (!_exn_47) (!failInp_48) (!farInp_49) (!farExp_50) = let _ = "catch.ko ExceptionFailure" + in if (GHC.Classes.==) @GHC.Types.Int inp_44 failInp_48 + then let _ = "choicesBranch.then" + in let _ = "resume" + in ok_43 farInp_49 farExp_50 (let _ = "resume.genCode" + in \x_51 -> x_51) failInp_48 + else let _ = "choicesBranch.else" + in Data.Map.Strict.Internal.findWithDefault finalRaise_18 Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel_45 Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp_48 farInp_49 farExp_50 + in let join_52 = \farInp_53 farExp_54 v_55 (!inp_56) -> name_25 (let _ = "suspend" + in \farInp_57 farExp_58 v_59 (!inp_60) -> name_38 (let _ = "suspend" + in \farInp_61 farExp_62 v_63 (!inp_64) -> let _ = "resume" + in ok_43 farInp_61 farExp_62 (let _ = "resume.genCode" + in \x_65 -> v_55 : v_63 x_65) inp_64) inp_60 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler_46 Data.Map.Internal.Tip Data.Map.Internal.Tip)) inp_56 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure catchHandler_46 Data.Map.Internal.Tip Data.Map.Internal.Tip) + in let readFail_66 = catchHandler_46 + in if readMore_2 inp_44 + then let !(# c_67, + cs_68 #) = readNext_3 inp_44 + in if (\x_69 -> GHC.Types.True) c_67 + then if 60 GHC.Classes.== c_67 + then let _ = "choicesBranch.then" + in let readFail_70 = readFail_66 + in if readMore_2 inp_44 + then let !(# c_71, + cs_72 #) = readNext_3 inp_44 + in if (\x_73 -> GHC.Types.True) c_71 + then let _ = "resume" + in join_52 init_1 Data.Set.Internal.empty (let _ = "resume.genCode" + in Parsers.Brainfuck.Types.Backward) cs_72 + else let _ = "checkToken.else" + in let failExp_74 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureAny @tok'_6989586621679198986)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_75, + farExp_76 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_74 #) + GHC.Types.EQ -> (# init_1, + failExp_74 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_70 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_75 farExp_76 + else let _ = "checkHorizon.else" + in let failExp_77 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 1)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_78, + farExp_79 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_77 #) + GHC.Types.EQ -> (# init_1, + failExp_77 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_70 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_78 farExp_79 + else let _ = "choicesBranch.else" + in if 62 GHC.Classes.== c_67 + then let _ = "choicesBranch.then" + in let readFail_80 = readFail_66 + in if readMore_2 inp_44 + then let !(# c_81, + cs_82 #) = readNext_3 inp_44 + in if (\x_83 -> GHC.Types.True) c_81 + then let _ = "resume" + in join_52 init_1 Data.Set.Internal.empty (let _ = "resume.genCode" + in Parsers.Brainfuck.Types.Forward) cs_82 + else let _ = "checkToken.else" + in let failExp_84 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureAny @tok'_6989586621679198986)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_85, + farExp_86 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_84 #) + GHC.Types.EQ -> (# init_1, + failExp_84 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_80 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_85 farExp_86 + else let _ = "checkHorizon.else" + in let failExp_87 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 1)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_88, + farExp_89 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_87 #) + GHC.Types.EQ -> (# init_1, + failExp_87 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_80 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_88 farExp_89 + else let _ = "choicesBranch.else" + in if 43 GHC.Classes.== c_67 + then let _ = "choicesBranch.then" + in let readFail_90 = readFail_66 + in if readMore_2 inp_44 + then let !(# c_91, + cs_92 #) = readNext_3 inp_44 + in if (\x_93 -> GHC.Types.True) c_91 + then let _ = "resume" + in join_52 init_1 Data.Set.Internal.empty (let _ = "resume.genCode" + in Parsers.Brainfuck.Types.Increment) cs_92 + else let _ = "checkToken.else" + in let failExp_94 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureAny @tok'_6989586621679198986)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_95, + farExp_96 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_94 #) + GHC.Types.EQ -> (# init_1, + failExp_94 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_90 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_95 farExp_96 + else let _ = "checkHorizon.else" + in let failExp_97 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 1)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_98, + farExp_99 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_97 #) + GHC.Types.EQ -> (# init_1, + failExp_97 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_90 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_98 farExp_99 + else let _ = "choicesBranch.else" + in if 45 GHC.Classes.== c_67 + then let _ = "choicesBranch.then" + in let readFail_100 = readFail_66 + in if readMore_2 inp_44 + then let !(# c_101, + cs_102 #) = readNext_3 inp_44 + in if (\x_103 -> GHC.Types.True) c_101 + then let _ = "resume" + in join_52 init_1 Data.Set.Internal.empty (let _ = "resume.genCode" + in Parsers.Brainfuck.Types.Decrement) cs_102 + else let _ = "checkToken.else" + in let failExp_104 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureAny @tok'_6989586621679198986)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_105, + farExp_106 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_104 #) + GHC.Types.EQ -> (# init_1, + failExp_104 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_100 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_105 farExp_106 + else let _ = "checkHorizon.else" + in let failExp_107 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 1)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_108, + farExp_109 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_107 #) + GHC.Types.EQ -> (# init_1, + failExp_107 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_100 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_108 farExp_109 + else let _ = "choicesBranch.else" + in if 44 GHC.Classes.== c_67 + then let _ = "choicesBranch.then" + in let readFail_110 = readFail_66 + in if readMore_2 inp_44 + then let !(# c_111, + cs_112 #) = readNext_3 inp_44 + in if (\x_113 -> GHC.Types.True) c_111 + then let _ = "resume" + in join_52 init_1 Data.Set.Internal.empty (let _ = "resume.genCode" + in Parsers.Brainfuck.Types.Input) cs_112 + else let _ = "checkToken.else" + in let failExp_114 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureAny @tok'_6989586621679198986)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_115, + farExp_116 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_114 #) + GHC.Types.EQ -> (# init_1, + failExp_114 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_110 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_115 farExp_116 + else let _ = "checkHorizon.else" + in let failExp_117 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 1)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_118, + farExp_119 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_117 #) + GHC.Types.EQ -> (# init_1, + failExp_117 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_110 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_118 farExp_119 + else let _ = "choicesBranch.else" + in if 46 GHC.Classes.== c_67 + then let _ = "choicesBranch.then" + in let readFail_120 = readFail_66 + in if readMore_2 inp_44 + then let !(# c_121, + cs_122 #) = readNext_3 inp_44 + in if (\x_123 -> GHC.Types.True) c_121 + then let _ = "resume" + in join_52 init_1 Data.Set.Internal.empty (let _ = "resume.genCode" + in Parsers.Brainfuck.Types.Output) cs_122 + else let _ = "checkToken.else" + in let failExp_124 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureAny @tok'_6989586621679198986)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_125, + farExp_126 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_124 #) + GHC.Types.EQ -> (# init_1, + failExp_124 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_120 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_125 farExp_126 + else let _ = "checkHorizon.else" + in let failExp_127 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 1)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_128, + farExp_129 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_127 #) + GHC.Types.EQ -> (# init_1, + failExp_127 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_120 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_128 farExp_129 + else let _ = "choicesBranch.else" + in if 91 GHC.Classes.== c_67 + then let _ = "choicesBranch.then" + in let readFail_130 = readFail_66 + in if readMore_2 ((GHC.Num.+) @GHC.Types.Int 1 inp_44) + then let !(# c_131, + cs_132 #) = readNext_3 inp_44 + in if (\x_133 -> GHC.Types.True) c_131 + then name_25 (let _ = "suspend" + in \farInp_134 farExp_135 v_136 (!inp_137) -> name_34 (let _ = "suspend" + in \farInp_138 farExp_139 v_140 (!inp_141) -> let readFail_142 = readFail_130 + in if readMore_2 inp_141 + then let !(# c_143, + cs_144 #) = readNext_3 inp_141 + in if (93 GHC.Classes.==) c_143 + then let _ = "resume" + in join_52 farInp_138 farExp_139 (let _ = "resume.genCode" + in Parsers.Brainfuck.Types.Loop v_140) cs_144 + else let _ = "checkToken.else" + in readFail_142 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_141 farInp_138 farExp_139 + else let _ = "checkHorizon.else" + in let failExp_145 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 1)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_146, + farExp_147 #) = case GHC.Classes.compare @GHC.Types.Int farInp_138 inp_141 of + GHC.Types.LT -> (# inp_141, + failExp_145 #) + GHC.Types.EQ -> (# farInp_138, + failExp_145 GHC.Base.<> farExp_139 #) + GHC.Types.GT -> (# farInp_138, + farExp_139 #) + in readFail_142 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_141 farInp_146 farExp_147) inp_137 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail_130 Data.Map.Internal.Tip Data.Map.Internal.Tip)) cs_132 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail_130 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else let _ = "checkToken.else" + in let failExp_148 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureAny @tok'_6989586621679198986)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_149, + farExp_150 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_148 #) + GHC.Types.EQ -> (# init_1, + failExp_148 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_130 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_149 farExp_150 + else let _ = "checkHorizon.else" + in let failExp_151 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 2)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_152, + farExp_153 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_151 #) + GHC.Types.EQ -> (# init_1, + failExp_151 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_130 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_152 farExp_153 + else let _ = "choicesBranch.else" + in let failExp_154 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEmpty) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_155, + farExp_156 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_154 #) + GHC.Types.EQ -> (# init_1, + failExp_154 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_66 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_155 farExp_156 + else let _ = "checkToken.else" + in let failExp_157 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureAny @tok'_6989586621679198986)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_158, + farExp_159 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_157 #) + GHC.Types.EQ -> (# init_1, + failExp_157 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_66 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_158 farExp_159 + else let _ = "checkHorizon.else" + in let failExp_160 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 1)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_161, + farExp_162 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_44 of + GHC.Types.LT -> (# inp_44, + failExp_160 #) + GHC.Types.EQ -> (# init_1, + failExp_160 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_66 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_44 farInp_161 farExp_162; + name_29 = \(!ok_163) (!inp_164) (!koByLabel_165) -> let _ = "catch ExceptionFailure" + in let catchHandler_166 (!_exn_167) (!failInp_168) (!farInp_169) (!farExp_170) = let _ = "catch.ko ExceptionFailure" + in if (GHC.Classes.==) @GHC.Types.Int inp_164 failInp_168 + then let _ = "choicesBranch.then" + in let _ = "resume" + in ok_163 farInp_169 farExp_170 (let _ = "resume.genCode" + in \x_171 -> x_171) failInp_168 + else let _ = "choicesBranch.else" + in Data.Map.Strict.Internal.findWithDefault finalRaise_18 Symantic.Parser.Grammar.Combinators.ExceptionFailure koByLabel_165 Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp_168 farInp_169 farExp_170 + in let readFail_172 = catchHandler_166 + in if readMore_2 inp_164 + then let !(# c_173, + cs_174 #) = readNext_3 inp_164 + in if (\c_175 -> GHC.Classes.not ((60 GHC.Classes.== c_175) GHC.Classes.|| ((62 GHC.Classes.== c_175) GHC.Classes.|| ((43 GHC.Classes.== c_175) GHC.Classes.|| ((45 GHC.Classes.== c_175) GHC.Classes.|| ((44 GHC.Classes.== c_175) GHC.Classes.|| ((46 GHC.Classes.== c_175) GHC.Classes.|| ((91 GHC.Classes.== c_175) GHC.Classes.|| ((93 GHC.Classes.== c_175) GHC.Classes.|| GHC.Types.False))))))))) c_173 + then name_29 (let _ = "suspend" + in \farInp_176 farExp_177 v_178 (!inp_179) -> let _ = "resume" + in ok_163 farInp_176 farExp_177 (let _ = "resume.genCode" + in \x_180 -> v_178 x_180) inp_179) cs_174 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail_172 Data.Map.Internal.Tip Data.Map.Internal.Tip) + else let _ = "checkToken.else" + in readFail_172 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_164 init_1 Data.Set.Internal.empty + else let _ = "checkHorizon.else" + in let failExp_181 = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure (case inputToken of + (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_6989586621679198986) -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok'_6989586621679198986 1)) Data.Set.Internal.Tip Data.Set.Internal.Tip + in let (# farInp_182, + farExp_183 #) = case GHC.Classes.compare @GHC.Types.Int init_1 inp_164 of + GHC.Types.LT -> (# inp_164, + failExp_181 #) + GHC.Types.EQ -> (# init_1, + failExp_181 GHC.Base.<> Data.Set.Internal.empty #) + GHC.Types.GT -> (# init_1, + Data.Set.Internal.empty #) + in readFail_172 Symantic.Parser.Grammar.Combinators.ExceptionFailure inp_164 farInp_182 farExp_183} + in name_25 (let _ = "suspend" + in \farInp_184 farExp_185 v_186 (!inp_187) -> name_34 (let _ = "suspend" + in \farInp_188 farExp_189 v_190 (!inp_191) -> let _ = "resume" + in finalRet_13 farInp_188 farExp_189 (let _ = "resume.genCode" + in v_190) inp_191) inp_187 Data.Map.Internal.Tip) init_1 Data.Map.Internal.Tip diff --git a/symantic-parser.cabal b/symantic-parser.cabal index 58d2385..3ba63b4 100644 --- a/symantic-parser.cabal +++ b/symantic-parser.cabal @@ -21,7 +21,7 @@ stability: experimental category: Parsing extra-doc-files: ChangeLog.md - HackMe.md + Hacking.md ReadMe.md ToDo.md extra-source-files: @@ -123,7 +123,10 @@ library parsers exposed-modules: Parsers.Brainfuck.Attoparsec Parsers.Brainfuck.Handrolled - Parsers.Brainfuck.SymanticParser + Parsers.Brainfuck.SymanticParser.AutoSplice + Parsers.Brainfuck.SymanticParser.DumpSplice + Parsers.Brainfuck.SymanticParser.Grammar + Parsers.Brainfuck.SymanticParser.PprSplice Parsers.Brainfuck.Types Parsers.Nandlang Parsers.Playground @@ -143,7 +146,7 @@ library parsers TypeApplications, TypeFamilies, TypeOperators - ghc-options: -O2 + ghc-options: -O2 -ddump-to-file -ddump-simpl-stats -ddump-splices build-depends: symantic-parser, attoparsec >= 0.13, @@ -153,6 +156,7 @@ library parsers deepseq >= 1.4, directory >= 1.3, filepath >= 1.4, + ghc-prim, hashable >= 1.2.6, megaparsec >= 9.0, process >= 1.6, -- 2.44.1 From 8135ef953156f1f53ac4149bea4f109f74906d56 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 7 May 2021 14:03:01 +0200 Subject: [PATCH 15/16] doc: improve a bit the ReadMe.md --- ReadMe.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ReadMe.md b/ReadMe.md index b95279f..bff0fb5 100644 --- a/ReadMe.md +++ b/ReadMe.md @@ -1,16 +1,16 @@ ### Main differences with respect to `ParsleyHaskell` -- Extensible primitive grammar combinators, including their underlying optimization passes, by leveraging reciprocal injections between a tagless-final encoding of syntaxes (aka. type-classes) and a corresponding tagged-initial encoding to pattern-match syntaxes (aka. data-instances). This enables a very principled, yet flexible source code. Moreover `DefaultSignatures` are supplied to succinctly derive new semantics (aka. type-class-instances) using automatic `trans`formations. +- Extensible primitive grammar combinators, including their underlying optimization passes, by leveraging reciprocal injections between a tagless-final encoding of syntaxes (aka. type-classes) and a corresponding tagged-initial encoding to pattern-match syntaxes (aka. data-instances). This is a final approach to recursion patterns, whereas [recursion-schemes](http://hackage.haskell.org/package/recursion-schemes) is an initial one. Here `DefaultSignatures` are supplied to succinctly derive new semantics (aka. type-class-instances) using automatic `trans`formations. - Error messages based upon the farthest input position reached (not yet implemented in `ParsleyHaskell`). -- Minimal input length checks ("horizon" checks) required for a successful parsing are factorized using a different static analysis than `ParsleyHaskell`'s "piggy bank" which I've not understood well. This analysis can see beyond calls to subroutines, but maybe `ParsleyHaskell`'s analysis can also be adjusted to do the same. Both analysis are not well documented and studied. +- Minimal input length checks ("horizon" checks) required for a successful parsing are factorized using a different static analysis than `ParsleyHaskell`'s "piggy bank" which I've not understood well. This analysis uses [polyfix](http://okmij.org/ftp/Computation/fixed-point-combinators.html#Poly-variadic) to see beyond calls to subroutines. - No dependency upon GHC plugins: `lift-plugin` and `idioms-plugin`, because those are plugins hence introduce a bit of complexity in the build processes using this parser, but most importantly they are experimental and mostly cosmetics, since they only enable a cleaner usage of the parsing combinators, by lifting Haskell code in `pure` to integrate the `TemplateHaskell` needed. I do not understand them that much and do not feel confortable to maintain them come the day that their authors abandon them. - No dependency upon `dependent-map` by keeping observed sharing inside `def` and `ref` combinators, instead of passing by a `DMap`. And also when introducing the join-points optimization, where fresh `TemplateHaskell` names are also directly used instead of passing by a `DMap`. -- No support for general purpose registers in the `Machine` producing the `TemplateHaskell` splices (maybe it will come if I need and understand what's done in `ParsleyHaskell`). +- No support (yet?) for general purpose registers in the `Machine` producing the `TemplateHaskell` splices. - License is `AGPL-3-or-later` not `BSD-3-Clause`. @@ -18,4 +18,4 @@ - For me to better understand [ParsleyHaskell](https://github.com/j-mie6/ParsleyHaskell), and find a manageable balance between simplicity of the codebase and features of the parser. And by doing so, challenging and showcasing symantic techniques. -- To support the parsing of tree-like data structures instead of only string-like data structures. Eg. to validate XML using RelaxNG in [symantic-xml](http://hackage.haskell.org/package/symantic-xml) or to perform routing of HTTP requests in [symantic-http-server](http://hackage.haskell.org/package/symantic-http-server). This is currently done in those packages using `megaparsec`, but `megaparsec` is not conceived for such input, and is less principled when it comes to optimizing, like merging alternatives. +- To support the parsing of tree-like data structures instead of only string-like data structures. Eg. to validate XML using RelaxNG in [symantic-xml](https://hackage.haskell.org/package/symantic-xml) or to perform routing of HTTP requests in [symantic-http-server](http://hackage.haskell.org/package/symantic-http-server). This is currently done in those packages using `megaparsec`, but `megaparsec` is not conceived for such input, and is less principled when it comes to optimizing, like merging alternatives. -- 2.44.1 From 183e844d0382e910285f73ca0e5c01fcd2406228 Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Tue, 29 Jun 2021 09:37:45 +0200 Subject: [PATCH 16/16] replace ValueCode by Production --- .envrc | 11 - Makefile | 29 + default.nix | 1 + .../Brainfuck/SymanticParser/AutoSplice.hs | 8 +- .../Brainfuck/SymanticParser/DumpSplice.hs | 568 +++++++++--------- .../Brainfuck/SymanticParser/Grammar.hs | 31 +- .../Brainfuck/SymanticParser/PprSplice.hs | 1 - parsers/Parsers/Nandlang.hs | 13 +- parsers/Parsers/Playground.hs | 2 +- src/Language/Haskell/TH/HideName.hs | 2 +- src/Symantic/Parser/Grammar.hs | 4 +- src/Symantic/Parser/Grammar/Combinators.hs | 111 ++-- src/Symantic/Parser/Grammar/Optimize.hs | 91 +-- src/Symantic/Parser/Grammar/Production.hs | 195 ++++++ src/Symantic/Parser/Grammar/View.hs | 9 +- src/Symantic/Parser/Haskell.hs | 8 - src/Symantic/Parser/Haskell/Optimize.hs | 98 --- src/Symantic/Parser/Haskell/Term.hs | 229 +++---- src/Symantic/Parser/Haskell/View.hs | 115 ---- src/Symantic/Parser/Machine/Generate.hs | 33 +- src/Symantic/Parser/Machine/Instructions.hs | 24 +- src/Symantic/Parser/Machine/Optimize.hs | 15 +- src/Symantic/Parser/Machine/Program.hs | 15 +- src/Symantic/Univariant/Data.hs | 264 ++++++++ src/Symantic/Univariant/Lang.hs | 128 ++++ src/Symantic/Univariant/Optim.hs | 59 ++ src/Symantic/Univariant/Trans.hs | 12 +- src/Symantic/Univariant/View.hs | 117 ++++ symantic-parser.cabal | 35 +- 29 files changed, 1385 insertions(+), 843 deletions(-) create mode 100644 src/Symantic/Parser/Grammar/Production.hs delete mode 100644 src/Symantic/Parser/Haskell.hs delete mode 100644 src/Symantic/Parser/Haskell/View.hs create mode 100644 src/Symantic/Univariant/Data.hs create mode 100644 src/Symantic/Univariant/Lang.hs create mode 100644 src/Symantic/Univariant/Optim.hs create mode 100644 src/Symantic/Univariant/View.hs diff --git a/.envrc b/.envrc index 324cf67..3550a30 100644 --- a/.envrc +++ b/.envrc @@ -1,12 +1 @@ -use_flake() { - watch_file flake.nix - watch_file flake.lock - watch_file default.nix - watch_file shell.nix - profile="$(direnv_layout_dir)"/flake-profile - mkdir -p "$(direnv_layout_dir)" - eval "$(time nix print-dev-env --show-trace --profile "$profile" || echo false)" && - nix-store --add-root "shell.root" --indirect --realise "$profile" && - nix-env --delete-generations +1 --profile "$profile" -} use flake diff --git a/Makefile b/Makefile index 30694e9..f4b828d 100644 --- a/Makefile +++ b/Makefile @@ -2,6 +2,7 @@ override RTS_OPTIONS += -L100 override TEST_OPTIONS += --color always --size-cutoff 1000000 $(addprefix -p ,$t) override GHC_PROF_OPTIONS += -fprof-auto -fprof-auto-calls override BENCHMARK_OPTIONS += --output benchmarks/html/$(version).html --match glob $b +override REPL_OPTIONS += -ignore-dot-ghci cabal := $(wildcard *.cabal) package := $(notdir ./$(cabal:.cabal=)) @@ -15,8 +16,20 @@ clean c: cabal clean repl: cabal repl $(project) +ghcid: + ghcid -c 'cabal repl $(project) --repl-options "$(REPL_OPTIONS)"' --reverse-errors +.PHONY: parsers +parsers: + cabal build $(project):parsers parsers/repl: cabal repl $(project):parsers +parsers/ghcid: + ghcid -c 'cabal repl $(project):parsers --repl-options "$(REPL_OPTIONS)"' --reverse-errors +parsers/prof-th: + cabal v2-build lib:$(project) --enable-profiling $(GHC_PROF_OPTIONS) --write-ghc-environment-files=always + cabal build $(project):parsers $(CABAL_BUILD_FLAGS) \ + --enable-profiling $(GHC_PROF_OPTIONS) \ + --ghc-options "$(addprefix -opti,+RTS $(RTS_OPTIONS))" .PHONY: tests tests: @@ -62,6 +75,7 @@ benchmarks/prof-time: $(project)-benchmark.eventlog.json benchmarks/prof-heap: $(project)-benchmark.eventlog.html .PHONY: $(project)-benchmark.eventlog $(project)-benchmark.eventlog $(project)-benchmark.prof: + @echo "$$(tput setaf 1)WARNING: benchmarking with --enable-profiling can create significant biases$$(tput sgr0)" cabal bench $(CABAL_BENCH_FLAGS) \ --benchmark-options "$(BENCHMARK_OPTIONS) +RTS $(RTS_OPTIONS)" \ --enable-profiling $(GHC_PROF_OPTIONS) @@ -99,3 +113,18 @@ nix-repl: nix -L develop --command cabal repl nix-shell: nix -L develop + +.PHONY: debug-ppr +debug-ppr: debug-ppr/PprSplice.hs debug-ppr/AutoSplice.hs +debug-ppr/PprSplice.hs.ppr: parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs.ppr Makefile + mkdir -p $(@D) + sed $< >$@ -e '1s/^/parser = /' -e 's/\x00//g' +debug-ppr/AutoSplice.dump-splices: dist-newstyle/build/x86_64-linux/ghc-9.0.1/symantic-parser-$(version)/l/parsers/build/parsers/parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.dump-splices Makefile + mkdir -p $(@D) + sed $< >$@ -e '1,/^ ======>/d;' -e '4s/^/parser = /' -e 's/\x00//g' +%.hs: %.hs.ppr + ormolu -m stdout >$@ -o -XBangPatterns -o -XUnboxedTuples -o -XMagicHash -o -XTypeApplications -o -XUnboxedTuples <$< + #sed -i $@ -e 'N;s/\n\s*#)/ #)/;P;D' +%.hs: %.dump-splices + ormolu -m stdout >$@ -o -XBangPatterns -o -XUnboxedTuples -o -XMagicHash -o -XTypeApplications -o -XUnboxedTuples <$< + #sed -i $@ -e 'N;s/\n\s*#)/ #)/;P;D' diff --git a/default.nix b/default.nix index 711121b..2936542 100644 --- a/default.nix +++ b/default.nix @@ -29,6 +29,7 @@ in hs.symantic-parser // { hs.hs-speedscope hs.profiteur hs.eventlog2html + hs.ghcid #hs.threadscope #hs.ghc-events-analyze #hs.haskell-language-server diff --git a/parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.hs b/parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.hs index 67787ca..b34a789 100644 --- a/parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.hs +++ b/parsers/Parsers/Brainfuck/SymanticParser/AutoSplice.hs @@ -15,9 +15,15 @@ module Parsers.Brainfuck.SymanticParser.AutoSplice where import Data.Either (Either) import qualified Data.ByteString as BS import qualified Symantic.Parser as SP +import qualified GHC.Word -import Parsers.Brainfuck.SymanticParser.Grammar (grammar) +import Parsers.Brainfuck.SymanticParser.Grammar (grammar, reproGrammar) import Parsers.Brainfuck.Types (Instruction) parserByteString :: BS.ByteString -> Either (SP.ParsingError BS.ByteString) [Instruction] parserByteString = $$(SP.runParser @BS.ByteString grammar) + +{- +parserByteStringRepro :: BS.ByteString -> Either (SP.ParsingError BS.ByteString) [GHC.Word.Word8] +parserByteStringRepro = $$(SP.runParser @BS.ByteString reproGrammar) +-} diff --git a/parsers/Parsers/Brainfuck/SymanticParser/DumpSplice.hs b/parsers/Parsers/Brainfuck/SymanticParser/DumpSplice.hs index f03e4e3..ada8155 100644 --- a/parsers/Parsers/Brainfuck/SymanticParser/DumpSplice.hs +++ b/parsers/Parsers/Brainfuck/SymanticParser/DumpSplice.hs @@ -37,7 +37,7 @@ import qualified Language.Haskell.TH.Syntax as TH import qualified Prelude import qualified Symantic.Parser as SP import qualified Symantic.Parser.Grammar.Combinators -import qualified Symantic.Parser.Haskell +import qualified Symantic.Univariant.Lang import qualified Symantic.Parser.Machine import qualified Symantic.Parser.Machine.Generate import qualified Symantic.Parser.Machine.Input @@ -63,13 +63,13 @@ parserByteString = = input_ama8 next_amai i_amaj@(GHC.Types.I# i_amak#) = case - ((GHC.Prim.readWord8OffAddr# - (addr_amae# `GHC.Prim.plusAddr#` i_amak#)) - 0#) + GHC.Prim.readWord8OffAddr# + (addr_amae# `GHC.Prim.plusAddr#` i_amak#) + 0# GHC.Prim.realWorld# of { (# s'_amal, x_amam #) - -> case (GHC.Prim.touch# final_amaf) s'_amal of { + -> case GHC.Prim.touch# final_amaf s'_amal of { _ -> (# GHC.Word.W8# x_amam, (i_amaj GHC.Num.+ 1) #) } } in (# off_amag, (GHC.Classes.< size_amah), next_amai #) finalRet_ama9 @@ -96,39 +96,39 @@ parserByteString = let name_1 = \ !ok_amcU !inp_amcV !koByLabel_amcW - -> ((name_4 + -> name_4 (let _ = "suspend" in \ farInp_amcX farExp_amcY v_amcZ !inp_amd0 -> let _ = "resume" in - (((ok_amcU farInp_amcX) farExp_amcY) - (let _ = "resume.genCode" in ())) - inp_amd0)) - inp_amcV) - (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) - (((Data.Map.Strict.Internal.findWithDefault finalRaise_amad) - SP.ExceptionFailure) - koByLabel_amcW)) - Data.Map.Internal.Tip) + ok_amcU farInp_amcX farExp_amcY + (let _ = "resume.genCode" in ()) + inp_amd0) + inp_amcV + (Data.Map.Internal.Bin 1 SP.ExceptionFailure + (Data.Map.Strict.Internal.findWithDefault finalRaise_amad + SP.ExceptionFailure + koByLabel_amcW) + Data.Map.Internal.Tip Data.Map.Internal.Tip) name_2 = \ !ok_amcN !inp_amcO !koByLabel_amcP - -> ((name_3 + -> name_3 (let _ = "suspend" in \ farInp_amcQ farExp_amcR v_amcS !inp_amcT -> let _ = "resume" in - (((ok_amcN farInp_amcQ) farExp_amcR) - (let _ = "resume.genCode" in v_amcS [])) - inp_amcT)) - inp_amcO) - (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) - (((Data.Map.Strict.Internal.findWithDefault finalRaise_amad) - SP.ExceptionFailure) - koByLabel_amcP)) - Data.Map.Internal.Tip) + ok_amcN farInp_amcQ farExp_amcR + (let _ = "resume.genCode" in v_amcS []) + inp_amcT) + inp_amcO + (Data.Map.Internal.Bin 1 SP.ExceptionFailure + (Data.Map.Strict.Internal.findWithDefault finalRaise_amad + SP.ExceptionFailure + koByLabel_amcP) + Data.Map.Internal.Tip Data.Map.Internal.Tip) name_3 = \ !ok_amaS !inp_amaT !koByLabel_amaU @@ -141,51 +141,51 @@ parserByteString = !farExp_amaZ = let _ = "catch.ko ExceptionFailure" in - if (((GHC.Classes.==) @GHC.Types.Int) inp_amaT) failInp_amaX then + if (GHC.Classes.==) @GHC.Types.Int inp_amaT failInp_amaX then let _ = "choicesBranch.then" in let _ = "resume" in - (((ok_amaS farInp_amaY) farExp_amaZ) - (let _ = "resume.genCode" in \ x_amb0 -> x_amb0)) + ok_amaS farInp_amaY farExp_amaZ + (let _ = "resume.genCode" in \ x_amb0 -> x_amb0) failInp_amaX else let _ = "choicesBranch.else" in - ((((((Data.Map.Strict.Internal.findWithDefault finalRaise_amad) - SP.ExceptionFailure) - koByLabel_amaU) - SP.ExceptionFailure) - failInp_amaX) - farInp_amaY) + Data.Map.Strict.Internal.findWithDefault finalRaise_amad + SP.ExceptionFailure + koByLabel_amaU + SP.ExceptionFailure + failInp_amaX + farInp_amaY farExp_amaZ in let join_1s = \ farInp_amb1 farExp_amb2 v_amb3 !inp_amb4 - -> ((name_1 + -> name_1 (let _ = "suspend" in \ farInp_amb5 farExp_amb6 v_amb7 !inp_amb8 - -> ((name_3 + -> (name_3 (let _ = "suspend" in \ farInp_amb9 farExp_amba v_ambb !inp_ambc -> let _ = "resume" in - (((ok_amaS farInp_amb9) farExp_amba) + ok_amaS farInp_amb9 farExp_amba (let _ = "resume.genCode" in \ x_ambd - -> (v_amb3 : v_ambb x_ambd))) - inp_ambc)) + -> (v_amb3 : v_ambb x_ambd)) + inp_ambc) inp_amb8) - (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) - catchHandler_amaV) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip))) - inp_amb4) - (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) - catchHandler_amaV) - Data.Map.Internal.Tip) + (Data.Map.Internal.Bin 1 SP.ExceptionFailure + catchHandler_amaV + Data.Map.Internal.Tip + Data.Map.Internal.Tip)) + inp_amb4 + (Data.Map.Internal.Bin 1 SP.ExceptionFailure + catchHandler_amaV + Data.Map.Internal.Tip Data.Map.Internal.Tip) in let readFail_ambe = catchHandler_amaV in @@ -211,12 +211,12 @@ parserByteString = let _ = "checkToken.else" in let failExp_ambm - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> SP.FailureAny @tok'_aLiK }))) - Data.Set.Internal.Tip) + -> SP.FailureAny @tok'_aLiK })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_ambn, farExp_ambo #) @@ -235,19 +235,19 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambi SP.ExceptionFailure) inp_amaT) - farInp_ambn) + readFail_ambi SP.ExceptionFailure inp_amaT + farInp_ambn farExp_ambo else let _ = "checkHorizon.else" in let failExp_ambp - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon @tok'_aLiK) 1 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon @tok'_aLiK 1 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_ambq, farExp_ambr #) @@ -263,8 +263,8 @@ parserByteString = GHC.Types.GT -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambi SP.ExceptionFailure) inp_amaT) - farInp_ambq) + readFail_ambi SP.ExceptionFailure inp_amaT + farInp_ambq farExp_ambr else let _ = "choicesBranch.else" @@ -279,29 +279,29 @@ parserByteString = if (\ x_ambv -> GHC.Types.True) c_ambt then let _ = "resume" in - (((join_1s init_amaa) - Data.Set.Internal.empty) + join_1s init_amaa + Data.Set.Internal.empty (let _ = "resume.genCode" - in Parsers.Brainfuck.Types.Forward)) + in Parsers.Brainfuck.Types.Forward) cs_ambu else let _ = "checkToken.else" in let failExp_ambw - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) -> SP.FailureAny - @tok'_aLiK }))) - Data.Set.Internal.Tip) + @tok'_aLiK })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_ambx, farExp_amby #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -323,19 +323,19 @@ parserByteString = let _ = "checkHorizon.else" in let failExp_ambz - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon @tok'_aLiK) - 1 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon @tok'_aLiK + 1 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_ambA, farExp_ambB #) = case - ((GHC.Classes.compare @GHC.Types.Int) - init_amaa) + GHC.Classes.compare @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT -> (# inp_amaT, failExp_ambz #) @@ -348,8 +348,8 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambs SP.ExceptionFailure) inp_amaT) - farInp_ambA) + readFail_ambs SP.ExceptionFailure inp_amaT + farInp_ambA farExp_ambB else let _ = "choicesBranch.else" @@ -366,30 +366,30 @@ parserByteString = if (\ x_ambF -> GHC.Types.True) c_ambD then let _ = "resume" in - (((join_1s init_amaa) - Data.Set.Internal.empty) + join_1s init_amaa + Data.Set.Internal.empty (let _ = "resume.genCode" in - Parsers.Brainfuck.Types.Increment)) + Parsers.Brainfuck.Types.Increment) cs_ambE else let _ = "checkToken.else" in let failExp_ambG - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) -> SP.FailureAny - @tok'_aLiK }))) - Data.Set.Internal.Tip) + @tok'_aLiK })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_ambH, farExp_ambI #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -404,22 +404,22 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambC SP.ExceptionFailure) - inp_amaT) - farInp_ambH) + readFail_ambC SP.ExceptionFailure + inp_amaT + farInp_ambH farExp_ambI else let _ = "checkHorizon.else" in let failExp_ambJ - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon - @tok'_aLiK) - 1 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon + @tok'_aLiK + 1 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_ambK, farExp_ambL #) @@ -440,9 +440,9 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambC SP.ExceptionFailure) - inp_amaT) - farInp_ambK) + readFail_ambC SP.ExceptionFailure + inp_amaT + farInp_ambK farExp_ambL else let _ = "choicesBranch.else" @@ -460,30 +460,30 @@ parserByteString = c_ambN then let _ = "resume" in - (((join_1s init_amaa) - Data.Set.Internal.empty) + join_1s init_amaa + Data.Set.Internal.empty (let _ = "resume.genCode" in - Parsers.Brainfuck.Types.Decrement)) + Parsers.Brainfuck.Types.Decrement) cs_ambO else let _ = "checkToken.else" in let failExp_ambQ - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) -> SP.FailureAny - @tok'_aLiK }))) - Data.Set.Internal.Tip) + @tok'_aLiK })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_ambR, farExp_ambS #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -498,30 +498,30 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambM - SP.ExceptionFailure) - inp_amaT) - farInp_ambR) + readFail_ambM + SP.ExceptionFailure + inp_amaT + farInp_ambR farExp_ambS else let _ = "checkHorizon.else" in let failExp_ambT - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon - @tok'_aLiK) - 1 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon + @tok'_aLiK + 1 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_ambU, farExp_ambV #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -536,9 +536,9 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambM SP.ExceptionFailure) - inp_amaT) - farInp_ambU) + readFail_ambM SP.ExceptionFailure + inp_amaT + farInp_ambU farExp_ambV else let _ = "choicesBranch.else" @@ -556,35 +556,35 @@ parserByteString = c_ambX then let _ = "resume" in - (((join_1s init_amaa) - Data.Set.Internal.empty) + join_1s init_amaa + Data.Set.Internal.empty (let _ = "resume.genCode" in - Parsers.Brainfuck.Types.Input)) + Parsers.Brainfuck.Types.Input) cs_ambY else let _ = "checkToken.else" in let failExp_amc0 - = (((Data.Set.Internal.Bin - 1) + = Data.Set.Internal.Bin + 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) -> SP.FailureAny - @tok'_aLiK }))) - Data.Set.Internal.Tip) + @tok'_aLiK })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amc1, farExp_amc2 #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -599,30 +599,30 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambW - SP.ExceptionFailure) - inp_amaT) - farInp_amc1) + readFail_ambW + SP.ExceptionFailure + inp_amaT + farInp_amc1 farExp_amc2 else let _ = "checkHorizon.else" in let failExp_amc3 - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon - @tok'_aLiK) - 1 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon + @tok'_aLiK + 1 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amc4, farExp_amc5 #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -637,10 +637,10 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambW - SP.ExceptionFailure) - inp_amaT) - farInp_amc4) + readFail_ambW + SP.ExceptionFailure + inp_amaT + farInp_amc4 farExp_amc5 else let _ = "choicesBranch.else" @@ -659,37 +659,37 @@ parserByteString = c_amc7 then let _ = "resume" in - (((join_1s - init_amaa) - Data.Set.Internal.empty) + join_1s + init_amaa + Data.Set.Internal.empty (let _ = "resume.genCode" in - Parsers.Brainfuck.Types.Output)) + Parsers.Brainfuck.Types.Output) cs_amc8 else let _ = "checkToken.else" in let failExp_amca - = (((Data.Set.Internal.Bin - 1) + = Data.Set.Internal.Bin + 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) -> SP.FailureAny - @tok'_aLiK }))) - Data.Set.Internal.Tip) + @tok'_aLiK })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amcb, farExp_amcc #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -704,35 +704,35 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_amc6 - SP.ExceptionFailure) - inp_amaT) - farInp_amcb) + readFail_amc6 + SP.ExceptionFailure + inp_amaT + farInp_amcb farExp_amcc else let _ = "checkHorizon.else" in let failExp_amcd - = (((Data.Set.Internal.Bin - 1) + = Data.Set.Internal.Bin + 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon - @tok'_aLiK) - 1 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon + @tok'_aLiK + 1 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amce, farExp_amcf #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -747,10 +747,10 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_amc6 - SP.ExceptionFailure) - inp_amaT) - farInp_amce) + readFail_amc6 + SP.ExceptionFailure + inp_amaT + farInp_amce farExp_amcf else let _ = "choicesBranch.else" @@ -765,9 +765,9 @@ parserByteString = = readFail_ambe in if readMore_amab - ((((GHC.Num.+) - @GHC.Types.Int) - 1) + ((GHC.Num.+) + @GHC.Types.Int + 1 inp_amaT) then let !(# c_amch, @@ -778,7 +778,7 @@ parserByteString = if (\ x_amcj -> GHC.Types.True) c_amch then - ((name_1 + name_1 (let _ = "suspend" in @@ -786,7 +786,7 @@ parserByteString = farExp_amcl v_amcm !inp_amcn - -> ((name_2 + -> name_2 (let _ = "suspend" in @@ -812,48 +812,48 @@ parserByteString = let _ = "resume" in - (((join_1s - farInp_amco) - farExp_amcp) + join_1s + farInp_amco + farExp_amcp (let _ = "resume.genCode" in Parsers.Brainfuck.Types.Loop - v_amcq)) + v_amcq) cs_amcu else let _ = "checkToken.else" in - (((readFail_amcs - SP.ExceptionFailure) - inp_amcr) - farInp_amco) + readFail_amcs + SP.ExceptionFailure + inp_amcr + farInp_amco farExp_amcp else let _ = "checkHorizon.else" in let failExp_amcv - = (((Data.Set.Internal.Bin - 1) + = Data.Set.Internal.Bin + 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon - @tok'_aLiK) - 1 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon + @tok'_aLiK + 1 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amcw, farExp_amcx #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - farInp_amco) + GHC.Classes.compare + @GHC.Types.Int + farInp_amco inp_amcr of GHC.Types.LT @@ -868,48 +868,48 @@ parserByteString = -> (# farInp_amco, farExp_amcp #) in - (((readFail_amcs - SP.ExceptionFailure) - inp_amcr) - farInp_amcw) - farExp_amcx)) - inp_amcn) - (((((Data.Map.Internal.Bin - 1) - SP.ExceptionFailure) - readFail_amcg) - Data.Map.Internal.Tip) - Data.Map.Internal.Tip))) - cs_amci) - (((((Data.Map.Internal.Bin - 1) - SP.ExceptionFailure) - readFail_amcg) - Data.Map.Internal.Tip) + readFail_amcs + SP.ExceptionFailure + inp_amcr + farInp_amcw + farExp_amcx) + inp_amcn + (Data.Map.Internal.Bin + 1 + SP.ExceptionFailure + readFail_amcg + Data.Map.Internal.Tip + Data.Map.Internal.Tip)) + cs_amci + (Data.Map.Internal.Bin + 1 + SP.ExceptionFailure + readFail_amcg + Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "checkToken.else" in let failExp_amcy - = (((Data.Set.Internal.Bin - 1) + = Data.Set.Internal.Bin + 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) -> SP.FailureAny - @tok'_aLiK }))) - Data.Set.Internal.Tip) + @tok'_aLiK })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amcz, farExp_amcA #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -924,35 +924,35 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_amcg - SP.ExceptionFailure) - inp_amaT) - farInp_amcz) + readFail_amcg + SP.ExceptionFailure + inp_amaT + farInp_amcz farExp_amcA else let _ = "checkHorizon.else" in let failExp_amcB - = (((Data.Set.Internal.Bin - 1) + = Data.Set.Internal.Bin + 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon - @tok'_aLiK) - 2 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon + @tok'_aLiK + 2 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amcC, farExp_amcD #) = case - ((GHC.Classes.compare - @GHC.Types.Int) - init_amaa) + GHC.Classes.compare + @GHC.Types.Int + init_amaa inp_amaT of GHC.Types.LT @@ -967,21 +967,21 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_amcg - SP.ExceptionFailure) - inp_amaT) - farInp_amcC) + readFail_amcg + SP.ExceptionFailure + inp_amaT + farInp_amcC farExp_amcD else let _ = "choicesBranch.else" in let failExp_amcE - = (((Data.Set.Internal.Bin - 1) + = Data.Set.Internal.Bin + 1 (SP.SomeFailure - SP.FailureEmpty)) - Data.Set.Internal.Tip) + SP.FailureEmpty) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amcF, @@ -1004,26 +1004,26 @@ parserByteString = -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambe - SP.ExceptionFailure) - inp_amaT) - farInp_amcF) + readFail_ambe + SP.ExceptionFailure + inp_amaT + farInp_amcF farExp_amcG else let _ = "checkToken.else" in let failExp_amcH - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> SP.FailureAny @tok'_aLiK }))) - Data.Set.Internal.Tip) + -> SP.FailureAny @tok'_aLiK })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amcI, farExp_amcJ #) = case - ((GHC.Classes.compare @GHC.Types.Int) init_amaa) inp_amaT + GHC.Classes.compare @GHC.Types.Int init_amaa inp_amaT of GHC.Types.LT -> (# inp_amaT, failExp_amcH #) GHC.Types.EQ @@ -1032,29 +1032,29 @@ parserByteString = GHC.Base.<> Data.Set.Internal.empty) #) GHC.Types.GT -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambe SP.ExceptionFailure) inp_amaT) farInp_amcI) + readFail_ambe SP.ExceptionFailure inp_amaT farInp_amcI farExp_amcJ else let _ = "checkHorizon.else" in let failExp_amcK - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon @tok'_aLiK) 1 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon @tok'_aLiK 1 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amcL, farExp_amcM #) - = case ((GHC.Classes.compare @GHC.Types.Int) init_amaa) inp_amaT of + = case GHC.Classes.compare @GHC.Types.Int init_amaa inp_amaT of GHC.Types.LT -> (# inp_amaT, failExp_amcK #) GHC.Types.EQ -> (# init_amaa, (failExp_amcK GHC.Base.<> Data.Set.Internal.empty) #) GHC.Types.GT -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_ambe SP.ExceptionFailure) inp_amaT) farInp_amcL) + readFail_ambe SP.ExceptionFailure inp_amaT farInp_amcL farExp_amcM name_4 = \ !ok_amax !inp_amay !koByLabel_amaz @@ -1067,22 +1067,22 @@ parserByteString = !farExp_amaE = let _ = "catch.ko ExceptionFailure" in - if (((GHC.Classes.==) @GHC.Types.Int) inp_amay) failInp_amaC then + if (GHC.Classes.==) @GHC.Types.Int inp_amay failInp_amaC then let _ = "choicesBranch.then" in let _ = "resume" in - (((ok_amax farInp_amaD) farExp_amaE) - (let _ = "resume.genCode" in \ x_amaF -> x_amaF)) + ok_amax farInp_amaD farExp_amaE + (let _ = "resume.genCode" in \ x_amaF -> x_amaF) failInp_amaC else let _ = "choicesBranch.else" in - ((((((Data.Map.Strict.Internal.findWithDefault finalRaise_amad) - SP.ExceptionFailure) - koByLabel_amaz) - SP.ExceptionFailure) - failInp_amaC) - farInp_amaD) + Data.Map.Strict.Internal.findWithDefault finalRaise_amad + SP.ExceptionFailure + koByLabel_amaz + SP.ExceptionFailure + failInp_amaC + farInp_amaD farExp_amaE in let readFail_amaG = catchHandler_amaA in @@ -1110,62 +1110,62 @@ parserByteString = GHC.Classes.|| GHC.Types.False))))))))) c_amaH then - ((name_4 + name_4 (let _ = "suspend" in \ farInp_amaK farExp_amaL v_amaM !inp_amaN -> let _ = "resume" in - (((ok_amax farInp_amaK) farExp_amaL) + ok_amax farInp_amaK farExp_amaL (let _ = "resume.genCode" - in \ x_amaO -> v_amaM x_amaO)) - inp_amaN)) - cs_amaI) - (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure) readFail_amaG) - Data.Map.Internal.Tip) + in \ x_amaO -> v_amaM x_amaO) + inp_amaN) + cs_amaI + (Data.Map.Internal.Bin 1 SP.ExceptionFailure readFail_amaG + Data.Map.Internal.Tip Data.Map.Internal.Tip) else let _ = "checkToken.else" in - (((readFail_amaG SP.ExceptionFailure) inp_amay) init_amaa) + readFail_amaG SP.ExceptionFailure inp_amay init_amaa Data.Set.Internal.empty else let _ = "checkHorizon.else" in let failExp_amaP - = (((Data.Set.Internal.Bin 1) + = Data.Set.Internal.Bin 1 (SP.SomeFailure (case inputToken of { (Data.Proxy.Proxy :: Data.Proxy.Proxy tok'_aLiK) - -> (SP.FailureHorizon @tok'_aLiK) 1 }))) - Data.Set.Internal.Tip) + -> SP.FailureHorizon @tok'_aLiK 1 })) + Data.Set.Internal.Tip Data.Set.Internal.Tip in let (# farInp_amaQ, farExp_amaR #) - = case ((GHC.Classes.compare @GHC.Types.Int) init_amaa) inp_amay of + = case GHC.Classes.compare @GHC.Types.Int init_amaa inp_amay of GHC.Types.LT -> (# inp_amay, failExp_amaP #) GHC.Types.EQ -> (# init_amaa, (failExp_amaP GHC.Base.<> Data.Set.Internal.empty) #) GHC.Types.GT -> (# init_amaa, Data.Set.Internal.empty #) in - (((readFail_amaG SP.ExceptionFailure) inp_amay) farInp_amaQ) + readFail_amaG SP.ExceptionFailure inp_amay farInp_amaQ farExp_amaR in - ((name_1 + name_1 (let _ = "suspend" in \ farInp_amd1 farExp_amd2 v_amd3 !inp_amd4 - -> ((name_2 + -> name_2 (let _ = "suspend" in \ farInp_amd5 farExp_amd6 v_amd7 !inp_amd8 -> let _ = "resume" in - (((finalRet_ama9 farInp_amd5) farExp_amd6) - (let _ = "resume.genCode" in v_amd7)) - inp_amd8)) - inp_amd4) - Data.Map.Internal.Tip)) - init_amaa) + finalRet_ama9 farInp_amd5 farExp_amd6 + (let _ = "resume.genCode" in v_amd7) + inp_amd8) + inp_amd4 + Data.Map.Internal.Tip) + init_amaa Data.Map.Internal.Tip diff --git a/parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs b/parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs index aadbece..a90497f 100644 --- a/parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs +++ b/parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs @@ -12,14 +12,10 @@ import qualified Prelude import Symantic.Univariant.Trans import qualified Symantic.Parser as SP -import qualified Symantic.Parser.Haskell as H import Parsers.Utils import Parsers.Brainfuck.Types -haskell :: TH.Lift a => a -> SP.TermGrammar a -haskell a = H.Term (H.ValueCode a [||a||]) - -- | Use with @$$(runParser @Text grammar)@, -- but in another Haskell module to avoid -- GHC stage restriction on such top-level splice. @@ -35,17 +31,24 @@ grammar = whitespace SP.*> bf lexeme p = p SP.<* whitespace bf :: repr [Instruction] bf = SP.many (lexeme (SP.match (SP.look (SP.item @tok)) - (haskell . coerceEnum Prelude.<$> "<>+-,.[") + (SP.prod . coerceEnum Prelude.<$> "<>+-,.[") op SP.empty)) - op :: H.Term H.ValueCode tok -> repr Instruction - op (trans -> H.ValueCode c _) = case coerceEnum c of - '<' -> SP.item @tok SP.$> SP.code Backward - '>' -> SP.item @tok SP.$> SP.code Forward - '+' -> SP.item @tok SP.$> SP.code Increment - '-' -> SP.item @tok SP.$> SP.code Decrement - ',' -> SP.item @tok SP.$> SP.code Input - '.' -> SP.item @tok SP.$> SP.code Output + op :: SP.Production tok -> repr Instruction + op prod = case coerceEnum (SP.runValue prod) of + '<' -> SP.item @tok SP.$> SP.prod Backward + '>' -> SP.item @tok SP.$> SP.prod Forward + '+' -> SP.item @tok SP.$> SP.prod Increment + '-' -> SP.item @tok SP.$> SP.prod Decrement + ',' -> SP.item @tok SP.$> SP.prod Input + '.' -> SP.item @tok SP.$> SP.prod Output '[' -> SP.between (lexeme (SP.item @tok)) (SP.token (coerceEnum @_ @tok ']')) - (H.Term (H.ValueCode Loop [||Loop||]) SP.<$> bf) + (SP.production Loop [||Loop||] SP.<$> bf) _ -> Prelude.undefined + +reproGrammar :: forall tok repr. + CoerceEnum Char tok => + CoerceEnum tok Char => + SP.Grammarable tok repr => + repr [tok] +reproGrammar = SP.many (SP.item @tok) diff --git a/parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs b/parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs index 4417854..4caa647 100644 --- a/parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs +++ b/parsers/Parsers/Brainfuck/SymanticParser/PprSplice.hs @@ -41,7 +41,6 @@ import qualified Language.Haskell.TH.Syntax as TH import qualified Prelude import qualified Symantic.Parser as SP import qualified Symantic.Parser.Grammar.Combinators -import qualified Symantic.Parser.Haskell import qualified Symantic.Parser.Machine import qualified Symantic.Parser.Machine.Generate import qualified Symantic.Parser.Machine.Input diff --git a/parsers/Parsers/Nandlang.hs b/parsers/Parsers/Nandlang.hs index aff8999..4ec2652 100644 --- a/parsers/Parsers/Nandlang.hs +++ b/parsers/Parsers/Nandlang.hs @@ -19,7 +19,7 @@ import qualified Data.Text as Text import Symantic.Univariant.Trans import qualified Symantic.Parser as P -import qualified Symantic.Parser.Haskell as H +import qualified Symantic.Univariant.Lang as H type Parser a = P.Parser Text.Text a @@ -50,7 +50,7 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof charLit = P.between (P.char '\'') (symbol '\'') charChar charChar :: repr () charChar = P.void (P.satisfy - (trans (H.ValueCode nandStringLetter [||nandStringLetter||]))) P.<|> esc + (P.production nandStringLetter [||nandStringLetter||])) P.<|> esc esc :: repr () esc = P.char '\\' P.*> P.void (P.oneOf "0tnvfr") expr :: repr () @@ -62,7 +62,7 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof identifier :: repr () identifier = P.try (identStart P.*> P.skipMany identLetter) P.*> whitespace identStart = P.satisfy - (trans (H.ValueCode nandIdentStart [||nandIdentStart||])) + (P.production nandIdentStart [||nandIdentStart||]) exprlist = commaSep expr exprlist1 = commaSep1 expr @@ -95,7 +95,7 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof notIdentLetter = P.negLook identLetter -} identLetter = P.satisfy - (trans (H.ValueCode nandIdentLetter [||nandIdentLetter||])) + (P.production nandIdentLetter [||nandIdentLetter||]) -- hexadecimal = P.oneOf "xX" P.*> number (P.oneOf (['a'..'f'] <> ['A'..'F'] <> ['0'..'9'])) -- octal = P.oneOf "oO" P.*> number (P.oneOf ['0'..'7']) @@ -118,15 +118,14 @@ grammar = whitespace P.*> P.skipMany funcdef P.<* P.eof commaSep1 p = p P.*> P.skipMany (comma P.*> p) space :: repr () - space = P.void (P.satisfy - (trans (H.ValueCode isSpace [||isSpace||]))) + space = P.void (P.satisfy (P.production isSpace [||isSpace||])) whitespace :: repr () whitespace = spaces {- whitespace = P.skipMany (spaces P.<|> oneLineComment) oneLineComment :: repr () oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy - (trans (H.ValueCode (/= '\n') [||(/= '\n')||])))) + (P.production (/= '\n') [||(/= '\n')||]))) -} spaces :: repr () spaces = P.skipSome space diff --git a/parsers/Parsers/Playground.hs b/parsers/Parsers/Playground.hs index 03dde7b..2bda9f6 100644 --- a/parsers/Parsers/Playground.hs +++ b/parsers/Parsers/Playground.hs @@ -3,7 +3,7 @@ module Parsers.Playground where import Symantic.Parser -import qualified Symantic.Parser.Haskell as H +import qualified Symantic.Univariant.Lang as H boom :: CombApplicable repr => repr () boom = diff --git a/src/Language/Haskell/TH/HideName.hs b/src/Language/Haskell/TH/HideName.hs index e3a06af..c34a61c 100644 --- a/src/Language/Haskell/TH/HideName.hs +++ b/src/Language/Haskell/TH/HideName.hs @@ -7,7 +7,7 @@ import Prelude (undefined) class HideName a where -- | Map all 'Name's to a constant in order to overcome - -- cases where reseting 'TH.counter' is not enough + -- cases where resetting 'TH.counter' is not enough -- to get deterministic 'TH.Name's. hideName :: a -> a instance HideName Body where diff --git a/src/Symantic/Parser/Grammar.hs b/src/Symantic/Parser/Grammar.hs index 9ba1d1c..18a5c0a 100644 --- a/src/Symantic/Parser/Grammar.hs +++ b/src/Symantic/Parser/Grammar.hs @@ -6,16 +6,18 @@ module Symantic.Parser.Grammar , module Symantic.Parser.Grammar.Fixity , module Symantic.Parser.Grammar.Optimize , module Symantic.Parser.Grammar.ObserveSharing + , module Symantic.Parser.Grammar.Production , module Symantic.Parser.Grammar.Write , module Symantic.Parser.Grammar.View , Letable(..) , Letsable(..) ) where import Symantic.Parser.Grammar.Combinators -import Symantic.Parser.Grammar.View import Symantic.Parser.Grammar.Fixity import Symantic.Parser.Grammar.ObserveSharing import Symantic.Parser.Grammar.Optimize +import Symantic.Parser.Grammar.Production +import Symantic.Parser.Grammar.View import Symantic.Parser.Grammar.Write import Control.DeepSeq (NFData) diff --git a/src/Symantic/Parser/Grammar/Combinators.hs b/src/Symantic/Parser/Grammar/Combinators.hs index 3c8ff59..a3e1047 100644 --- a/src/Symantic/Parser/Grammar/Combinators.hs +++ b/src/Symantic/Parser/Grammar/Combinators.hs @@ -43,17 +43,14 @@ import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH import qualified Symantic.Univariant.Trans as Sym -import qualified Symantic.Parser.Haskell as H - --- * Type 'TermGrammar' -type TermGrammar = H.Term H.ValueCode +import qualified Symantic.Univariant.Lang as H +import qualified Symantic.Univariant.Data as Prod +import qualified Symantic.Univariant.View +import Symantic.Parser.Grammar.Production -- * Type 'ReprComb' type ReprComb = Type -> Type -code :: TH.Lift a => a -> TermGrammar a -code x = H.Term (H.ValueCode x [||x||]) - -- * Class 'CombAlternable' class CombAlternable repr where -- | @('alt' es l r)@ parses @(l)@ and return its return value or, @@ -167,13 +164,13 @@ p <+> q = H.left <$> p <|> H.right <$> q infixl 3 <|>, <+> -optionally :: CombApplicable repr => CombAlternable repr => repr a -> TermGrammar b -> repr b +optionally :: CombApplicable repr => CombAlternable repr => repr a -> Production b -> repr b optionally p x = p $> x <|> pure x optional :: CombApplicable repr => CombAlternable repr => repr a -> repr () optional = flip optionally H.unit -option :: CombApplicable repr => CombAlternable repr => TermGrammar a -> repr a -> repr a +option :: CombApplicable repr => CombAlternable repr => Production a -> repr a -> repr a option x p = p <|> pure x choice :: CombAlternable repr => [repr a] -> repr a @@ -187,10 +184,16 @@ maybeP p = option H.nothing (H.just <$> p) manyTill :: CombApplicable repr => CombAlternable repr => repr a -> repr b -> repr [a] manyTill p end = let go = end $> H.nil <|> p <:> go in go +{- +class CombProductionable repr where +infixl 4 <$>, <&>, <$, $> +data instance Failure CombProductionable +-} + -- * Class 'CombApplicable' -- | This is like the usual 'Functor' and 'Applicative' type classes --- from the @base@ package, but using @('TermGrammar' a)@ instead of just @(a)@ +-- from the @base@ package, but using @('Production' a)@ instead of just @(a)@ -- to be able to use and pattern match on some usual terms of type @(a)@ (like 'H.id') -- and thus apply some optimizations. -- @(repr)@, for "representation", is the usual tagless-final abstraction @@ -198,26 +201,26 @@ manyTill p end = let go = end $> H.nil <|> p <:> go in go -- of type class like this one) will be interpreted. class CombApplicable repr where -- | @(a2b '<$>' ra)@ parses like @(ra)@ but maps its returned value with @(a2b)@. - (<$>) :: TermGrammar (a -> b) -> repr a -> repr b + (<$>) :: Production (a -> b) -> repr a -> repr b (<$>) f = (pure f <*>) -- | Like '<$>' but with its arguments 'flip'-ped. - (<&>) :: repr a -> TermGrammar (a -> b) -> repr b + (<&>) :: repr a -> Production (a -> b) -> repr b (<&>) = flip (<$>) -- | @(a '<$' rb)@ parses like @(rb)@ but discards its returned value by replacing it with @(a)@. - (<$) :: TermGrammar a -> repr b -> repr a + (<$) :: Production a -> repr b -> repr a (<$) x = (pure x <*) -- | @(ra '$>' b)@ parses like @(ra)@ but discards its returned value by replacing it with @(b)@. - ($>) :: repr a -> TermGrammar b -> repr b + ($>) :: repr a -> Production b -> repr b ($>) = flip (<$) -- | @('pure' a)@ parses the empty string, always succeeding in returning @(a)@. - pure :: TermGrammar a -> repr a + pure :: Production a -> repr a default pure :: Sym.Liftable repr => CombApplicable (Sym.Output repr) => - TermGrammar a -> repr a + Production a -> repr a pure = Sym.lift . pure -- | @(ra2b '<*>' ra)@ parses sequentially @(ra2b)@ and then @(ra)@, @@ -229,11 +232,6 @@ class CombApplicable repr where repr (a -> b) -> repr a -> repr b (<*>) = Sym.lift2 (<*>) - -- | @('liftA2' a2b2c ra rb)@ parses sequentially @(ra)@ and then @(rb)@, - -- and returns the application of @(a2b2c)@ to the values returned by those parsers. - liftA2 :: TermGrammar (a -> b -> c) -> repr a -> repr b -> repr c - liftA2 f x = (<*>) (f <$> x) - -- | @(ra '<*' rb)@ parses sequentially @(ra)@ and then @(rb)@, -- and returns like @(ra)@, discarding the return value of @(rb)@. (<*) :: repr a -> repr b -> repr a @@ -251,7 +249,12 @@ class CombApplicable repr where (<**>) :: repr a -> repr (a -> b) -> repr b (<**>) = liftA2 (\a f -> f a) -} -infixl 4 <$>, <&>, <$, $>, <*>, <*, *>, <**> + -- | @('liftA2' a2b2c ra rb)@ parses sequentially @(ra)@ and then @(rb)@, + -- and returns the application of @(a2b2c)@ to the values returned by those parsers. + liftA2 :: Production (a -> b -> c) -> repr a -> repr b -> repr c + liftA2 f x = (<*>) (f <$> x) + +infixl 4 <*>, <*, *>, <**> data instance Failure CombApplicable {-# INLINE (<:>) #-} @@ -310,7 +313,7 @@ class CombFoldable repr where data instance Failure CombFoldable {- -conditional :: CombSelectable repr => [(TermGrammar (a -> Bool), repr b)] -> repr a -> repr b -> repr b +conditional :: CombSelectable repr => [(Production (a -> Bool), repr b)] -> repr a -> repr b -> repr b conditional cs p def = match p fs qs def where (fs, qs) = List.unzip cs -} @@ -318,28 +321,28 @@ conditional cs p def = match p fs qs def -- Parser Folds pfoldr :: CombApplicable repr => CombFoldable repr => - TermGrammar (a -> b -> b) -> TermGrammar b -> repr a -> repr b + Production (a -> b -> b) -> Production b -> repr a -> repr b pfoldr f k p = chainPre (f <$> p) (pure k) pfoldr1 :: CombApplicable repr => CombFoldable repr => - TermGrammar (a -> b -> b) -> TermGrammar b -> repr a -> repr b + Production (a -> b -> b) -> Production b -> repr a -> repr b pfoldr1 f k p = f <$> p <*> pfoldr f k p pfoldl :: CombApplicable repr => CombFoldable repr => - TermGrammar (b -> a -> b) -> TermGrammar b -> repr a -> repr b + Production (b -> a -> b) -> Production b -> repr a -> repr b pfoldl f k p = chainPost (pure k) ((H.flip <$> pure f) <*> p) pfoldl1 :: CombApplicable repr => CombFoldable repr => - TermGrammar (b -> a -> b) -> TermGrammar b -> repr a -> repr b + Production (b -> a -> b) -> Production b -> repr a -> repr b pfoldl1 f k p = chainPost (f <$> pure k <*> p) ((H.flip <$> pure f) <*> p) -- Chain Combinators chainl1' :: CombApplicable repr => CombFoldable repr => - TermGrammar (a -> b) -> repr a -> repr (b -> a -> b) -> repr b + Production (a -> b) -> repr a -> repr (b -> a -> b) -> repr b chainl1' f p op = chainPost (f <$> p) (H.flip <$> op <*> p) chainl1 :: @@ -358,13 +361,13 @@ chainr1' f p op = newRegister_ H.id $ \acc -> chainr1 :: repr a -> repr (a -> a -> a) -> repr a chainr1 = chainr1' H.id -chainr :: repr a -> repr (a -> a -> a) -> TermGrammar a -> repr a +chainr :: repr a -> repr (a -> a -> a) -> Production a -> repr a chainr p op x = option x (chainr1 p op) -} chainl :: CombApplicable repr => CombAlternable repr => CombFoldable repr => - repr a -> repr (a -> a -> a) -> TermGrammar a -> repr a + repr a -> repr (a -> a -> a) -> Production a -> repr a chainl p op x = option x (chainl1 p op) -- Derived Combinators @@ -443,30 +446,30 @@ sepEndBy1 p sep = newRegister_ H.id $ \acc -> -- * Class 'CombMatchable' class CombMatchable repr where conditional :: - Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b + Eq a => repr a -> [Production (a -> Bool)] -> [repr b] -> repr b -> repr b default conditional :: Sym.Unliftable repr => Sym.Liftable1 repr => CombMatchable (Sym.Output repr) => - Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b + Eq a => repr a -> [Production (a -> Bool)] -> [repr b] -> repr b -> repr b conditional a ps bs = Sym.lift1 (conditional (Sym.unlift a) ps (Sym.unlift Functor.<$> bs)) - match :: Eq a => repr a -> [TermGrammar a] -> (TermGrammar a -> repr b) -> repr b -> repr b - match a as a2b = conditional a ((H.eq H..@) Functor.<$> as) (a2b Functor.<$> as) + match :: Eq a => repr a -> [Production a] -> (Production a -> repr b) -> repr b -> repr b + match a as a2b = conditional a ((H.equal H..@) Functor.<$> as) (a2b Functor.<$> as) -- match a as a2b = conditional a (((H.eq H..@ H.qual) H..@) Functor.<$> as) (a2b Functor.<$> as) data instance Failure CombMatchable -- * Class 'CombSatisfiable' class CombSatisfiable tok repr where -- | Like 'satisfyOrFail' but with no custom failure. - satisfy :: TermGrammar (tok -> Bool) -> repr tok + satisfy :: Production (tok -> Bool) -> repr tok satisfy = satisfyOrFail Set.empty -- | Like 'satisfy' but with a custom set of 'SomeFailure's. satisfyOrFail :: Set SomeFailure -> - TermGrammar (tok -> Bool) -> repr tok + Production (tok -> Bool) -> repr tok default satisfyOrFail :: Sym.Liftable repr => CombSatisfiable tok (Sym.Output repr) => Set SomeFailure -> - TermGrammar (tok -> Bool) -> repr tok + Production (tok -> Bool) -> repr tok satisfyOrFail fs = Sym.lift . satisfyOrFail fs data instance Failure (CombSatisfiable tok) @@ -499,14 +502,17 @@ char :: CombApplicable repr => CombSatisfiable Char repr => Char -> repr Char -char c = satisfyOrFail (Set.singleton (SomeFailure (FailureToken c))) - (H.eq H..@ H.char c) $> H.char c +char c = satisfyOrFail + (Set.singleton (SomeFailure (FailureToken c))) + ((H.equal H..@ H.char c)) + $> H.char c item :: forall tok repr. Eq tok => Show tok => Typeable tok => TH.Lift tok => NFData tok => CombSatisfiable tok repr => repr tok -item = satisfyOrFail (Set.singleton (SomeFailure (FailureAny @tok))) - (H.const H..@ H.bool True) +item = satisfyOrFail + (Set.singleton (SomeFailure (FailureAny @tok))) + (H.const H..@ H.bool True) anyChar :: CombAlternable repr => @@ -526,18 +532,17 @@ oneOf :: [tok] -> repr tok oneOf ts = satisfyOrFail (Set.fromList (SomeFailure . FailureToken Functor.<$> ts)) - (Sym.trans H.ValueCode - { value = (`List.elem` ts) - , code = [||\t -> $$(ofChars ts [||t||])||] }) + (production + (`List.elem` ts) + [||\t -> $$(ofChars ts [||t||])||]) noneOf :: TH.Lift tok => Eq tok => CombSatisfiable tok repr => [tok] -> repr tok -noneOf cs = satisfy (Sym.trans H.ValueCode - { value = not . (`List.elem` cs) - , code = [||\c -> not $$(ofChars cs [||c||])||] - }) +noneOf cs = satisfy (production + (not . (`List.elem` cs)) + [||\c -> not $$(ofChars cs [||c||])||]) ofChars :: TH.Lift tok => Eq tok => @@ -556,16 +561,16 @@ more :: more = look (void (item @Char)) token :: - TH.Lift tok => Show tok => Eq tok => + TH.Lift tok => Show tok => Eq tok => Typeable tok => CombAlternable repr => CombApplicable repr => CombSatisfiable tok repr => tok -> repr tok -token tok = satisfy (H.eq H..@ H.char tok) $> H.char tok +token tok = satisfy (H.equal H..@ H.constant tok) $> H.constant tok -- token tok = satisfy [ExceptionToken tok] (H.eq H..@ H.qual H..@ H.char tok) $> H.char tok tokens :: - TH.Lift tok => Eq tok => Show tok => + TH.Lift tok => Eq tok => Show tok => Typeable tok => CombApplicable repr => CombAlternable repr => CombSatisfiable tok repr => [tok] -> repr [tok] tokens = try . traverse token @@ -628,12 +633,12 @@ infixl 4 ~> -- Lift Operations liftA2 :: CombApplicable repr => - TermGrammar (a -> b -> c) -> repr a -> repr b -> repr c + Production (a -> b -> c) -> repr a -> repr b -> repr c liftA2 f x = (<*>) (fmap f x) liftA3 :: CombApplicable repr => - TermGrammar (a -> b -> c -> d) -> repr a -> repr b -> repr c -> repr d + Production (a -> b -> c -> d) -> repr a -> repr b -> repr c -> repr d liftA3 f a b c = liftA2 f a b <*> c -} diff --git a/src/Symantic/Parser/Grammar/Optimize.hs b/src/Symantic/Parser/Grammar/Optimize.hs index e4e33f8..c5e3d42 100644 --- a/src/Symantic/Parser/Grammar/Optimize.hs +++ b/src/Symantic/Parser/Grammar/Optimize.hs @@ -9,20 +9,23 @@ module Symantic.Parser.Grammar.Optimize where import Data.Bool (Bool(..)) import Data.Either (Either(..), either) import Data.Eq (Eq(..)) -import Data.Function ((.)) +import Data.Function (($), (.)) import Data.Kind (Constraint) import Data.Maybe (Maybe(..)) import Data.Set (Set) +import Data.Functor.Identity (Identity(..)) import Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..)) import qualified Data.Foldable as Foldable import qualified Data.Functor as Functor import qualified Data.List as List import Symantic.Parser.Grammar.Combinators hiding (code) -import Symantic.Parser.Haskell () +import qualified Symantic.Parser.Grammar.Production as Prod +import Symantic.Parser.Grammar.Production import Symantic.Univariant.Letable import Symantic.Univariant.Trans -import qualified Symantic.Parser.Haskell as H +import qualified Symantic.Univariant.Lang as H +import qualified Symantic.Univariant.Data as H {- import Data.Function (($), flip) @@ -45,8 +48,7 @@ optimizeGrammar = trans -- This is an extensible data-type. data family Comb (comb :: ReprComb -> Constraint) - (repr :: ReprComb) - :: ReprComb + :: ReprComb -> ReprComb -- | Convenient utility to pattern-match a 'SomeComb'. pattern Comb :: Typeable comb => Comb comb repr a -> SomeComb repr a @@ -131,18 +133,18 @@ instance -- CombApplicable data instance Comb CombApplicable repr a where - Pure :: TermGrammar a -> Comb CombApplicable repr a + Pure :: Production a -> Comb CombApplicable repr a (:<*>:) :: SomeComb repr (a -> b) -> SomeComb repr a -> Comb CombApplicable repr b (:<*:) :: SomeComb repr a -> SomeComb repr b -> Comb CombApplicable repr a (:*>:) :: SomeComb repr a -> SomeComb repr b -> Comb CombApplicable repr b infixl 4 :<*>:, :<*:, :*>: -pattern (:<$>:) :: TermGrammar (a -> b) -> SomeComb repr a -> Comb CombApplicable repr b +pattern (:<$>:) :: Production (a -> b) -> SomeComb repr a -> Comb CombApplicable repr b pattern t :<$>: x <- Comb (Pure t) :<*>: x -pattern (:$>:) :: SomeComb repr a -> TermGrammar b -> Comb CombApplicable repr b +pattern (:$>:) :: SomeComb repr a -> Production b -> Comb CombApplicable repr b pattern x :$>: t <- x :*>: Comb (Pure t) instance CombApplicable repr => Trans (Comb CombApplicable repr) repr where trans = \case - Pure x -> pure (H.optimizeTerm x) + Pure x -> pure (optimizeProduction x) f :<*>: x -> trans f <*> trans x x :<*: y -> trans x <* trans y x :*>: y -> trans x *> trans y @@ -323,7 +325,7 @@ instance data instance Comb CombMatchable repr a where Conditional :: Eq a => SomeComb repr a -> - [TermGrammar (a -> Bool)] -> + [Production (a -> Bool)] -> [SomeComb repr b] -> SomeComb repr b -> Comb CombMatchable repr b @@ -331,7 +333,7 @@ instance CombMatchable repr => Trans (Comb CombMatchable repr) repr where trans = \case Conditional a ps bs b -> conditional (trans a) - (H.optimizeTerm Functor.<$> ps) + (optimizeProduction Functor.<$> ps) (trans Functor.<$> bs) (trans b) instance ( CombApplicable repr @@ -348,9 +350,9 @@ instance conditional a _ps bs (Comb Empty) | Foldable.all (\case { Comb Empty -> True; _ -> False }) bs = a *> empty -- & trace "Conditional Weakening Law" - conditional (Comb (Pure (trans -> a))) ps bs d = - Foldable.foldr (\(trans -> p, b) next -> - if H.value p (H.value a) then b else next + conditional (Comb (Pure a)) ps bs d = + Foldable.foldr (\(p, b) next -> + if runValue (p H..@ a) then b else next ) d (List.zip ps bs) -- & trace "Conditional Pure Law" conditional a ps bs d = SomeComb (Conditional a ps bs d) @@ -367,13 +369,13 @@ data instance Comb (CombSatisfiable tok) repr a where SatisfyOrFail :: CombSatisfiable tok repr => Set SomeFailure -> - TermGrammar (tok -> Bool) -> + Production (tok -> Bool) -> Comb (CombSatisfiable tok) repr tok instance CombSatisfiable tok repr => Trans (Comb (CombSatisfiable tok) repr) repr where trans = \case - SatisfyOrFail fs p -> satisfyOrFail fs (H.optimizeTerm p) + SatisfyOrFail fs p -> satisfyOrFail fs (optimizeProduction p) instance (CombSatisfiable tok repr, Typeable tok) => CombSatisfiable tok (SomeComb repr) where @@ -400,37 +402,46 @@ instance -- & trace "Branch Absorption Law" branch b (Comb Empty) (Comb Empty) = b *> empty -- & trace "Branch Weakening Law" - branch (Comb (Pure (trans -> lr))) l r = - case H.value lr of - Left value -> l <*> pure (trans H.ValueCode{..}) - where code = [|| case $$(H.code lr) of Left x -> x ||] - Right value -> r <*> pure (trans H.ValueCode{..}) - where code = [|| case $$(H.code lr) of Right x -> x ||] - -- & trace "Branch Pure Left/Right Law" - branch b (Comb (Pure (trans -> l))) (Comb (Pure (trans -> r))) = - trans H.ValueCode{..} <$> b + branch (Comb (Pure lr)) l r = + case runValue lr of + Left value -> l <*> pure Production{..} + where + prodValue = H.SomeData $ H.Var $ Identity value + prodCode = H.SomeData $ H.Var + [|| case $$(runCode lr) of Left x -> x ||] + Right value -> r <*> pure Production{..} + where + prodValue = H.SomeData $ H.Var $ Identity value + prodCode = H.SomeData $ H.Var + [|| case $$(runCode lr) of Right x -> x ||] + -- & trace "Branch Pure Either Law" + branch b (Comb (Pure l)) (Comb (Pure r)) = + Production{..} <$> b -- & trace "Branch Generalised Identity Law" where - value = either (H.value l) (H.value r) - code = [|| either $$(H.code l) $$(H.code r) ||] + prodValue = H.SomeData $ H.Var $ Identity $ either (runValue l) (runValue r) + prodCode = H.SomeData $ H.Var [|| either $$(runCode l) $$(runCode r) ||] branch (Comb (x :*>: y)) p q = x *> branch y p q -- & trace "Interchange Law" branch b l (Comb Empty) = - branch (pure (trans (H.ValueCode{..})) <*> b) empty l + branch (pure Production{..} <*> b) empty l -- & trace "Negated Branch Law" where - value = either Right Left - code = [||either Right Left||] - branch (Comb (Branch b (Comb Empty) (Comb (Pure (trans -> lr))))) (Comb Empty) br = - branch (pure (trans H.ValueCode{..}) <*> b) empty br + prodValue = H.SomeData $ H.Var $ Identity $ either Right Left + prodCode = H.SomeData $ H.Var $ [||either Right Left||] + branch (Comb (Branch b (Comb Empty) (Comb (Pure lr)))) (Comb Empty) br = + branch (pure Production{..} <*> b) empty br -- & trace "Branch Fusion Law" where - value Left{} = Left () - value (Right r) = case H.value lr r of - Left _ -> Left () - Right rr -> Right rr - code = [|| \case Left{} -> Left () - Right r -> case $$(H.code lr) r of - Left _ -> Left () - Right rr -> Right rr ||] + prodValue = H.SomeData $ H.Var $ Identity $ \case + Left{} -> Left () + Right r -> + case runValue lr r of + Left{} -> Left () + Right rr -> Right rr + prodCode = H.SomeData $ H.Var + [|| \case Left{} -> Left () + Right r -> case $$(runCode lr) r of + Left{} -> Left () + Right rr -> Right rr ||] branch b l r = SomeComb (Branch b l r) diff --git a/src/Symantic/Parser/Grammar/Production.hs b/src/Symantic/Parser/Grammar/Production.hs new file mode 100644 index 0000000..5115a34 --- /dev/null +++ b/src/Symantic/Parser/Grammar/Production.hs @@ -0,0 +1,195 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} +module Symantic.Parser.Grammar.Production where + +import Data.Bool (Bool(..)) +import Data.Char (Char) +import Data.Eq (Eq) +import Data.Functor.Identity (Identity(..)) +import Prelude (undefined) +import Text.Show (Show(..), showString) +import qualified Data.Either as Either +import qualified Data.Eq as Eq +import qualified Data.Function as Fun +import qualified Data.Maybe as Maybe +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH +import Type.Reflection (Typeable) + +import Symantic.Univariant.Data +import Symantic.Univariant.Lang +import Symantic.Univariant.Optim +import Symantic.Univariant.Trans +import Symantic.Univariant.View + +import Debug.Trace + +-- * Type 'Production' +data Production a + = Production + { prodValue :: SomeData Identity a + , prodCode :: SomeData TH.CodeQ a + --, prodView :: SomeData View a + } + +production :: a -> TH.CodeQ a -> Production a +production v c = Production + { prodValue = SomeData (Var (Identity v)) + , prodCode = SomeData (Var c) + } + +prod :: TH.Lift a => a -> Production a +prod x = production x [||x||] + +runValue :: Production a -> a +runValue x = runIdentity (trans x) +runCode :: Production a -> TH.CodeQ a +runCode = trans + +instance Trans Production Identity where + trans Production{prodValue = SomeData x} = trans x +instance Trans Production TH.CodeQ where + trans Production{prodCode = SomeData x} = trans x + +instance Abstractable Production where + var = Fun.id + f .@ x = Production + { prodValue = prodValue f .@ prodValue x + , prodCode = prodCode f .@ prodCode x + } + lam f = Production + { prodValue = lam (\x -> prodValue (f Production{prodValue = x})) + , prodCode = lam (\x -> prodCode (f Production{prodCode = x})) + } + lam1 f = Production + { prodValue = lam1 (\x -> prodValue (f Production{prodValue = x})) + , prodCode = lam1 (\x -> prodCode (f Production{prodCode = x})) + } + const = Production const const + ($) = Production ($) ($) + (.) = Production (.) (.) + flip = Production flip flip + id = Production id id +instance Eitherable Production where + left = Production left left + right = Production right right +instance (TH.Lift c, Typeable c) => Constantable c Production where + constant c = Production (constant c) (constant c) +instance Maybeable Production where + nothing = Production nothing nothing + just = Production just just +instance Listable Production where + nil = Production nil nil + cons = Production cons cons +instance Equalable Production where + equal = Production equal equal + +optimizeProduction :: Production a -> Production a +optimizeProduction p = Production + { prodValue = normalOrderReduction (prodValue p) + , prodCode = normalOrderReduction (prodCode p) + } + +{- +class Tokenable repr where + token :: tok -> repr tok + default token :: + Liftable repr => Tokenable (Output repr) => + tok -> repr tok + token = lift Fun.. token + +instance Show (SomeData ValueCode a) where + showsPrec p (SomeData x) = showsPrec p (trans @_ @View x) +-} + +{- +-- * Type 'ValueCode' +data ValueCode a = ValueCode + { value :: a + , code :: TH.CodeQ a + } +instance Trans ValueCode ValueCode where + trans = Fun.id +instance Abstractable ValueCode where + f .@ x = ValueCode + { value = runIdentity (Identity (value f) .@ (Identity (value x))) + , code = code f .@ code x + } + lam f = ValueCode + { value = runIdentity (lam (Identity Fun.. value Fun.. f Fun.. (`ValueCode` undefined) Fun.. runIdentity)) + , code = lam (code Fun.. f Fun.. ValueCode undefined) + } + lam1 = lam + const = ValueCode (runIdentity const) const + flip = ValueCode (runIdentity flip) flip + id = ValueCode (runIdentity id) id + ($) = ValueCode (runIdentity ($)) ($) + (.) = ValueCode (runIdentity (.)) (.) +instance Anythingable ValueCode +instance TH.Lift c => Constantable c ValueCode where + constant c = ValueCode (runIdentity (constant c)) (constant c) +instance Listable ValueCode where + cons = ValueCode (runIdentity cons) cons + nil = ValueCode (runIdentity nil) nil +instance Equalable ValueCode where + equal = ValueCode (runIdentity equal) equal +instance Eitherable ValueCode where + left = ValueCode (runIdentity left) left + right = ValueCode (runIdentity right) right +instance Maybeable ValueCode where + nothing = ValueCode (runIdentity nothing) nothing + just = ValueCode (runIdentity just) just +-} + +-- Identity +instance Anythingable Identity +instance Abstractable Identity where + f .@ x = Identity (runIdentity f (runIdentity x)) + lam f = Identity (runIdentity Fun.. f Fun.. Identity) + lam1 = lam + var = Fun.id + const = Identity Fun.const + flip = Identity Fun.flip + id = Identity Fun.id + ($) = Identity (Fun.$) + (.) = Identity (Fun..) +instance Constantable c Identity where + constant = Identity +instance Eitherable Identity where + left = Identity Either.Left + right = Identity Either.Right +instance Equalable Identity where + equal = Identity (Eq.==) +instance Listable Identity where + cons = Identity (:) + nil = Identity [] +instance Maybeable Identity where + nothing = Identity Maybe.Nothing + just = Identity Maybe.Just + +-- TH.CodeQ +instance Anythingable TH.CodeQ +instance Abstractable TH.CodeQ where + (.@) f x = [|| $$f $$x ||] + lam f = [|| \x -> $$(f [||x||]) ||] + lam1 = lam + var = Fun.id + id = [|| \x -> x ||] + const = [|| Fun.const ||] + flip = [|| \f x y -> f y x ||] + ($) = [|| (Fun.$) ||] + (.) = [|| (Fun..) ||] +instance TH.Lift c => Constantable c TH.CodeQ where + constant c = [|| c ||] +instance Eitherable TH.CodeQ where + left = [|| Either.Left ||] + right = [|| Either.Right ||] +instance Equalable TH.CodeQ where + equal = [|| (Eq.==) ||] +instance Listable TH.CodeQ where + cons = [|| (:) ||] + nil = [|| [] ||] +instance Maybeable TH.CodeQ where + nothing = [|| Maybe.Nothing ||] + just = [|| Maybe.Just ||] diff --git a/src/Symantic/Parser/Grammar/View.hs b/src/Symantic/Parser/Grammar/View.hs index 0999df1..2d7545e 100644 --- a/src/Symantic/Parser/Grammar/View.hs +++ b/src/Symantic/Parser/Grammar/View.hs @@ -8,14 +8,17 @@ import Data.Semigroup (Semigroup(..)) import Data.String (String) import Data.Tuple (fst) import Text.Show (Show(..)) -import qualified Control.Applicative as Fct import qualified Data.Functor as Functor import qualified Data.HashMap.Strict as HM import qualified Data.List as List import qualified Data.Tree as Tree import Symantic.Univariant.Letable +import qualified Symantic.Univariant.Trans as Sym +import qualified Symantic.Univariant.Data as Sym +import qualified Symantic.Univariant.View as Sym import Symantic.Parser.Grammar.Combinators +import qualified Symantic.Parser.Grammar.Production as Prod -- * Type 'ViewGrammar' newtype ViewGrammar (showName::Bool) a = ViewGrammar { unViewGrammar :: @@ -46,7 +49,7 @@ instance CombAlternable (ViewGrammar sN) where try x = ViewGrammar $ Tree.Node ("try", "") [unViewGrammar x] instance CombApplicable (ViewGrammar sN) where _f <$> x = ViewGrammar $ Tree.Node ("<$>", "") [unViewGrammar x] - pure a = ViewGrammar $ Tree.Node ("pure "<>showsPrec 10 a "", "") [] + pure a = ViewGrammar $ Tree.Node ("pure "{-FIXME: <>showsPrec 10 a ""-}, "") [] x <*> y = ViewGrammar $ Tree.Node ("<*>", "") [unViewGrammar x, unViewGrammar y] x <* y = ViewGrammar $ Tree.Node ("<*", "") [unViewGrammar x, unViewGrammar y] x *> y = ViewGrammar $ Tree.Node ("*>", "") [unViewGrammar x, unViewGrammar y] @@ -81,7 +84,7 @@ instance CombLookable (ViewGrammar sN) where instance CombMatchable (ViewGrammar sN) where conditional a _ps bs b = ViewGrammar $ Tree.Node ("conditional", "") [ unViewGrammar a - , Tree.Node ("branches", "") (unViewGrammar Fct.<$> bs) + , Tree.Node ("branches", "") (unViewGrammar Functor.<$> bs) , unViewGrammar b ] instance CombSatisfiable tok (ViewGrammar sN) where diff --git a/src/Symantic/Parser/Haskell.hs b/src/Symantic/Parser/Haskell.hs deleted file mode 100644 index 468ebe3..0000000 --- a/src/Symantic/Parser/Haskell.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Symantic.Parser.Haskell - ( module Symantic.Parser.Haskell.Optimize - , module Symantic.Parser.Haskell.Term - , module Symantic.Parser.Haskell.View - ) where -import Symantic.Parser.Haskell.Optimize -import Symantic.Parser.Haskell.Term -import Symantic.Parser.Haskell.View diff --git a/src/Symantic/Parser/Haskell/Optimize.hs b/src/Symantic/Parser/Haskell/Optimize.hs index d6022b0..d3e6e74 100644 --- a/src/Symantic/Parser/Haskell/Optimize.hs +++ b/src/Symantic/Parser/Haskell/Optimize.hs @@ -94,101 +94,3 @@ optimizeTerm = nor Lam1 f -> whnf (f y) x' -> x' :@ y x -> x - -instance Trans (Term Identity) Identity where - trans = \case - Cons -> cons - Char t -> char t - Eq -> eq - Term repr -> repr - x :@ y -> Identity (runIdentity (trans x) (runIdentity (trans y))) - Lam f -> Identity (runIdentity Fun.. trans Fun.. f Fun.. Term Fun.. Identity) - Lam1 f -> trans (Lam f) - Var{} -> undefined - {- - Const -> const - Flip -> flip - Id -> id - (:$) -> ($) - -} -instance Trans (Term TH.CodeQ) TH.CodeQ where - -- Superfluous pattern-matches are only here - -- for cosmetic concerns when reading *.dump-splices, - -- not for optimizing, which is done in 'optimizeTerm'. - trans = \case - Cons :@ x :@ y -> [|| $$(trans x) : $$(trans y) ||] - Cons :@ x -> [|| ($$(trans x) :) ||] - Cons -> cons - Char t -> char t - Eq :@ x :@ y -> [|| $$(trans x) Eq.== $$(trans y) ||] - Eq :@ x -> [|| ($$(trans x) Eq.==) ||] - Eq -> eq - Term repr -> repr - -- (:$) :@ x -> [|| ($$(trans x) Fun.$) ||] - -- (:.) :@ f :@ g -> [|| \xx -> $$(trans f) ($$(trans g) xx) ||] - -- (:.) :@ (:.) -> [|| \f x -> (\g y -> (f x) (g y)) ||] - -- (:.) :@ x :@ y -> [|| $$(trans x) Fun.. $$(trans y) ||] - -- (:.) :@ x -> [|| ($$(trans x) Fun..) ||] - -- (:.) :@ f -> [|| \g x -> $$(trans f) (g x) ||] - -- (:.) -> (.) - x :@ y -> [|| $$(trans x) $$(trans y) ||] - Lam f -> [|| \x -> $$(trans (f (Term [||x||]))) ||] - Lam1 f -> trans (Lam f) - Var{} -> undefined - {- - Const -> const - Flip -> flip - Id -> id - (:$) -> ($) - -} -instance Trans (Term ValueCode) ValueCode where - trans = \case - Term x -> x - Char c -> char c - Cons -> cons - Eq -> eq - (:@) f x -> (.@) (trans f) (trans x) - Lam f -> ValueCode - { value = value Fun.. trans Fun.. f Fun.. Term Fun.. (`ValueCode` undefined) - , code = [|| \x -> $$(code Fun.. trans Fun.. f Fun.. Term Fun.. (undefined `ValueCode`) Fun.$ [||x||]) ||] - } - Lam1 f -> trans (Lam f) - Var{} -> undefined - {- - Const -> const - Flip -> flip - Id -> id - (:$) -> ($) - -} -instance Trans (Term ValueCode) (Term TH.CodeQ) where - trans = \case - Term x -> Term (code x) - Char c -> char c - Cons -> cons - Eq -> eq - (:@) f x -> (.@) (trans f) (trans x) - Lam f -> Lam (\x -> trans (f (trans x))) - Lam1 f -> Lam1 (\x -> trans (f (trans x))) - Var v -> Var v - {- - Const -> const - Flip -> flip - Id -> id - (:$) -> ($) - -} -instance Trans (Term TH.CodeQ) (Term ValueCode) where - trans = \case - Term x -> Term (ValueCode undefined x) - Char c -> char c - Cons -> cons - Eq -> eq - (:@) f x -> (.@) (trans f) (trans x) - Lam f -> Lam (\x -> trans (f (trans x))) - Lam1 f -> Lam1 (\x -> trans (f (trans x))) - Var v -> Var v - {- - Const -> const - Flip -> flip - Id -> id - (:$) -> ($) - -} diff --git a/src/Symantic/Parser/Haskell/Term.hs b/src/Symantic/Parser/Haskell/Term.hs index 00c8c44..eca628a 100644 --- a/src/Symantic/Parser/Haskell/Term.hs +++ b/src/Symantic/Parser/Haskell/Term.hs @@ -5,6 +5,7 @@ module Symantic.Parser.Haskell.Term where import Data.Bool (Bool(..)) +import Data.Char (Char) import Data.Either (Either(..)) import Data.Eq (Eq) import Data.Maybe (Maybe(..)) @@ -16,179 +17,109 @@ import qualified Data.Function as Fun import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH -import qualified Symantic.Univariant.Trans as Sym - --- * Class 'Termable' --- | Single-out some Haskell terms in order to -class Termable repr where +import Symantic.Univariant.Trans +{- +class Abstractable repr where -- | Application, aka. unabstract. - (.@) :: repr (a->b) -> repr a -> repr b + (.@) :: repr (a->b) -> repr a -> repr b; infixl 9 .@ -- | Lambda term abstraction, in HOAS (Higher-Order Abstract Syntax) style. lam :: (repr a -> repr b) -> repr (a->b) -- | Like 'lam' but whose argument is used only once, -- hence safe to beta-reduce (inline) without duplicating work. lam1 :: (repr a -> repr b) -> repr (a->b) - - -- Singled-out terms - bool :: Bool -> repr Bool - char :: (TH.Lift tok, Show tok) => tok -> repr tok - cons :: repr (a -> [a] -> [a]) - nil :: repr [a] - eq :: Eq a => repr (a -> a -> Bool) - unit :: repr () - left :: repr (l -> Either l r) - right :: repr (r -> Either l r) - nothing :: repr (Maybe a) - just :: repr (a -> Maybe a) const :: repr (a -> b -> a) flip :: repr ((a -> b -> c) -> b -> a -> c) id :: repr (a->a) - (.) :: repr ((b->c) -> (a->b) -> a -> c) - ($) :: repr ((a->b) -> a -> b) - + (.) :: repr ((b->c) -> (a->b) -> a -> c); infixr 9 . + ($) :: repr ((a->b) -> a -> b); infixr 0 $ default (.@) :: - Sym.Liftable2 repr => Termable (Sym.Output repr) => + Liftable2 repr => Abstractable (Output repr) => repr (a->b) -> repr a -> repr b default lam :: - Sym.Liftable repr => Sym.Unliftable repr => Termable (Sym.Output repr) => + Liftable repr => Unliftable repr => Abstractable (Output repr) => (repr a -> repr b) -> repr (a->b) default lam1 :: - Sym.Liftable repr => Sym.Unliftable repr => Termable (Sym.Output repr) => + Liftable repr => Unliftable repr => Abstractable (Output repr) => (repr a -> repr b) -> repr (a->b) + default const :: + Liftable repr => Abstractable (Output repr) => + repr (a -> b -> a) + default flip :: + Liftable repr => Abstractable (Output repr) => + repr ((a -> b -> c) -> b -> a -> c) + default id :: + Liftable repr => Abstractable (Output repr) => + repr (a->a) + default (.) :: + Liftable repr => Abstractable (Output repr) => + repr ((b->c) -> (a->b) -> a -> c) + default ($) :: + Liftable repr => Abstractable (Output repr) => + repr ((a->b) -> a -> b) + (.@) = lift2 (.@) + lam f = lift (lam (trans Fun.. f Fun.. trans)) + lam1 f = lift (lam1 (trans Fun.. f Fun.. trans)) + const = lift const + flip = lift flip + id = lift id + (.) = lift (.) + ($) = lift ($) +class Boolable repr where + bool :: Bool -> repr Bool default bool :: - Sym.Liftable repr => Termable (Sym.Output repr) => + Liftable repr => Boolable (Output repr) => Bool -> repr Bool + bool = lift Fun.. bool +class Charable repr where + char :: Char -> repr Char default char :: - Sym.Liftable repr => Termable (Sym.Output repr) => - TH.Lift tok => Show tok => - tok -> repr tok - default cons :: - Sym.Liftable repr => Termable (Sym.Output repr) => - repr (a -> [a] -> [a]) - default nil :: - Sym.Liftable repr => Termable (Sym.Output repr) => - repr [a] - default eq :: - Sym.Liftable repr => Termable (Sym.Output repr) => - Eq a => repr (a -> a -> Bool) - default unit :: - Sym.Liftable repr => Termable (Sym.Output repr) => - repr () + Liftable repr => Charable (Output repr) => + Char -> repr Char + char = lift Fun.. char +class Eitherable repr where + left :: repr (l -> Either l r) + right :: repr (r -> Either l r) default left :: - Sym.Liftable repr => Termable (Sym.Output repr) => + Liftable repr => Eitherable (Output repr) => repr (l -> Either l r) default right :: - Sym.Liftable repr => Termable (Sym.Output repr) => + Liftable repr => Eitherable (Output repr) => repr (r -> Either l r) + left = lift left + right = lift right +class Equalable repr where + eq :: Eq a => repr (a -> a -> Bool) + default eq :: + Liftable repr => Equalable (Output repr) => + Eq a => repr (a -> a -> Bool) + eq = lift eq +class Listable repr where + cons :: repr (a -> [a] -> [a]) + nil :: repr [a] + default cons :: + Liftable repr => Listable (Output repr) => + repr (a -> [a] -> [a]) + default nil :: + Liftable repr => Listable (Output repr) => + repr [a] + cons = lift cons + nil = lift nil +class Maybeable repr where + nothing :: repr (Maybe a) + just :: repr (a -> Maybe a) default nothing :: - Sym.Liftable repr => Termable (Sym.Output repr) => + Liftable repr => Maybeable (Output repr) => repr (Maybe a) default just :: - Sym.Liftable repr => Termable (Sym.Output repr) => + Liftable repr => Maybeable (Output repr) => repr (a -> Maybe a) - default const :: - Sym.Liftable repr => Termable (Sym.Output repr) => - repr (a -> b -> a) - default flip :: - Sym.Liftable repr => Termable (Sym.Output repr) => - repr ((a -> b -> c) -> b -> a -> c) - default id :: - Sym.Liftable repr => Termable (Sym.Output repr) => - repr (a->a) - default (.) :: - Sym.Liftable repr => Termable (Sym.Output repr) => - repr ((b->c) -> (a->b) -> a -> c) - default ($) :: - Sym.Liftable repr => Termable (Sym.Output repr) => - repr ((a->b) -> a -> b) - - (.@) = Sym.lift2 (.@) - lam f = Sym.lift (lam (Sym.trans Fun.. f Fun.. Sym.trans)) - lam1 f = Sym.lift (lam1 (Sym.trans Fun.. f Fun.. Sym.trans)) - bool = Sym.lift Fun.. bool - char = Sym.lift Fun.. char - cons = Sym.lift cons - nil = Sym.lift nil - eq = Sym.lift eq - unit = Sym.lift unit - left = Sym.lift left - right = Sym.lift right - nothing = Sym.lift nothing - just = Sym.lift just - const = Sym.lift const - flip = Sym.lift flip - id = Sym.lift id - (.) = Sym.lift (.) - ($) = Sym.lift ($) -infixr 0 $ -infixr 9 . -infixl 9 .@ + nothing = lift nothing + just = lift just +class Unitable repr where + unit :: repr () + default unit :: + Liftable repr => Unitable (Output repr) => + repr () + unit = lift unit --- * Type 'ValueCode' -data ValueCode a = ValueCode - { value :: a - , code :: TH.CodeQ a - } -instance Termable ValueCode where - f .@ x = ValueCode - { value = runIdentity (Identity (value f) .@ (Identity (value x))) - , code = code f .@ code x - } - lam f = ValueCode - { value = runIdentity (lam (Identity Fun.. value Fun.. f Fun.. (`ValueCode` undefined) Fun.. runIdentity)) - , code = lam (code Fun.. f Fun.. ValueCode undefined) - } - lam1 = lam - bool b = ValueCode (runIdentity (bool b)) (bool b) - char c = ValueCode (runIdentity (char c)) (char c) - cons = ValueCode (runIdentity cons) cons - nil = ValueCode (runIdentity nil) nil - eq = ValueCode (runIdentity eq) eq - unit = ValueCode (runIdentity unit) unit - left = ValueCode (runIdentity left) left - right = ValueCode (runIdentity right) right - nothing = ValueCode (runIdentity nothing) nothing - just = ValueCode (runIdentity just) just - const = ValueCode (runIdentity const) const - flip = ValueCode (runIdentity flip) flip - id = ValueCode (runIdentity id) id - ($) = ValueCode (runIdentity ($)) ($) - (.) = ValueCode (runIdentity (.)) (.) -instance Termable Identity where - f .@ x = Identity (runIdentity f (runIdentity x)) - lam f = Identity (runIdentity Fun.. f Fun.. Identity) - lam1 = lam - bool = Identity - char = Identity - cons = Identity (:) - nil = Identity [] - eq = Identity (Eq.==) - unit = Identity () - left = Identity Left - right = Identity Right - nothing = Identity Nothing - just = Identity Just - const = Identity Fun.const - flip = Identity Fun.flip - id = Identity Fun.id - ($) = Identity (Fun.$) - (.) = Identity (Fun..) -instance Termable TH.CodeQ where - (.@) f x = [|| $$f $$x ||] - lam f = [|| \x -> $$(f [||x||]) ||] - lam1 = lam - bool b = [|| b ||] - char c = [|| c ||] - cons = [|| (:) ||] - nil = [|| [] ||] - eq = [|| (Eq.==) ||] - unit = [|| () ||] - left = [|| Left ||] - right = [|| Right ||] - nothing = [|| Nothing ||] - just = [|| Just ||] - const = [|| Fun.const ||] - id = [|| \x -> x ||] - flip = [|| \f x y -> f y x ||] - ($) = [|| (Fun.$) ||] - (.) = [|| (Fun..) ||] +-} diff --git a/src/Symantic/Parser/Haskell/View.hs b/src/Symantic/Parser/Haskell/View.hs deleted file mode 100644 index 38a4ca1..0000000 --- a/src/Symantic/Parser/Haskell/View.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Symantic.Parser.Haskell.View where - -import Data.Bool -import Data.Function (($), (.)) -import Data.Int (Int) -import Data.Semigroup (Semigroup(..)) -import Data.String (IsString(..), String) -import Prelude ((+)) -import Text.Show (Show(..), ShowS, shows, showParen, showString) -import qualified Data.Function as Fun - -import Symantic.Parser.Grammar.Fixity -import qualified Symantic.Parser.Haskell.Optimize as H - --- * Type 'ViewTerm' -newtype ViewTerm a = ViewTerm { unViewTerm :: - ViewTermInh -> ShowS } - -instance IsString (ViewTerm a) where - fromString s = ViewTerm $ \_inh -> showString s - --- ** Type 'ViewTermInh' -data ViewTermInh - = ViewTermInh - { viewTermInh_op :: (Infix, Side) - , viewTermInh_pair :: Pair - , viewTermInh_lamDepth :: Int - } - -pairViewTerm :: ViewTermInh -> Infix -> ShowS -> ShowS -pairViewTerm inh op s = - if isPairNeeded (viewTermInh_op inh) op - then showString o . s . showString c - else s - where (o,c) = viewTermInh_pair inh - -instance Show (ViewTerm a) where - showsPrec p v = unViewTerm v ViewTermInh - { viewTermInh_op = (infixN p, SideL) - , viewTermInh_pair = pairParen - , viewTermInh_lamDepth = 1 - } -instance Show (H.Term repr a) where - showsPrec p = showsPrec p . go - where - go :: forall b. H.Term repr b -> ViewTerm b - go = \case - H.Term{} -> "Term" - {- - (H.:.) H.:@ f H.:@ g -> ViewTerm $ \inh -> - pairViewTerm inh op Fun.$ - unViewTerm (go f) inh{viewTermInh_op=op} Fun.. - showString " . " Fun.. - unViewTerm (go g) inh{viewTermInh_op=op} - where op = infixR 9 - (H.:.) -> "(.)" - -} - {- - H.Char t -> ViewTerm $ \_inh -> - showString "(char " . - shows t . - showString ")" - -} - H.Char t -> ViewTerm $ \_inh -> shows t - H.Cons H.:@ x H.:@ xs -> ViewTerm $ \inh -> - pairViewTerm inh op Fun.$ - unViewTerm (go x) inh{viewTermInh_op=(op, SideL)} Fun.. - showString " : " Fun.. - unViewTerm (go xs) inh{viewTermInh_op=(op, SideR)} - where op = infixN 5 - H.Cons -> "cons" - H.Eq H.:@ x H.:@ y -> ViewTerm $ \inh -> - pairViewTerm inh op Fun.$ - unViewTerm (go x) inh{viewTermInh_op=(op, SideL)} Fun.. - showString " == " Fun.. - unViewTerm (go y) inh{viewTermInh_op=(op, SideR)} - where op = infixN 4 - H.Eq H.:@ x -> ViewTerm $ \inh -> - showParen True Fun.$ - unViewTerm (go x) inh{viewTermInh_op=(op, SideL)} Fun.. - showString " ==" - where op = infixN 4 - H.Eq -> "(==)" - H.Var v -> fromString v - H.Lam1 f -> viewLam "u" f - H.Lam f -> viewLam "x" f - f H.:@ x -> ViewTerm $ \inh -> - pairViewTerm inh op $ - unViewTerm (go f) inh{viewTermInh_op = (op, SideL) } . - -- showString " :@ " . - showString " " . - unViewTerm (go x) inh{viewTermInh_op = (op, SideR) } - where op = infixN 10 - {- - H.Const -> "const" - H.Flip -> "flip" - H.Id -> "id" - (H.:$) -> "($)" - -} - viewLam :: forall b c. String -> (H.Term repr b -> H.Term repr c) -> ViewTerm (b -> c) - viewLam v f = ViewTerm $ \inh -> - pairViewTerm inh op $ - let x = v<>show (viewTermInh_lamDepth inh) in - -- showString "Lam1 (" . - showString "\\" . showString x . showString " -> " . - (unViewTerm (go (f (H.Var x))) inh - { viewTermInh_op = (op, SideL) - , viewTermInh_lamDepth = viewTermInh_lamDepth inh + 1 - }) - -- . showString ")" - where op = infixN 0 diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs index b3875a9..1a62fcb 100644 --- a/src/Symantic/Parser/Machine/Generate.hs +++ b/src/Symantic/Parser/Machine/Generate.hs @@ -47,15 +47,18 @@ import qualified Language.Haskell.TH.Syntax as TH import Symantic.Univariant.Letable import Symantic.Univariant.Trans +import Symantic.Univariant.Optim import Symantic.Parser.Grammar.Combinators (Exception(..), Failure(..), SomeFailure(..), inputTokenProxy) import Symantic.Parser.Machine.Input import Symantic.Parser.Machine.Instructions +import qualified Symantic.Parser.Grammar.Production as Prod import qualified Language.Haskell.TH.HideName as TH -import qualified Symantic.Parser.Haskell as H +import qualified Symantic.Univariant.Data as H +import qualified Symantic.Univariant.Lang as H --import Debug.Trace -genCode :: TermInstr a -> CodeQ a +genCode :: Splice a -> CodeQ a genCode = trans -- * Type 'Gen' @@ -265,7 +268,7 @@ data GenCtx inp vs a = data ValueStack vs where ValueStackEmpty :: ValueStack '[] ValueStackCons :: - { valueStackHead :: TermInstr v + { valueStackHead :: Splice v , valueStackTail :: ValueStack vs } -> ValueStack (v ': vs) @@ -282,7 +285,7 @@ instance InstrValuable Gen where { unGen = \ctx -> {-trace "unGen.lift2Value" $-} unGen k ctx { valueStack = let ValueStackCons y (ValueStackCons x vs) = valueStack ctx in - ValueStackCons (f H.:@ x H.:@ y) vs + ValueStackCons (f H..@ x H..@ y) vs } } swapValue k = k @@ -300,8 +303,8 @@ instance InstrBranchable Gen where let ValueStackCons v vs = valueStack ctx in [|| case $$(genCode v) of - Left x -> $$(unGen kx ctx{ valueStack = ValueStackCons (H.Term [||x||]) vs }) - Right y -> $$(unGen ky ctx{ valueStack = ValueStackCons (H.Term [||y||]) vs }) + Left x -> $$(unGen kx ctx{ valueStack = ValueStackCons (splice [||x||]) vs }) + Right y -> $$(unGen ky ctx{ valueStack = ValueStackCons (splice [||y||]) vs }) ||] } choicesBranch fs ks kd = Gen @@ -313,7 +316,7 @@ instance InstrBranchable Gen where } where go ctx x (f:fs') (k:ks') = [|| - if $$(genCode (H.optimizeTerm (f H.:@ x))) + if $$(genCode (normalOrderReduction (f H..@ x))) then let _ = "choicesBranch.then" in $$({-trace "unGen.choicesBranch.k" $-} unGen k ctx) @@ -380,7 +383,7 @@ instance InstrExceptionable Gen where -- as they were when entering 'catch', -- they will be available to 'loadInput', if any. { valueStack = - ValueStackCons (H.Term (input ctx)) $ + ValueStackCons (splice (input ctx)) $ --ValueStackCons (H.Term [||exn||]) $ valueStack ctx , horizonStack = @@ -418,7 +421,7 @@ instance InstrInputable Gen where { unGen = \ctx -> {-trace "unGen.pushInput" $-} unGen k ctx - { valueStack = H.Term (input ctx) `ValueStackCons` valueStack ctx + { valueStack = splice (input ctx) `ValueStackCons` valueStack ctx , horizonStack = checkedHorizon ctx : horizonStack ctx } } @@ -588,7 +591,7 @@ generateSuspend k ctx = [|| let _ = $$(liftTypedString $ "suspend") in \farInp farExp v !inp -> $$({-trace "unGen.generateSuspend" $-} unGen k ctx - { valueStack = ValueStackCons ({-trace "unGen.generateSuspend.value" $-} H.Term [||v||]) (valueStack ctx) + { valueStack = ValueStackCons ({-trace "unGen.generateSuspend.value" $-} splice [||v||]) (valueStack ctx) , input = [||inp||] , farthestInput = [||farInp||] , farthestExpecting = [||farExp||] @@ -613,8 +616,8 @@ generateResume k = Gen $$k $$(farthestInput ctx) $$(farthestExpecting ctx) - (let _ = "resume.genCode" in $$({-trace "unGen.generateResume.genCode" $-} genCode $ H.optimizeTerm $ - valueStackHead $ valueStack ctx)) + (let _ = "resume.genCode" in $$({-trace "unGen.generateResume.genCode" $-} + genCode $ normalOrderReduction $ valueStackHead $ valueStack ctx)) $$(input ctx) ||] } @@ -629,7 +632,7 @@ instance InstrJoinable Gen where -- Called by 'generateResume'. \farInp farExp v !inp -> $$({-trace ("unGen.defJoin.next: "<>show n) $-} unGen sub ctx - { valueStack = ValueStackCons (H.Term [||v||]) (valueStack ctx) + { valueStack = ValueStackCons (splice [||v||]) (valueStack ctx) , input = [||inp||] , farthestInput = [||farInp||] , farthestExpecting = [||farExp||] @@ -755,7 +758,7 @@ finalGenAnalysis ctx k = checkToken :: Set SomeFailure -> - {-predicate-}TermInstr (InputToken inp -> Bool) -> + {-predicate-}Splice (InputToken inp -> Bool) -> {-ok-}Gen inp (InputToken inp ': vs) a -> Gen inp vs a checkToken fs p ok = ok @@ -763,7 +766,7 @@ checkToken fs p ok = ok let !(# c, cs #) = $$(nextInput ctx) $$(input ctx) in if $$(genCode p) c then $$(unGen ok ctx - { valueStack = ValueStackCons (H.Term [||c||]) (valueStack ctx) + { valueStack = ValueStackCons (splice [||c||]) (valueStack ctx) , input = [||cs||] }) else let _ = "checkToken.else" in diff --git a/src/Symantic/Parser/Machine/Instructions.hs b/src/Symantic/Parser/Machine/Instructions.hs index 331c0a1..f92bb41 100644 --- a/src/Symantic/Parser/Machine/Instructions.hs +++ b/src/Symantic/Parser/Machine/Instructions.hs @@ -12,15 +12,21 @@ import Data.Eq (Eq(..)) import Data.Function ((.)) import Data.Kind (Type) import Data.Set (Set) -import Text.Show (Show(..)) +import Text.Show (Show(..), showString) import qualified Language.Haskell.TH as TH -import qualified Symantic.Parser.Haskell as H import Symantic.Parser.Grammar import Symantic.Parser.Machine.Input +import qualified Symantic.Univariant.Lang as H +import qualified Symantic.Univariant.Data as Sym --- * Type 'TermInstr' -type TermInstr = H.Term TH.CodeQ +-- * Type 'Splice' +type Splice = Sym.SomeData TH.CodeQ +instance Show (Splice a) where + showsPrec _p _ = showString "" + +splice :: TH.CodeQ a -> Splice a +splice x = Sym.SomeData (Sym.Var x) -- ** Type 'ReprInstr' type ReprInstr = {-input-}Type -> {-valueStack-}[Type] -> {-a-}Type -> Type @@ -38,7 +44,7 @@ class InstrValuable (repr::ReprInstr) where -- | @('pushValue' x k)@ pushes @(x)@ on the 'valueStack' -- and continues with the next 'Instr'uction @(k)@. pushValue :: - TermInstr v -> + Splice v -> repr inp (v ': vs) a -> repr inp vs a -- | @('popValue' k)@ pushes @(x)@ on the 'valueStack'. @@ -48,7 +54,7 @@ class InstrValuable (repr::ReprInstr) where -- | @('lift2Value' f k)@ pops two values from the 'valueStack', -- and pushes the result of @(f)@ applied to them. lift2Value :: - TermInstr (x -> y -> z) -> + Splice (x -> y -> z) -> repr inp (z ': vs) a -> repr inp (y ': x ': vs) a -- | @('swapValue' k)@ pops two values on the 'valueStack', @@ -59,7 +65,7 @@ class InstrValuable (repr::ReprInstr) where repr inp (y ': x ': vs) a -- | @('mapValue' f k)@. mapValue :: - TermInstr (x -> y) -> + Splice (x -> y) -> repr inp (y ': vs) a -> repr inp (x ': vs) a mapValue f = pushValue f . lift2Value (H.flip H..@ (H.$)) @@ -102,7 +108,7 @@ class InstrBranchable (repr::ReprInstr) where repr inp (Either x y ': vs) r -- | @('choicesBranch' ps bs d)@. choicesBranch :: - [TermInstr (v -> Bool)] -> + [Splice (v -> Bool)] -> [repr inp vs a] -> repr inp vs a -> repr inp (v ': vs) a @@ -168,6 +174,6 @@ class InstrReadable (tok::Type) (repr::ReprInstr) where read :: tok ~ InputToken inp => Set SomeFailure -> - TermInstr (tok -> Bool) -> + Splice (tok -> Bool) -> repr inp (tok ': vs) a -> repr inp vs a diff --git a/src/Symantic/Parser/Machine/Optimize.hs b/src/Symantic/Parser/Machine/Optimize.hs index 3413b16..8da5363 100644 --- a/src/Symantic/Parser/Machine/Optimize.hs +++ b/src/Symantic/Parser/Machine/Optimize.hs @@ -22,13 +22,14 @@ import Symantic.Parser.Machine.Input import Symantic.Parser.Machine.Instructions import Symantic.Univariant.Trans +import Debug.Trace + -- * Data family 'Instr' -- | 'Instr'uctions of the 'Machine'. -- This is an extensible data-type. data family Instr (instr :: ReprInstr -> Constraint) - (repr :: ReprInstr) - :: ReprInstr + :: ReprInstr -> ReprInstr -- | Convenient utility to pattern-match a 'SomeInstr'. pattern Instr :: Typeable comb => @@ -74,14 +75,14 @@ unSomeInstr (SomeInstr (i::Instr i repr inp vs a)) = -- InstrValuable data instance Instr InstrValuable repr inp vs a where PushValue :: - TermInstr v -> + Splice v -> SomeInstr repr inp (v ': vs) a -> Instr InstrValuable repr inp vs a PopValue :: SomeInstr repr inp vs a -> Instr InstrValuable repr inp (v ': vs) a Lift2Value :: - TermInstr (x -> y -> z) -> + Splice (x -> y -> z) -> SomeInstr repr inp (z : vs) a -> Instr InstrValuable repr inp (y : x : vs) a SwapValue :: @@ -89,7 +90,7 @@ data instance Instr InstrValuable repr inp vs a where Instr InstrValuable repr inp (y ': x ': vs) a instance InstrValuable repr => Trans (Instr InstrValuable repr inp vs) (repr inp vs) where trans = \case - PushValue x k -> pushValue x (trans k) + PushValue x k -> trace "trans.pushValue" (pushValue x (trans k)) PopValue k -> popValue (trans k) Lift2Value f k -> lift2Value f (trans k) SwapValue k -> swapValue (trans k) @@ -136,7 +137,7 @@ data instance Instr InstrBranchable repr inp vs a where SomeInstr repr inp (y ': vs) a -> Instr InstrBranchable repr inp (Either x y ': vs) a ChoicesBranch :: - [TermInstr (v -> Bool)] -> + [Splice (v -> Bool)] -> [SomeInstr repr inp vs a] -> SomeInstr repr inp vs a -> Instr InstrBranchable repr inp (v ': vs) a @@ -213,7 +214,7 @@ instance InstrInputable repr => InstrInputable (SomeInstr repr) where data instance Instr (InstrReadable tok) repr inp vs a where Read :: Set SomeFailure -> - TermInstr (InputToken inp -> Bool) -> + Splice (InputToken inp -> Bool) -> SomeInstr repr inp (InputToken inp ': vs) a -> Instr (InstrReadable tok) repr inp vs a instance diff --git a/src/Symantic/Parser/Machine/Program.hs b/src/Symantic/Parser/Machine/Program.hs index 64f9663..4fed35a 100644 --- a/src/Symantic/Parser/Machine/Program.hs +++ b/src/Symantic/Parser/Machine/Program.hs @@ -23,13 +23,14 @@ import qualified Data.Set as Set import qualified Data.Traversable as Traversable import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH -import qualified Symantic.Parser.Haskell as H +import qualified Symantic.Univariant.Lang as H import Symantic.Parser.Grammar import Symantic.Parser.Machine.Input import Symantic.Parser.Machine.Instructions import Symantic.Parser.Machine.Optimize import Symantic.Univariant.Trans +import Debug.Trace -- * Type 'Program' -- | A 'Program' is a tree of 'Instr'uctions, @@ -85,7 +86,7 @@ instance Alt ExceptionFailure (Comb (SatisfyOrFail _fs p :: Comb (CombSatisfiable (InputToken inp)) (Program repr inp) a)) (Comb (Failure sf)) -> - Program $ return . read (Set.singleton sf) (trans p) + Program $ return . trace "trans.read" . read (Set.singleton sf) (trace "read.prodCode" (prodCode p)) Alt exn x y -> alt exn (trans x) (trans y) Empty -> empty Failure sf -> failure sf @@ -127,7 +128,7 @@ failIfConsumed :: SomeInstr repr inp (Cursor inp ': vs) ret failIfConsumed exn k = pushInput $ - lift2Value (H.Term sameOffset) $ + lift2Value (splice sameOffset) $ ifBranch k $ case exn of ExceptionLabel lbl -> raise lbl @@ -164,9 +165,9 @@ joinNext (Program m) = Program $ \case instance InstrValuable repr => CombApplicable (Program repr inp) where - pure x = Program $ return . pushValue (trans x) + pure x = Program $ return . pushValue (prodCode (trace "pushValue.prodCode" x)) Program f <*> Program x = Program $ (f <=< x) . applyValue - liftA2 f (Program x) (Program y) = Program $ (x <=< y) . lift2Value (trans f) + liftA2 f (Program x) (Program y) = Program $ (x <=< y) . lift2Value (prodCode f) Program x *> Program y = Program (x <=< return . popValue <=< y) Program x <* Program y = Program (x <=< y <=< return . popValue) instance @@ -242,13 +243,13 @@ instance ) => CombMatchable (Program repr inp) where conditional (Program a) ps bs (Program d) = joinNext $ Program $ \next -> do bs' <- Control.Monad.sequence $ (\(Program b) -> b next) Functor.<$> bs - a =<< liftM (choicesBranch (trans Functor.<$> ps) bs') (d next) + a =<< liftM (choicesBranch (prodCode Functor.<$> ps) bs') (d next) instance ( tok ~ InputToken inp , InstrReadable tok repr , Typeable tok ) => CombSatisfiable tok (Program repr inp) where - satisfyOrFail fs p = Program $ return . read fs (trans p) + satisfyOrFail fs p = Program $ return . read fs (trace "satisfyOrFail.read.prodCode" (prodCode p)) instance ( InstrBranchable repr , InstrJoinable repr diff --git a/src/Symantic/Univariant/Data.hs b/src/Symantic/Univariant/Data.hs new file mode 100644 index 0000000..10137b7 --- /dev/null +++ b/src/Symantic/Univariant/Data.hs @@ -0,0 +1,264 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +--{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +--{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- For Abstractable (SomeData repr) +{-# LANGUAGE ViewPatterns #-} +module Symantic.Univariant.Data where + +import Data.Kind +import Type.Reflection +import Data.Char (Char) +import Data.Bool (Bool) +import Data.Either (Either) +import Data.Maybe (Maybe) +import Data.Functor.Identity (Identity(..)) +import Data.String (String) +import Prelude (undefined) +import Text.Show (Show(..)) +import qualified Data.Eq as Eq +import qualified Data.Maybe as Maybe +import qualified Data.Function as Fun +import Data.Coerce + +import Symantic.Univariant.Lang +import Symantic.Univariant.Trans + +data SomeData repr a = + forall able. + ( Trans (Data able repr) repr + , Typeable able + ) => SomeData (Data able repr a) + +instance Trans (SomeData repr) repr where + trans (SomeData x) = trans x + +type UnivariantRepr = Type -> Type + +-- TODO: neither data families nor data instances +-- can have phantom roles with GHC-9's RoleAnnotations, +-- hence 'Data.Coerce.coerce' cannot be used on them for now. +-- https://gitlab.haskell.org/ghc/ghc/-/issues/8177 +-- https://gitlab.haskell.org/ghc/ghc/-/wikis/roles#proposal-roles-for-type-families +-- Would be useful for @Trans (Data able repr) (Data able repr')@ instances. +data family Data + (able :: UnivariantRepr -> Constraint) + :: UnivariantRepr -> UnivariantRepr +--instance Trans (Data able repr) (Data able repr) where +-- trans = Fun.id + +-- | Convenient utility to pattern-match a 'SomeData'. +pattern Data :: Typeable able => Data able repr a -> SomeData repr a +pattern Data x <- (unSomeData -> Maybe.Just x) + +{- +class TransUnit able where + -- | The 'Bottomable' constraint is needed when a @(repr)@ value + -- has to be constructed. + reprFromUnit :: Bottomable repr => Data able Unit a -> SomeData repr a + -- | The 'Bottomable' constraint is also needed here + -- to call 'reprFromUnit' in the 'Lam' case. + unitFromRepr :: Bottomable repr => Data able repr a -> SomeData Unit a + +coerceRepr :: + Bottomable repr => Bottomable repr' => + SomeData repr a -> SomeData repr' a +coerceRepr (SomeData r) = + case unitFromRepr r of + SomeData d -> reprFromUnit d +-} + +-- | @(unSomeData c :: 'Maybe' ('Data' able repr a))@ +-- extract the data-constructor from the given 'SomeData' +-- iif. it belongs to the @('Data' able repr a)@ data-instance. +unSomeData :: + forall able repr a. + Typeable able => + SomeData repr a -> Maybe (Data able repr a) +unSomeData (SomeData (c::Data c repr a)) = + case typeRep @able `eqTypeRep` typeRep @c of + Maybe.Just HRefl -> Maybe.Just c + Maybe.Nothing -> Maybe.Nothing + +-- Abstractable +data instance Data Abstractable repr a where + (:@) :: SomeData repr (a->b) -> SomeData repr a -> Data Abstractable repr b + Lam :: (SomeData repr a -> SomeData repr b) -> Data Abstractable repr (a->b) + Lam1 :: (SomeData repr a -> SomeData repr b) -> Data Abstractable repr (a->b) + Var :: repr a -> Data Abstractable repr a + -- FIXME: add constructors +instance + ( Abstractable repr + --, Trans (SomeData repr) repr + --, Trans repr (SomeData repr) + ) => Trans (Data Abstractable repr) repr where + trans = \case + f :@ x -> trans f .@ trans x + Lam f -> lam (\x -> trans (f (SomeData (Var x)))) + Lam1 f -> lam1 (\x -> trans (f (SomeData (Var x)))) + Var x -> var x +instance + ( Abstractable repr + --, Trans (SomeData repr) repr + --, Trans repr (SomeData repr) + ) => Abstractable (SomeData repr) where + f .@ x = SomeData (f :@ x) + lam f = SomeData (Lam f) + lam1 f = SomeData (Lam1 f) + var = Fun.id + ($) = lam1 (\f -> lam1 (\x -> f .@ x)) + (.) = lam1 (\f -> lam1 (\g -> lam1 (\x -> f .@ (g .@ x)))) + const = lam1 (\x -> lam1 (\_y -> x)) + flip = lam1 (\f -> lam1 (\x -> lam1 (\y -> f .@ y .@ x))) + id = lam1 (\x -> x) + +{- +instance + ( Abstractable repr + ) => + Abstractable (Data Abstractable repr) where + var = Var Fun.. SomeData + f .@ x = SomeData f :@ SomeData x + lam f = Lam (SomeData Fun.. f Fun.. Var) + lam1 f = Lam1 (SomeData Fun.. f Fun.. Var) + ($) = lam1 (\f -> lam1 (\x -> f .@ x)) + (.) = lam1 (\f -> lam1 (\g -> lam1 (\x -> f .@ (g .@ x)))) + const = lam1 (\x -> lam1 (\_y -> x)) + flip = lam1 (\f -> lam1 (\x -> lam1 (\y -> f .@ y .@ x))) + id = lam1 (\x -> x) +-} +{- +instance Bottomable repr => Morph (SomeData repr) (SomeData Unit) where + morph (SomeData x) = morph x +instance Bottomable repr => Morph (SomeData Unit) (SomeData repr) where + morph (SomeData x) = morph x +instance Abstractable Unit where + (.@) _f _x = Unit + lam _f = Unit + lam1 _f = Unit + ($) = Unit + (.) = Unit + const = Unit + flip = Unit + id = Unit +instance Abstractable (Data Abstractable Unit) where + f .@ x = SomeData f :@ SomeData x + lam f = Lam (\(SomeData x) -> SomeData (f (trans x))) + lam1 f = Lam1 (\(SomeData x) -> SomeData (f (trans x))) + ($) = ($) + (.) = (.) + const = const + flip = flip + id = id +-} + +-- Anythingable +data instance Data Anythingable repr a where + Anything :: repr a -> Data Anythingable repr a +instance + ( Anythingable repr + ) => + Trans (Data Anythingable repr) repr where + trans = \case + Anything x -> anything x +instance Anythingable (SomeData repr) +instance Anythingable (Data Anythingable repr) + +-- Bottomable +class Bottomable repr where + bottom :: repr a +data instance Data Bottomable repr a where + Bottom :: Data Bottomable repr a +instance Bottomable repr => Trans (Data Bottomable repr) repr where + trans Bottom{} = bottom + +-- Constantable +data instance Data (Constantable c) repr a where + Constant :: c -> Data (Constantable c) repr c +instance Constantable c repr => Trans (Data (Constantable c) repr) repr where + trans = \case + Constant x -> constant x +instance + ( Constantable c repr + , Typeable c + ) => Constantable c (SomeData repr) where + constant c = SomeData (Constant c) +instance Constantable c (Data (Constantable c) repr) where + constant = Constant + +-- Eitherable +data instance Data Eitherable repr a where + Left :: Data Eitherable repr (l -> Either l r) + Right :: Data Eitherable repr (r -> Either l r) +instance Eitherable repr => Trans (Data Eitherable repr) repr where + trans = \case + Left -> left + Right -> right +instance + ( Eitherable repr + ) => Eitherable (SomeData repr) where + left = SomeData Left + right = SomeData Right +instance Eitherable (Data Eitherable repr) where + left = Left + right = Right + +-- Equalable +data instance Data Equalable repr a where + Equal :: Eq.Eq a => Data Equalable repr (a -> a -> Bool) +instance Equalable repr => Trans (Data Equalable repr) repr where + trans = \case + Equal -> equal +instance + ( Equalable repr + ) => Equalable (SomeData repr) where + equal = SomeData Equal +instance Equalable (Data Equalable repr) where + equal = Equal + +-- Listable +data instance Data Listable repr a where + Cons :: Data Listable repr (a -> [a] -> [a]) + Nil :: Data Listable repr [a] +infixr 4 `Cons` +instance Listable repr => Trans (Data Listable repr) repr where + trans = \case + Cons -> cons + Nil -> nil +instance + ( Listable repr + ) => Listable (SomeData repr) where + cons = SomeData Cons + nil = SomeData Nil +instance Listable (Data Listable repr) where + cons = Cons + nil = Nil + +-- Maybeable +data instance Data Maybeable repr a where + Nothing :: Data Maybeable repr (Maybe a) + Just :: Data Maybeable repr (a -> Maybe a) +instance Maybeable repr => Trans (Data Maybeable repr) repr where + trans = \case + Nothing -> nothing + Just -> just +instance + ( Maybeable repr + ) => Maybeable (SomeData repr) where + nothing = SomeData Nothing + just = SomeData Just +instance Maybeable (Data Maybeable repr) where + nothing = Nothing + just = Just diff --git a/src/Symantic/Univariant/Lang.hs b/src/Symantic/Univariant/Lang.hs new file mode 100644 index 0000000..707a0c2 --- /dev/null +++ b/src/Symantic/Univariant/Lang.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE NoImplicitPrelude #-} +module Symantic.Univariant.Lang where + +import Data.Char (Char) +import Data.Bool (Bool(..)) +import Data.Either (Either(..)) +import Data.Eq (Eq) +import Data.Kind +import Data.Maybe (Maybe(..)) +import Prelude (undefined) +import Text.Show (Show(..)) +import qualified Data.Eq as Eq +import qualified Data.Function as Fun +import qualified Prelude + +import Symantic.Univariant.Trans + +class Abstractable repr where + -- | Application, aka. unabstract. + (.@) :: repr (a->b) -> repr a -> repr b; infixl 9 .@ + -- | Lambda term abstraction, in HOAS (Higher-Order Abstract Syntax) style. + lam :: (repr a -> repr b) -> repr (a->b) + -- | Like 'lam' but whose argument is used only once, + -- hence safe to beta-reduce (inline) without duplicating work. + lam1 :: (repr a -> repr b) -> repr (a->b) + const :: repr (a -> b -> a) + flip :: repr ((a -> b -> c) -> b -> a -> c) + id :: repr (a->a) + (.) :: repr ((b->c) -> (a->b) -> a -> c); infixr 9 . + ($) :: repr ((a->b) -> a -> b); infixr 0 $ + var :: repr a -> repr a + default (.@) :: + Liftable2 repr => Abstractable (Output repr) => + repr (a->b) -> repr a -> repr b + default lam :: + Liftable repr => Unliftable repr => Abstractable (Output repr) => + (repr a -> repr b) -> repr (a->b) + default lam1 :: + Liftable repr => Unliftable repr => Abstractable (Output repr) => + (repr a -> repr b) -> repr (a->b) + default const :: + Liftable repr => Abstractable (Output repr) => + repr (a -> b -> a) + default flip :: + Liftable repr => Abstractable (Output repr) => + repr ((a -> b -> c) -> b -> a -> c) + default id :: + Liftable repr => Abstractable (Output repr) => + repr (a->a) + default (.) :: + Liftable repr => Abstractable (Output repr) => + repr ((b->c) -> (a->b) -> a -> c) + default ($) :: + Liftable repr => Abstractable (Output repr) => + repr ((a->b) -> a -> b) + default var :: + Liftable1 repr => Abstractable (Output repr) => + repr a -> repr a + (.@) = lift2 (.@) + lam f = lift (lam (trans Fun.. f Fun.. trans)) + lam1 f = lift (lam1 (trans Fun.. f Fun.. trans)) + const = lift const + flip = lift flip + id = lift id + (.) = lift (.) + ($) = lift ($) + var = lift1 var +class Anythingable repr where + anything :: repr a -> repr a + anything = Fun.id +class Constantable c repr where + constant :: c -> repr c + default constant :: + Liftable repr => Constantable c (Output repr) => + c -> repr c + constant = lift Fun.. constant +bool = constant @Bool +char = constant @Char +unit = constant @() () +class Eitherable repr where + left :: repr (l -> Either l r) + right :: repr (r -> Either l r) + default left :: + Liftable repr => Eitherable (Output repr) => + repr (l -> Either l r) + default right :: + Liftable repr => Eitherable (Output repr) => + repr (r -> Either l r) + left = lift left + right = lift right +class Equalable repr where + equal :: Eq a => repr (a -> a -> Bool) + default equal :: + Liftable repr => Equalable (Output repr) => + Eq a => repr (a -> a -> Bool) + equal = lift equal +infix 4 `equal`, == +(==) = lam (\x -> lam (\y -> equal .@ x .@ y)) +class Listable repr where + cons :: repr (a -> [a] -> [a]) + nil :: repr [a] + default cons :: + Liftable repr => Listable (Output repr) => + repr (a -> [a] -> [a]) + default nil :: + Liftable repr => Listable (Output repr) => + repr [a] + cons = lift cons + nil = lift nil +class Maybeable repr where + nothing :: repr (Maybe a) + just :: repr (a -> Maybe a) + default nothing :: + Liftable repr => Maybeable (Output repr) => + repr (Maybe a) + default just :: + Liftable repr => Maybeable (Output repr) => + repr (a -> Maybe a) + nothing = lift nothing + just = lift just diff --git a/src/Symantic/Univariant/Optim.hs b/src/Symantic/Univariant/Optim.hs new file mode 100644 index 0000000..1c1e51c --- /dev/null +++ b/src/Symantic/Univariant/Optim.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} +module Symantic.Univariant.Optim where + +import Data.Kind +import Type.Reflection +import Data.Char (Char) +import Data.Bool (Bool(..)) +import Data.Maybe (Maybe(..)) +import Data.Functor.Identity (Identity(..)) +import Data.String (String) +import Prelude (undefined) +import Text.Show (Show(..)) +import qualified Data.Eq as Eq +import qualified Data.Function as Fun + +import Symantic.Univariant.Trans +import Symantic.Univariant.Lang +import Symantic.Univariant.Data + +-- | Beta-reduce the left-most outer-most lambda abstraction (aka. normal-order reduction), +-- but to avoid duplication of work, only those manually marked +-- as using their variable at most once. +-- +-- DOC: Demonstrating Lambda Calculus Reduction, Peter Sestoft, 2001, +-- https://www.itu.dk/people/sestoft/papers/sestoft-lamreduce.pdf +normalOrderReduction :: forall repr a. + Abstractable repr => + SomeData repr a -> SomeData repr a +normalOrderReduction = nor + where + -- | normal-order reduction + nor :: SomeData repr b -> SomeData repr b + nor = \case + Data (Lam f) -> lam (nor Fun.. f) + Data (Lam1 f) -> lam1 (nor Fun.. f) + Data (x :@ y) -> case whnf x of + Data (Lam1 f) -> nor (f y) + x' -> nor x' .@ nor y + x -> x + -- | weak-head normal-form + whnf :: SomeData repr b -> SomeData repr b + whnf = \case + Data (x :@ y) -> case whnf x of + Data (Lam1 f) -> whnf (f y) + x' -> x' .@ y + x -> x diff --git a/src/Symantic/Univariant/Trans.hs b/src/Symantic/Univariant/Trans.hs index 0f5636e..8ecd2e4 100644 --- a/src/Symantic/Univariant/Trans.hs +++ b/src/Symantic/Univariant/Trans.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-} -- For type class synonyms +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE DefaultSignatures #-} -- For adding Trans* constraints module Symantic.Univariant.Trans where @@ -11,9 +12,16 @@ import Data.Kind (Type) type family Output (repr :: Type -> Type) :: Type -> Type -- * Class 'Trans' --- | A 'trans'lation from an interpreter @(from)@ to an interpreter @(to)@. +-- | A 'trans'formation from an interpreter @(from)@ to an interpreter @(to)@. class Trans from to where trans :: from a -> to a +class MetaTrans some from to where + meta :: some from a -> some to a +{- +newtype Compo some repr a = Compo { getCompo :: some repr a } +type family UnSome s where + UnSome (some m) = +-} -- * Class 'BiTrans' -- | Convenient type class synonym. @@ -106,6 +114,7 @@ lift3 :: forall repr a b c d. lift3 = trans3 @(Output repr) {-# INLINE lift3 #-} +{- -- * Type 'Any' -- | A newtype to disambiguate the 'Trans' instance to any other interpreter when there is also one or more 'Trans's to other interpreters with a different interpretation than the generic one. newtype Any repr a = Any { unAny :: repr a } @@ -120,3 +129,4 @@ instance Trans repr (Any repr) where instance Trans1 repr (Any repr) instance Trans2 repr (Any repr) instance Trans3 repr (Any repr) +-} diff --git a/src/Symantic/Univariant/View.hs b/src/Symantic/Univariant/View.hs new file mode 100644 index 0000000..7a5283f --- /dev/null +++ b/src/Symantic/Univariant/View.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImplicitPrelude #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- For Show (SomeData a) +module Symantic.Univariant.View where + +import Data.Int (Int) +import Data.Semigroup (Semigroup(..)) +import Data.String +import Prelude (undefined) +import Text.Show +import Type.Reflection (Typeable) +import qualified Data.Function as Fun +import qualified Prelude + +import Symantic.Parser.Grammar.Fixity +import Symantic.Univariant.Lang +import Symantic.Univariant.Data +import Symantic.Univariant.Trans + +data View a where + View :: (ViewEnv -> ShowS) -> View a + ViewUnifix :: Unifix -> String -> String -> View (a -> b) + ViewInfix :: Infix -> String -> String -> View (a -> b -> c) + ViewApp :: View (b -> a) -> View b -> View a + +runView :: View a -> ViewEnv -> ShowS +runView (View f) env = f env +runView (ViewInfix _op name _infixName) env = showString name +runView (ViewApp f x) env = + pairView env op Fun.$ + runView f env{viewEnv_op = (op, SideL) } Fun.. + showString " " Fun.. + runView x env{viewEnv_op = (op, SideR) } + where op = infixN 10 + +type instance Output View = View +instance Trans View View where + trans = Fun.id + +instance IsString (View a) where + fromString s = View Fun.$ \_env -> showString s +instance Show (View a) where + showsPrec p (View v) = v ViewEnv + { viewEnv_op = (infixN p, SideL) + , viewEnv_pair = pairParen + , viewEnv_lamDepth = 1 + } +instance Show (SomeData View a) where + showsPrec p (SomeData x) = showsPrec p (trans @_ @View x) + +data ViewEnv + = ViewEnv + { viewEnv_op :: (Infix, Side) + , viewEnv_pair :: Pair + , viewEnv_lamDepth :: Int + } + +pairView :: ViewEnv -> Infix -> ShowS -> ShowS +pairView env op s = + if isPairNeeded (viewEnv_op env) op + then showString o Fun.. s Fun.. showString c + else s + where (o,c) = viewEnv_pair env + +instance Abstractable View where + var = Fun.id + lam f = viewLam "x" f + lam1 f = viewLam "u" f + ViewInfix op _name infixName .@ ViewApp x y = View Fun.$ \env -> + pairView env op Fun.$ + runView x env{viewEnv_op=(op, SideL)} Fun.. + showString " " Fun.. showString infixName Fun.. showString " " Fun.. + runView y env{viewEnv_op=(op, SideR)} + ViewInfix op name _infixName .@ x = View Fun.$ \env -> + showParen Prelude.True Fun.$ + runView x env{viewEnv_op=(op, SideL)} Fun.. + showString " " Fun.. showString name + f .@ x = ViewApp f x +viewLam :: String -> (View a -> View b) -> View (a -> b) +viewLam varPrefix f = View Fun.$ \env -> + pairView env op Fun.$ + let x = showString varPrefix Fun.. + showsPrec 0 (viewEnv_lamDepth env) in + -- showString "Lam1 (" . + showString "\\" Fun.. x Fun.. showString " -> " Fun.. + runView (f (View (\_env -> x))) env + { viewEnv_op = (op, SideL) + , viewEnv_lamDepth = Prelude.succ (viewEnv_lamDepth env) + } + -- . showString ")" + where + op = infixN 0 +instance Anythingable View +instance Bottomable View where + bottom = "" +instance Show c => Constantable c View where + constant c = View Fun.$ \_env -> shows c +instance Eitherable View where + left = "Left" + right = "Right" +instance Equalable View where + equal = ViewInfix (infixN 4) "(==)" "==" +instance Listable View where + cons = ViewInfix (infixR 5) "(:)" ":" + nil = "[]" +instance Maybeable View where + nothing = "Nothing" + just = "Just" diff --git a/symantic-parser.cabal b/symantic-parser.cabal index 3ba63b4..0865eb9 100644 --- a/symantic-parser.cabal +++ b/symantic-parser.cabal @@ -13,10 +13,10 @@ description: Selective Parser Combinators](https://icfp20.sigplan.org/details/icfp-2020-papers/20/Staged-Selective-Parser-Combinators). license: AGPL-3.0-or-later -author: Julien Moutinho -maintainer: Julien Moutinho -bug-reports: Julien Moutinho -copyright: Julien Moutinho +author: Julien Moutinho +maintainer: Julien Moutinho +bug-reports: https://mails.sourcephile.fr/inbox/symantic-parser +copyright: Julien Moutinho stability: experimental category: Parsing extra-doc-files: @@ -57,9 +57,10 @@ common boilerplate -Wincomplete-record-updates -Wpartial-fields -fhide-source-paths - -freverse-errors - ghc-prof-options: - -eventlog -fprof-auto -fprof-auto-calls + ---freverse-errors + -fprint-potential-instances + ghc-prof-options: -eventlog -fprof-auto + -- -fprof-auto-calls library import: boilerplate @@ -72,12 +73,9 @@ library Symantic.Parser.Grammar.Fixity Symantic.Parser.Grammar.ObserveSharing Symantic.Parser.Grammar.Optimize + Symantic.Parser.Grammar.Production Symantic.Parser.Grammar.View Symantic.Parser.Grammar.Write - Symantic.Parser.Haskell - Symantic.Parser.Haskell.Optimize - Symantic.Parser.Haskell.Term - Symantic.Parser.Haskell.View Symantic.Parser.Machine Symantic.Parser.Machine.Generate Symantic.Parser.Machine.Input @@ -85,8 +83,12 @@ library Symantic.Parser.Machine.Optimize Symantic.Parser.Machine.Program Symantic.Parser.Machine.View + Symantic.Univariant.Data + Symantic.Univariant.Lang Symantic.Univariant.Letable + Symantic.Univariant.Optim Symantic.Univariant.Trans + Symantic.Univariant.View default-extensions: BangPatterns, DataKinds, @@ -146,7 +148,8 @@ library parsers TypeApplications, TypeFamilies, TypeOperators - ghc-options: -O2 -ddump-to-file -ddump-simpl-stats -ddump-splices + ghc-options: -O2 + -- -ddump-to-file -ddump-simpl-stats -ddump-splices build-depends: symantic-parser, attoparsec >= 0.13, @@ -188,8 +191,7 @@ test-suite symantic-parser-test autogen-modules: Paths_symantic_parser ghc-options: -O2 - ghc-prof-options: - -fexternal-interpreter + ghc-prof-options: -fexternal-interpreter build-depends: symantic-parser, symantic-parser:parsers, @@ -235,9 +237,8 @@ benchmark symantic-parser-benchmark autogen-modules: Paths_symantic_parser default-extensions: - ghc-options: -O2 - ghc-prof-options: - -fexternal-interpreter + ghc-options: -O2 -fno-enable-th-splice-warnings + ghc-prof-options: -fexternal-interpreter build-depends: base >= 4.6 && < 5, symantic-parser, -- 2.44.1