diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,14 @@
+## symantic-parser-0.1.0.20210201
+
+* Add error reporting using the farthest position reached.
+* Add factoring of minimal input length checks ("horizon" checks).
+* Open data-types `Comb` and `Instr`
+  using a new technique based upon `data family` and `Typeable`.
+* Leverage symantics further more to simplify the optimization passes.
+* Rename some types and terms for clarity.
+* Fix reproductibility of unit tests by hidding unique names.
+* Add a few more tests.
+
 ## symantic-parser-0.0.0.20210102
 
 * Add missing golden tests in the Cabal tarball.
diff --git a/ReadMe.md b/ReadMe.md
--- a/ReadMe.md
+++ b/ReadMe.md
@@ -1,19 +1,21 @@
 ### Main differences with respect to `ParsleyHaskell`
 
-- Tagless-final and `DefaultSignatures` are used instead of tagfull-final to handle recursion schemes, this avoids constructing and deconstructing as much tags when transforming combinators or instructions.
-  And structures/simplifies the code by avoiding to define custom traversals (`traverseCombinator`) or custom fix-point data-types (`Fix4`) and associated utilities (`cata4`) when introducing new index-types. 
-  Note that the extensibility of combinators, a great feature of tagless-final, is not really achievable when using the optimizing pass which requires a comprehensive initial encoding.
+- 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 tagful-initial encoding to pattern-match syntaxes (aka. data-instances). This enable a very principled, yet flexible source code. Moreover `DefaultSignatures` are supplied to succinctly derive new semantics (aka. type-class-instances) using automatic `trans`formations.
 
-- No dependency on `dependent-map` by keeping observed sharing inside `def` and `ref` combinators, instead of passing by a `DMap`. Same for join-points, where `TemplateHaskell` names are also directly used instead of passing by a `DMap`.
+- Error messages based upon the farthest input position reached (not yet implemented in `ParsleyHaskell`).
 
-- No dependency on 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 only cosmetic, 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 in case their authors abandon them.
+- 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 analyis 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.
 
-- Error messages based upon the farthest input position reached (not yet implemented in `ParsleyHaskell`).
+- 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`).
+
 - License is `GPL-3.0-or-later` not `BSD-3-Clause`.
 
 ### Main goals
 
-- For me to better understand `ParsleyHaskell`, and find a manageable balance between simplicity of the codebase and features of the parser.
+- 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 parsing tree-like data structures (like XML or HTTP routes) instead of just string-like data structures, which I've done using `megaparsec`, but it 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](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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,138 @@
+{-# OPTIONS_GHC -Wall #-}
+module Main (main) where
+
+import Control.Monad
+
+import Data.List
+import Data.String
+
+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
+import System.FilePath
+
+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 = rootDir </> distPref
+                | 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 buildSingletonsBaseFile = testAutogenDir </> buildSingletonsBaseModule <.> "hs"
+    withLibLBI pkg lbi $ \_ libCLBI -> do
+      let libDeps = map fst $ componentPackageDeps libCLBI
+          pidx = case dependencyClosure (installedPkgs lbi) libDeps of
+                   Left p  -> p
+                   Right _ -> error "Broken dependency closure"
+          libTransDeps = map installedUnitId $ allPackages pidx
+          singletonsBaseUnitId = componentUnitId libCLBI
+          deps = formatDeps (singletonsBaseUnitId:libTransDeps)
+          allFlags = dbFlags ++ deps
+      writeFile buildSingletonsBaseFile $ unlines
+        [ "module Build_singletons_base where"
+        , ""
+        , "ghcPath :: FilePath"
+        , "ghcPath = " ++ show ghc
+        , ""
+        , "ghcFlags :: [String]"
+        , "ghcFlags = " ++ show allFlags
+        , ""
+        , "rootDir :: FilePath"
+        , "rootDir = " ++ show rootDir
+        ]
+  where
+    formatDeps = map formatOne
+    formatOne 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
+
+buildSingletonsBaseModule :: FilePath
+buildSingletonsBaseModule = "Build_singletons_base"
+
+testSuiteName :: String
+testSuiteName = "singletons-base-test-suite"
+
+amendGPD :: GenericPackageDescription -> GenericPackageDescription
+amendGPD gpd = gpd
+    { condTestSuites = map f (condTestSuites gpd)
+    }
+  where
+    f (name, condTree)
+        | name == fromString testSuiteName = (name, condTree')
+        | otherwise                        = (name, condTree)
+      where
+        -- I miss 'lens'
+        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 buildSingletonsBaseModule
+
+        bi' = bi { otherModules = om', autogenModules = am' }
+        testSuite' = testSuite { testBuildInfo = bi' }
+        condTree' = condTree { condTreeData = testSuite' }
diff --git a/ToDo.md b/ToDo.md
--- a/ToDo.md
+++ b/ToDo.md
@@ -1,12 +1,22 @@
-- [ ] Factorize input size checks (like Parsley's piggy bank).
+- [ ] Error messages also based upon: [A Parsing Machine for Parsing Expression Grammars with Labeled Failures](https://dl.acm.org/doi/10.1145/2851613.2851750)
 
 - [ ] Golden tests using more complex grammars.
 
 - [ ] Error messages also based upon: [A Parsing Machine for Parsing Expression Grammars with Labeled Failures](https://dl.acm.org/doi/10.1145/2851613.2851750)
 
-- [ ] Consider introducing registers like in ParsleyHaskell.
-
-- [ ] Concerning the unusual `pure :: H.Haskell a -> repr a`,
-  it may be acceptable to use `H.Haskell` only internally.
+- [ ] Concerning the unusual `pure :: H.Term pure a -> repr a`,
+  it may be acceptable to use `H.Term` only internally.
 
 - [ ] Move the `Symantic.Univariant.*` modules into a separate package, maybe `symantic-base`.
+
+- [ ] Golden tests for TH splices as in `singleton`.
+      Note that the custom `Setup.hs` to get `ghcFlags` requires `cabal-install-3.4` which does not compile in Nixpkgs yet.
+
+- [ ] Support parsing tree inputs (eg. RelaxNG in `symantic-xml` or HTTP routing in `symantic-http-server`).
+
+- [ ] Consider introducing registers like in ParsleyHaskell.
+      The custom `Setup.hs` requires `cabal-install-3.4`
+      which does not compile in Nixpkgs yet.
+
+- [ ] Study if the generated parser can easily and without much costs be made reentrant like `attoparsec`.
+      In which case it could maybe replace `attoparsec` in `pipes`.
diff --git a/default.nix b/default.nix
--- a/default.nix
+++ b/default.nix
@@ -8,7 +8,8 @@
     then pkgs.haskellPackages
     else pkgs.haskell.packages.${ghc};
   hs = haskellPackages.extend (with pkgs.haskell.lib;
-    hself: hsuper: {
+    hself: hsuper:
+    {
       data-fix = doJailbreak hsuper.data-fix;
       primitive = doJailbreak hsuper.primitive;
       assoc = doJailbreak hsuper.assoc;
@@ -25,8 +26,9 @@
   shell = hs.shellFor {
     packages = p: [ p.symantic-parser ];
     nativeBuildInputs = [
-      pkgs.cabal-install
+      #pkgs.cabal-install
       #hs.cabal-install
+      pkgs.cabal-install
       #hs.haskell-language-server
       #hs.hpc
     ];
diff --git a/flake.nix b/flake.nix
--- a/flake.nix
+++ b/flake.nix
@@ -6,9 +6,7 @@
     pkgs = inputs.nixpkgs.legacyPackages.${system};
     in {
       defaultPackage = import ./default.nix { inherit pkgs; };
-      devShell = (import ./default.nix {
-        inherit pkgs;
-      }).shell;
+      devShell = (import ./default.nix { inherit pkgs; }).shell;
     }
   );
 }
diff --git a/src/Symantic/Parser.hs b/src/Symantic/Parser.hs
--- a/src/Symantic/Parser.hs
+++ b/src/Symantic/Parser.hs
@@ -1,14 +1,15 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Symantic.Parser
- ( module Symantic.Parser.Grammar
- , module Symantic.Parser.Machine
- , module Symantic.Parser
- ) where
+  ( module Symantic.Parser.Grammar
+  , module Symantic.Parser.Machine
+  , module Symantic.Parser
+  ) where
 
 import Data.Either (Either(..))
 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
@@ -18,9 +19,10 @@
   Ord (InputToken inp) =>
   Show (InputToken inp) =>
   TH.Lift (InputToken inp) =>
+  Typeable (InputToken inp) =>
   -- InputToken inp ~ Char =>
   Input inp =>
-  Readable Gen (InputToken inp) =>
+  Readable (InputToken inp) Gen =>
   Parser inp a ->
   CodeQ (inp -> Either (ParsingError inp) a)
-runParser p = [|| \input -> $$(generate [||input||] (machine p)) ||]
+runParser p = [|| \input -> $$(generateCode [||input||] (machine p)) ||]
diff --git a/src/Symantic/Parser/Grammar.hs b/src/Symantic/Parser/Grammar.hs
--- a/src/Symantic/Parser/Grammar.hs
+++ b/src/Symantic/Parser/Grammar.hs
@@ -1,32 +1,32 @@
+{-# LANGUAGE AllowAmbiguousTypes #-} -- For grammar
 {-# LANGUAGE ConstraintKinds #-} -- For Grammar
 module Symantic.Parser.Grammar
- ( module Symantic.Parser.Grammar
- , module Symantic.Parser.Grammar.Combinators
- , module Symantic.Parser.Grammar.Fixity
- , module Symantic.Parser.Grammar.Optimize
- , module Symantic.Parser.Grammar.ObserveSharing
- , module Symantic.Parser.Grammar.Write
- , module Symantic.Parser.Grammar.Dump
- , Letable(..)
- ) where
+  ( module Symantic.Parser.Grammar
+  , module Symantic.Parser.Grammar.Combinators
+  , module Symantic.Parser.Grammar.Fixity
+  , module Symantic.Parser.Grammar.Optimize
+  , module Symantic.Parser.Grammar.ObserveSharing
+  , module Symantic.Parser.Grammar.Write
+  , module Symantic.Parser.Grammar.View
+  , Letable(..)
+  ) where
 import Symantic.Parser.Grammar.Combinators
-import Symantic.Parser.Grammar.Dump
+import Symantic.Parser.Grammar.View
 import Symantic.Parser.Grammar.Fixity
 import Symantic.Parser.Grammar.ObserveSharing
 import Symantic.Parser.Grammar.Optimize
 import Symantic.Parser.Grammar.Write
-import Symantic.Univariant.Letable (Letable(..))
 
 import Data.Function ((.))
 import Data.String (String)
 import Text.Show (Show(..))
 import qualified Language.Haskell.TH.Syntax as TH
 
--- Class 'Grammar'
-type Grammar repr =
+-- * Class 'Grammar'
+type Grammar tok repr =
   ( Applicable repr
   , Alternable repr
-  --, Satisfiable repr
+  , Satisfiable tok repr
   , Letable TH.Name repr
   , Selectable repr
   , Matchable repr
@@ -35,11 +35,18 @@
   )
 
 -- | A usual pipeline to interpret 'Comb'inators:
--- 'observeSharing' then 'optimizeComb' then a polymorphic @(repr)@.
-grammar :: Grammar repr => ObserveSharing TH.Name (OptimizeComb TH.Name repr) a -> repr a
-grammar = optimizeComb . observeSharing
+-- 'observeSharing' then 'optimizeGrammar' then a polymorphic @(repr)@.
+grammar ::
+  Grammar tok repr =>
+  ObserveSharing TH.Name
+    (OptimizeGrammar repr) a ->
+  repr a
+grammar = optimizeGrammar . observeSharing
 
--- | A usual pipeline to show 'Comb'inators:
--- 'observeSharing' then 'optimizeComb' then 'dumpComb' then 'show'.
-showGrammar :: ObserveSharing TH.Name (OptimizeComb TH.Name DumpComb) a -> String
-showGrammar = show . dumpComb . optimizeComb . observeSharing
+-- | An usual pipeline to show 'Comb'inators:
+-- 'observeSharing' then 'optimizeGrammar' then 'viewGrammar' then 'show'.
+showGrammar ::
+  ObserveSharing TH.Name
+    (OptimizeGrammar (ViewGrammar showName)) a ->
+  String
+showGrammar = show . viewGrammar . optimizeGrammar . observeSharing
diff --git a/src/Symantic/Parser/Grammar/Combinators.hs b/src/Symantic/Parser/Grammar/Combinators.hs
--- a/src/Symantic/Parser/Grammar/Combinators.hs
+++ b/src/Symantic/Parser/Grammar/Combinators.hs
@@ -8,6 +8,8 @@
 {-# LANGUAGE DeriveLift #-} -- For TH.Lift (ErrorItem tok)
 {-# LANGUAGE StandaloneDeriving #-} -- For Show (ErrorItem (InputToken inp))
 {-# LANGUAGE TemplateHaskell #-}
+-- | Semantic of the grammar combinators used to express parsers,
+-- in the convenient tagless-final encoding.
 module Symantic.Parser.Grammar.Combinators where
 
 import Data.Bool (Bool(..), not, (||))
@@ -19,45 +21,48 @@
 import Data.Maybe (Maybe(..))
 import Data.Ord (Ord)
 import Data.String (String)
-import Language.Haskell.TH (CodeQ)
 import Text.Show (Show(..))
 import qualified Data.Functor as Functor
 import qualified Data.List as List
+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
+
 -- * Class 'Applicable'
 -- | This is like the usual 'Functor' and 'Applicative' type classes
--- from the @base@ package, but using @('H.Haskell' 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
+-- 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')
+-- and thus apply some optimizations.
+-- @(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
   -- | @(a2b '<$>' ra)@ parses like @(ra)@ but maps its returned value with @(a2b)@.
-  (<$>) :: H.Haskell (a -> b) -> repr a -> repr b
+  (<$>) :: TermGrammar (a -> b) -> repr a -> repr b
   (<$>) f = (pure f <*>)
 
   -- | Like '<$>' but with its arguments 'flip'-ped.
-  (<&>) :: repr a -> H.Haskell (a -> b) -> repr b
+  (<&>) :: repr a -> TermGrammar (a -> b) -> repr b
   (<&>) = flip (<$>)
 
   -- | @(a '<$' rb)@ parses like @(rb)@ but discards its returned value by replacing it with @(a)@.
-  (<$) :: H.Haskell a -> repr b -> repr a
+  (<$) :: TermGrammar 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 -> H.Haskell b -> repr b
+  ($>) :: repr a -> TermGrammar b -> repr b
   ($>) = flip (<$)
 
   -- | @('pure' a)@ parses the empty string, always succeeding in returning @(a)@.
-  pure :: H.Haskell a -> repr a
+  pure :: TermGrammar a -> repr a
   default pure ::
     Sym.Liftable repr => Applicable (Sym.Output repr) =>
-    H.Haskell a -> repr a
+    TermGrammar a -> repr a
   pure = Sym.lift . pure
 
   -- | @(ra2b '<*>' ra)@ parses sequentially @(ra2b)@ and then @(ra)@,
@@ -71,7 +76,7 @@
 
   -- | @('liftA2' a2b2c ra rb)@ parses sequentially @(ra)@ and then @(rb)@,
   -- and returns the application of @(a2b2c)@ to the values returned by those parsers.
-  liftA2 :: H.Haskell (a -> b -> c) -> repr a -> repr b -> repr c
+  liftA2 :: TermGrammar (a -> b -> c) -> repr a -> repr b -> repr c
   liftA2 f x = (<*>) (f <$> x)
 
   -- | @(ra '<*' rb)@ parses sequentially @(ra)@ and then @(rb)@,
@@ -124,13 +129,13 @@
   p <+> q = H.left <$> p <|> H.right <$> q
 infixl 3 <|>, <+>
 
-optionally :: Applicable repr => Alternable repr => repr a -> H.Haskell b -> repr b
+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 => H.Haskell a -> repr a -> repr a
+option :: Applicable repr => Alternable repr => TermGrammar a -> repr a -> repr a
 option x p = p <|> pure x
 
 choice :: Alternable repr => [repr a] -> repr a
@@ -155,14 +160,15 @@
 -- * Class 'Matchable'
 class Matchable repr where
   conditional ::
-    Eq a => [H.Haskell (a -> Bool)] -> [repr b] -> repr a -> repr b -> repr b
+    Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b
   default conditional ::
-    Sym.Unliftable repr => Sym.Liftable2 repr => Matchable (Sym.Output repr) =>
-    Eq a => [H.Haskell (a -> Bool)] -> [repr b] -> repr a -> repr b -> repr b
-  conditional cs bs = Sym.lift2 (conditional cs (Sym.trans Functor.<$> bs))
+    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))
 
-  match :: Eq a => [H.Haskell a] -> repr a -> (H.Haskell a -> repr b) -> repr b -> repr b
-  match as a a2b = conditional (H.eq Functor.<$> as) (a2b Functor.<$> as) a
+  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 'Foldable'
 class Foldable repr where
@@ -192,24 +198,28 @@
     where go = (H..) <$> op <*> go <|> pure H.id
 
 {-
-conditional :: Selectable repr => [(H.Haskell (a -> Bool), repr b)] -> repr a -> repr b -> repr b
+conditional :: Selectable 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 repr tok where
-  satisfy :: [ErrorItem tok] -> H.Haskell (tok -> Bool) -> repr tok
+class Satisfiable tok repr where
+  satisfy :: [ErrorItem tok] -> TermGrammar (tok -> Bool) -> repr tok
   default satisfy ::
-    Sym.Liftable repr => Satisfiable (Sym.Output repr) tok =>
+    Sym.Liftable repr => Satisfiable tok (Sym.Output repr) =>
     [ErrorItem tok] ->
-    H.Haskell (tok -> Bool) -> repr 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)
@@ -228,8 +238,8 @@
   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)
+  -- eof = negLook (satisfy @Char [ErrorItemAny] (H.const H..@ H.bool True))
+             -- (item @Char)
 
 {-# INLINE (<:>) #-}
 infixl 4 <:>
@@ -250,43 +260,64 @@
 between :: Applicable repr => repr o -> repr c -> repr a -> repr a
 between open close p = open *> p <* close
 
-string :: Applicable repr => Satisfiable repr Char => [Char] -> repr [Char]
-string = traverse char
+string ::
+  Applicable repr => Alternable repr =>
+  Satisfiable Char repr =>
+  [Char] -> repr [Char]
+string = try . traverse char
 
--- oneOf :: [Char] -> repr Char
--- oneOf cs = satisfy [] (makeQ (flip elem cs) [||\c -> $$(ofChars cs [||c||])||])
+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 repr tok => [tok] -> repr tok
-noneOf cs = satisfy (ErrorItemToken Functor.<$> cs) (H.Haskell H.ValueCode{..})
-  where
-  value = H.Value (not . flip List.elem cs)
-  code = [||\c -> not $$(ofChars cs [||c||])||]
+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 => [tok] -> CodeQ tok -> CodeQ Bool
-ofChars = List.foldr (\c rest qc -> [|| c == $$qc || $$(rest qc) ||]) (const [||False||])
+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 repr Char => Lookable repr => repr ()
-more = look (void (item @_ @Char))
+more :: Applicable repr => Satisfiable Char repr => Lookable repr => repr ()
+more = look (void (item @Char))
 
-char :: Applicable repr => Satisfiable repr Char => Char -> repr Char
-char c = satisfy [ErrorItemToken c] (H.eq (H.char c)) $> H.char c
+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 repr Char => repr Char
+anyChar :: Satisfiable Char repr => repr Char
 anyChar = satisfy [] (H.const H..@ H.bool True)
 
 token ::
-  TH.Lift tok => Eq tok => Applicable repr =>
-  Satisfiable repr tok => tok -> repr tok
-token tok = satisfy [ErrorItemToken tok] (H.eq (H.char tok)) $> H.char tok
+  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 => Applicable repr => Alternable repr =>
-  Satisfiable repr tok => [tok] -> repr [tok]
+  TH.Lift tok => Eq tok => Show tok =>
+  Applicable repr => Alternable repr =>
+  Satisfiable tok repr => [tok] -> repr [tok]
 tokens = try . traverse token
 
-item :: Satisfiable repr tok => repr tok
-item = satisfy [] (H.const H..@ H.bool True)
-
 -- Composite Combinators
 -- someTill :: repr a -> repr b -> repr [a]
 -- someTill p end = negLook end *> (p <:> manyTill p end)
@@ -324,12 +355,12 @@
 -- Lift Operations
 liftA2 ::
  Applicable repr =>
- H.Haskell (a -> b -> c) -> repr a -> repr b -> repr c
+ TermGrammar (a -> b -> c) -> repr a -> repr b -> repr c
 liftA2 f x = (<*>) (fmap f x)
 
 liftA3 ::
  Applicable repr =>
- H.Haskell (a -> b -> c -> d) -> repr a -> repr b -> repr c -> repr d
+ TermGrammar (a -> b -> c -> d) -> repr a -> repr b -> repr c -> repr d
 liftA3 f a b c = liftA2 f a b <*> c
 
 -}
@@ -337,28 +368,28 @@
 -- Parser Folds
 pfoldr ::
  Applicable repr => Foldable repr =>
- H.Haskell (a -> b -> b) -> H.Haskell b -> repr a -> repr b
+ TermGrammar (a -> b -> b) -> TermGrammar b -> repr a -> repr b
 pfoldr f k p = chainPre (f <$> p) (pure k)
 
 pfoldr1 ::
  Applicable repr => Foldable repr =>
- H.Haskell (a -> b -> b) -> H.Haskell b -> repr a -> repr b
+ 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 =>
- H.Haskell (b -> a -> b) -> H.Haskell b -> repr a -> repr b
+ 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 =>
- H.Haskell (b -> a -> b) -> H.Haskell b -> repr a -> repr b
+ 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 =>
- H.Haskell (a -> b) -> repr a -> repr (b -> a -> b) -> repr b
+ TermGrammar (a -> b) -> repr a -> repr (b -> a -> b) -> repr b
 chainl1' f p op = chainPost (f <$> p) (H.flip <$> op <*> p)
 
 chainl1 ::
@@ -377,13 +408,13 @@
 chainr1 :: repr a -> repr (a -> a -> a) -> repr a
 chainr1 = chainr1' H.id
 
-chainr :: repr a -> repr (a -> a -> a) -> H.Haskell a -> repr a
+chainr :: repr a -> repr (a -> a -> a) -> TermGrammar a -> repr a
 chainr p op x = option x (chainr1 p op)
 -}
 
 chainl ::
  Applicable repr => Alternable repr => Foldable repr =>
- repr a -> repr (a -> a -> a) -> H.Haskell a -> repr a
+ repr a -> repr (a -> a -> a) -> TermGrammar a -> repr a
 chainl p op x = option x (chainl1 p op)
 
 -- Derived Combinators
diff --git a/src/Symantic/Parser/Grammar/Dump.hs b/src/Symantic/Parser/Grammar/Dump.hs
deleted file mode 100644
--- a/src/Symantic/Parser/Grammar/Dump.hs
+++ /dev/null
@@ -1,68 +0,0 @@
-module Symantic.Parser.Grammar.Dump where
-
-import Data.Function (($), (.), id)
-import Data.Semigroup (Semigroup(..))
-import Data.String (String, IsString(..))
-import Text.Show (Show(..))
-import qualified Control.Applicative as Fct
-import qualified Data.Tree as Tree
-import qualified Data.List as List
-
-import Symantic.Univariant.Letable
-import Symantic.Parser.Grammar.Combinators
-
--- * Type 'DumpComb'
-newtype DumpComb a = DumpComb { unDumpComb :: Tree.Tree String }
-
-dumpComb :: DumpComb a -> DumpComb a
-dumpComb = id
-
-instance Show (DumpComb a) where
-  show = drawTree . unDumpComb
-    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 (DumpComb a) where
-  fromString s = DumpComb $ Tree.Node (fromString s) []
-
-instance Show letName => Letable letName DumpComb where
-  def name x = DumpComb $
-    Tree.Node ("def "<>show name) [unDumpComb x]
-  ref rec name = DumpComb $
-    Tree.Node
-      ( (if rec then "rec " else "ref ")
-      <> show name
-      ) []
-instance Applicable DumpComb where
-  _f <$> x = DumpComb $ Tree.Node "<$>" [unDumpComb x]
-  pure a = DumpComb $ Tree.Node ("pure "<>showsPrec 10 a "") []
-  x <*> y = DumpComb $ Tree.Node "<*>" [unDumpComb x, unDumpComb y]
-instance Alternable DumpComb where
-  empty = DumpComb $ Tree.Node "empty" []
-  x <|> y = DumpComb $ Tree.Node "<|>" [unDumpComb x, unDumpComb y]
-  try x = DumpComb $ Tree.Node "try" [unDumpComb x]
-instance Satisfiable DumpComb tok where
-  satisfy _es _p = DumpComb $ Tree.Node "satisfy" []
-instance Selectable DumpComb where
-  branch lr l r = DumpComb $ Tree.Node "branch"
-    [ unDumpComb lr, unDumpComb l, unDumpComb r ]
-instance Matchable DumpComb where
-  conditional _cs bs a b = DumpComb $ Tree.Node "conditional"
-    [ Tree.Node "bs" (unDumpComb Fct.<$> bs)
-    , unDumpComb a
-    , unDumpComb b
-    ]
-instance Lookable DumpComb where
-  look x = DumpComb $ Tree.Node "look" [unDumpComb x]
-  negLook x = DumpComb $ Tree.Node "negLook" [unDumpComb x]
-  eof = DumpComb $ Tree.Node "eof" []
-instance Foldable DumpComb where
-  chainPre f x = DumpComb $ Tree.Node "chainPre" [unDumpComb f, unDumpComb x]
-  chainPost x f = DumpComb $ Tree.Node "chainPost" [unDumpComb x, unDumpComb f]
diff --git a/src/Symantic/Parser/Grammar/ObserveSharing.hs b/src/Symantic/Parser/Grammar/ObserveSharing.hs
--- a/src/Symantic/Parser/Grammar/ObserveSharing.hs
+++ b/src/Symantic/Parser/Grammar/ObserveSharing.hs
@@ -1,107 +1,111 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Symantic.Parser.Grammar.ObserveSharing
- ( module Symantic.Parser.Grammar.ObserveSharing
- , ObserveSharing(..)
- ) where
+  ( module Symantic.Univariant.Letable
+  , module Symantic.Parser.Grammar.ObserveSharing
+  ) where
 
 import Control.Monad (mapM)
-import Control.Applicative (Applicative(..))
 import Data.Eq (Eq(..))
 import Data.Function (($), (.))
-import Data.Functor ((<$>))
 import Data.Hashable (Hashable, hashWithSalt)
 import Text.Show (Show(..))
+import qualified Control.Applicative as Functor
 
-import Symantic.Univariant.Letable as Letable
-import qualified Symantic.Univariant.Trans as Sym
-import qualified Symantic.Parser.Grammar.Combinators as Comb
+import Symantic.Parser.Grammar.Combinators
+import Symantic.Univariant.Letable hiding (observeSharing)
+import qualified Symantic.Univariant.Letable as Letable
 import qualified Language.Haskell.TH.Syntax as TH
+import qualified Symantic.Univariant.Trans as Sym
 
 -- | Like 'Letable.observeSharing'
--- but type-binding @(letName)@ to 'TH.Name' to help type inference.
+-- 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
 
+-- | Needed by 'observeSharing'.
 instance Hashable TH.Name where
   hashWithSalt s = hashWithSalt s . show
 
--- Combinators semantics for the 'ObserveSharing' interpreter
+-- Combinators semantics for the 'ObserveSharing' interpreter.
 instance
   ( Letable letName repr
   , MakeLetName letName
   , Eq letName
   , Hashable letName
-  , Comb.Satisfiable repr tok
-  ) => Comb.Satisfiable (ObserveSharing letName repr) tok
+  , Satisfiable tok repr
+  ) => Satisfiable tok (ObserveSharing letName repr)
 instance
   ( Letable letName repr
   , MakeLetName letName
   , Eq letName
   , Hashable letName
-  , Comb.Alternable repr
-  ) => Comb.Alternable (ObserveSharing letName repr)
+  , Alternable repr
+  ) => Alternable (ObserveSharing letName repr)
 instance
   ( Letable letName repr
   , MakeLetName letName
   , Eq letName
   , Hashable letName
-  , Comb.Applicable repr
-  ) => Comb.Applicable (ObserveSharing letName repr)
+  , Applicable repr
+  ) => Applicable (ObserveSharing letName repr)
 instance
   ( Letable letName repr
   , MakeLetName letName
   , Eq letName
   , Hashable letName
-  , Comb.Selectable repr
-  ) => Comb.Selectable (ObserveSharing letName repr)
+  , Selectable repr
+  ) => Selectable (ObserveSharing letName repr)
 instance
   ( Letable letName repr
   , MakeLetName letName
   , Eq letName
   , Hashable letName
-  , Comb.Matchable repr
-  ) => Comb.Matchable (ObserveSharing letName repr) where
+  , Matchable repr
+  ) => Matchable (ObserveSharing letName repr) where
   -- Here the default definition does not fit
   -- since there is no lift* for the type of 'conditional'
-  -- and its default definition handles does not handles 'bs'
+  -- and its default definition does not handles 'bs'
   -- as needed by the 'ObserveSharing' transformation.
-  conditional cs bs a b = observeSharingNode $ ObserveSharing $
-    Comb.conditional cs
-      <$> mapM unObserveSharing bs
-      <*> unObserveSharing a
-      <*> unObserveSharing b
+  conditional a cs bs b = observeSharingNode $ ObserveSharing $
+    conditional
+      Functor.<$> unObserveSharing a
+      Functor.<*> Functor.pure cs
+      Functor.<*> mapM unObserveSharing bs
+      Functor.<*> unObserveSharing b
 instance
   ( Letable letName repr
   , MakeLetName letName
   , Eq letName
   , Hashable letName
-  , Comb.Foldable 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
    -}
-  , Comb.Applicable repr
-  , Comb.Alternable repr
-  ) => Comb.Foldable (ObserveSharing letName repr)
+  , Applicable repr
+  , Alternable repr
+  ) => Foldable (ObserveSharing letName repr)
 instance
   ( Letable letName repr
   , MakeLetName letName
   , Eq letName
   , Hashable letName
-  , Comb.Lookable repr
-  ) => Comb.Lookable (ObserveSharing letName repr)
+  , Lookable repr
+  ) => Lookable (ObserveSharing letName repr)
 
--- Combinators semantics for the 'CleanDefs' interpreter
-instance Comb.Applicable repr => Comb.Applicable (CleanDefs letName repr)
-instance Comb.Alternable repr => Comb.Alternable (CleanDefs letName repr)
-instance Comb.Satisfiable repr tok => Comb.Satisfiable (CleanDefs letName repr) tok
-instance Comb.Selectable repr => Comb.Selectable (CleanDefs letName repr)
-instance Comb.Matchable repr => Comb.Matchable (CleanDefs letName repr) where
-  conditional cs bs a b = CleanDefs $
-    Comb.conditional cs
-      <$> mapM unCleanDefs bs
-      <*> unCleanDefs a
-      <*> unCleanDefs b
-instance Comb.Lookable repr => Comb.Lookable (CleanDefs letName repr)
-instance Comb.Foldable repr => Comb.Foldable (CleanDefs letName repr) where
-  chainPre = Sym.lift2 Comb.chainPre
-  chainPost = Sym.lift2 Comb.chainPost
+-- 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 $
+    conditional
+      Functor.<$> unCleanDefs 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
+  chainPre = Sym.lift2 chainPre
+  chainPost = Sym.lift2 chainPost
diff --git a/src/Symantic/Parser/Grammar/Optimize.hs b/src/Symantic/Parser/Grammar/Optimize.hs
--- a/src/Symantic/Parser/Grammar/Optimize.hs
+++ b/src/Symantic/Parser/Grammar/Optimize.hs
@@ -1,440 +1,409 @@
-{-# LANGUAGE PatternSynonyms #-} -- For aliased combinators
-{-# LANGUAGE TemplateHaskell #-} -- For optimizeCombNode
-{-# LANGUAGE ViewPatterns #-} -- For optimizeCombNode
+{-# LANGUAGE PatternSynonyms #-} -- For Comb
+{-# LANGUAGE TemplateHaskell #-} -- For branch
+{-# LANGUAGE ViewPatterns #-} -- For unSomeComb
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- For MakeLetName TH.Name
+-- | Bottom-up optimization of 'Comb'inators,
+-- reexamining downward as needed after each optimization.
 module Symantic.Parser.Grammar.Optimize where
 
 import Data.Bool (Bool(..))
 import Data.Either (Either(..), either)
 import Data.Eq (Eq(..))
-import Data.Foldable (all, foldr)
 import Data.Function ((.))
-import Data.Kind (Type)
+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, (:~~:)(..))
 
 import Symantic.Parser.Grammar.Combinators as Comb
-import Symantic.Parser.Haskell (ValueCode(..), Value(..), getValue, code)
+import Symantic.Parser.Haskell ()
 import Symantic.Univariant.Letable
 import Symantic.Univariant.Trans
 import qualified Symantic.Parser.Haskell as H
 
--- import Debug.Trace (trace)
+{- Uncomment to trace optimizations
+import Data.Function (($), flip)
+import Debug.Trace (trace)
 
--- * Type 'Comb'
--- | Pattern-matchable 'Comb'inators of the grammar.
--- @(repr)@ is not strictly necessary since it's only a phantom type
--- (no constructor use it as a value), but having it:
---
--- 1. emphasizes that those 'Comb'inators will be 'trans'formed again
---    (eg. in 'DumpComb' or 'Instr'uctions).
---
--- 2. Avoid overlapping instances between
---    @('Trans' ('Comb' repr) repr)@ and
---    @('Trans' ('Comb' repr) ('OptimizeComb' letName repr))@
-data Comb (repr :: Type -> Type) a where
-  Pure :: H.Haskell a -> Comb repr a
-  Satisfy ::
-    Satisfiable repr tok =>
-    [ErrorItem tok] ->
-    H.Haskell (tok -> Bool) -> Comb repr tok
-  Item :: Satisfiable repr tok => Comb repr tok
-  Try :: Comb repr a -> Comb repr a
-  Look :: Comb repr a -> Comb repr a
-  NegLook :: Comb repr a -> Comb repr ()
-  Eof :: Comb repr ()
-  (:<*>) :: Comb repr (a -> b) -> Comb repr a -> Comb repr b
-  (:<|>) :: Comb repr a -> Comb repr a -> Comb repr a
-  Empty :: Comb repr a
-  Branch ::
-    Comb repr (Either a b) ->
-    Comb repr (a -> c) -> Comb repr (b -> c) -> Comb repr c
-  Match :: Eq a =>
-    [H.Haskell (a -> Bool)] ->
-    [Comb repr b] -> Comb repr a -> Comb repr b -> Comb repr b
-  ChainPre :: Comb repr (a -> a) -> Comb repr a -> Comb repr a
-  ChainPost :: Comb repr a -> Comb repr (a -> a) -> Comb repr a
-  Def :: TH.Name -> Comb repr a -> Comb repr a
-  Ref :: Bool -> TH.Name -> Comb repr a
+(&) = flip ($)
+infix 0 &
+-}
 
-pattern (:<$>) :: H.Haskell (a -> b) -> Comb repr a -> Comb repr b
-pattern (:$>) :: Comb repr a -> H.Haskell b -> Comb repr b
-pattern (:<$) :: H.Haskell a -> Comb repr b -> Comb repr a
-pattern (:*>) :: Comb repr a -> Comb repr b -> Comb repr b
-pattern (:<*) :: Comb repr a -> Comb repr b -> Comb repr a
-pattern x :<$> p = Pure x :<*> p
-pattern p :$> x = p :*> Pure x
-pattern x :<$ p = Pure x :<* p
-pattern x :<* p = H.Const :<$> x :<*> p
-pattern p :*> x = H.Id :<$ p :<*> x
+-- * Type 'OptimizeGrammar'
+type OptimizeGrammar = SomeComb
 
-infixl 3 :<|>
-infixl 4 :<*>, :<*, :*>
-infixl 4 :<$>, :<$, :$>
+optimizeGrammar ::
+  Trans (SomeComb repr) repr =>
+  SomeComb repr a -> repr a
+optimizeGrammar = trans
 
-instance Applicable (Comb repr) where
-  pure = Pure
-  (<*>) = (:<*>)
-instance Alternable (Comb repr) where
-  (<|>) = (:<|>)
-  empty = Empty
-  try = Try
-instance Selectable (Comb repr) where
-  branch = Branch
-instance Matchable (Comb repr) where
-  conditional = Match
-instance Foldable (Comb repr) where
-  chainPre = ChainPre
-  chainPost = ChainPost
-instance Satisfiable repr tok => Satisfiable (Comb repr) tok where
-  satisfy = Satisfy
-instance Lookable (Comb repr) where
-  look = Look
-  negLook = NegLook
-  eof = Eof
-instance Letable TH.Name (Comb repr) where
-  def = Def
-  ref = Ref
-instance MakeLetName TH.Name where
-  makeLetName _ = TH.qNewName "name"
+-- * Data family 'Comb'
+-- | 'Comb'inators of the 'Grammar'.
+-- This is an extensible data-type.
+data family Comb
+  (comb :: ReprComb -> Constraint)
+  (repr :: ReprComb)
+  :: ReprComb
 
--- Pattern-matchable 'Comb'inators keep enough structure
--- to have some of the symantics producing them interpreted again
--- (eg. after being modified by 'optimizeComb').
-type instance Output (Comb repr) = repr
+-- | Convenient utility to pattern-match a 'SomeComb'.
+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
+-- without requiring impredicative quantification.
+-- Must be used by pattern-matching
+-- on the 'SomeComb' data-constructor,
+-- to bring the constraints in scope.
+--
+-- The optimizations are directly applied within it,
+-- to avoid introducing an extra newtype,
+-- this also give a more comprehensible code.
+data SomeComb repr a =
+  forall comb.
+  (Trans (Comb comb repr) repr, Typeable comb) =>
+  SomeComb (Comb comb repr a)
+
+instance Trans (SomeComb repr) repr where
+  trans (SomeComb x) = trans x
+
+-- | @(unSomeComb c :: 'Maybe' ('Comb' comb repr a))@
+-- extract the data-constructor from the given 'SomeComb'
+-- iif. it belongs to the @('Comb' comb repr a)@ data-instance.
+unSomeComb ::
+  forall comb repr a.
+  Typeable comb =>
+  SomeComb repr a -> Maybe (Comb comb repr a)
+unSomeComb (SomeComb (c::Comb c repr a)) =
+  case typeRep @comb `eqTypeRep` typeRep @c of
+    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
+infixl 4 :<*>:, :<*:, :*>:
+pattern (:<$>:) :: TermGrammar (a -> b) -> SomeComb repr a -> Comb Applicable repr b
+pattern t :<$>: x <- Comb (Pure t) :<*>: x
+pattern (:$>:) :: SomeComb repr a -> TermGrammar b -> Comb Applicable repr b
+pattern x :$>: t <- x :*>: Comb (Pure t)
+instance Applicable repr => Trans (Comb Applicable 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
-  , Selectable repr
-  , Foldable repr
   , Lookable repr
   , Matchable repr
-  , Letable TH.Name repr
-  ) => Trans (Comb repr) repr where
-  trans = \case
-    Pure a -> pure a
-    Satisfy es p -> satisfy es p
-    Item -> item
-    Try x -> try (trans x)
-    Look x -> look (trans x)
-    NegLook x -> negLook (trans x)
-    Eof -> eof
-    x :<*> y -> trans x <*> trans y
-    x :<|> y -> trans x <|> trans y
-    Empty -> empty
-    Branch lr l r -> branch (trans lr) (trans l) (trans r)
-    Match ps bs a b -> conditional ps (trans Functor.<$> bs) (trans a) (trans b)
-    ChainPre x y -> chainPre (trans x) (trans y)
-    ChainPost x y -> chainPost (trans x) (trans y)
-    Def n x -> def n (trans x)
-    Ref r n -> ref r n
-
--- * Type 'OptimizeComb'
--- Bottom-up application of 'optimizeCombNode'.
-newtype OptimizeComb letName repr a =
-        OptimizeComb { unOptimizeComb :: Comb repr a }
+  , Selectable repr
+  ) => Applicable (SomeComb repr) where
+  pure = SomeComb . Pure
+  f <$> Comb (Branch b l r) =
+    branch b
+      ((H..) H..@ f <$> l)
+      ((H..) H..@ f <$> r)
+    -- & trace "Branch Distributivity Law"
+  f <$> Comb (Conditional a ps bs d) =
+    conditional a ps
+      ((f <$>) Functor.<$> bs)
+      (f <$> d)
+    -- & trace "Conditional Distributivity Law"
+  -- Being careful here to use (<*>),
+  -- instead of SomeComb (f <$> unOptComb x),
+  -- in order to apply the optimizations of (<*>).
+  f <$> x = pure f <*> x
 
-optimizeComb ::
-  Trans (OptimizeComb TH.Name repr) repr =>
-  OptimizeComb TH.Name repr a -> repr a
-optimizeComb = trans
-instance
-  Trans (Comb repr) repr =>
-  Trans (OptimizeComb letName repr) repr where
-  trans = trans . unOptimizeComb
+  x <$ u = u $> x
+    -- & trace "Commutativity Law"
 
-type instance Output (OptimizeComb _letName repr) = Comb repr
-instance Trans (OptimizeComb letName repr) (Comb repr) where
-  trans = unOptimizeComb
-instance Trans (Comb repr) (OptimizeComb letName repr) where
-  trans = OptimizeComb . optimizeCombNode
-instance Trans1 (Comb repr) (OptimizeComb letName repr)
-instance Trans2 (Comb repr) (OptimizeComb letName repr)
-instance Trans3 (Comb repr) (OptimizeComb letName repr)
+  Comb Empty <*> _ = empty
+    -- & trace "App Right Absorption Law"
+  u <*> Comb Empty = u *> empty
+    -- & 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.
+    (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"
+  Comb (u :*>: v) <*> w = u *> (v <*> w)
+    -- & trace "Reassociation Law 1"
+  u <*> Comb (v :<*: w) = (u <*> v) <* w
+    -- & trace "Reassociation Law 2"
+  u <*> Comb (v :$>: x) = (u <*> pure x) <* v
+    -- & trace "Reassociation Law 3"
+  p <*> Comb (NegLook q) =
+    (p <*> pure H.unit) <* negLook (q)
+    -- & trace "Absorption Law"
+  x <*> y = SomeComb (x :<*>: y)
 
-instance
-  Letable letName (Comb repr) =>
-  Letable letName (OptimizeComb letName repr) where
-  -- Disable useless calls to 'optimizeCombNode'
-  -- because 'Def' or 'Ref' have no matching in it.
-  def n = OptimizeComb . def n . unOptimizeComb
-  ref r n = OptimizeComb (ref r n)
-instance Comb.Applicable (OptimizeComb letName repr)
-instance Comb.Alternable (OptimizeComb letName repr)
-instance Comb.Satisfiable repr tok =>
-         Comb.Satisfiable (OptimizeComb letName repr) tok
-instance Comb.Selectable (OptimizeComb letName repr)
-instance Comb.Matchable (OptimizeComb letName repr)
-instance Comb.Lookable (OptimizeComb letName repr)
-instance Comb.Foldable (OptimizeComb letName repr)
+  Comb Empty *> _ = empty
+    -- & trace "App Right Absorption Law"
+  Comb (_ :<$>: p) *> q = p *> q
+    -- & trace "Right Absorption Law"
+  Comb Pure{} *> u = u
+    -- & trace "Identity Law"
+  Comb (u :$>: _) *> v = u *> v
+    -- & trace "Identity Law"
+  u *> Comb (v :*>: w) = (u *> v) *> w
+    -- & trace "Associativity Law"
+  x *> y = SomeComb (x :*>: y)
 
-optimizeCombNode :: Comb repr a -> Comb repr a
-optimizeCombNode = \case
-  -- Functor Identity Law
-  H.Id :<$> x ->
-    -- trace "Functor Identity Law" $
-    x
-  -- Functor Commutativity Law
-  x :<$ u ->
-    -- trace "Functor Commutativity Law" $
-    optimizeCombNode (u :$> x)
-  -- Functor Flip Const Law
-  H.Flip H.:@ H.Const :<$> u ->
-    -- trace "Functor Flip Const Law" $
-    optimizeCombNode (u :*> Pure H.Id)
-  -- Functor Homomorphism Law
-  f :<$> Pure x ->
-    -- trace "Functor Homomorphism Law" $
-    Pure (f H..@ x)
+  Comb Empty <* _ = empty
+    -- & trace "App Right Absorption Law"
+  u <* Comb Empty = u *> empty
+    -- & trace "App Failure Weakening Law"
+  p <* Comb (_ :<$>: q) = p <* q
+    -- & trace "Left Absorption Law"
+  u <* Comb Pure{} = u
+    -- & trace "Identity Law"
+  u <* Comb (v :$>: _) = u <* v
+    -- & trace "Identity Law"
+  Comb (u :<*: v) <* w = u <* (v <* w)
+    -- & trace "Associativity Law"
+  x <* y = SomeComb (x :<*: y)
 
-  -- App Right Absorption Law
-  Empty :<*> _ ->
-    -- trace "App Right Absorption Law" $
-    Empty
-  _ :<*> Empty ->
-    -- In Parsley: this is only a weakening to u :*> Empty
-    -- but here :*> is an alias to :<*>
-    -- hence it would loop on itself forever.
-    -- trace "App Left Absorption Law" $
-    Empty
-  -- App Composition Law
-  u :<*> (v :<*> w) ->
-    -- trace "App Composition Law" $
-    optimizeCombNode (optimizeCombNode (optimizeCombNode ((H.:.) :<$> u) :<*> v) :<*> w)
-  -- App Interchange Law
-  u :<*> Pure x ->
-    -- trace "App Interchange Law" $
-    optimizeCombNode (H.Flip H..@ (H.:$) H..@ x :<$> u)
-  -- App Left Absorption Law
-  p :<* (_ :<$> q) ->
-    -- trace "App Left Absorption Law" $
-    p :<* q
-  -- App Right Absorption Law
-  (_ :<$> p) :*> q ->
-    -- trace "App Right Absorption Law" $
-    p :*> q
-  -- App Pure Left Identity Law
-  Pure _ :*> u ->
-    -- trace "App Pure Left Identity Law" $
-    u
-  -- App Functor Left Identity Law
-  (u :$> _) :*> v ->
-    -- trace "App Functor Left Identity Law" $
-    u :*> v
-  -- App Pure Right Identity Law
-  u :<* Pure _ ->
-    -- trace "App Pure Right Identity Law" $
-    u
-  -- App Functor Right Identity Law
-  u :<* (v :$> _) ->
-    -- trace "App Functor Right Identity Law" $
-    optimizeCombNode (u :<* v)
-  -- App Left Associativity Law
-  (u :<* v) :<* w ->
-    -- trace "App Left Associativity Law" $
-    optimizeCombNode (u :<* optimizeCombNode (v :<* w))
+-- 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
+  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
 
-  -- Alt Left CatchFail Law
-  p@Pure{} :<|> _ ->
-    -- trace "Alt Left CatchFail Law" $
-    p
-  -- Alt Left Neutral Law
-  Empty :<|> u ->
-    -- trace "Alt Left Neutral Law" $
-    u
-  -- All Right Neutral Law
-  u :<|> Empty ->
-    -- trace "Alt Right Neutral Law" $
-    u
-  -- Alt Associativity Law
-  (u :<|> v) :<|> w ->
-    -- trace "Alt Associativity Law" $
-    u :<|> optimizeCombNode (v :<|> w)
+  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)
 
-  -- Look Pure Law
-  Look p@Pure{} ->
-    -- trace "Look Pure Law" $
-    p
-  -- Look Empty Law
-  Look p@Empty ->
-    -- trace "Look Empty Law" $
-    p
-  -- NegLook Pure Law
-  NegLook Pure{} ->
-    -- trace "NegLook Pure Law" $
-    Empty
-  -- NegLook Empty Law
-  NegLook Empty ->
-    -- trace "NegLook Dead Law" $
-    Pure H.unit
-  -- NegLook Double Negation Law
-  NegLook (NegLook p) ->
-    -- trace "NegLook Double Negation Law" $
-    optimizeCombNode (Look (Try p) :*> Pure H.unit)
-  -- NegLook Zero Consumption Law
-  NegLook (Try p) ->
-    -- trace "NegLook Zero Consumption Law" $
-    optimizeCombNode (NegLook p)
-  -- Idempotence Law
-  Look (Look p) ->
-    -- trace "Look Idempotence Law" $
-    Look p
-  -- Look Right Identity Law
-  NegLook (Look p) ->
-    -- trace "Look Right Identity Law" $
-    optimizeCombNode (NegLook p)
-  -- Look Left Identity Law
-  Look (NegLook p) ->
-    -- trace "Look Left Identity Law" $
-    NegLook p
-  -- NegLook Transparency Law
-  NegLook (Try p :<|> q) ->
-    -- trace "NegLook Transparency Law" $
-    optimizeCombNode (optimizeCombNode (NegLook p) :*> optimizeCombNode (NegLook q))
-  -- Look Distributivity Law
-  Look p :<|> Look q ->
-    -- trace "Look Distributivity Law" $
-    optimizeCombNode (Look (optimizeCombNode (Try p :<|> q)))
-  -- Look Interchange Law
-  Look (f :<$> p) ->
-    -- trace "Look Interchange Law" $
-    optimizeCombNode (f :<$> optimizeCombNode (Look p))
-  -- NegLook Idempotence Right Law
-  NegLook (_ :<$> p) ->
-    -- trace "NegLook Idempotence Law" $
-    optimizeCombNode (NegLook p)
-  -- Try Interchange Law
-  Try (f :<$> p) ->
-    -- trace "Try Interchange Law" $
-    optimizeCombNode (f :<$> optimizeCombNode (Try p))
+  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)
 
-  -- Branch Absorption Law
-  Branch Empty _ _ ->
-    -- trace "Branch Absorption Law" $
-    empty
-  -- Branch Weakening Law
-  Branch b Empty Empty ->
-    -- trace "Branch Weakening Law" $
-    optimizeCombNode (b :*> Empty)
-  -- Branch Pure Left/Right Laws
-  Branch (Pure (trans -> lr)) l r ->
-    -- trace "Branch Pure Left/Right Law" $
-    case getValue lr of
-     Left v -> optimizeCombNode (l :<*> Pure (H.Haskell (ValueCode (Value v) c)))
-      where c = [|| case $$(code lr) of Left x -> x ||]
-     Right v -> optimizeCombNode (r :<*> Pure (H.Haskell (ValueCode (Value v) c)))
-      where c = [|| case $$(code lr) of Right x -> x ||]
-  -- Branch Generalised Identity Law
-  Branch b (Pure (trans -> l)) (Pure (trans -> r)) ->
-    -- trace "Branch Generalised Identity Law" $
-    optimizeCombNode (H.Haskell (ValueCode v c) :<$> b)
+-- 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)
+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
-    v = Value (either (getValue l) (getValue r))
-    c = [|| either $$(code l) $$(code r) ||]
-  -- Branch Interchange Law
-  Branch (x :*> y) p q ->
-    -- trace "Branch Interchange Law" $
-    optimizeCombNode (x :*> optimizeCombNode (Branch y p q))
-  -- Branch Empty Right Law
-  Branch b l Empty ->
-    -- trace " Branch Empty Right Law" $
-    Branch (Pure (H.Haskell (ValueCode v c)) :<*> b) Empty l
+    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
-    v = Value (either Right Left)
-    c = [||either Right Left||]
-  -- Branch Fusion Law
-  Branch (Branch b Empty (Pure (trans -> lr))) Empty br ->
-    -- trace "Branch Fusion Law" $
-    optimizeCombNode (Branch (optimizeCombNode (Pure (H.Haskell (ValueCode (Value v) c)) :<*> b))
-                             Empty br)
+    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
-    v Left{} = Left ()
-    v (Right r) = case getValue lr r of
-                   Left _ -> Left ()
-                   Right rr -> Right rr
-    c = [|| \case Left{} -> Left ()
-                  Right r -> case $$(code lr) r of
-                              Left _ -> Left ()
-                              Right rr -> Right rr ||]
-  -- Branch Distributivity Law
-  f :<$> Branch b l r ->
-    -- trace "Branch Distributivity Law" $
-    optimizeCombNode (Branch b (optimizeCombNode ((H..@) (H..) f :<$> l))
-                               (optimizeCombNode ((H..@) (H..) f :<$> r)))
+    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)
 
-  -- Match Absorption Law
-  Match _ _ Empty d ->
-    -- trace "Match Absorption Law" $
-    d
-  -- Match Weakening Law
-  Match _ bs a Empty
-    | all (\case {Empty -> True; _ -> False}) bs ->
-      -- trace "Match Weakening Law" $
-      optimizeCombNode (a :*> Empty)
-  -- Match Pure Law
-  Match ps bs (Pure (trans -> a)) d ->
-    -- trace "Match Pure Law" $
-    foldr (\(trans -> p, b) next ->
-      if getValue p (getValue a) then b else next
+-- 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
+  trans = \case
+    Conditional a ps bs b -> conditional (trans a) ps (trans Functor.<$> bs) (trans b)
+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)
-  -- Match Distributivity Law
-  f :<$> Match ps bs a d ->
-    -- trace "Match Distributivity Law" $
-    Match ps (optimizeCombNode . (f :<$>) Functor.<$> bs) a
-             (optimizeCombNode (f :<$> d))
+    -- & trace "Conditional Pure Law"
+  conditional a ps bs d = SomeComb (Conditional a ps bs d)
 
-  {- Possibly useless laws to be tested
-  Empty  :*> _ -> Empty
-  Empty :<*  _ -> Empty
-  -- App Definition of *> Law
-  H.Flip H..@ H.Const :<$> p :<*> q ->
-    -- -- trace "EXTRALAW: App Definition of *> Law" $
-    p :*> q
-  -- App Definition of <* Law
-  H.Const :<$> p :<*> q ->
-    -- -- trace "EXTRALAW: App Definition of <* Law" $
-    p :<* q
+-- 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
+  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
 
-  -- Functor Composition Law
-  -- (a shortcut that could also have been be caught
-  -- by the Composition Law and Homomorphism Law)
-  f :<$> (g :<$> p) ->
-    -- -- trace "EXTRALAW: Functor Composition Law" $
-    optimizeCombNode ((H.:.) H..@ f H..@ g :<$> p)
-  -- Applicable Failure Weakening Law
-  u :<*  Empty ->
-    -- -- trace "EXTRALAW: App Failure Weakening Law" $
-    optimizeCombNode (u :*> Empty)
-  Try (p :$> x) ->
-    -- -- trace "EXTRALAW: Try Interchange Right Law" $
-    optimizeCombNode (optimizeCombNode (Try p) :$> x)
-  -- App Reassociation Law 1
-  (u :*> v) :<*> w ->
-    -- -- trace "EXTRALAW: App Reassociation Law 1" $
-    optimizeCombNode (u :*> optimizeCombNode (v :<*> w))
-  -- App Reassociation Law 2
-  u :<*> (v :<* w) ->
-    -- -- trace "EXTRALAW: App Reassociation Law 2" $
-    optimizeCombNode (optimizeCombNode (u :<*> v) :<* w)
-  -- App Right Associativity Law
-  u :*> (v :*> w) ->
-    -- -- trace "EXTRALAW: App Right Associativity Law" $
-    optimizeCombNode (optimizeCombNode (u :*> v) :*> w)
-  -- App Reassociation Law 3
-  u :<*> (v :$> x) ->
-    -- -- trace "EXTRALAW: App Reassociation Law 3" $
-    optimizeCombNode (optimizeCombNode (u :<*> Pure x) :<* v)
+-- 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
+  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
+  look p@(Comb Pure{}) = p
+    -- & trace "Pure Look Law"
+  look p@(Comb Empty) = p
+    -- & trace "Dead Look Law"
+  look (Comb (Look x)) = look x
+    -- & trace "Idempotence Law"
+  look (Comb (NegLook x)) = negLook x
+    -- & trace "Left Identity Law"
+  look (Comb (p :$>: x)) = look p $> x
+    -- & trace "Interchange Law"
+  look (Comb (f :<$>: p)) = f <$> look p
+    -- & trace "Interchange Law"
+  look x = SomeComb (Look x)
 
-  Look (p :$> x) ->
-    optimizeCombNode (optimizeCombNode (Look p) :$> x)
-  NegLook (p :$> _) -> optimizeCombNode (NegLook p)
+  negLook (Comb Pure{}) = empty
+    -- & trace "Pure Negative-Look"
+  negLook (Comb Empty) = pure H.unit
+    -- & trace "Dead Negative-Look"
+  negLook (Comb (NegLook x)) = look (try x *> pure H.unit)
+    -- & trace "Double Negation Law"
+  negLook (Comb (Try x)) = negLook x
+    -- & trace "Zero Consumption Law"
+  negLook (Comb (Look x)) = negLook x
+    -- & trace "Right Identity Law"
+  negLook (Comb (Comb (Try p) :<|>: q)) = negLook p *> negLook q
+    -- & trace "Transparency Law"
+  negLook (Comb (p :$>: _)) = negLook p
+    -- & trace "NegLook Idempotence Law"
+  negLook x = SomeComb (NegLook x)
 
-  -- NegLook Absorption Law
-  p :<*> NegLook q ->
-    -- trace "EXTRALAW: Neglook Absorption Law" $
-    optimizeCombNode (optimizeCombNode (p :<*> Pure H.unit) :<* NegLook q)
-    -- Infinite loop, because :<* expands to :<*>
-  -}
+  eof = SomeComb Eof
 
-  x -> x
+-- Satisfiable
+data instance Comb (Satisfiable tok) repr a where
+  Satisfy ::
+    Satisfiable tok repr =>
+    [ErrorItem tok] ->
+    TermGrammar (tok -> Bool) ->
+    Comb (Satisfiable tok) repr tok
+  Item ::
+    Satisfiable tok repr =>
+    Comb (Satisfiable tok) repr tok
+instance Satisfiable tok repr => Trans (Comb (Satisfiable tok) repr) repr where
+  trans = \case
+    Satisfy es p -> satisfy es p
+    Item -> item
+instance
+  (Satisfiable tok repr, Typeable tok) =>
+  Satisfiable tok (SomeComb repr) where
+  satisfy es = SomeComb . Satisfy es
+  item = SomeComb Item
+
+-- Letable
+data instance Comb (Letable letName) repr a where
+  Def :: 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
+  trans = \case
+    Def n v -> def n (trans v)
+    Ref isRec n -> ref isRec n
+instance
+  (Letable letName repr, Typeable letName) =>
+  Letable letName (SomeComb repr) where
+  def n = SomeComb . Def n
+  ref isRec = SomeComb . Ref isRec
+instance MakeLetName TH.Name where
+  makeLetName _ = TH.qNewName "name"
diff --git a/src/Symantic/Parser/Grammar/View.hs b/src/Symantic/Parser/Grammar/View.hs
new file mode 100644
--- /dev/null
+++ b/src/Symantic/Parser/Grammar/View.hs
@@ -0,0 +1,74 @@
+module Symantic.Parser.Grammar.View where
+
+import Data.Bool (Bool)
+import Data.Function (($), (.), id)
+import Data.Semigroup (Semigroup(..))
+import Data.String (String, IsString(..))
+import Text.Show (Show(..))
+import qualified Control.Applicative as Fct
+import qualified Data.Tree as Tree
+import qualified Data.List as List
+
+import Symantic.Univariant.Letable
+import Symantic.Parser.Grammar.Combinators
+
+-- * Type 'ViewGrammar'
+newtype ViewGrammar (showName::Bool) a = ViewGrammar { unViewGrammar ::
+  Tree.Tree String }
+
+viewGrammar :: ViewGrammar sN a -> ViewGrammar sN a
+viewGrammar = id
+
+instance Show (ViewGrammar sN a) where
+  show = drawTree . 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) []
+
+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 $
+    Tree.Node
+      ( (if rec then "rec " else "ref ")
+      <> showLetName @sN name
+      ) []
+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
+  conditional a _ps bs b = ViewGrammar $ Tree.Node "conditional"
+    [ unViewGrammar a
+    , Tree.Node "bs" (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]
diff --git a/src/Symantic/Parser/Grammar/Write.hs b/src/Symantic/Parser/Grammar/Write.hs
--- a/src/Symantic/Parser/Grammar/Write.hs
+++ b/src/Symantic/Parser/Grammar/Write.hs
@@ -1,13 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Symantic.Parser.Grammar.Write where
 
+import Data.Bool (Bool(..))
 import Control.Monad (Monad(..))
 import Data.Function (($))
 import Data.Maybe (Maybe(..), fromMaybe, catMaybes)
 import Data.Monoid (Monoid(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (IsString(..))
-import Text.Show (Show(..))
 import qualified Data.Functor as Pre
 import qualified Data.List as List
 import qualified Data.Text.Lazy as TL
@@ -17,62 +17,64 @@
 import Symantic.Parser.Grammar.Combinators
 import Symantic.Parser.Grammar.Fixity
 
--- * Type 'WriteComb'
-newtype WriteComb a = WriteComb { unWriteComb :: WriteCombInh -> Maybe TLB.Builder }
+-- * Type 'WriteGrammar'
+newtype WriteGrammar (showName::Bool) a = WriteGrammar { unWriteGrammar :: WriteGrammarInh -> Maybe TLB.Builder }
 
-instance IsString (WriteComb a) where
-  fromString s = WriteComb $ \_inh ->
+instance IsString (WriteGrammar sN a) where
+  fromString s = WriteGrammar $ \_inh ->
     if List.null s then Nothing
     else Just (fromString s)
 
--- ** Type 'WriteCombInh'
-data WriteCombInh
- =   WriteCombInh
- {   writeCombInh_indent :: TLB.Builder
- ,   writeCombInh_op :: (Infix, Side)
- ,   writeCombInh_pair :: Pair
+-- ** Type 'WriteGrammarInh'
+data WriteGrammarInh
+ =   WriteGrammarInh
+ {   writeGrammarInh_indent :: TLB.Builder
+ ,   writeGrammarInh_op :: (Infix, Side)
+ ,   writeGrammarInh_pair :: Pair
  }
 
-emptyWriteCombInh :: WriteCombInh
-emptyWriteCombInh = WriteCombInh
- { writeCombInh_indent = "\n"
- , writeCombInh_op = (infixN0, SideL)
- , writeCombInh_pair = pairParen
+emptyWriteGrammarInh :: WriteGrammarInh
+emptyWriteGrammarInh = WriteGrammarInh
+ { writeGrammarInh_indent = "\n"
+ , writeGrammarInh_op = (infixN0, SideL)
+ , writeGrammarInh_pair = pairParen
  }
 
-writeComb :: WriteComb a -> TL.Text
-writeComb (WriteComb r) = TLB.toLazyText $ fromMaybe "" $ r emptyWriteCombInh
+writeGrammar :: WriteGrammar sN a -> TL.Text
+writeGrammar (WriteGrammar r) = TLB.toLazyText $ fromMaybe "" $ r emptyWriteGrammarInh
 
-pairWriteCombInh ::
+pairWriteGrammarInh ::
  Semigroup s => IsString s =>
- WriteCombInh -> Infix -> Maybe s -> Maybe s
-pairWriteCombInh inh op s =
-  if isPairNeeded (writeCombInh_op inh) op
+ WriteGrammarInh -> Infix -> Maybe s -> Maybe s
+pairWriteGrammarInh inh op s =
+  if isPairNeeded (writeGrammarInh_op inh) op
   then Just (fromString o<>" ")<>s<>Just (" "<>fromString c)
   else s
-  where (o,c) = writeCombInh_pair inh
+  where (o,c) = writeGrammarInh_pair inh
 
-instance Show letName => Letable letName WriteComb where
-  def name x = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
+instance
+  ShowLetName sN letName =>
+  Letable letName (WriteGrammar sN) where
+  def name x = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
       Just "def "
-      <> Just (fromString (show name))
-      <> unWriteComb x inh
+      <> Just (fromString (showLetName @sN name))
+      <> unWriteGrammar x inh
     where
     op = infixN 9
-  ref rec name = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
+  ref rec name = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
       Just (if rec then "rec " else "ref ") <>
-      Just (fromString (show name))
+      Just (fromString (showLetName @sN name))
     where
     op = infixN 9
-instance Applicable WriteComb where
-  pure _ = WriteComb $ return Nothing
+instance Applicable (WriteGrammar sN) where
+  pure _ = WriteGrammar $ return Nothing
   -- pure _ = "pure"
-  WriteComb x <*> WriteComb y = WriteComb $ \inh ->
+  WriteGrammar x <*> WriteGrammar y = WriteGrammar $ \inh ->
     let inh' side = inh
-         { writeCombInh_op = (op, side)
-         , writeCombInh_pair = pairParen
+         { writeGrammarInh_op = (op, side)
+         , writeGrammarInh_pair = pairParen
          } in
     case x (inh' SideL) of
      Nothing -> y (inh' SideR)
@@ -80,73 +82,73 @@
       case y (inh' SideR) of
        Nothing -> Just xt
        Just yt ->
-        pairWriteCombInh inh op $
+        pairWriteGrammarInh inh op $
           Just $ xt <> ", " <> yt
     where
     op = infixN 1
-instance Alternable WriteComb where
+instance Alternable (WriteGrammar sN) where
   empty = "empty"
-  try x = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
-      Just "try " <> unWriteComb x inh
+  try x = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
+      Just "try " <> unWriteGrammar x inh
     where
     op = infixN 9
-  x <|> y = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
-    unWriteComb x inh
-     { writeCombInh_op = (op, SideL)
-     , writeCombInh_pair = pairParen
+  x <|> y = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
+    unWriteGrammar x inh
+     { writeGrammarInh_op = (op, SideL)
+     , writeGrammarInh_pair = pairParen
      } <>
     Just " | " <>
-    unWriteComb y inh
-     { writeCombInh_op = (op, SideR)
-     , writeCombInh_pair = pairParen
+    unWriteGrammar y inh
+     { writeGrammarInh_op = (op, SideR)
+     , writeGrammarInh_pair = pairParen
      }
     where op = infixB SideL 3
-instance Satisfiable WriteComb tok where
+instance Satisfiable tok (WriteGrammar sN) where
   satisfy _es _f = "satisfy"
-instance Selectable WriteComb where
-  branch lr l r = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
+instance Selectable (WriteGrammar sN) where
+  branch lr l r = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
       Just "branch " <>
-      unWriteComb lr inh <> Just " " <>
-      unWriteComb l inh <> Just " " <>
-      unWriteComb r inh
+      unWriteGrammar lr inh <> Just " " <>
+      unWriteGrammar l inh <> Just " " <>
+      unWriteGrammar r inh
     where
     op = infixN 9
-instance Matchable WriteComb where
-  conditional _ps bs a d = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
+instance Matchable (WriteGrammar sN) where
+  conditional a _ps bs d = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
       Just "conditional " <>
-      Just "[" <>
+      unWriteGrammar a inh <>
+      Just " [" <>
       Just (mconcat (List.intersperse ", " $
       catMaybes $ (Pre.<$> bs) $ \x ->
-        unWriteComb x inh{writeCombInh_op=(infixN 0, SideL)})) <>
+        unWriteGrammar x inh{writeGrammarInh_op=(infixN 0, SideL)})) <>
       Just "] " <>
-      unWriteComb a inh <> Just " " <>
-      unWriteComb d inh
+      unWriteGrammar d inh
     where
     op = infixN 9
-instance Lookable WriteComb where
-  look x = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
-      Just "look " <> unWriteComb x inh
+instance Lookable (WriteGrammar sN) where
+  look x = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
+      Just "look " <> unWriteGrammar x inh
     where op = infixN 9
-  negLook x = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
-      Just "negLook " <> unWriteComb x inh
+  negLook x = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
+      Just "negLook " <> unWriteGrammar x inh
     where op = infixN 9
   eof = "eof"
-instance Foldable WriteComb where
-  chainPre f x = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
+instance Foldable (WriteGrammar sN) where
+  chainPre f x = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
       Just "chainPre " <>
-      unWriteComb f inh <> Just " " <>
-      unWriteComb x inh
+      unWriteGrammar f inh <> Just " " <>
+      unWriteGrammar x inh
     where op = infixN 9
-  chainPost f x = WriteComb $ \inh ->
-    pairWriteCombInh inh op $
+  chainPost f x = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
       Just "chainPost " <>
-      unWriteComb f inh <> Just " " <>
-      unWriteComb x inh
+      unWriteGrammar f inh <> Just " " <>
+      unWriteGrammar x inh
     where op = infixN 9
diff --git a/src/Symantic/Parser/Haskell.hs b/src/Symantic/Parser/Haskell.hs
--- a/src/Symantic/Parser/Haskell.hs
+++ b/src/Symantic/Parser/Haskell.hs
@@ -1,215 +1,8 @@
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TemplateHaskell #-}
--- | Haskell terms which are interesting
--- to pattern-match when optimizing.
-module Symantic.Parser.Haskell where
-
-import Data.Bool (Bool(..))
-import Data.Either (Either(..))
-import Data.Eq (Eq)
-import Data.Maybe (Maybe(..))
-import Data.Ord (Ord(..))
-import Data.Kind (Type)
-import Text.Show (Show(..), showParen, showString)
-import qualified Data.Eq as Eq
-import qualified Data.Function as Function
-import qualified Language.Haskell.TH as TH
-import qualified Language.Haskell.TH.Syntax as TH
-
-import Symantic.Univariant.Trans
-
--- * Type 'ValueCode'
--- | Compile-time 'value' and corresponding 'code'
--- (that can produce that value at runtime).
-data ValueCode a = ValueCode
-  { value :: Value a
-  , code :: TH.CodeQ a
-  }
-getValue :: ValueCode a -> a
-getValue = unValue Function.. value
-getCode :: ValueCode a -> TH.CodeQ a
-getCode = code
-
--- ** Type 'Value'
-newtype Value a = Value { unValue :: a }
-
--- * Class 'Haskellable'
--- | Final encoding of some Haskell functions
--- useful for some optimizations in 'optimizeComb'.
-class Haskellable (repr :: Type -> Type) where
-  (.) :: repr ((b->c) -> (a->b) -> a -> c)
-  ($) :: repr ((a->b) -> a -> b)
-  (.@) :: repr (a->b) -> repr a -> repr b
-  bool :: Bool -> repr Bool
-  char :: TH.Lift tok => tok -> repr tok
-  cons :: repr (a -> [a] -> [a])
-  const :: repr (a -> b -> a)
-  eq :: Eq a => repr a -> repr (a -> Bool)
-  flip :: repr ((a -> b -> c) -> b -> a -> c)
-  id :: repr (a->a)
-  nil :: repr [a]
-  unit :: repr ()
-  left :: repr (l -> Either l r)
-  right :: repr (r -> Either l r)
-  nothing :: repr (Maybe a)
-  just :: repr (a -> Maybe a)
-
--- ** Type 'Haskellable'
--- | Initial encoding of 'Haskellable'.
-data Haskell a where
-  Haskell :: ValueCode a -> Haskell a
-  (:.) :: Haskell ((b->c) -> (a->b) -> a -> c)
-  (:$) :: Haskell ((a->b) -> a -> b)
-  (:@) :: Haskell (a->b) -> Haskell a -> Haskell b
-  Cons :: Haskell (a -> [a] -> [a])
-  Const :: Haskell (a -> b -> a)
-  Eq :: Eq a => Haskell a -> Haskell (a -> Bool)
-  Flip :: Haskell ((a -> b -> c) -> b -> a -> c)
-  Id :: Haskell (a->a)
-  Unit :: Haskell ()
-infixr 0 $, :$
-infixr 9 ., :.
-infixl 9 .@, :@
-
-{-
-pattern (:.@) ::
-  -- Dummy constraint to get the following constraint
-  -- in scope when pattern-matching.
-  () =>
-  ((x -> y -> z) ~ ((b -> c) -> (a -> b) -> a -> c)) =>
-  Haskell x -> Haskell y -> Haskell z
-pattern (:.@) f g = (:.) :@ f :@ g
-pattern FlipApp ::
-  () =>
-  ((x -> y) ~ ((a -> b -> c) -> b -> a -> c)) =>
-  Haskell x -> Haskell y
-pattern FlipApp f = Flip :@ f
-pattern FlipConst ::
-  () =>
-  (x ~ (a -> b -> b)) =>
-  Haskell x
-pattern FlipConst = FlipApp Const
--}
-
-instance Show (Haskell a) where
-  showsPrec p = \case
-    Haskell{} -> showString "Haskell"
-    (:$) -> showString "($)"
-    (:.) :@ f :@ g ->
-      showParen (p >= 9)
-      Function.$ showsPrec 9 f
-      Function.. showString " . "
-      Function.. showsPrec 9 g
-    (:.) -> showString "(.)"
-    Cons :@ x :@ xs ->
-      showParen (p >= 10)
-      Function.$ showsPrec 10 x
-      Function.. showString " : "
-      Function.. showsPrec 10 xs
-    Cons -> showString "cons"
-    Const -> showString "const"
-    Eq x ->
-      showParen True
-      Function.$ showString "== "
-      Function.. showsPrec 0 x
-    Flip -> showString "flip"
-    Id -> showString "id"
-    Unit -> showString "()"
-    (:@) f x ->
-      showParen (p >= 10)
-      Function.$ showsPrec 10 f
-      Function.. showString " "
-      Function.. showsPrec 10 x
-instance Trans Haskell Value where
-  trans = value Function.. trans
-instance Trans Haskell TH.CodeQ where
-  trans = code Function.. trans
-instance Trans Haskell ValueCode where
-  trans = \case
-    Haskell x -> x
-    (:.) -> (.)
-    (:$) -> ($)
-    (:@) f x -> (.@) (trans f) (trans x)
-    Cons -> cons
-    Const -> const
-    Eq x -> eq (trans x)
-    Flip -> flip
-    Id -> id
-    Unit -> unit
-instance Trans ValueCode Haskell where
-  trans = Haskell
-type instance Output Haskell = ValueCode
-
-instance Haskellable Haskell where
-  (.)     = (:.)
-  ($)     = (:$)
-  -- Small optimizations, mainly to reduce dump sizes.
-  Id .@ x = x
-  (Const :@ x) .@ _y = x
-  ((Flip :@ Const) :@ _x) .@ y = y
-  --
-  f .@ x  = f :@ x
-  cons    = Cons
-  const   = Const
-  eq      = Eq
-  flip    = Flip
-  id      = Id
-  unit    = Unit
-  bool b  = Haskell (bool b)
-  char c  = Haskell (char c)
-  nil     = Haskell nil
-  left    = Haskell left
-  right   = Haskell right
-  nothing = Haskell nothing
-  just    = Haskell just
-instance Haskellable ValueCode where
-  (.)      = ValueCode (.) (.)
-  ($)      = ValueCode ($) ($)
-  (.@) f x = ValueCode ((.@) (value f) (value x)) ((.@) (code f) (code x))
-  bool b   = ValueCode (bool b) (bool b)
-  char c   = ValueCode (char c) (char c)
-  cons     = ValueCode cons cons
-  const    = ValueCode const const
-  eq x     = ValueCode (eq (value x)) (eq (code x))
-  flip     = ValueCode flip flip
-  id       = ValueCode id id
-  nil      = ValueCode nil nil
-  unit     = ValueCode unit unit
-  left     = ValueCode left left
-  right    = ValueCode right right
-  nothing  = ValueCode nothing nothing
-  just     = ValueCode just just
-instance Haskellable Value where
-  (.)      = Value (Function..)
-  ($)      = Value (Function.$)
-  (.@) f x = Value (unValue f (unValue x))
-  bool     = Value
-  char     = Value
-  cons     = Value (:)
-  const    = Value Function.const
-  eq x     = Value (unValue x Eq.==)
-  flip     = Value Function.flip
-  id       = Value Function.id
-  nil      = Value []
-  unit     = Value ()
-  left     = Value Left
-  right    = Value Right
-  nothing  = Value Nothing
-  just     = Value Just
-instance Haskellable TH.CodeQ where
-  (.)      = [|| (Function..) ||]
-  ($)      = [|| (Function.$) ||]
-  (.@) f x = [|| $$f $$x ||]
-  bool b   = [|| b ||]
-  char c   = [|| c ||]
-  cons     = [|| (:) ||]
-  const    = [|| Function.const ||]
-  eq x     = [|| ($$x Eq.==) ||]
-  flip     = [|| \f x y -> f y x ||]
-  id       = [|| \x -> x ||]
-  nil      = [|| [] ||]
-  unit     = [|| () ||]
-  left     = [|| Left ||]
-  right    = [|| Right ||]
-  nothing  = [|| Nothing ||]
-  just     = [|| Just ||]
+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
new file mode 100644
--- /dev/null
+++ b/src/Symantic/Parser/Haskell/Optimize.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ViewPatterns #-}
+module Symantic.Parser.Haskell.Optimize where
+
+import Data.Bool (Bool(..))
+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 qualified Language.Haskell.TH as TH
+import qualified Language.Haskell.TH.Syntax as TH
+
+import Symantic.Univariant.Trans
+import Symantic.Parser.Haskell.Term
+
+-- * Type 'Term'
+-- | Initial encoding of some 'Termable' symantics,
+-- useful for some optimizations in 'optimizeTerm'.
+data Term repr a where
+  -- | Black-box for all terms neither interpreted nor pattern-matched.
+  Term :: { unTerm :: repr a } -> Term repr a
+
+  -- Terms useful for 'optimizeTerm'.
+  (:@) :: Term repr (a->b) -> Term repr a -> Term repr b
+  Lam :: (Term repr a -> Term repr b) -> Term repr (a->b)
+  Lam1 :: (Term repr a -> Term repr b) -> Term repr (a->b)
+  Var :: String -> Term repr a
+
+  -- Terms useful for prettier dumps.
+  Char :: (TH.Lift tok, Show tok) => tok -> Term repr tok
+  Cons :: Term repr (a -> [a] -> [a])
+  Eq :: Eq.Eq a => Term repr (a -> a -> Bool)
+  {-
+  Const :: Term repr (a -> b -> a)
+  Flip :: Term repr ((a -> b -> c) -> b -> a -> c)
+  Id :: Term repr (a->a)
+  (:$) :: Term repr ((a->b) -> a -> b)
+  -- (:.) :: Term repr ((b->c) -> (a->b) -> a -> c)
+-- infixr 0 :$
+-- infixr 9 :.
+  -}
+infixl 9 :@
+
+type instance Output (Term repr) = repr
+instance Trans repr (Term repr) where
+  trans = Term
+
+instance Termable repr => Termable (Term repr) where
+  lam     = Lam
+  lam1    = Lam1
+  (.@)    = (:@)
+  cons    = Cons
+  eq      = Eq
+  unit    = Term unit
+  bool b  = Term (bool b)
+  char    = Char
+  nil     = Term nil
+  left    = Term left
+  right   = Term right
+  nothing = Term nothing
+  just    = Term just
+  const   = Lam1 (\x -> Lam1 (\_y -> x))
+  flip    = Lam1 (\f -> Lam1 (\x -> Lam1 (\y -> f .@ y .@ x)))
+  id      = Lam1 (\x -> x)
+  ($)     = Lam1 (\f -> Lam1 (\x -> f .@ x))
+  (.)     = Lam1 (\f -> Lam1 (\g -> Lam1 (\x -> f .@ (g .@ x))))
+
+-- | 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.
+-- This is mainly to get prettier splices.
+-- 
+-- DOC: Demonstrating Lambda Calculus Reduction, Peter Sestoft, 2001,
+-- https://www.itu.dk/people/sestoft/papers/sestoft-lamreduce.pdf
+optimizeTerm :: Term repr a -> Term repr a
+optimizeTerm = nor
+  where
+  -- | normal-order reduction
+  nor :: Term repr a -> Term repr a
+  nor = \case
+    Lam f -> Lam (nor Fun.. f)
+    Lam1 f -> Lam1 (nor Fun.. f)
+    x :@ y -> case whnf x of
+      Lam1 f -> nor (f y)
+      x' -> nor x' :@ nor y
+    x -> x
+  -- | weak-head normal-form
+  whnf :: Term repr a -> Term repr a
+  whnf = \case
+    x :@ y -> case whnf x of
+      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
+  -- out of a 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
new file mode 100644
--- /dev/null
+++ b/src/Symantic/Parser/Haskell/Term.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+-- | Haskell terms which are interesting
+-- to pattern-match when optimizing.
+module Symantic.Parser.Haskell.Term where
+
+import Data.Bool (Bool(..))
+import Data.Either (Either(..))
+import Data.Eq (Eq)
+import Data.Maybe (Maybe(..))
+import Data.Functor.Identity (Identity(..))
+import Prelude (undefined)
+import Text.Show (Show(..))
+import qualified Data.Eq as Eq
+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
+  -- | Application, aka. unabstract.
+  (.@) :: repr (a->b) -> repr a -> repr b
+  -- | 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)
+
+  default (.@) ::
+    Sym.Liftable2 repr => Termable (Sym.Output repr) =>
+    repr (a->b) -> repr a -> repr b
+  default lam ::
+    Sym.Liftable repr => Sym.Unliftable repr => Termable (Sym.Output repr) =>
+    (repr a -> repr b) -> repr (a->b)
+  default lam1 ::
+    Sym.Liftable repr => Sym.Unliftable repr => Termable (Sym.Output repr) =>
+    (repr a -> repr b) -> repr (a->b)
+  default bool ::
+    Sym.Liftable repr => Termable (Sym.Output repr) =>
+    Bool -> repr Bool
+  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 ()
+  default left ::
+    Sym.Liftable repr => Termable (Sym.Output repr) =>
+    repr (l -> Either l r)
+  default right ::
+    Sym.Liftable repr => Termable (Sym.Output repr) =>
+    repr (r -> Either l r)
+  default nothing ::
+    Sym.Liftable repr => Termable (Sym.Output repr) =>
+    repr (Maybe a)
+  default just ::
+    Sym.Liftable repr => Termable (Sym.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 .@
+
+-- * 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
new file mode 100644
--- /dev/null
+++ b/src/Symantic/Parser/Haskell/View.hs
@@ -0,0 +1,114 @@
+{-# 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.hs b/src/Symantic/Parser/Machine.hs
--- a/src/Symantic/Parser/Machine.hs
+++ b/src/Symantic/Parser/Machine.hs
@@ -1,35 +1,40 @@
 module Symantic.Parser.Machine
- ( module Symantic.Parser.Machine
- , module Symantic.Parser.Machine.Instructions
- , module Symantic.Parser.Machine.Dump
- , module Symantic.Parser.Machine.Generate
- , module Symantic.Parser.Machine.Input
- ) where
+  ( module Symantic.Parser.Machine
+  , module Symantic.Parser.Machine.Generate
+  , module Symantic.Parser.Machine.Input
+  , module Symantic.Parser.Machine.Instructions
+  , module Symantic.Parser.Machine.Optimize
+  , module Symantic.Parser.Machine.Program
+  , module Symantic.Parser.Machine.View
+  ) where
 import Data.Function ((.))
 import Data.Ord (Ord)
-import Symantic.Parser.Machine.Input
-import Symantic.Parser.Grammar
 import Text.Show (Show)
 import qualified Language.Haskell.TH.Syntax as TH
 
-import Symantic.Parser.Machine.Instructions
-import Symantic.Parser.Machine.Dump
+import Symantic.Parser.Grammar
 import Symantic.Parser.Machine.Generate
+import Symantic.Parser.Machine.Input
+import Symantic.Parser.Machine.Instructions
+import Symantic.Parser.Machine.Optimize
+import Symantic.Parser.Machine.Program
+import Symantic.Parser.Machine.View
 
 -- * Type 'Parser'
-type Parser inp =
+type Parser inp = ParserRepr Gen inp
+
+-- | Like a 'Parser' but not bound to the 'Gen' interpreter.
+type ParserRepr repr inp =
   ObserveSharing TH.Name
-                 (OptimizeComb TH.Name
-                               (Machine inp))
+                 (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) =>
-  -- InputToken inp ~ Char =>
-  Executable repr =>
-  Readable repr (InputToken inp) =>
-  Grammar (Machine inp) =>
-  Parser inp a ->
+  Grammar (InputToken inp) (Program repr inp) =>
+  Machine (InputToken inp) repr =>
+  ParserRepr repr inp a ->
   repr inp '[] ('Succ 'Zero) a
-machine = runMachine . optimizeComb . observeSharing
+machine = optimizeMachine . grammar @(InputToken inp)
diff --git a/src/Symantic/Parser/Machine/Dump.hs b/src/Symantic/Parser/Machine/Dump.hs
deleted file mode 100644
--- a/src/Symantic/Parser/Machine/Dump.hs
+++ /dev/null
@@ -1,82 +0,0 @@
-module Symantic.Parser.Machine.Dump where
-
-import Data.Function (($), (.), id)
-import Data.Functor ((<$>))
-import Data.Kind (Type)
-import Data.Semigroup (Semigroup(..))
-import Data.String (String, IsString(..))
-import Text.Show (Show(..))
-import qualified Data.Tree as Tree
-import qualified Data.List as List
-
-import Symantic.Parser.Machine.Instructions
-
--- * Type 'DumpInstr'
-newtype DumpInstr inp (vs:: [Type]) (es::Peano) a
-  =     DumpInstr { unDumpInstr ::
-  Tree.Forest String -> Tree.Forest String }
-
-dumpInstr :: DumpInstr inp vs es a -> DumpInstr inp vs es a
-dumpInstr = id
-
--- | Helper to dump a command.
-dumpInstrCmd :: String -> Tree.Forest String -> Tree.Tree String
-dumpInstrCmd n = Tree.Node n
--- | Helper to dump an argument.
-dumpInstrArg :: String -> Tree.Forest String -> Tree.Tree String
-dumpInstrArg n = Tree.Node ("<"<>n<>">")
-
-instance Show (DumpInstr inp vs es a) where
-  show = drawTree . Tree.Node "" . ($ []) . unDumpInstr
-    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 (DumpInstr inp vs es a) where
-  fromString s = DumpInstr $ \is -> Tree.Node (fromString s) [] : is
-
-instance Stackable DumpInstr where
-  push a k = DumpInstr $ \is -> dumpInstrCmd ("push "<>showsPrec 10 a "") [] : unDumpInstr k is
-  pop k = DumpInstr $ \is -> dumpInstrCmd "pop" [] : unDumpInstr k is
-  liftI2 f k = DumpInstr $ \is -> dumpInstrCmd ("lift "<>show f) [] : unDumpInstr k is
-  swap k = DumpInstr $ \is -> dumpInstrCmd "swap" [] : unDumpInstr k is
-instance Branchable DumpInstr where
-  case_ l r = DumpInstr $ \is -> dumpInstrCmd "case"
-    [ dumpInstrArg "left" (unDumpInstr l [])
-    , dumpInstrArg "right" (unDumpInstr r [])
-    ] : is
-  choices ps bs d = DumpInstr $ \is ->
-    dumpInstrCmd ("choices "<>show ps) (
-      (dumpInstrArg "branch" . ($ []) . unDumpInstr <$> bs) <>
-      [ dumpInstrArg "default" (unDumpInstr d []) ]
-    ) : is
-instance Failable DumpInstr where
-  fail _err = DumpInstr $ \is -> dumpInstrCmd "fail" [] : is
-  popFail k = DumpInstr $ \is -> dumpInstrCmd "popFail" [] : unDumpInstr k is
-  catchFail t h = DumpInstr $ \is -> dumpInstrCmd "catchFail"
-    [ dumpInstrArg "try" (unDumpInstr t [])
-    , dumpInstrArg "handler" (unDumpInstr h [])
-    ] : is
-instance Inputable DumpInstr where
-  loadInput k = DumpInstr $ \is -> dumpInstrCmd "loadInput" [] : unDumpInstr k is
-  pushInput k = DumpInstr $ \is -> dumpInstrCmd "pushInput" [] : unDumpInstr k is
-instance Routinable DumpInstr where
-  subroutine n sub k = DumpInstr $ \is ->
-    Tree.Node (show n<>":") (unDumpInstr sub [])
-    : unDumpInstr k is
-  jump n = DumpInstr $ \is -> dumpInstrCmd ("jump "<>show n) [] : is
-  call n k = DumpInstr $ \is -> dumpInstrCmd ("call "<>show n) [] : unDumpInstr k is
-  ret = DumpInstr $ \is -> dumpInstrCmd "ret" [] : is
-instance Joinable DumpInstr where
-  defJoin n sub k = DumpInstr $ \is ->
-    Tree.Node (show n<>":") (unDumpInstr sub [])
-    : unDumpInstr k is
-  refJoin n = DumpInstr $ \is -> dumpInstrCmd ("refJoin "<>show n) [] : is
-instance Readable DumpInstr inp where
-  read _es _p k = DumpInstr $ \is -> dumpInstrCmd "read" [] : unDumpInstr k is
diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs
--- a/src/Symantic/Parser/Machine/Generate.hs
+++ b/src/Symantic/Parser/Machine/Generate.hs
@@ -9,19 +9,22 @@
 import Data.Bool (Bool)
 import Data.Char (Char)
 import Data.Either (Either(..))
-import Data.Function (($))
--- import Data.Functor ((<$>))
+import Data.Function (($), (.))
+import Data.Functor ((<$>))
 import Data.Int (Int)
+import Data.List (minimum)
+import Data.Map (Map)
 import Data.Maybe (Maybe(..))
-import Data.Ord (Ord, Ordering(..))
+import Data.Ord (Ord(..), Ordering(..))
 import Data.Semigroup (Semigroup(..))
 import Data.Set (Set)
 import Language.Haskell.TH (CodeQ, Code(..))
-import Prelude (($!))
+import Prelude ((+), (-))
 import Text.Show (Show(..))
-import qualified Data.Eq as Eq
+import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Language.Haskell.TH.Syntax as TH
+-- import qualified Control.Monad.Trans.Writer as Writer
 
 import Symantic.Univariant.Trans
 import Symantic.Parser.Grammar.Combinators (ErrorItem(..))
@@ -29,17 +32,31 @@
 import Symantic.Parser.Machine.Instructions
 import qualified Symantic.Parser.Haskell as H
 
+genCode :: TermInstr a -> CodeQ a
+genCode = trans
+
 -- * Type 'Gen'
 -- | Generate the 'CodeQ' parsing the input.
-newtype Gen inp vs es a = Gen { unGen ::
-  GenCtx inp vs es a ->
-  CodeQ (Either (ParsingError inp) a)
-}
+data Gen inp vs es 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.
+  , unGen ::
+      GenCtx inp vs es 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))
   }
@@ -48,6 +65,14 @@
 -- ** 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 ->
@@ -56,13 +81,6 @@
   Cursor inp ->
   Either (ParsingError inp) a
 
--- ** Type 'SubRoutine'
-type SubRoutine inp v a =
-  {-ok-}Cont inp v a ->
-  Cursor inp ->
-  {-ko-}FailHandler inp a ->
-  Either (ParsingError inp) a
-
 -- ** Type 'FailHandler'
 type FailHandler inp a =
   {-failureInput-}Cursor inp ->
@@ -78,9 +96,9 @@
   }
 -}
 
--- | @('generate' input mach)@ generates @TemplateHaskell@ code
--- parsing given 'input' according to given 'mach'ine.
-generate ::
+-- | @('generateCode' input mach)@ generates @TemplateHaskell@ code
+-- parsing the given 'input' according to the given 'Machine'.
+generateCode ::
   forall inp ret.
   Ord (InputToken inp) =>
   Show (InputToken inp) =>
@@ -91,7 +109,7 @@
   Show (Cursor inp) =>
   Gen inp '[] ('Succ 'Zero) ret ->
   CodeQ (Either (ParsingError inp) ret)
-generate input (Gen k) = [||
+generateCode input k = [||
   -- Pattern bindings containing unlifted types
   -- should use an outermost bang pattern.
   let !(# init, readMore, readNext #) = $$(cursorOf input) in
@@ -105,7 +123,7 @@
             else Nothing
         , parsingErrorExpecting = Set.fromList farExp
         } in
-  $$(k GenCtx
+  $$(unGen k GenCtx
     { valueStack = ValueStackEmpty
     , failStack = FailStackCons [||finalFail||] FailStackEmpty
     , retCode = [||finalRet||]
@@ -115,11 +133,14 @@
     -- , farthestError = [||Nothing||]
     , farthestInput = [||init||]
     , farthestExpecting = [|| [] ||]
+    , checkedHorizon = 0
+    , minHorizonByName = Map.empty
     })
   ||]
 
 -- ** Type 'GenCtx'
--- | This is a context only present at compile-time.
+-- | This is an inherited (top-down) context
+-- only present at compile-time, to build TemplateHaskell splices.
 data GenCtx inp vs (es::Peano) a =
   ( TH.Lift (InputToken inp)
   , Cursorable (Cursor inp)
@@ -127,290 +148,322 @@
   -- , InputToken inp ~ Char
   ) => GenCtx
   { valueStack :: ValueStack vs
-  , failStack :: FailStack inp es a
+  , failStack :: FailStack inp a es
+  --, failStacks :: FailStack inp es a
   , retCode :: CodeQ (Cont inp a a)
   , input :: CodeQ (Cursor inp)
   , moreInput :: CodeQ (Cursor inp -> Bool)
   , nextInput :: CodeQ (Cursor inp -> (# InputToken inp, Cursor inp #))
   , farthestInput :: CodeQ (Cursor inp)
   , farthestExpecting :: CodeQ [ErrorItem (InputToken inp)]
+    -- | Remaining horizon already checked.
+    -- Updated by 'checkHorizon'
+    -- and reset elsewhere when needed.
+  , checkedHorizon :: Offset
+    -- | Minimal horizon for each 'subroutine' 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 Offset
   }
 
 -- ** Type 'ValueStack'
 data ValueStack vs where
   ValueStackEmpty :: ValueStack '[]
   ValueStackCons ::
-    -- TODO: maybe use H.Haskell instead of CodeQ ?
-    -- as in https://github.com/j-mie6/ParsleyHaskell/popFail/3ec0986a5017866919a6404c14fe78678b7afb46
-    { valueStackHead :: CodeQ v
+    { valueStackHead :: TermInstr v
     , valueStackTail :: ValueStack vs
     } -> ValueStack (v ': vs)
 
 -- ** Type 'FailStack'
-data FailStack inp es a where
-  FailStackEmpty :: FailStack inp 'Zero a
+data FailStack inp a es where
+  FailStackEmpty :: FailStack inp a 'Zero
   FailStackCons ::
     { failStackHead :: CodeQ (FailHandler inp a)
-    , failStackTail :: FailStack inp es a
+    , failStackTail :: FailStack inp a es
     } ->
-    FailStack inp ('Succ es) a
+    FailStack inp a ('Succ es)
 
 instance Stackable Gen where
-  push x k = Gen $ \ctx -> unGen k ctx
-    { valueStack = ValueStackCons (liftCode x) (valueStack ctx) }
-  pop k = Gen $ \ctx -> unGen k ctx
-    { valueStack = valueStackTail (valueStack ctx) }
-  liftI2 f k = Gen $ \ctx -> unGen k ctx
-    { valueStack =
-      let ValueStackCons y (ValueStackCons x xs) = valueStack ctx in
-      ValueStackCons (liftCode2 f x y) xs
+  push x k = k
+    { unGen = \ctx -> unGen k ctx
+      { valueStack = ValueStackCons x (valueStack ctx) }
     }
-  swap k = Gen $ \ctx -> unGen k ctx
-    { valueStack =
+  pop k = k
+    { unGen = \ctx -> unGen k ctx
+      { valueStack = valueStackTail (valueStack ctx) }
+    }
+  liftI2 f k = k
+    { unGen = \ctx -> unGen k ctx
+      { valueStack =
         let ValueStackCons y (ValueStackCons x xs) = valueStack ctx in
-        ValueStackCons x (ValueStackCons y xs)
+        ValueStackCons (f H.:@ x H.:@ y) xs
+      }
     }
+  swap k = k
+    { unGen = \ctx -> unGen k ctx
+      { valueStack =
+          let ValueStackCons y (ValueStackCons x xs) = valueStack ctx in
+          ValueStackCons x (ValueStackCons y xs)
+      }
+    }
 instance Branchable Gen where
-  case_ kx ky = Gen $ \ctx ->
-    let ValueStackCons v vs = valueStack ctx in
-    [||
-      case $$v of
-        Left  x -> $$(unGen kx ctx{ valueStack = ValueStackCons [||x||] vs })
-        Right y -> $$(unGen ky ctx{ valueStack = ValueStackCons [||y||] vs })
-    ||]
-  choices fs ks kd = Gen $ \ctx ->
-    let ValueStackCons v vs = valueStack ctx in
-    go ctx{valueStack = vs} v fs ks
+  caseI kx ky = Gen
+    { minHorizon = \ls ->
+      minHorizon kx ls `min` minHorizon ky ls
+    , unGen = \ctx ->
+      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 })
+      ||]
+    }
+  choices fs ks kd = Gen
+    { minHorizon = \hs -> minimum $
+        minHorizon kd hs :
+        (($ hs) . minHorizon <$> ks)
+    , unGen = \ctx ->
+      let ValueStackCons v vs = valueStack ctx in
+      go ctx{valueStack = vs} v fs ks
+    }
     where
-    go ctx x (f:fs') (Gen k:ks') = [||
-      if $$(liftCode1 f x) then $$(k ctx)
+    go ctx x (f:fs') (k:ks') = [||
+      if $$(genCode (f H.:@ x))
+      then $$(unGen k ctx)
       else $$(go ctx x fs' ks')
       ||]
     go ctx _ _ _ = unGen kd ctx
 instance Failable Gen where
-  fail failExp = Gen $ \ctx@GenCtx{} -> [||
-    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
-    {-
-    trace ("fail: "
-      <>" failExp="<>show @[ErrorItem Char] failExp
-      <>" farthestExpecting="<>show @[ErrorItem Char] ($$(farthestExpecting ctx))
-      <>" farExp="<>show @[ErrorItem Char] farExp) $
-    -}
-    $$(failStackHead (failStack ctx))
-      $$(input ctx) farInp farExp
-    ||]
-  popFail k = Gen $ \ctx ->
-    let FailStackCons _e es = failStack ctx in
-    unGen k ctx{failStack = es}
-  catchFail ok ko = Gen $ \ctx@GenCtx{} -> [||
-    let _ = "catchFail" in $$(unGen ok ctx
-      { failStack = FailStackCons [|| \(!failInp) (!farInp) (!farExp) ->
-          -- trace ("catchFail: " <> "farExp="<>show farExp) $
-          $$(unGen ko ctx
-            -- Push the input as it was when entering the catchFail.
-            { valueStack = ValueStackCons (input ctx) (valueStack ctx)
-            -- Move the input to the failing position.
-            , input = [||failInp||]
-            -- Set the farthestInput to the farthest computed by 'fail'
-            , farthestInput = [||farInp||]
-            , farthestExpecting = [||farExp||]
-            })
-        ||] (failStack ctx)
-      })
-    ||]
+  fail failExp = Gen
+    { minHorizon = \_hs -> 0
+    , unGen = \ctx@GenCtx{} -> [||
+      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
+      $$(failStackHead (failStack ctx))
+        $$(input ctx) farInp farExp
+      ||]
+    }
+  popFail k = k
+    { unGen = \ctx ->
+      unGen k ctx{failStack = failStackTail (failStack ctx)}
+    }
+  catchFail ok ko = Gen
+    { minHorizon = \ls -> minHorizon ok ls `min` minHorizon ko ls
+    , unGen = \ctx@GenCtx{} -> unGen ok ctx
+        { failStack = FailStackCons [|| \ !failInp !farInp !farExp ->
+            -- trace ("catchFail: " <> "farExp="<>show farExp) $
+            $$(unGen ko ctx
+              -- Push the input as it was when entering the catchFail.
+              { valueStack = ValueStackCons (H.Term (input ctx)) (valueStack ctx)
+              -- Move the input to the failing position.
+              , input = [||failInp||]
+              -- Set the farthestInput to the farthest computed by 'fail'
+              , farthestInput = [||farInp||]
+              , farthestExpecting = [||farExp||]
+              })
+          ||] (failStack ctx)
+        }
+    }
 instance Inputable Gen where
-  loadInput k = Gen $ \ctx ->
-    let ValueStackCons input vs = valueStack ctx in
-    unGen k ctx{valueStack = vs, input}
-  pushInput k = Gen $ \ctx ->
-    unGen k ctx{valueStack = ValueStackCons (input ctx) (valueStack ctx)}
+  loadInput k = k
+    { unGen = \ctx ->
+      let ValueStackCons input vs = valueStack ctx in
+      unGen k ctx
+        { valueStack = vs
+        , input = genCode input
+        , checkedHorizon = 0
+        }
+    }
+  pushInput k = k
+    { unGen = \ctx ->
+      unGen k ctx{valueStack = ValueStackCons (H.Term (input ctx)) (valueStack ctx)}
+    }
 instance Routinable Gen where
-  call (LetName n) k = Gen $ \ctx -> [||
-    let _ = "call" in
-    $$(Code (TH.unsafeTExpCoerce (return (TH.VarE n))))
-      $$(suspend k ctx)
-      $$(input ctx)
-      $! $$(failStackHead (failStack ctx))
-    ||]
-  jump (LetName n) = Gen $ \ctx -> [||
-    let _ = "jump" in
-    $$(Code (TH.unsafeTExpCoerce (return (TH.VarE n))))
-      $$(retCode ctx)
-      $$(input ctx)
-      $! $$(failStackHead (failStack ctx))
-    ||]
-  ret = Gen $ \ctx -> unGen (resume (retCode ctx)) ctx
-  subroutine (LetName n) sub k = Gen $ \ctx -> Code $ TH.unsafeTExpCoerce $ do
-    body <- TH.unTypeQ $ TH.examineCode $ [|| -- buildRec in Parsley
-      -- SubRoutine
-      -- Why using $! at call site and not ! here on ko?
-      \ !ok !inp ko ->
-        $$(unGen sub ctx
-          { valueStack = ValueStackEmpty
-          , failStack = FailStackCons [||ko||] FailStackEmpty
-          , input = [||inp||]
-          , retCode = [||ok||]
-          -- , farthestInput = [|inp|]
-          -- , farthestExpecting = [|| [] ||]
-          })
+  subroutine (LetName n) sub k = Gen
+    { minHorizon = minHorizon k
+    , unGen = \ctx -> 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)
+      body <- TH.unTypeQ $ TH.examineCode $ [|| -- buildRec in Parsley
+        -- subroutine called by 'call' or 'jump'
+        \ !ok{-from generateSuspend or retCode-}
+          !inp
+          !ko{-from failStackHead-} ->
+          $$(unGen sub ctx
+            { valueStack = ValueStackEmpty
+            , failStack = FailStackCons [||ko||] FailStackEmpty
+            , input = [||inp||]
+            , retCode = [||ok||]
+
+            -- These are passed by the caller via 'ok' or 'ko'
+            -- , farthestInput = 
+            -- , farthestExpecting = 
+
+            -- Some callers can call this subroutine
+            -- with zero checkedHorizon, hence use this minimum.
+            -- TODO: maybe it could be improved a bit
+            -- by taking the minimum of the checked horizons
+            -- before all the 'call's and 'jump's to this subroutine.
+            , checkedHorizon = 0
+            , minHorizonByName = minHorizonByNameButSub
+            })
+        ||]
+      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)
+        }))
+      return (TH.LetE [decl] expr)
+    }
+  jump (LetName n) = Gen
+    { minHorizon = (Map.! n)
+    , unGen = \ctx -> [||
+      let _ = "jump" in
+      $$(Code (TH.unsafeTExpCoerce (return (TH.VarE n))))
+        {-ok-}$$(retCode ctx)
+        $$(input ctx)
+        $$(failStackHead (failStack ctx))
       ||]
-    let decl = TH.FunD n [TH.Clause [] (TH.NormalB body) []]
-    expr <- TH.unTypeQ (TH.examineCode (unGen k ctx))
-    return (TH.LetE [decl] expr)
+    }
+  call (LetName n) k = k
+    { minHorizon = (Map.! n)
+    , unGen = \ctx -> [||
+      let _ = "call" in
+      $$(Code (TH.unsafeTExpCoerce (return (TH.VarE n))))
+        {-ok-}$$(generateSuspend k ctx)
+        $$(input ctx)
+        $$(failStackHead (failStack ctx))
+      ||]
+    }
+  ret = Gen
+    { minHorizon = \_hs -> 0
+    , unGen = \ctx -> unGen (generateResume (retCode ctx)) ctx
+    }
 
-suspend ::
+-- | Generate a continuation to be called with 'generateResume',
+-- used when 'call' 'ret'urns.
+-- The return 'v'alue is 'push'ed on the 'valueStack'.
+generateSuspend ::
   {-k-}Gen inp (v ': vs) es a ->
   GenCtx inp vs es a ->
   CodeQ (Cont inp v a)
-suspend k ctx = [||
+generateSuspend k ctx = [||
   let _ = "suspend" in
   \farInp farExp v !inp ->
     $$(unGen k ctx
-      { valueStack = ValueStackCons [||v||] (valueStack ctx)
+      { valueStack = ValueStackCons (H.Term [||v||]) (valueStack ctx)
       , input = [||inp||]
       , farthestInput = [||farInp||]
       , farthestExpecting = [||farExp||]
+      , checkedHorizon = 0
       }
     )
   ||]
 
-resume :: CodeQ (Cont inp v a) -> Gen inp (v ': vs) es a
-resume k = Gen $ \ctx -> [||
-  let _ = "resume" in
-  $$k
-    $$(farthestInput ctx)
-    $$(farthestExpecting ctx)
-    $$(valueStackHead (valueStack ctx))
-    $$(input ctx)
-  ||]
+-- | Generate a call to the 'generateSuspend' continuation.
+-- Used when 'call' 'ret'urns.
+generateResume ::
+  CodeQ (Cont inp v a) ->
+  Gen inp (v ': vs) es a
+generateResume k = Gen
+  { minHorizon = \_hs -> 0
+  , unGen = \ctx -> [||
+    let _ = "resume" in
+    $$k
+      $$(farthestInput ctx)
+      $$(farthestExpecting ctx)
+      (let _ = "resume.genCode" in $$(genCode (valueStackHead (valueStack ctx))))
+      $$(input ctx)
+    ||]
+  }
 
 instance Joinable Gen where
-  defJoin (LetName n) sub k = Gen $ \ctx -> Code $ TH.unsafeTExpCoerce $ do
-    body <- TH.unTypeQ $ TH.examineCode $ [||
-      \farInp farExp v !inp ->
-        $$(unGen sub ctx
-          { valueStack = ValueStackCons [||v||] (valueStack ctx)
-          , input = [||inp||]
-          , farthestInput = [||farInp||]
-          , farthestExpecting = [||farExp||]
-          })
-      ||]
-    let decl = TH.FunD n [TH.Clause [] (TH.NormalB body) []]
-    expr <- TH.unTypeQ (TH.examineCode (unGen k ctx))
-    return (TH.LetE [decl] expr)
-  refJoin (LetName n) =
-    resume (Code (TH.unsafeTExpCoerce (return (TH.VarE n))))
-instance Readable Gen Char where
-  read farExp p k =
-    -- TODO: piggy bank
-    maybeEmitCheck (Just 1) k
-    where
-    maybeEmitCheck Nothing ok = sat (liftCode p) ok (fail farExp)
-    maybeEmitCheck (Just n) ok = Gen $ \ctx ->
-      let FailStackCons e es = failStack ctx in
-      [||
-      let readFail = $$(e) in -- Factorize failure code
-      $$((`unGen` ctx{failStack = FailStackCons [||readFail||] es}) $ emitLengthCheck n
-        {-ok-}(sat (liftCode p) ok
-          {-ko-}(fail farExp))
-        {-ko-}(fail farExp))
-      ||]
+  defJoin (LetName n) joined k = k
+    { minHorizon = minHorizon k
+    , unGen = \ctx -> Code $ TH.unsafeTExpCoerce $ do
+      body <- TH.unTypeQ $ TH.examineCode $ [||
+        \farInp farExp v !inp ->
+          $$(unGen joined ctx
+            { valueStack = ValueStackCons (H.Term [||v||]) (valueStack ctx)
+            , input = [||inp||]
+            , farthestInput = [||farInp||]
+            , farthestExpecting = [||farExp||]
+            , checkedHorizon = 0
+            })
+        ||]
+      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 'subroutine'.
+              (minHorizon joined (minHorizonByName ctx))
+              (minHorizonByName ctx)
+        }))
+      return (TH.LetE [decl] expr)
+    }
+  refJoin (LetName n) = (generateResume (Code (TH.unsafeTExpCoerce (return (TH.VarE n)))))
+    { minHorizon = (Map.! n)
+    }
+instance Readable Char Gen where
+  read farExp p = checkHorizon . checkToken farExp p
 
-sat ::
+checkHorizon ::
+  TH.Lift (InputToken inp) =>
+  {-ok-}Gen inp vs ('Succ es) a ->
+  Gen inp vs ('Succ es) a
+checkHorizon ok = ok
+  { minHorizon = \hs -> 1 + minHorizon ok hs
+  , unGen = \ctx0@GenCtx{failStack = FailStackCons e es} -> [||
+      -- Factorize failure code
+      let readFail = $$(e) in
+      $$(
+        let ctx = ctx0{ failStack = FailStackCons [||readFail||] es } in
+        if checkedHorizon ctx >= 1
+        then unGen ok ctx0{checkedHorizon = checkedHorizon ctx - 1}
+        else let minHoriz = minHorizon ok (minHorizonByName ctx) in
+          [||
+          if $$(moreInput ctx)
+               $$(if minHoriz > 0
+                 then [||$$shiftRight minHoriz $$(input ctx)||]
+                 else input ctx)
+          then $$(unGen ok ctx{checkedHorizon = minHoriz})
+          else let _ = "checkHorizon.else" in
+            $$(unGen (fail [ErrorItemHorizon (minHoriz + 1)]) ctx)
+          ||]
+      )
+    ||]
+  }
+
+checkToken ::
   forall inp vs es a.
-  -- Cursorable (Cursor inp) =>
-  -- InputToken inp ~ Char =>
   Ord (InputToken inp) =>
   TH.Lift (InputToken inp) =>
-  {-predicate-}CodeQ (InputToken inp -> Bool) ->
+  [ErrorItem (InputToken inp)] ->
+  {-predicate-}TermInstr (InputToken inp -> Bool) ->
   {-ok-}Gen inp (InputToken inp ': vs) ('Succ es) a ->
-  {-ko-}Gen inp vs ('Succ es) a ->
   Gen inp vs ('Succ es) a
-sat p ok ko = Gen $ \ctx -> [||
-  let !(# c, cs #) = $$(nextInput ctx) $$(input ctx) in
-  if $$p c
-  then $$(unGen ok ctx
-    { valueStack = ValueStackCons [||c||] (valueStack ctx)
-    , input = [||cs||]
-    })
-  else let _ = "sat.else" in $$(unGen ko ctx)
-  ||]
-
-{-
-evalSat ::
-  -- Cursorable inp =>
-  -- HandlerOps inp =>
-  InstrPure (Char -> Bool) ->
-  Gen inp (Char ': vs) ('Succ es) a ->
-  Gen inp vs ('Succ es) a
-evalSat p k = do
-  bankrupt <- asks isBankrupt
-  hasChange <- asks hasCoin
-  if | bankrupt -> maybeEmitCheck (Just 1) <$> k
-     | hasChange -> maybeEmitCheck Nothing <$> local spendCoin k
-     | otherwise -> local breakPiggy (maybeEmitCheck . Just <$> asks coins <*> local spendCoin k)
-  where
-  maybeEmitCheck Nothing mk ctx = sat (genDefunc p) mk (raise ctx) ctx
-  maybeEmitCheck (Just n) mk ctx =
-    [|| let bad = $$(raise ctx) in $$(emitLengthCheck n (sat (genDefunc p) mk [||bad||]) [||bad||] ctx)||]
--}
-
-emitLengthCheck ::
-  TH.Lift (InputToken inp) =>
-  Int -> Gen inp vs es a -> Gen inp vs es a -> Gen inp vs es a
-emitLengthCheck 0 ok _ko = ok
-emitLengthCheck 1 ok ko = Gen $ \ctx -> [||
-  if $$(moreInput ctx) $$(input ctx)
-  then $$(unGen ok ctx)
-  else let _ = "sat.length-check.else" in $$(unGen ko ctx)
-  ||]
-{-
-emitLengthCheck n ok ko ctx = Gen $ \ctx -> [||
-  if $$moreInput ($$shiftRight $$(input ctx) (n - 1))
-  then $$(unGen ok ctx)
-  else $$(unGen ko ctx {farthestExpecting = [||farExp||]})
-  ||]
--}
-
-
-liftCode :: InstrPure a -> CodeQ a
-liftCode = trans
-{-# INLINE liftCode #-}
-
-liftCode1 :: InstrPure (a -> b) -> CodeQ a -> CodeQ b
-liftCode1 p a = case p of
-  InstrPureSameOffset -> [|| $$sameOffset $$a ||]
-  InstrPureHaskell h -> go a h
-  where
-  go :: CodeQ a -> H.Haskell (a -> b) -> CodeQ b
-  go qa = \case
-    (H.:$) -> [|| \x -> $$qa x ||]
-    (H.:.) -> [|| \g x -> $$qa (g x) ||]
-    H.Flip -> [|| \x y -> $$qa y x ||]
-    (H.:.) H.:@ f H.:@ g -> [|| $$(go (go qa g) f) ||]
-    H.Const -> [|| \_ -> $$qa ||]
-    H.Flip H.:@ H.Const -> H.id
-    h@(H.Flip H.:@ _f) -> [|| \x -> $$(liftCode2 (InstrPureHaskell h) qa [||x||]) ||]
-    H.Eq x -> [|| $$(trans x) Eq.== $$qa ||]
-    H.Id -> qa
-    h -> [|| $$(trans h) $$qa ||]
+checkToken farExp p ok = ok
+  { unGen = \ctx -> [||
+    let !(# c, cs #) = $$(nextInput ctx) $$(input ctx) in
+    if $$(genCode p) c
+    then $$(unGen ok ctx
+      { valueStack = ValueStackCons (H.Term [||c||]) (valueStack ctx)
+      , input = [||cs||]
+      })
+    else let _ = "checkToken.else" in $$(unGen (fail farExp) ctx)
+    ||]
+  }
 
-liftCode2 :: InstrPure (a -> b -> c) -> CodeQ a -> CodeQ b -> CodeQ c
-liftCode2 p a b = case p of
-  InstrPureSameOffset -> [|| $$sameOffset $$a $$b ||]
-  InstrPureHaskell h -> go a b h
-  where
-  go :: CodeQ a -> CodeQ b -> H.Haskell (a -> b -> c) -> CodeQ c
-  go qa qb = \case
-    (H.:$) -> [|| $$qa $$qb ||]
-    (H.:.) -> [|| \x -> $$qa ($$qb x) ||]
-    H.Flip -> [|| \x -> $$qa x $$qb ||]
-    H.Flip H.:@ H.Const -> [|| $$qb ||]
-    H.Flip H.:@ f -> go qb qa f
-    H.Const -> [|| $$qa ||]
-    H.Cons -> [|| $$qa : $$qb ||]
-    h -> [|| $$(trans h) $$qa $$qb ||]
diff --git a/src/Symantic/Parser/Machine/Input.hs b/src/Symantic/Parser/Machine/Input.hs
--- a/src/Symantic/Parser/Machine/Input.hs
+++ b/src/Symantic/Parser/Machine/Input.hs
@@ -35,7 +35,7 @@
   compareOffset = [|| compare `on` offset ||]
   lowerOffset :: CodeQ (cur -> cur -> Bool)
   sameOffset :: CodeQ (cur -> cur -> Bool)
-  shiftRight :: CodeQ (cur -> Int -> cur)
+  shiftRight :: CodeQ (Int -> cur -> cur)
 instance Cursorable Int where
   offset = \inp -> inp
   compareOffset = [|| compare @Int ||]
@@ -48,22 +48,25 @@
   sameOffset = [|| \(Text _ i _) (Text _ j _) -> i == j ||]
   shiftRight = [||shiftRightText||]
 
-shiftRightText :: Text -> Int -> Text
-shiftRightText (Text arr off unconsumed) i = go i off unconsumed
+shiftRightText :: Int -> Text -> Text
+shiftRightText i (Text arr off unconsumed) = go i off unconsumed
   where
-    go 0 off' unconsumed' = Text arr off' unconsumed'
-    go n off' unconsumed'
-      | unconsumed' > 0 = let !d = iter_ (Text arr off' unconsumed') 0
-                          in go (n-1) (off'+d) (unconsumed'-d)
-      | otherwise = Text arr off' unconsumed'
+  go 0 off' unconsumed' = Text arr off' unconsumed'
+  go n off' unconsumed'
+    | unconsumed' > 0
+    , !d <- iter_ (Text arr off' unconsumed') 0
+    = go (n-1) (off'+d) (unconsumed'-d)
+    | otherwise = Text arr off' unconsumed'
 
-shiftLeftText :: Text -> Int -> Text
-shiftLeftText (Text arr off unconsumed) i = go i off unconsumed
+shiftLeftText :: Int -> Text -> Text
+shiftLeftText i (Text arr off unconsumed) = go i off unconsumed
   where
-    go 0 off' unconsumed' = Text arr off' unconsumed'
-    go n off' unconsumed'
-      | off' > 0 = let !d = reverseIter_ (Text arr off' unconsumed') 0 in go (n-1) (off'+d) (unconsumed'-d)
-      | otherwise = Text arr off' unconsumed'
+  go 0 off' unconsumed' = Text arr off' unconsumed'
+  go n off' unconsumed'
+    | off' > 0
+    , !d <- reverseIter_ (Text arr off' unconsumed') 0
+    = go (n-1) (off'+d) (unconsumed'-d)
+    | otherwise = Text arr off' unconsumed'
 
 instance Cursorable UnpackedLazyByteString where
   offset = \(UnpackedLazyByteString i _ _ _ _ _) -> i
@@ -71,15 +74,17 @@
   sameOffset = [||\(UnpackedLazyByteString i _ _ _ _ _) (UnpackedLazyByteString j _ _ _ _ _) -> i == j||]
   shiftRight = [||shiftRightByteString||]
 
-shiftRightByteString :: UnpackedLazyByteString -> Int -> UnpackedLazyByteString
-shiftRightByteString !(UnpackedLazyByteString i addr# final off size cs) j
+shiftRightByteString :: Int -> UnpackedLazyByteString -> UnpackedLazyByteString
+shiftRightByteString j !(UnpackedLazyByteString i addr# final off size cs)
   | j < size  = UnpackedLazyByteString (i + j) addr# final (off + j) (size - j) cs
   | otherwise = case cs of
-    BSL.Chunk (PS (ForeignPtr addr'# final') off' size') cs' -> shiftRightByteString (UnpackedLazyByteString (i + size) addr'# final' off' size' cs') (j - size)
+    BSL.Chunk (PS (ForeignPtr addr'# final') off' size') cs' ->
+      shiftRightByteString (j - size)
+        (UnpackedLazyByteString (i + size) addr'# final' off' size' cs')
     BSL.Empty -> emptyUnpackedLazyByteString (i + size)
 
-shiftLeftByteString :: UnpackedLazyByteString -> Int -> UnpackedLazyByteString
-shiftLeftByteString (UnpackedLazyByteString i addr# final off size cs) j =
+shiftLeftByteString :: Int -> UnpackedLazyByteString -> UnpackedLazyByteString
+shiftLeftByteString j (UnpackedLazyByteString i addr# final off size cs) =
   UnpackedLazyByteString (i - d) addr# final (off - d) (size + d) cs
   where d = min off j
 
@@ -99,7 +104,7 @@
 instance Cursorable (OffWith Stream) where
   lowerOffset = [|| \(OffWith i _) (OffWith j _) -> i < j ||]
   sameOffset = [|| \(OffWith i _) (OffWith j _) -> i == j ||]
-  shiftRight = [|| \(OffWith o ts) i -> OffWith (o + i) (dropStream i ts) ||]
+  shiftRight = [|| \i (OffWith o ts) -> OffWith (o + i) (dropStream i ts) ||]
   where
     dropStream :: Int -> Stream -> Stream
     dropStream 0 cs = cs
@@ -114,7 +119,7 @@
   offset = \(OffWith i _) -> i
   lowerOffset = [|| \(OffWith i _) (OffWith j _) -> i < j ||]
   sameOffset = [|| \(OffWith i _) (OffWith j _) -> i == j ||]
-  shiftRight = [|| \(OffWith o ts) i -> OffWith (o + i) (List.drop i ts) ||]
+  shiftRight = [|| \i (OffWith o ts) -> OffWith (o + i) (List.drop i ts) ||]
 
 -- ** Type 'OffWithStreamAnd'
 data OffWithStreamAnd ts = OffWithStreamAnd {-# UNPACK #-} !Int !Stream ts
@@ -194,13 +199,15 @@
                   (# C# (chr# (word2Int# x))
                   , if size /= 1 then UnpackedLazyByteString (i+1) addr# final (off+1) (size-1) cs
                     else case cs of
-                      BSL.Chunk (PS (ForeignPtr addr'# final') off' size') cs' -> UnpackedLazyByteString (i+1) addr'# final' off' size' cs'
+                      BSL.Chunk (PS (ForeignPtr addr'# final') off' size') cs' ->
+                        UnpackedLazyByteString (i+1) addr'# final' off' size' cs'
                       BSL.Empty -> emptyUnpackedLazyByteString (i+1)
                   #)
           more (UnpackedLazyByteString _ _ _ _ 0 _) = False
           more _ = True
           init = case $$qinput of
-            BSL.Chunk (PS (ForeignPtr addr# final) off size) cs -> UnpackedLazyByteString 0 addr# final off size cs
+            BSL.Chunk (PS (ForeignPtr addr# final) off size) cs ->
+              UnpackedLazyByteString 0 addr# final off size cs
             BSL.Empty -> emptyUnpackedLazyByteString 0
       in (# init, more, next #)
     ||]
diff --git a/src/Symantic/Parser/Machine/Instructions.hs b/src/Symantic/Parser/Machine/Instructions.hs
--- a/src/Symantic/Parser/Machine/Instructions.hs
+++ b/src/Symantic/Parser/Machine/Instructions.hs
@@ -1,407 +1,155 @@
-{-# LANGUAGE ConstraintKinds #-} -- For Executable
+{-# LANGUAGE ConstraintKinds #-} -- For Machine
 {-# LANGUAGE DerivingStrategies #-} -- For Show (LetName a)
-{-# LANGUAGE PatternSynonyms #-} -- For Fmap, App, …
-{-# LANGUAGE UndecidableInstances #-} -- For Cursorable (Cursor inp)
+-- | Semantic of the parsing instructions used
+-- to make the parsing control-flow explicit,
+-- in the convenient tagless-final encoding.
 module Symantic.Parser.Machine.Instructions where
 
 import Data.Bool (Bool(..))
 import Data.Either (Either)
-import Data.Eq (Eq)
-import Data.Ord (Ord)
-import Data.Function (($), (.))
+import Data.Eq (Eq(..))
+import Data.Function ((.))
 import Data.Kind (Type)
-import System.IO.Unsafe (unsafePerformIO)
-import Text.Show (Show(..), showString)
-import qualified Data.Functor as Functor
+-- import GHC.TypeLits (Symbol)
+import Text.Show (Show(..))
 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
 import Symantic.Parser.Machine.Input
-import Symantic.Univariant.Trans
 
--- * Type 'Instr'
--- | 'Instr'uctions for the 'Machine'.
-data Instr input valueStack (failStack::Peano) returnValue where
-  -- | @('Push' x k)@ pushes @(x)@ on the 'valueStack'
-  -- and continues with the next 'Instr'uction @(k)@.
-  Push ::
-    InstrPure v ->
-    Instr inp (v ': vs) es ret ->
-    Instr inp vs es ret
-  -- | @('Pop' k)@ pushes @(x)@ on the 'valueStack'.
-  Pop ::
-    Instr inp vs es ret ->
-    Instr inp (v ': vs) es ret
-  -- | @('LiftI2' f k)@ pops two values from the 'valueStack',
-  -- and pushes the result of @(f)@ applied to them.
-  LiftI2 ::
-    InstrPure (x -> y -> z) ->
-    Instr inp (z : vs) es ret ->
-    Instr inp (y : x : vs) es ret
-  -- | @('Fail')@ raises an error from the 'failStack'.
-  Fail ::
-    [ErrorItem (InputToken inp)] ->
-    Instr inp vs ('Succ es) ret
-  -- | @('PopFail' k)@ removes a 'FailHandler' from the 'failStack'
-  -- and continues with the next 'Instr'uction @(k)@.
-  PopFail ::
-    Instr inp vs es ret ->
-    Instr inp vs ('Succ es) ret
-  -- | @('CatchFail' 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',
-  -- and the control flow goes on with the @(r)@ 'Instr'uction.
-  CatchFail ::
-    Instr inp vs ('Succ es) ret ->
-    Instr inp (Cursor inp ': vs) es ret ->
-    Instr inp vs es ret
-  -- | @('LoadInput' k)@ removes the input from the 'valueStack'
-  -- and continues with the next 'Instr'uction @(k)@ using that input.
-  LoadInput ::
-    Instr inp vs es r ->
-    Instr inp (Cursor inp : vs) es r
-  -- | @('PushInput' k)@ pushes the input @(inp)@ on the 'valueStack'
-  -- and continues with the next 'Instr'uction @(k)@.
-  PushInput ::
-    Instr inp (Cursor inp ': vs) es ret ->
-    Instr inp vs es ret
-  -- | @('Case' l r)@.
-  Case ::
-    Instr inp (x ': vs) es r ->
-    Instr inp (y ': vs) es r ->
-    Instr inp (Either x y ': vs) es r
-  -- | @('Swap' k)@ pops two values on the 'valueStack',
-  -- pushes the first popped-out, then the second,
-  -- and continues with the next 'Instr'uction @(k)@.
-  Swap ::
-    Instr inp (x ': y ': vs) es r ->
-    Instr inp (y ': x ': vs) es r
-  -- | @('Choices' ps bs d)@.
-  Choices ::
-    [InstrPure (v -> Bool)] ->
-    [Instr inp vs es ret] ->
-    Instr inp vs es ret ->
-    Instr inp (v ': vs) es ret
-  -- | @('Subroutine' n v k)@ binds the 'LetName' @(n)@ to the 'Instr'uction's @(v)@,
-  -- 'Call's @(n)@ and
-  -- continues with the next 'Instr'uction @(k)@.
-  Subroutine ::
-    LetName v -> Instr inp '[] ('Succ 'Zero) v ->
-    Instr inp vs ('Succ es) ret ->
-    Instr inp vs ('Succ es) ret
-  -- | @('Jump' n k)@ pass the control-flow to the 'Subroutine' named @(n)@.
-  Jump ::
-    LetName ret ->
-    Instr inp '[] ('Succ es) ret
-  -- | @('Call' n k)@ pass the control-flow to the 'Subroutine' named @(n)@,
-  -- and when it 'Ret'urns, continues with the next 'Instr'uction @(k)@.
-  Call ::
-    LetName v ->
-    Instr inp (v ': vs) ('Succ es) ret ->
-    Instr inp vs ('Succ es) ret
-  -- | @('Ret')@ returns the value stored in a singleton 'valueStack'.
-  Ret ::
-    Instr inp '[ret] es ret
-  -- | @('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 'Fail'.
-  Read ::
-    [ErrorItem (InputToken inp)] ->
-    InstrPure (InputToken inp -> Bool) ->
-    Instr inp (InputToken inp ': vs) ('Succ es) ret ->
-    Instr inp vs ('Succ es) ret
-  DefJoin ::
-    LetName v -> Instr inp (v ': vs) es ret ->
-    Instr inp vs es ret ->
-    Instr inp vs es ret
-  RefJoin ::
-    LetName v ->
-    Instr inp (v ': vs) es ret
-
--- ** Type 'InstrPure'
-data InstrPure a where
-  InstrPureHaskell :: H.Haskell a -> InstrPure a
-  InstrPureSameOffset :: Cursorable cur => InstrPure (cur -> cur -> Bool)
-
-instance Show (InstrPure a) where
-  showsPrec p = \case
-    InstrPureHaskell x -> showsPrec p x
-    InstrPureSameOffset -> showString "InstrPureSameOffset"
-instance Trans InstrPure TH.CodeQ where
-  trans = \case
-    InstrPureHaskell x -> trans x
-    InstrPureSameOffset -> sameOffset
+-- * Type 'TermInstr'
+type TermInstr = H.Term TH.CodeQ
 
--- ** Type 'LetName'
-newtype LetName a = LetName { unLetName :: TH.Name }
-  deriving (Eq)
-  deriving newtype Show
+-- * Type 'Peano'
+-- | Type-level natural numbers,
+-- using the Peano recursive encoding.
+data Peano = Zero | Succ Peano
 
--- * Class 'Executable'
-type Executable repr =
-  ( Stackable repr
-  , Branchable repr
+-- * Class 'Machine'
+-- | All the 'Instr'uctions.
+type Machine tok repr =
+  ( Branchable repr
   , Failable repr
   , Inputable repr
-  , Routinable repr
   , Joinable repr
+  , Routinable repr
+  , Stackable repr
+  , Readable tok repr
   )
 
+-- ** Type 'ReprInstr'
+type ReprInstr = Type -> [Type] -> Peano -> Type -> Type
+
+-- ** Type 'LetName'
+-- | 'TH.Name' of a 'subroutine' or 'defJoin'
+-- indexed by the return type of the factorized 'Instr'uctions.
+-- This helps type-inferencing.
+newtype LetName a = LetName { unLetName :: TH.Name }
+  deriving Eq
+  deriving newtype Show
+
 -- ** Class 'Stackable'
-class Stackable (repr :: Type -> [Type] -> Peano -> Type -> Type) where
+class Stackable (repr::ReprInstr) where
   push ::
-    InstrPure v ->
-    repr inp (v ': vs) n ret ->
-    repr inp vs n ret
+    TermInstr v ->
+    repr inp (v ': vs) es a ->
+    repr inp vs es a
   pop ::
-    repr inp vs n ret ->
-    repr inp (v ': vs) n ret
+    repr inp vs es a ->
+    repr inp (v ': vs) es a
   liftI2 ::
-    InstrPure (x -> y -> z) ->
-    repr inp (z ': vs) es ret ->
-    repr inp (y ': x ': vs) es ret
+    TermInstr (x -> y -> z) ->
+    repr inp (z ': vs) es a ->
+    repr inp (y ': x ': vs) es a
   swap ::
-    repr inp (x ': y ': vs) n r ->
-    repr inp (y ': x ': vs) n r
+    repr inp (x ': y ': vs) es a ->
+    repr inp (y ': x ': vs) es a
+  -- | @('mapI' f k)@.
+  mapI ::
+    TermInstr (x -> y) ->
+    repr inp (y ': vs) es a ->
+    repr inp (x ': vs) es a
+  mapI f = push f . liftI2 (H.flip H..@ (H.$))
+  -- | @('appI' k)@ pops @(x)@ and @(x2y)@ from the 'valueStack',
+  -- pushes @(x2y x)@ and continues with the next 'Instr'uction @(k)@.
+  appI ::
+    repr inp (y ': vs) es a ->
+    repr inp (x ': (x -> y) ': vs) es a
+  appI = liftI2 (H.$)
 
+-- ** Class 'Routinable'
+class Routinable (repr::ReprInstr) where
+  subroutine ::
+    LetName v -> repr inp '[] ('Succ 'Zero) v ->
+    repr inp vs ('Succ es) a ->
+    repr inp vs ('Succ es) a
+  call ::
+    LetName v -> repr inp (v ': vs) ('Succ es) a ->
+    repr inp vs ('Succ es) a
+  ret ::
+    repr inp '[a] es a
+  jump ::
+    LetName a ->
+    repr inp '[] ('Succ es) a
+
 -- ** Class 'Branchable'
-class Branchable (repr :: Type -> [Type] -> Peano -> Type -> Type) where
-  case_ ::
-    repr inp (x ': vs) n r ->
-    repr inp (y ': vs) n r ->
-    repr inp (Either x y ': vs) n r
+class Branchable (repr::ReprInstr) where
+  caseI ::
+    repr inp (x ': vs) es r ->
+    repr inp (y ': vs) es r ->
+    repr inp (Either x y ': vs) es r
   choices ::
-    [InstrPure (v -> Bool)] ->
-    [repr inp vs es ret] ->
-    repr inp vs es ret ->
-    repr inp (v ': vs) es ret
+    [TermInstr (v -> Bool)] ->
+    [repr inp vs es a] ->
+    repr inp vs es a ->
+    repr inp (v ': vs) es a
+  -- | @('ifI' ok ko)@ pops a 'Bool' from the 'valueStack'
+  -- and continues either with the 'Instr'uction @(ok)@ if it is 'True'
+  -- or @(ko)@ otherwise.
+  ifI ::
+    repr inp vs es a ->
+    repr inp vs es a ->
+    repr inp (Bool ': vs) es a
+  ifI ok ko = choices [H.id] [ok] ko
 
 -- ** Class 'Failable'
-class Failable (repr :: Type -> [Type] -> Peano -> Type -> Type) where
-  fail :: [ErrorItem (InputToken inp)] -> repr inp vs ('Succ es) ret
+class Failable (repr::ReprInstr) where
+  fail ::
+    [ErrorItem (InputToken inp)] ->
+    repr inp vs ('Succ es) a
   popFail ::
-    repr inp vs es ret ->
-    repr inp vs ('Succ es) ret
+    repr inp vs es a ->
+    repr inp vs ('Succ es) a
   catchFail ::
-    repr inp vs ('Succ es) ret ->
-    repr inp (Cursor inp ': vs) es ret ->
-    repr inp vs es ret
+    repr inp vs ('Succ es) a ->
+    repr inp (Cursor inp ': vs) es a ->
+    repr inp vs es a
 
 -- ** Class 'Inputable'
-class Inputable (repr :: Type -> [Type] -> Peano -> Type -> Type) where
+class Inputable (repr::ReprInstr) where
   loadInput ::
-    repr inp vs es r ->
-    repr inp (Cursor inp ': vs) es r
+    repr inp vs es a ->
+    repr inp (Cursor inp ': vs) es a
   pushInput ::
-    repr inp (Cursor inp ': vs) es ret ->
-    repr inp vs es ret
-
--- ** Class 'Routinable'
-class Routinable (repr :: Type -> [Type] -> Peano -> Type -> Type) where
-  subroutine ::
-    LetName v -> repr inp '[] ('Succ 'Zero) v ->
-    repr inp vs ('Succ es) ret ->
-    repr inp vs ('Succ es) ret
-  call ::
-    LetName v -> repr inp (v ': vs) ('Succ es) ret ->
-    repr inp vs ('Succ es) ret
-  ret ::
-    repr inp '[ret] es ret
-  jump ::
-    LetName ret ->
-    repr inp '[] ('Succ es) ret
+    repr inp (Cursor inp ': vs) es a ->
+    repr inp vs es a
 
 -- ** Class 'Joinable'
-class Joinable (repr :: Type -> [Type] -> Peano -> Type -> Type) where
+class Joinable (repr::ReprInstr) where
   defJoin ::
-    LetName v ->
-    repr inp (v ': vs) es ret ->
-    repr inp vs es ret ->
-    repr inp vs es ret
+    LetName v -> repr inp (v ': vs) es a ->
+    repr inp vs es a ->
+    repr inp vs es a
   refJoin ::
     LetName v ->
-    repr inp (v ': vs) es ret
+    repr inp (v ': vs) es a
 
 -- ** Class 'Readable'
-class Readable (repr :: Type -> [Type] -> Peano -> Type -> Type) (tok::Type) where
+class Readable (tok::Type) (repr::ReprInstr) where
   read ::
     tok ~ InputToken inp =>
     [ErrorItem tok] ->
-    InstrPure (tok -> Bool) ->
-    repr inp (tok ': vs) ('Succ es) ret ->
-    repr inp vs ('Succ es) ret
-
-instance
-  ( Executable repr
-  , Readable repr (InputToken inp)
-  ) => Trans (Instr inp vs es) (repr inp vs es) where
-  trans = \case
-    Push x k -> push x (trans k)
-    Pop k -> pop (trans k)
-    LiftI2 f k -> liftI2 f (trans k)
-    Fail err -> fail err
-    PopFail k -> popFail (trans k)
-    CatchFail l r -> catchFail (trans l) (trans r)
-    LoadInput k -> loadInput (trans k)
-    PushInput k -> pushInput (trans k)
-    Case l r -> case_ (trans l) (trans r)
-    Swap k -> swap (trans k)
-    Choices ps bs d -> choices ps (trans Functor.<$> bs) (trans d)
-    Subroutine n sub k -> subroutine n (trans sub) (trans k)
-    Jump n -> jump n
-    Call n k -> call n (trans k)
-    Ret -> ret
-    Read es p k -> read es p (trans k)
-    DefJoin n sub k -> defJoin n (trans sub) (trans k)
-    RefJoin n -> refJoin n
-
--- ** Type 'Peano'
--- | Type-level natural numbers, using the Peano recursive encoding.
-data Peano = Zero | Succ Peano
-
--- | @('Fmap' f k)@.
-pattern Fmap ::
-  InstrPure (x -> y) ->
-  Instr inp (y ': xs) es ret ->
-  Instr inp (x ': xs) es ret
-pattern Fmap f k = Push f (LiftI2 (InstrPureHaskell (H.Flip H.:@ (H.:$))) k)
-
--- | @('App' k)@ pops @(x)@ and @(x2y)@ from the 'valueStack',
--- pushes @(x2y x)@ and continues with the next 'Instr'uction @(k)@.
-pattern App ::
-  Instr inp (y : vs) es ret ->
-  Instr inp (x : (x -> y) : vs) es ret
-pattern App k = LiftI2 (InstrPureHaskell (H.:$)) k
-
--- | @('If' ok ko)@ pops a 'Bool' from the 'valueStack'
--- and continues either with the 'Instr'uction @(ok)@ if it is 'True'
--- or @(ko)@ otherwise.
-pattern If ::
-  Instr inp vs es ret ->
-  Instr inp vs es ret ->
-  Instr inp (Bool ': vs) es ret
-pattern If ok ko = Choices [InstrPureHaskell H.Id] [ok] ko
-
--- * Type 'Machine'
--- | Making the control-flow explicit.
-data Machine inp v = Machine { unMachine ::
-  forall vs es ret.
-  {-k-}Instr inp (v ': vs) ('Succ es) ret ->
-  Instr inp vs ('Succ es) ret
-  }
-
-runMachine ::
-  forall inp v es repr.
-  Executable repr =>
-  Readable repr (InputToken inp) =>
-  Machine inp v -> repr inp '[] ('Succ es) v
-runMachine (Machine auto) =
-  trans @(Instr inp '[] ('Succ es)) $
-  auto Ret
-
-instance Applicable (Machine inp) where
-  pure x = Machine $ Push (InstrPureHaskell x)
-  Machine f <*> Machine x = Machine $ f . x . App
-  liftA2 f (Machine x) (Machine y) = Machine $
-    x . y . LiftI2 (InstrPureHaskell f)
-  Machine x *> Machine y = Machine $ x . Pop . y
-  Machine x <* Machine y = Machine $ x . y . Pop
-instance
-  Cursorable (Cursor inp) =>
-  Alternable (Machine inp) where
-  empty = Machine $ \_k -> Fail []
-  Machine l <|> Machine r = Machine $ \k ->
-    makeJoin k $ \j ->
-    CatchFail
-      (l (PopFail j))
-      (failIfConsumed (r j))
-  try (Machine x) = Machine $ \k ->
-    CatchFail (x (PopFail k))
-      -- On exception, reset the input,
-      -- and propagate the failure.
-      (LoadInput (Fail []))
-
--- | If no input has been consumed by the failing alternative
--- then continue with the given continuation.
--- Otherwise, propagate the 'Fail'ure.
-failIfConsumed ::
-  Cursorable (Cursor inp) =>
-  Instr inp vs ('Succ es) ret ->
-  Instr inp (Cursor inp : vs) ('Succ es) ret
-failIfConsumed k = PushInput (LiftI2 InstrPureSameOffset (If k (Fail [])))
-
--- | @('makeJoin' k f)@ factorizes @(k)@ in @(f)@,
--- by introducing a 'DefJoin' if necessary,
--- and passing the corresponding 'RefJoin' to @(f)@,
--- or @(k)@ as is when factorizing is useless.
-makeJoin ::
-  Instr inp (v : vs) es ret ->
-  (Instr inp (v : vs) es ret -> Instr inp vs es ret) ->
-  Instr inp vs es ret
--- Double RefJoin Optimization:
--- If a join-node points directly to another join-node,
--- then reuse it
-makeJoin k@RefJoin{} = ($ k)
--- Terminal RefJoin Optimization:
--- If a join-node points directly to a terminal operation,
--- then it's useless to introduce a join-point.
-makeJoin k@Ret = ($ k)
-makeJoin k =
-  let joinName = LetName $ unsafePerformIO $ TH.qNewName "join" in
-  \f -> DefJoin joinName k (f (RefJoin joinName))
-
-instance tok ~ InputToken inp => Satisfiable (Machine inp) tok where
-  satisfy es p = Machine $ Read es (InstrPureHaskell p)
-instance Selectable (Machine inp) where
-  branch (Machine lr) (Machine l) (Machine r) = Machine $ \k ->
-    makeJoin k $ \j ->
-    lr (Case (l (Swap (App j)))
-             (r (Swap (App j))))
-instance Matchable (Machine inp) where
-  conditional ps bs (Machine m) (Machine default_) = Machine $ \k ->
-    makeJoin k $ \j ->
-    m (Choices (InstrPureHaskell Functor.<$> ps)
-               ((\b -> unMachine b j) Functor.<$> bs)
-               (default_ j))
-instance
-  ( Ord (InputToken inp)
-  , Cursorable (Cursor inp)
-  ) => Lookable (Machine inp) where
-  look (Machine x) = Machine $ \k ->
-    PushInput (x (Swap (LoadInput k)))
-  eof = negLook (satisfy [{-discarded by negLook-}] (H.const H..@ H.bool True))
-        -- Set a better failure message
-        <|> (Machine $ \_k -> Fail [ErrorItemEnd])
-  negLook (Machine x) = Machine $ \k ->
-    CatchFail
-      -- On x success, discard the result,
-      -- and replace this 'CatchFail''s failure handler
-      -- by a 'Fail'ure 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)
-      --   succeed can get the blame for the overall
-      --   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.
-      (PushInput (x (Pop (PopFail (LoadInput (Fail []))))))
-      -- On x failure, reset the input,
-      -- and go on with the next 'Instr'uctions.
-      (LoadInput (Push (InstrPureHaskell H.unit) k))
-instance Letable TH.Name (Machine inp) where
-  def n v = Machine $ \k ->
-    Subroutine (LetName n) (unMachine v Ret) (Call (LetName n) k)
-  ref _isRec n = Machine $ \case
-    Ret -> Jump (LetName n)
-    k -> Call (LetName n) k
-instance Cursorable (Cursor inp) => Foldable (Machine 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
-  -}
+    TermInstr (tok -> Bool) ->
+    repr inp (tok ': vs) ('Succ es) a ->
+    repr inp vs ('Succ es) a
diff --git a/src/Symantic/Parser/Machine/Optimize.hs b/src/Symantic/Parser/Machine/Optimize.hs
new file mode 100644
--- /dev/null
+++ b/src/Symantic/Parser/Machine/Optimize.hs
@@ -0,0 +1,249 @@
+{-# 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 'push') so far,
+-- but the introspection enabled by the 'Instr' data-type
+-- is also useful to optimize with more context in the 'Machine'.
+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 Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..))
+import qualified Data.Functor as Functor
+
+import Symantic.Parser.Grammar
+import Symantic.Parser.Machine.Input
+import Symantic.Parser.Machine.Instructions
+import Symantic.Univariant.Trans
+
+-- * Data family 'Instr'
+-- | 'Instr'uctions of the 'Machine'.
+-- This is an extensible data-type.
+data family Instr
+  (instr :: ReprInstr -> Constraint)
+  (repr :: ReprInstr)
+  :: ReprInstr
+
+-- | Convenient utility to pattern-match a 'SomeInstr'.
+pattern Instr :: Typeable comb =>
+  Instr comb repr inp vs es a ->
+  SomeInstr repr inp vs es a
+pattern Instr x <- (unSomeInstr -> Just x)
+
+-- ** Type 'SomeInstr'
+-- | Some 'Instr'uction existantialized over the actual instruction symantic class.
+-- Useful to handle a list of 'Instr'uctions
+-- without requiring impredicative quantification.
+-- Must be used by pattern-matching
+-- on the 'SomeInstr' data-constructor,
+-- to bring the constraints in scope.
+--
+-- 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.
+data SomeInstr repr inp vs es a =
+  forall instr.
+  (Trans (Instr instr repr inp vs es) (repr inp vs es), Typeable instr) =>
+  SomeInstr (Instr instr repr inp vs es a)
+
+instance Trans (SomeInstr repr inp vs es) (repr inp vs es) where
+  trans (SomeInstr x) = trans x
+
+-- | @(unSomeInstr i :: 'Maybe' ('Instr' comb repr inp vs es a))@
+-- extract the data-constructor from the given 'SomeInstr'
+-- iif. it belongs to the @('Instr' comb repr a)@ data-instance.
+unSomeInstr ::
+  forall instr repr inp vs es a.
+  Typeable instr =>
+  SomeInstr repr inp vs es a ->
+  Maybe (Instr instr repr inp vs es a)
+unSomeInstr (SomeInstr (i::Instr i repr inp vs es a)) =
+  case typeRep @instr `eqTypeRep` typeRep @i of
+    Just HRefl -> Just i
+    Nothing -> Nothing
+
+-- Stackable
+data instance Instr Stackable repr inp vs fs a where
+  -- | @('Push' x k)@ pushes @(x)@ on the 'valueStack'
+  -- and continues with the next 'Instr'uction @(k)@.
+  Push ::
+    TermInstr v ->
+    SomeInstr repr inp (v ': vs) es a ->
+    Instr Stackable repr inp vs es a
+  -- | @('Pop' k)@ pushes @(x)@ on the 'valueStack'.
+  Pop ::
+    SomeInstr repr inp vs es a ->
+    Instr Stackable repr inp (v ': vs) es a
+  -- | @('LiftI2' f k)@ pops two values from the 'valueStack',
+  -- and pushes the result of @(f)@ applied to them.
+  LiftI2 ::
+    TermInstr (x -> y -> z) ->
+    SomeInstr repr inp (z : vs) es a ->
+    Instr Stackable repr inp (y : x : vs) es a
+  -- | @('Swap' k)@ pops two values on the 'valueStack',
+  -- pushes the first popped-out, then the second,
+  -- and continues with the next 'Instr'uction @(k)@.
+  Swap ::
+    SomeInstr repr inp (x ': y ': vs) es a ->
+    Instr Stackable repr inp (y ': x ': vs) es a
+instance Stackable repr => Trans (Instr Stackable repr inp vs es) (repr inp vs es) where
+  trans = \case
+    Push x k -> push x (trans k)
+    Pop k -> pop (trans k)
+    LiftI2 f k -> liftI2 f (trans k)
+    Swap k -> swap (trans k)
+instance Stackable repr => Stackable (SomeInstr repr) where
+  push _v (Instr (Pop i)) = i
+  push v i = SomeInstr (Push v i)
+  pop = SomeInstr . Pop
+  liftI2 f = SomeInstr . LiftI2 f
+  swap = SomeInstr . Swap
+
+-- Routinable
+data instance Instr Routinable repr inp vs fs a where
+  -- | @('Subroutine' n v k)@ binds the 'LetName' @(n)@ to the 'Instr'uction's @(v)@,
+  -- 'Call's @(n)@ and
+  -- continues with the next 'Instr'uction @(k)@.
+  Subroutine ::
+    LetName v ->
+    SomeInstr repr inp '[] ('Succ 'Zero) v ->
+    SomeInstr repr inp vs ('Succ es) a ->
+    Instr Routinable repr inp vs ('Succ es) a
+  -- | @('Jump' n k)@ pass the control-flow to the 'Subroutine' named @(n)@.
+  Jump ::
+    LetName a ->
+    Instr Routinable repr inp '[] ('Succ es) a
+  -- | @('Call' n k)@ pass the control-flow to the 'Subroutine' named @(n)@,
+  -- and when it 'Ret'urns, continues with the next 'Instr'uction @(k)@.
+  Call ::
+    LetName v ->
+    SomeInstr repr inp (v ': vs) ('Succ es) a ->
+    Instr Routinable repr inp vs ('Succ es) a
+  -- | @('Ret')@ returns the value stored in a singleton 'valueStack'.
+  Ret ::
+    Instr Routinable repr inp '[a] es a
+instance Routinable repr => Trans (Instr Routinable repr inp vs es) (repr inp vs es) where
+  trans = \case
+    Subroutine n sub k -> subroutine n (trans sub) (trans k)
+    Jump n -> jump n
+    Call n k -> call n (trans k)
+    Ret -> ret
+instance Routinable repr => Routinable (SomeInstr repr) where
+  subroutine n sub = SomeInstr . Subroutine n sub
+  jump = SomeInstr . Jump
+  call n = SomeInstr . Call n
+  ret = SomeInstr Ret
+
+-- Branchable
+data instance Instr Branchable repr inp vs fs a where
+  -- | @('Case' l r)@.
+  Case ::
+    SomeInstr repr inp (x ': vs) es a ->
+    SomeInstr repr inp (y ': vs) es a ->
+    Instr Branchable repr inp (Either x y ': vs) es a
+  -- | @('Choices' ps bs d)@.
+  Choices ::
+    [TermInstr (v -> Bool)] ->
+    [SomeInstr repr inp vs es a] ->
+    SomeInstr repr inp vs es a ->
+    Instr Branchable repr inp (v ': vs) es a
+instance Branchable repr => Trans (Instr Branchable repr inp vs es) (repr inp vs es) where
+  trans = \case
+    Case l r -> caseI (trans l) (trans r)
+    Choices ps bs d -> choices ps (trans Functor.<$> bs) (trans d)
+instance Branchable repr => Branchable (SomeInstr repr) where
+  caseI l = SomeInstr . Case l
+  choices ps bs = SomeInstr . Choices ps bs
+
+-- Failable
+data instance Instr Failable repr inp vs fs a where
+  -- | @('Fail')@ raises an error from the 'failStack'.
+  Fail ::
+    [ErrorItem (InputToken inp)] ->
+    Instr Failable repr inp vs ('Succ es) a
+  -- | @('PopFail' k)@ removes a 'FailHandler' from the 'failStack'
+  -- and continues with the next 'Instr'uction @(k)@.
+  PopFail ::
+    SomeInstr repr inp vs es ret ->
+    Instr Failable repr inp vs ('Succ es) ret
+  -- | @('CatchFail' 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',
+  -- and the control flow goes on with the @(r)@ 'Instr'uction.
+  CatchFail ::
+    SomeInstr repr inp vs ('Succ es) ret ->
+    SomeInstr repr inp (Cursor inp ': vs) es ret ->
+    Instr Failable repr inp vs es ret
+instance Failable repr => Trans (Instr Failable repr inp vs es) (repr inp vs es) where
+  trans = \case
+    Fail err -> fail err
+    PopFail k -> popFail (trans k)
+    CatchFail l r -> catchFail (trans l) (trans r)
+instance Failable repr => Failable (SomeInstr repr) where
+  fail = SomeInstr . Fail
+  popFail = SomeInstr . PopFail
+  catchFail x = SomeInstr . CatchFail x
+
+-- Inputable
+data instance Instr Inputable repr inp vs fs a where
+  -- | @('LoadInput' k)@ removes the input from the 'valueStack'
+  -- and continues with the next 'Instr'uction @(k)@ using that input.
+  LoadInput ::
+    SomeInstr repr inp vs es a ->
+    Instr Inputable repr inp (Cursor inp : vs) es a
+  -- | @('PushInput' k)@ pushes the input @(inp)@ on the 'valueStack'
+  -- and continues with the next 'Instr'uction @(k)@.
+  PushInput ::
+    SomeInstr repr inp (Cursor inp ': vs) es a ->
+    Instr Inputable repr inp vs es a
+instance Inputable repr => Trans (Instr Inputable repr inp vs es) (repr inp vs es) where
+  trans = \case
+    LoadInput k -> loadInput (trans k)
+    PushInput k -> pushInput (trans k)
+instance Inputable repr => Inputable (SomeInstr repr) where
+  loadInput = SomeInstr . LoadInput
+  pushInput = SomeInstr . PushInput
+
+-- Joinable
+data instance Instr Joinable repr inp vs fs a where
+  DefJoin ::
+    LetName v ->
+    SomeInstr repr inp (v ': vs) es a ->
+    SomeInstr repr inp vs es a ->
+    Instr Joinable repr inp vs es a
+  RefJoin ::
+    LetName v ->
+    Instr Joinable repr inp (v ': vs) es a
+instance Joinable repr => Trans (Instr Joinable repr inp vs es) (repr inp vs es) where
+  trans = \case
+    DefJoin n sub k -> defJoin n (trans sub) (trans k)
+    RefJoin n -> refJoin n
+instance Joinable repr => Joinable (SomeInstr repr) where
+  defJoin n sub = SomeInstr . DefJoin n sub
+  refJoin = SomeInstr . RefJoin
+
+-- Readable
+data instance Instr (Readable tok) repr inp vs fs a 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 'Fail'.
+  Read ::
+    [ErrorItem (InputToken inp)] ->
+    TermInstr (InputToken inp -> Bool) ->
+    SomeInstr repr inp (InputToken inp ': vs) ('Succ es) a ->
+    Instr (Readable tok) repr inp vs ('Succ es) a
+instance
+  ( Readable tok repr, tok ~ InputToken inp ) =>
+  Trans (Instr (Readable tok) repr inp vs es) (repr inp vs es) where
+  trans = \case
+    Read es p k -> read es p (trans k)
+instance
+  ( Readable tok repr, Typeable tok ) =>
+  Readable tok (SomeInstr repr) where
+  read es p = SomeInstr . Read es p
diff --git a/src/Symantic/Parser/Machine/Program.hs b/src/Symantic/Parser/Machine/Program.hs
new file mode 100644
--- /dev/null
+++ b/src/Symantic/Parser/Machine/Program.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE UndecidableInstances #-} -- For Cursorable (Cursor inp)
+-- | Build the 'Instr'uction 'Program' of a 'Machine'
+-- from the 'Comb'inators of a 'Grammar'.
+-- 'Instr'uctions are kept introspectable
+-- to enable more optimizations now possible because
+-- of a broader knowledge of the 'Instr'uctions around
+-- those generated (eg. by using 'joinNext').
+module Symantic.Parser.Machine.Program where
+
+import Data.Bool (Bool(..))
+import Data.Ord (Ord)
+import Data.Function (($), (.))
+import Type.Reflection (Typeable)
+import System.IO.Unsafe (unsafePerformIO)
+import qualified Data.Functor as Functor
+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
+import Symantic.Parser.Machine.Input
+import Symantic.Parser.Machine.Instructions
+import Symantic.Parser.Machine.Optimize
+import Symantic.Univariant.Trans
+
+-- * Type 'Program'
+-- | A 'Program' is a tree of 'Instr'uctions,
+-- where each 'Instr'uction is built by a continuation
+-- to be able to introspect, duplicate and/or change
+-- the next 'Instr'uction.
+data Program repr inp a = Program { unProgram ::
+  forall vs es ret.
+  -- This is the next instruction
+  SomeInstr repr inp (a ': vs) ('Succ es) ret ->
+  -- This is the current instruction
+  SomeInstr repr inp vs ('Succ es) ret }
+
+-- | Build an interpreter of the 'Program' of the given 'Machine'.
+optimizeMachine ::
+  forall inp es repr a.
+  Machine (InputToken inp) repr =>
+  Program repr inp a ->
+  repr inp '[] ('Succ es) a
+optimizeMachine (Program f) = trans (f @'[] @es ret)
+
+instance
+  Stackable repr =>
+  Applicable (Program repr inp) where
+  pure x = Program (push (trans x))
+  Program f <*> Program x = Program (f . x . appI)
+  liftA2 f (Program x) (Program y) =
+    Program (x . y . liftI2 (trans f))
+  Program x *> Program y = Program (x . pop . y)
+  Program x <* Program y = Program (x . y . pop)
+instance
+  ( Cursorable (Cursor inp)
+  , Branchable repr
+  , Failable repr
+  , Inputable repr
+  , Joinable repr
+  , Stackable repr
+  ) => Alternable (Program repr inp) where
+  empty = Program $ \_next -> fail []
+  Program l <|> Program r = joinNext $ Program $ \next ->
+    catchFail
+      (l (popFail next))
+      (failIfConsumed (r next))
+  try (Program x) = Program $ \next ->
+    catchFail
+      (x (popFail next))
+      -- On exception, reset the input,
+      -- and propagate the failure.
+      (loadInput (fail []))
+
+-- | If no input has been consumed by the failing alternative
+-- then continue with the given continuation.
+-- Otherwise, propagate the 'Fail'ure.
+failIfConsumed ::
+  Cursorable (Cursor inp) =>
+  Branchable repr =>
+  Failable repr =>
+  Inputable repr =>
+  Stackable repr =>
+  SomeInstr repr inp vs ('Succ es) ret ->
+  SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
+failIfConsumed k = pushInput (liftI2 (H.Term sameOffset) (ifI k (fail [])))
+
+-- | @('joinNext' m)@ factorize the next 'Instr'uction
+-- to be able to reuse it multiple times without duplication.
+-- It does so by introducing a 'defJoin'
+-- and passing the corresponding 'refJoin'
+-- as next 'Instr'uction to @(m)@,
+-- unless factorizing is useless because the next 'Instr'uction
+-- is already a 'refJoin' or a 'ret'.
+-- It should be used each time the next 'Instr'uction
+-- is used multiple times.
+joinNext ::
+  Joinable repr =>
+  Program repr inp v ->
+  Program repr inp v
+joinNext (Program m) = Program $ \case
+  -- Double refJoin Optimization:
+  -- If a join-node points directly to another join-node,
+  -- then reuse it
+  next@(Instr RefJoin{}) -> m next
+  -- Terminal refJoin Optimization:
+  -- If a join-node points directly to a terminal operation,
+  -- 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"
+
+instance
+  ( tok ~ InputToken inp
+  , Readable tok repr
+  , Typeable tok
+  ) => Satisfiable tok (Program repr inp) where
+  satisfy es p = Program $ read es (trans p)
+instance
+  ( Branchable repr
+  , Joinable repr
+  , Stackable repr
+  ) => Selectable (Program repr inp) where
+  branch (Program lr) (Program l) (Program r) = joinNext $ Program $ \next ->
+    lr (caseI
+      (l (swap (appI next)))
+      (r (swap (appI next))))
+instance
+  ( Branchable repr
+  , Joinable repr
+  ) => Matchable (Program repr inp) where
+  conditional (Program a) ps bs (Program d) = joinNext $ Program $ \next ->
+    a (choices
+      (trans Functor.<$> ps)
+      ((\(Program b) -> b next) Functor.<$> bs)
+      (d next))
+instance
+  ( Ord (InputToken inp)
+  , Cursorable (Cursor inp)
+  , Branchable repr
+  , Failable repr
+  , Inputable repr
+  , Joinable repr
+  , Readable (InputToken inp) repr
+  , Typeable (InputToken inp)
+  , Stackable repr
+  ) => Lookable (Program repr inp) where
+  look (Program x) = Program $ \next ->
+    pushInput (x (swap (loadInput next)))
+  eof = negLook (satisfy [{-discarded by negLook-}] (H.lam1 (\_x -> H.bool True)))
+        -- This sets a better failure message
+        <|> (Program $ \_k -> fail [ErrorItemEnd])
+  negLook (Program x) = Program $ \next ->
+    catchFail
+      -- On x success, discard the result,
+      -- and replace this 'CatchFail''s failure handler
+      -- by a 'Fail'ure 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)
+      --   succeed can get the blame for the overall
+      --   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.
+      (pushInput (x (pop (popFail (loadInput (fail []))))))
+      -- On x failure, reset the input,
+      -- and go on with the next 'Instr'uctions.
+      (loadInput (push H.unit next))
+instance
+  Routinable repr =>
+  Letable TH.Name (Program repr inp) where
+  def n (Program v) = Program $ \next ->
+    subroutine (LetName n) (v ret) (call (LetName n) next)
+  ref _isRec n = Program $ \case
+    -- Returning just after a 'call' is useless:
+    -- using 'jump' lets the 'ret' of the 'subroutine'
+    -- directly return where it would in two 'ret's.
+    Instr Ret{} -> jump (LetName n)
+    next -> call (LetName n) next
+instance
+  ( Cursorable (Cursor inp)
+  , Branchable repr
+  , Failable repr
+  , Inputable repr
+  , Joinable repr
+  , Stackable 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
+  -}
diff --git a/src/Symantic/Parser/Machine/View.hs b/src/Symantic/Parser/Machine/View.hs
new file mode 100644
--- /dev/null
+++ b/src/Symantic/Parser/Machine/View.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE UndecidableInstances #-} -- For ShowLetName
+module Symantic.Parser.Machine.View where
+
+import Data.Bool (Bool(..))
+import Data.Function (($), (.), id)
+import Data.Functor ((<$>))
+import Data.Kind (Type)
+import Data.Semigroup (Semigroup(..))
+import Data.String (String, IsString(..))
+import Text.Show (Show(..))
+import qualified Data.Tree as Tree
+import qualified Data.List as List
+import qualified Language.Haskell.TH.Syntax as TH
+
+import Symantic.Parser.Grammar.ObserveSharing (ShowLetName(..))
+import Symantic.Parser.Machine.Instructions
+
+-- * Type 'ViewMachine'
+newtype ViewMachine (showName::Bool) inp (vs:: [Type]) (es::Peano) a
+  =     ViewMachine { unViewMachine ::
+  Tree.Forest String -> Tree.Forest String }
+
+viewMachine ::
+  ViewMachine sN inp vs es a ->
+  ViewMachine sN inp vs es a
+viewMachine = id
+
+-- | Helper to view a command.
+viewInstrCmd :: String -> Tree.Forest String -> Tree.Tree String
+viewInstrCmd n = Tree.Node n
+-- | Helper to view an argument.
+viewInstrArg :: String -> Tree.Forest String -> Tree.Tree String
+viewInstrArg n = Tree.Node ("<"<>n<>">")
+
+instance Show (ViewMachine sN inp vs es a) where
+  show = drawTree . Tree.Node "" . ($ []) . unViewMachine
+    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 es a) where
+  fromString s = ViewMachine $ \is -> Tree.Node (fromString s) [] : is
+
+instance Stackable (ViewMachine sN) where
+  push a k = ViewMachine $ \is -> viewInstrCmd ("push "<>showsPrec 10 a "") [] : unViewMachine k is
+  pop k = ViewMachine $ \is -> viewInstrCmd "pop" [] : unViewMachine k is
+  liftI2 f k = ViewMachine $ \is -> viewInstrCmd ("lift "<>showsPrec 10 f "") [] : unViewMachine k is
+  swap k = ViewMachine $ \is -> viewInstrCmd "swap" [] : unViewMachine k is
+instance Branchable (ViewMachine sN) where
+  caseI l r = ViewMachine $ \is -> viewInstrCmd "case"
+    [ viewInstrArg "left" (unViewMachine l [])
+    , viewInstrArg "right" (unViewMachine r [])
+    ] : is
+  choices ps bs d = ViewMachine $ \is ->
+    viewInstrCmd ("choices "<>show ps) (
+      (viewInstrArg "branch" . ($ []) . unViewMachine <$> bs) <>
+      [ viewInstrArg "default" (unViewMachine d []) ]
+    ) : is
+instance Failable (ViewMachine sN) where
+  fail _err = ViewMachine $ \is -> viewInstrCmd "fail" [] : is
+  popFail k = ViewMachine $ \is -> viewInstrCmd "popFail" [] : unViewMachine k is
+  catchFail t h = ViewMachine $ \is -> viewInstrCmd "catchFail"
+    [ viewInstrArg "try" (unViewMachine t [])
+    , viewInstrArg "handler" (unViewMachine h [])
+    ] : is
+instance Inputable (ViewMachine sN) where
+  loadInput k = ViewMachine $ \is -> viewInstrCmd "loadInput" [] : unViewMachine k is
+  pushInput k = ViewMachine $ \is -> viewInstrCmd "pushInput" [] : unViewMachine k is
+instance
+  ShowLetName sN TH.Name =>
+  Routinable (ViewMachine sN) where
+  subroutine (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
+instance
+  ShowLetName sN TH.Name =>
+  Joinable (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
+instance Readable tok (ViewMachine sN) where
+  read _es p k = ViewMachine $ \is -> viewInstrCmd ("read "<>showsPrec 10 p "") [] : unViewMachine k is
diff --git a/src/Symantic/Univariant/Letable.hs b/src/Symantic/Univariant/Letable.hs
--- a/src/Symantic/Univariant/Letable.hs
+++ b/src/Symantic/Univariant/Letable.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-} -- For ShowLetName
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE ExistentialQuantification #-} -- For SharingName
 -- {-# LANGUAGE MagicHash #-} -- For unsafeCoerce#
@@ -18,6 +19,7 @@
 import Data.Maybe (Maybe(..), isNothing)
 import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..))
+import Data.String (String)
 -- import GHC.Exts (Int(..))
 -- import GHC.Prim (unsafeCoerce#)
 import GHC.StableName (StableName(..), makeStableName, hashStableName, eqStableName)
@@ -25,7 +27,7 @@
 import Prelude ((+))
 import System.IO (IO)
 import System.IO.Unsafe (unsafePerformIO)
--- import Text.Show (Show(..))
+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
@@ -37,7 +39,7 @@
 -- import Debug.Trace (trace)
 
 -- * Class 'Letable'
--- | This class is not for manual usage like usual symantic operators,
+-- | This class is not for end-users like usual symantic operators,
 -- here 'def' and 'ref' are introduced by 'observeSharing'.
 class Letable letName repr where
   -- | @('def' letName x)@ let-binds @(letName)@ to be equal to @(x)@.
@@ -59,6 +61,19 @@
 class MakeLetName letName where
   makeLetName :: SharingName -> IO letName
 
+-- ** Type 'ShowLetName'
+-- | Useful on golden unit tests because 'StableName'
+-- change often when changing unrelated source code
+-- or even changing basic GHC or executable flags.
+class ShowLetName (showName::Bool) letName where
+  showLetName :: letName -> String
+-- | Like 'Show'.
+instance Show letName => ShowLetName 'True letName where
+  showLetName = show
+-- | Always return @"<hidden>"@,
+instance ShowLetName 'False letName where
+  showLetName _p = "<hidden>"
+
 -- * Type 'SharingName'
 -- | Note that the observable sharing enabled by 'StableName'
 -- is not perfect as it will not observe all the sharing explicitely done.
@@ -100,7 +115,8 @@
 observeSharing ::
   Eq letName =>
   Hashable letName =>
-  ObserveSharing letName repr a -> repr a
+  ObserveSharing letName repr a ->
+  repr a
 observeSharing (ObserveSharing m) = do
   let (a, st) = MT.runReaderT m mempty `MT.runState`
         ObserveSharingState
@@ -125,7 +141,8 @@
   Hashable letName =>
   Letable letName repr =>
   MakeLetName letName =>
-  ObserveSharing letName repr a -> ObserveSharing letName repr a
+  ObserveSharing letName repr a ->
+  ObserveSharing letName repr a
 observeSharingNode (ObserveSharing m) = ObserveSharing $ do
   let nodeName = makeSharingName m
   st <- MT.lift MT.get
diff --git a/src/Symantic/Univariant/Trans.hs b/src/Symantic/Univariant/Trans.hs
--- a/src/Symantic/Univariant/Trans.hs
+++ b/src/Symantic/Univariant/Trans.hs
@@ -17,7 +17,8 @@
 
 -- * Class 'BiTrans'
 -- | Convenient type class synonym.
--- Note that this is not necessarily a bijective 'trans'lation, a 'trans' being not necessarily injective nor surjective.
+-- Note that this is not necessarily a bijective 'trans'lation,
+-- a 'trans' being not necessarily injective nor surjective.
 type BiTrans from to = (Trans from to, Trans to from)
 
 -- ** Class 'Liftable'
diff --git a/symantic-parser.cabal b/symantic-parser.cabal
--- a/symantic-parser.cabal
+++ b/symantic-parser.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name: symantic-parser
-version: 0.0.0.20210102
+version: 0.1.0.20210201
 synopsis: Parser combinators statically optimized and staged via typed meta-programming
 description:
   This is a work-in-progress experimental library to generate parsers,
@@ -32,9 +32,11 @@
   shell.nix
   test/Golden/**/*.dump
   test/Golden/**/*.txt
+  test/Golden/Splice/**/*.hs
 extra-tmp-files:
 build-type: Simple
-tested-with: GHC==9.0.0
+-- build-type: Custom
+tested-with: GHC==9.0.1
 
 source-repository head
   type: git
@@ -76,26 +78,38 @@
     -fhide-source-paths
     -freverse-errors
 
+-- custom-setup
+--   setup-depends:
+--     base      >= 4.14,
+--     Cabal     >= 3.0,
+--     directory >= 1,
+--     filepath  >= 1.3
+
 library
   import: boilerplate
   hs-source-dirs: src
   exposed-modules:
-    Symantic.Univariant.Letable
-    Symantic.Univariant.Trans
     Symantic.Parser
     Symantic.Parser.Grammar
     Symantic.Parser.Grammar.Combinators
-    Symantic.Parser.Grammar.Dump
     Symantic.Parser.Grammar.Fixity
     Symantic.Parser.Grammar.ObserveSharing
     Symantic.Parser.Grammar.Optimize
+    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.Dump
     Symantic.Parser.Machine.Generate
     Symantic.Parser.Machine.Input
     Symantic.Parser.Machine.Instructions
+    Symantic.Parser.Machine.Optimize
+    Symantic.Parser.Machine.Program
+    Symantic.Parser.Machine.View
+    Symantic.Univariant.Letable
+    Symantic.Univariant.Trans
   build-depends:
     base >=4.10 && <5,
     array,
@@ -115,11 +129,17 @@
   main-is: Main.hs
   other-modules:
     Golden
-    Golden.Grammar
-    -- Golden.Utils
-    -- Golden.Parsers
+    --Golden.Splice
+    --Golden.Utils
+    Parser
+    Parser.Brainfuck
+    Parser.Nandlang
+    Parser.Playground
+    --Paths_symantic_parser
     -- HUnit
     -- QuickCheck
+  -- autogen-modules:
+  --   Paths_symantic_parser
   default-extensions:
     ViewPatterns
   ghc-options:
@@ -142,6 +162,7 @@
     text >= 1.2,
     -- time >= 1.9,
     transformers >= 0.4,
+    -- turtle >= 1.5,
     -- QuickCheck >= 2.0,
     -- tasty-quickcheck,
     unix >= 2.7,
diff --git a/test/Golden.hs b/test/Golden.hs
--- a/test/Golden.hs
+++ b/test/Golden.hs
@@ -2,8 +2,11 @@
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UnboxedTuples #-}
+{-# OPTIONS_GHC -Wno-unused-local-binds #-} -- For TH splices
+{-# OPTIONS_GHC -Wno-unused-matches #-} -- For TH splices
 module Golden where
 
+import Data.Bool (Bool(..))
 import Control.Monad (Monad(..))
 import Data.Char (Char)
 import Data.Either (Either(..))
@@ -24,48 +27,48 @@
 
 import qualified Symantic.Parser as P
 import qualified Symantic.Parser.Haskell as H
-import qualified Golden.Grammar as Grammar
---import Golden.Utils
+import qualified Parser
+--import qualified Golden.Splice
 
 goldensIO :: IO TestTree
 goldensIO = return $ testGroup "Golden"
   [ goldensGrammar
-  -- Commented-out for the release
-  -- because resetTHNameCounter is not enough:
-  -- TH names still change between runs
-  -- with and without --accept
-  -- , goldensMachine
+  , goldensMachine
   , goldensParser
+  -- TODO: this will need cabal-install-3.4 to compile under GHC9.
+  --, Golden.Splice.goldens
   ]
 
 goldensGrammar :: TestTree
 goldensGrammar = testGroup "Grammar"
-  [ testGroup "DumpComb" $ tests $ \name repr ->
+  [ testGroup "ViewGrammar" $ tests $ \name repr ->
     let file = "test/Golden/Grammar/"<>name<>".dump" in
     goldenVsStringDiff file diffGolden file $ do
       resetTHNameCounter
       return $ fromString $ show $
-        P.dumpComb $ P.observeSharing repr
-  , testGroup "OptimizeComb" $ tests $ \name repr ->
+        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 $ show $
-        P.dumpComb $ P.optimizeComb $ P.observeSharing repr
+      return $ fromString $ P.showGrammar @'False repr
   ]
   where
-  tests :: P.Grammar repr =>
-           P.Satisfiable repr Char =>
+  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.Haskell H.id) 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" $ Grammar.boom
-    , test "brainfuck" $ Grammar.brainfuck
+    , 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
@@ -75,24 +78,26 @@
     goldenVsStringDiff file diffGolden file $ do
       resetTHNameCounter
       return $ fromString $ show $
-        P.dumpInstr $ {-P.machine @() $ -}repr
+        P.viewMachine @'False repr
   ]
   where
   tests ::
-    P.Executable repr =>
-    P.Readable repr Char =>
+    P.Machine Char repr =>
     (forall vs es ret. String -> repr Text vs es ret -> 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.Haskell H.id) P.<*> P.unit
+    , test "app" $ P.machine $ P.pure H.id P.<*> P.unit
     , test "many-a" $ P.machine $ P.many (P.char 'a')
-    , test "boom" $ P.machine $ Grammar.boom
-    , test "brainfuck" $ P.machine $ Grammar.brainfuck
+    , 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
@@ -110,23 +115,29 @@
   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 "ab")
+    , 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 "alt-right" $$(P.runParser $ P.string "aa" P.<|> P.string "ab")
-    , test "alt-right-try" $$(P.runParser $ P.try (P.string "aa") P.<|> P.string "ab")
+    , 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 "alt-char-fail" $$(P.runParser $ P.some (P.char 'a') P.<|> P.string "b")
+    , 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 "alt-char-try-fail" $$(P.runParser $ P.try (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 profiling is enabled, in this case those tests may fail
+-- 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
 
diff --git a/test/Golden/Grammar.hs b/test/Golden/Grammar.hs
deleted file mode 100644
--- a/test/Golden/Grammar.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Golden.Grammar where
-
-import Data.Char (Char)
-import Data.Eq (Eq)
-import Data.Int (Int)
-import Data.String (String)
-import Prelude (undefined)
-import Text.Show (Show)
-import qualified Prelude
-import qualified Language.Haskell.TH as TH
-
-import Symantic.Parser
-import qualified Symantic.Parser.Haskell as H
-
-data Expr = Var String | Num Int | Add Expr Expr deriving Show
-data Asgn = Asgn String Expr deriving Show
-
-data BrainFuckOp = RightPointer | LeftPointer | Increment | Decrement | Output | Input | Loop [BrainFuckOp] deriving (Show, Eq)
-
-{-
-cinput = m --try (string "aaa") <|> string "db" --(string "aab" <|> string "aac") --(char 'a' <|> char 'b') *> string "ab"
-  where
-    --m = match "ab" (lookAhead item) op empty
-    --op 'a' = item $> haskell "aaaaa"
-    --op 'b' = item $> haskell "bbbbb"
-    m = bf <* item
-    -- match :: Eq a => [Pure repr a] -> repr a -> (Pure repr a -> repr b) -> repr b -> repr b
-    bf = match [char '>'] item op empty
-    op (H.ValueCode '>' _) = string ">"
--}
-
---defuncTest = haskell Just <$> (haskell (+) <$> (item $> haskell 1) <*> (item $> haskell 8))
-
--- manyTest = many (string "ab" $> (haskell 'c'))
-
---nfb = negLook (char 'a') <|> void (string "ab")
-
---skipManyInspect = skipMany (char 'a')
-
-boom :: Applicable repr => repr ()
-boom =
-  let foo = (-- newRegister_ unit (\r0 ->
-       let goo = (-- newRegister_ unit (\r1 ->
-             let hoo = {-get r0 <~> get r1 *>-} goo *> hoo in hoo
-            ) *> goo
-       in goo) *> pure H.unit
-  in foo *> foo
-
-haskell :: a -> TH.CodeQ a -> H.Haskell a
-haskell e c = H.Haskell (H.ValueCode (H.Value e) c)
-
-brainfuck :: Satisfiable repr Char => Grammar repr => repr [BrainFuckOp]
-brainfuck = whitespace *> bf
-  where
-    whitespace = skipMany (noneOf "<>+-[],.$")
-    lexeme p = p <* whitespace
-    -- match :: Eq a => [Pure repr a] -> repr a -> (Pure repr a -> repr b) -> repr b -> repr b
-    bf = many (lexeme (match ((\c -> haskell c [||c||]) Prelude.<$> "><+-.,[") (look anyChar) op empty))
-    --op :: H.Haskell Char -> repr BrainFuckOp
-    op (H.Haskell (H.ValueCode (H.Value c) _)) = case c of
-     '>' -> anyChar $> haskell RightPointer [||RightPointer||]
-     '<' -> anyChar $> haskell LeftPointer  [||LeftPointer||]
-     '+' -> anyChar $> haskell Increment    [||Increment||]
-     '-' -> anyChar $> haskell Decrement    [||Decrement||]
-     '.' -> anyChar $> haskell Output       [||Output||]
-     ',' -> anyChar $> haskell Input        [||Input||]
-     '[' -> between (lexeme anyChar) (char ']') (haskell Loop [||Loop||] <$> bf)
-     _ -> undefined
-    op _ = undefined
diff --git a/test/Golden/Grammar/app.dump b/test/Golden/Grammar/app.dump
--- a/test/Golden/Grammar/app.dump
+++ b/test/Golden/Grammar/app.dump
@@ -1,3 +1,3 @@
 <*>
-+ pure Haskell
-` pure ()
++ pure (\u1 -> u1)
+` pure Term
diff --git a/test/Golden/Grammar/app.opt.dump b/test/Golden/Grammar/app.opt.dump
--- a/test/Golden/Grammar/app.opt.dump
+++ b/test/Golden/Grammar/app.opt.dump
@@ -1,1 +1,1 @@
-pure (Haskell ())
+pure Term
diff --git a/test/Golden/Grammar/boom.dump b/test/Golden/Grammar/boom.dump
--- a/test/Golden/Grammar/boom.dump
+++ b/test/Golden/Grammar/boom.dump
@@ -1,46 +1,46 @@
 <*>
 + <*>
 | + <*>
-| | + pure const
-| | ` pure id
+| | + pure (\u1 -> (\u2 -> u1))
+| | ` pure (\u1 -> u1)
 | ` <*>
 |   + <*>
-|   | + def name_5
+|   | + def <hidden>
 |   | | ` <*>
-|   | |   + pure const
-|   | |   ` pure id
-|   | ` def name_7
+|   | |   + pure (\u1 -> (\u2 -> u1))
+|   | |   ` pure (\u1 -> u1)
+|   | ` def <hidden>
 |   |   ` <*>
 |   |     + <*>
-|   |     | + def name_1
+|   |     | + def <hidden>
 |   |     | | ` <*>
-|   |     | |   + pure const
-|   |     | |   ` pure id
-|   |     | ` def name_3
+|   |     | |   + pure (\u1 -> (\u2 -> u1))
+|   |     | |   ` pure (\u1 -> u1)
+|   |     | ` def <hidden>
 |   |     |   ` <*>
 |   |     |     + <*>
 |   |     |     | + <*>
-|   |     |     | | + pure const
-|   |     |     | | ` pure id
-|   |     |     | ` rec name_7
-|   |     |     ` rec name_3
-|   |     ` rec name_7
-|   ` def name_2
-|     ` pure ()
+|   |     |     | | + pure (\u1 -> (\u2 -> u1))
+|   |     |     | | ` pure (\u1 -> u1)
+|   |     |     | ` rec <hidden>
+|   |     |     ` rec <hidden>
+|   |     ` rec <hidden>
+|   ` def <hidden>
+|     ` pure Term
 ` <*>
   + <*>
-  | + ref name_5
-  | ` def name_4
+  | + ref <hidden>
+  | ` def <hidden>
   |   ` <*>
   |     + <*>
-  |     | + ref name_1
-  |     | ` def name_6
+  |     | + ref <hidden>
+  |     | ` def <hidden>
   |     |   ` <*>
   |     |     + <*>
   |     |     | + <*>
-  |     |     | | + pure const
-  |     |     | | ` pure id
-  |     |     | ` rec name_4
-  |     |     ` rec name_6
-  |     ` rec name_4
-  ` ref name_2
+  |     |     | | + pure (\u1 -> (\u2 -> u1))
+  |     |     | | ` pure (\u1 -> u1)
+  |     |     | ` rec <hidden>
+  |     |     ` rec <hidden>
+  |     ` rec <hidden>
+  ` ref <hidden>
diff --git a/test/Golden/Grammar/boom.opt.dump b/test/Golden/Grammar/boom.opt.dump
--- a/test/Golden/Grammar/boom.opt.dump
+++ b/test/Golden/Grammar/boom.opt.dump
@@ -4,33 +4,33 @@
 | | + <*>
 | | | + <*>
 | | | | + <*>
-| | | | | + pure ((.) ((.) (.)) . ((.) ((.) (.)) . (.) ((.) (const id))))
-| | | | | ` def name_2
-| | | | |   ` pure (const id)
-| | | | ` def name_4
+| | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (u4 u5) u6))))))
+| | | | | ` def <hidden>
+| | | | |   ` pure (\u1 -> (\u2 -> u2))
+| | | | ` def <hidden>
 | | | |   ` <*>
 | | | |     + <*>
-| | | |     | + def name_5
-| | | |     | | ` pure (const id)
-| | | |     | ` def name_7
+| | | |     | + def <hidden>
+| | | |     | | ` pure (\u1 -> (\u2 -> u2))
+| | | |     | ` def <hidden>
 | | | |     |   ` <*>
 | | | |     |     + <*>
-| | | |     |     | + pure (const id)
-| | | |     |     | ` rec name_4
-| | | |     |     ` rec name_7
-| | | |     ` rec name_4
-| | | ` def name_6
-| | |   ` pure ()
-| | ` ref name_2
-| ` def name_1
+| | | |     |     | + pure (\u1 -> (\u2 -> u2))
+| | | |     |     | ` rec <hidden>
+| | | |     |     ` rec <hidden>
+| | | |     ` rec <hidden>
+| | | ` def <hidden>
+| | |   ` pure Term
+| | ` ref <hidden>
+| ` def <hidden>
 |   ` <*>
 |     + <*>
-|     | + ref name_5
-|     | ` def name_3
+|     | + ref <hidden>
+|     | ` def <hidden>
 |     |   ` <*>
 |     |     + <*>
-|     |     | + pure (const id)
-|     |     | ` rec name_1
-|     |     ` rec name_3
-|     ` rec name_1
-` ref name_6
+|     |     | + pure (\u1 -> (\u2 -> u2))
+|     |     | ` rec <hidden>
+|     |     ` rec <hidden>
+|     ` rec <hidden>
+` ref <hidden>
diff --git a/test/Golden/Grammar/brainfuck.dump b/test/Golden/Grammar/brainfuck.dump
--- a/test/Golden/Grammar/brainfuck.dump
+++ b/test/Golden/Grammar/brainfuck.dump
@@ -1,140 +1,101 @@
 <*>
 + <*>
 | + <*>
-| | + pure const
-| | ` pure id
-| ` <*>
-|   + <*>
-|   | + <*>
-|   | | + pure const
-|   | | ` pure id
-|   | ` <*>
-|   |   + <*>
-|   |   | + pure (flip ($))
-|   |   | ` def name_6
-|   |   |   ` pure ()
-|   |   ` def name_8
-|   |     ` <|>
-|   |       + <*>
-|   |       | + <*>
-|   |       | | + pure (.)
-|   |       | | ` <*>
-|   |       | |   + def name_2
-|   |       | |   | ` <*>
-|   |       | |   |   + pure flip
-|   |       | |   |   ` pure const
-|   |       | |   ` def name_1
-|   |       | |     ` satisfy
-|   |       | ` rec name_8
-|   |       ` pure id
-|   ` ref name_6
-` def name_4
+| | + pure (\u1 -> (\u2 -> u1))
+| | ` pure (\u1 -> u1)
+| ` def <hidden>
+|   ` <*>
+|     + <*>
+|     | + <*>
+|     | | + pure (\u1 -> (\u2 -> u1))
+|     | | ` pure (\u1 -> u1)
+|     | ` <*>
+|     |   + <*>
+|     |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |   | ` pure Term
+|     |   ` def <hidden>
+|     |     ` <|>
+|     |       + <*>
+|     |       | + <*>
+|     |       | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
+|     |       | | ` <*>
+|     |       | |   + <*>
+|     |       | |   | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2)))
+|     |       | |   | ` pure (\u1 -> (\u2 -> u1))
+|     |       | |   ` def <hidden>
+|     |       | |     ` satisfy
+|     |       | ` rec <hidden>
+|     |       ` pure (\u1 -> u1)
+|     ` pure Term
+` def <hidden>
   ` <*>
-    + def name_5
+    + def <hidden>
     | ` <|>
     |   + <*>
     |   | + <*>
-    |   | | + pure (.)
+    |   | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
     |   | | ` <*>
     |   | |   + pure cons
     |   | |   ` <*>
     |   | |     + <*>
-    |   | |     | + pure const
+    |   | |     | + pure (\u1 -> (\u2 -> u1))
     |   | |     | ` conditional
+    |   | |     |   + look
+    |   | |     |   | ` ref <hidden>
     |   | |     |   + bs
     |   | |     |   | + <*>
     |   | |     |   | | + <*>
-    |   | |     |   | | | + pure const
-    |   | |     |   | | | ` pure Haskell
-    |   | |     |   | | ` ref name_1
+    |   | |     |   | | | + pure (\u1 -> (\u2 -> u1))
+    |   | |     |   | | | ` pure Term
+    |   | |     |   | | ` ref <hidden>
     |   | |     |   | + <*>
     |   | |     |   | | + <*>
-    |   | |     |   | | | + pure const
-    |   | |     |   | | | ` pure Haskell
-    |   | |     |   | | ` ref name_1
+    |   | |     |   | | | + pure (\u1 -> (\u2 -> u1))
+    |   | |     |   | | | ` pure Term
+    |   | |     |   | | ` ref <hidden>
     |   | |     |   | + <*>
     |   | |     |   | | + <*>
-    |   | |     |   | | | + pure const
-    |   | |     |   | | | ` pure Haskell
-    |   | |     |   | | ` ref name_1
+    |   | |     |   | | | + pure (\u1 -> (\u2 -> u1))
+    |   | |     |   | | | ` pure Term
+    |   | |     |   | | ` ref <hidden>
     |   | |     |   | + <*>
     |   | |     |   | | + <*>
-    |   | |     |   | | | + pure const
-    |   | |     |   | | | ` pure Haskell
-    |   | |     |   | | ` ref name_1
+    |   | |     |   | | | + pure (\u1 -> (\u2 -> u1))
+    |   | |     |   | | | ` pure Term
+    |   | |     |   | | ` ref <hidden>
     |   | |     |   | + <*>
     |   | |     |   | | + <*>
-    |   | |     |   | | | + pure const
-    |   | |     |   | | | ` pure Haskell
-    |   | |     |   | | ` ref name_1
+    |   | |     |   | | | + pure (\u1 -> (\u2 -> u1))
+    |   | |     |   | | | ` pure Term
+    |   | |     |   | | ` ref <hidden>
     |   | |     |   | + <*>
     |   | |     |   | | + <*>
-    |   | |     |   | | | + pure const
-    |   | |     |   | | | ` pure Haskell
-    |   | |     |   | | ` ref name_1
+    |   | |     |   | | | + pure (\u1 -> (\u2 -> u1))
+    |   | |     |   | | | ` pure Term
+    |   | |     |   | | ` ref <hidden>
     |   | |     |   | ` <*>
     |   | |     |   |   + <*>
-    |   | |     |   |   | + pure const
+    |   | |     |   |   | + pure (\u1 -> (\u2 -> u1))
     |   | |     |   |   | ` <*>
     |   | |     |   |   |   + <*>
     |   | |     |   |   |   | + <*>
-    |   | |     |   |   |   | | + pure const
-    |   | |     |   |   |   | | ` pure id
+    |   | |     |   |   |   | | + pure (\u1 -> (\u2 -> u1))
+    |   | |     |   |   |   | | ` pure (\u1 -> u1)
     |   | |     |   |   |   | ` <*>
     |   | |     |   |   |   |   + <*>
-    |   | |     |   |   |   |   | + pure const
-    |   | |     |   |   |   |   | ` ref name_1
-    |   | |     |   |   |   |   ` <*>
-    |   | |     |   |   |   |     + <*>
-    |   | |     |   |   |   |     | + <*>
-    |   | |     |   |   |   |     | | + pure const
-    |   | |     |   |   |   |     | | ` pure id
-    |   | |     |   |   |   |     | ` <*>
-    |   | |     |   |   |   |     |   + <*>
-    |   | |     |   |   |   |     |   | + pure (flip ($))
-    |   | |     |   |   |   |     |   | ` ref name_6
-    |   | |     |   |   |   |     |   ` def name_7
-    |   | |     |   |   |   |     |     ` <|>
-    |   | |     |   |   |   |     |       + <*>
-    |   | |     |   |   |   |     |       | + <*>
-    |   | |     |   |   |   |     |       | | + pure (.)
-    |   | |     |   |   |   |     |       | | ` <*>
-    |   | |     |   |   |   |     |       | |   + ref name_2
-    |   | |     |   |   |   |     |       | |   ` ref name_1
-    |   | |     |   |   |   |     |       | ` rec name_7
-    |   | |     |   |   |   |     |       ` pure id
-    |   | |     |   |   |   |     ` ref name_6
+    |   | |     |   |   |   |   | + pure (\u1 -> (\u2 -> u1))
+    |   | |     |   |   |   |   | ` ref <hidden>
+    |   | |     |   |   |   |   ` ref <hidden>
     |   | |     |   |   |   ` <*>
-    |   | |     |   |   |     + pure Haskell
-    |   | |     |   |   |     ` rec name_4
+    |   | |     |   |   |     + pure Term
+    |   | |     |   |   |     ` rec <hidden>
     |   | |     |   |   ` <*>
     |   | |     |   |     + <*>
-    |   | |     |   |     | + pure const
-    |   | |     |   |     | ` pure Haskell
-    |   | |     |   |     ` ref name_1
-    |   | |     |   + look
-    |   | |     |   | ` ref name_1
+    |   | |     |   |     | + pure (\u1 -> (\u2 -> u1))
+    |   | |     |   |     | ` pure ']'
+    |   | |     |   |     ` ref <hidden>
     |   | |     |   ` empty
-    |   | |     ` <*>
-    |   | |       + <*>
-    |   | |       | + <*>
-    |   | |       | | + pure const
-    |   | |       | | ` pure id
-    |   | |       | ` <*>
-    |   | |       |   + <*>
-    |   | |       |   | + pure (flip ($))
-    |   | |       |   | ` ref name_6
-    |   | |       |   ` def name_3
-    |   | |       |     ` <|>
-    |   | |       |       + <*>
-    |   | |       |       | + <*>
-    |   | |       |       | | + pure (.)
-    |   | |       |       | | ` <*>
-    |   | |       |       | |   + ref name_2
-    |   | |       |       | |   ` ref name_1
-    |   | |       |       | ` rec name_3
-    |   | |       |       ` pure id
-    |   | |       ` ref name_6
-    |   | ` rec name_5
-    |   ` pure id
-    ` pure Haskell
+    |   | |     ` ref <hidden>
+    |   | ` rec <hidden>
+    |   ` pure (\u1 -> u1)
+    ` pure Term
diff --git a/test/Golden/Grammar/brainfuck.opt.dump b/test/Golden/Grammar/brainfuck.opt.dump
--- a/test/Golden/Grammar/brainfuck.opt.dump
+++ b/test/Golden/Grammar/brainfuck.opt.dump
@@ -1,87 +1,58 @@
 <*>
 + <*>
-| + <*>
-| | + <*>
-| | | + pure ((.) ((.) (const id)) . ((.) (const id) . flip ($)))
-| | | ` def name_4
-| | |   ` pure ()
-| | ` def name_6
-| |   ` <|>
-| |     + <*>
-| |     | + <*>
-| |     | | + <*>
-| |     | | | + pure ((.) (.))
-| |     | | | ` def name_7
-| |     | | |   ` pure (flip const)
-| |     | | ` satisfy
-| |     | ` rec name_6
-| |     ` pure id
-| ` ref name_4
-` def name_2
+| + pure (\u1 -> (\u2 -> u2))
+| ` def <hidden>
+|   ` <*>
+|     + pure (\u1 -> Term)
+|     ` def <hidden>
+|       ` <|>
+|         + <*>
+|         | + <*>
+|         | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+|         | | ` satisfy
+|         | ` rec <hidden>
+|         ` pure (\u1 -> u1)
+` def <hidden>
   ` <*>
-    + pure ((flip ($)) Haskell)
-    ` def name_3
+    + pure (\u1 -> u1 Term)
+    ` def <hidden>
       ` <|>
         + <*>
         | + <*>
         | | + <*>
-        | | | + <*>
-        | | | | + conditional
-        | | | | | + bs
-        | | | | | | + <*>
-        | | | | | | | + pure ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-        | | | | | | | ` satisfy
-        | | | | | | + <*>
-        | | | | | | | + pure ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-        | | | | | | | ` satisfy
-        | | | | | | + <*>
-        | | | | | | | + pure ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-        | | | | | | | ` satisfy
-        | | | | | | + <*>
-        | | | | | | | + pure ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-        | | | | | | | ` satisfy
-        | | | | | | + <*>
-        | | | | | | | + pure ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-        | | | | | | | ` satisfy
-        | | | | | | + <*>
-        | | | | | | | + pure ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-        | | | | | | | ` satisfy
-        | | | | | | ` <*>
-        | | | | | |   + <*>
-        | | | | | |   | + <*>
-        | | | | | |   | | + <*>
-        | | | | | |   | | | + <*>
-        | | | | | |   | | | | + <*>
-        | | | | | |   | | | | | + pure ((.) ((.) ((.) ((.) ((.) ((.) ((.) ((.) (.)))))))) . ((.) ((.) ((.) ((.) ((.) ((.) ((.) ((.) cons))))))) . ((.) ((.) ((.) ((.) ((.) ((flip ($)) ((.) (const id) . flip ($))))))) . ((.) ((.) ((.) ((.) ((.) (.))))) . ((.) ((.) ((.) ((.) ((.) (.))))) . ((.) ((.) ((.) ((.) ((.) (.))))) . ((.) ((.) ((.) ((.) ((.) const)))) . ((.) ((.) ((.) ((.) ((flip ($)) (const Haskell))))) . ((.) ((.) ((.) ((.) (.)))) . ((.) ((.) ((.) ((.) const))) . ((.) ((.) ((.) ((flip ($)) Haskell))) . ((.) ((.) ((.) (.))) . ((.) ((.) ((.) (const id))) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . const)))))))))))))))))
-        | | | | | |   | | | | | ` satisfy
-        | | | | | |   | | | | ` ref name_4
-        | | | | | |   | | | ` def name_1
-        | | | | | |   | | |   ` <|>
-        | | | | | |   | | |     + <*>
-        | | | | | |   | | |     | + <*>
-        | | | | | |   | | |     | | + <*>
-        | | | | | |   | | |     | | | + pure ((.) (.))
-        | | | | | |   | | |     | | | ` ref name_7
-        | | | | | |   | | |     | | ` satisfy
-        | | | | | |   | | |     | ` rec name_1
-        | | | | | |   | | |     ` pure id
-        | | | | | |   | | ` ref name_4
-        | | | | | |   | ` rec name_2
-        | | | | | |   ` satisfy
-        | | | | | + look
-        | | | | | | ` satisfy
-        | | | | | ` empty
-        | | | | ` ref name_4
-        | | | ` def name_5
-        | | |   ` <|>
-        | | |     + <*>
-        | | |     | + <*>
-        | | |     | | + <*>
-        | | |     | | | + pure ((.) (.))
-        | | |     | | | ` ref name_7
-        | | |     | | ` satisfy
-        | | |     | ` rec name_5
-        | | |     ` pure id
-        | | ` ref name_4
-        | ` rec name_3
-        ` pure id
+        | | | + 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 <hidden>
+        | | |   |   | ` rec <hidden>
+        | | |   |   ` satisfy
+        | | |   ` empty
+        | | ` ref <hidden>
+        | ` rec <hidden>
+        ` pure (\u1 -> u1)
diff --git a/test/Golden/Grammar/many-a.dump b/test/Golden/Grammar/many-a.dump
--- a/test/Golden/Grammar/many-a.dump
+++ b/test/Golden/Grammar/many-a.dump
@@ -1,16 +1,16 @@
 <*>
-+ def name_1
++ def <hidden>
 | ` <|>
 |   + <*>
 |   | + <*>
-|   | | + pure (.)
+|   | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
 |   | | ` <*>
 |   | |   + pure cons
 |   | |   ` <*>
 |   | |     + <*>
-|   | |     | + pure const
-|   | |     | ` pure Haskell
+|   | |     | + pure (\u1 -> (\u2 -> u1))
+|   | |     | ` pure 'a'
 |   | |     ` satisfy
-|   | ` rec name_1
-|   ` pure id
-` pure Haskell
+|   | ` rec <hidden>
+|   ` pure (\u1 -> u1)
+` pure Term
diff --git a/test/Golden/Grammar/many-a.opt.dump b/test/Golden/Grammar/many-a.opt.dump
--- a/test/Golden/Grammar/many-a.opt.dump
+++ b/test/Golden/Grammar/many-a.opt.dump
@@ -1,10 +1,10 @@
 <*>
-+ pure ((flip ($)) Haskell)
-` def name_1
++ pure (\u1 -> u1 Term)
+` def <hidden>
   ` <|>
     + <*>
     | + <*>
-    | | + pure ((.) . (cons . const Haskell))
+    | | + pure (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3)))
     | | ` satisfy
-    | ` rec name_1
-    ` pure id
+    | ` rec <hidden>
+    ` pure (\u1 -> u1)
diff --git a/test/Golden/Grammar/many-char-eof.dump b/test/Golden/Grammar/many-char-eof.dump
--- a/test/Golden/Grammar/many-char-eof.dump
+++ b/test/Golden/Grammar/many-char-eof.dump
@@ -1,20 +1,20 @@
 <*>
 + <*>
-| + pure const
+| + pure (\u1 -> (\u2 -> u1))
 | ` <*>
-|   + def name_1
+|   + def <hidden>
 |   | ` <|>
 |   |   + <*>
 |   |   | + <*>
-|   |   | | + pure (.)
+|   |   | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
 |   |   | | ` <*>
 |   |   | |   + pure cons
 |   |   | |   ` <*>
 |   |   | |     + <*>
-|   |   | |     | + pure const
-|   |   | |     | ` pure Haskell
+|   |   | |     | + pure (\u1 -> (\u2 -> u1))
+|   |   | |     | ` pure 'r'
 |   |   | |     ` satisfy
-|   |   | ` rec name_1
-|   |   ` pure id
-|   ` pure Haskell
+|   |   | ` rec <hidden>
+|   |   ` 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
--- a/test/Golden/Grammar/many-char-eof.opt.dump
+++ b/test/Golden/Grammar/many-char-eof.opt.dump
@@ -1,12 +1,12 @@
 <*>
 + <*>
-| + pure (const . (flip ($)) Haskell)
-| ` def name_1
+| + pure (\u1 -> (\u2 -> u1 Term))
+| ` def <hidden>
 |   ` <|>
 |     + <*>
 |     | + <*>
-|     | | + pure ((.) . (cons . const Haskell))
+|     | | + pure (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3)))
 |     | | ` satisfy
-|     | ` rec name_1
-|     ` pure id
+|     | ` rec <hidden>
+|     ` pure (\u1 -> u1)
 ` eof
diff --git a/test/Golden/Grammar/many-char-fail.dump b/test/Golden/Grammar/many-char-fail.dump
deleted file mode 100644
--- a/test/Golden/Grammar/many-char-fail.dump
+++ /dev/null
@@ -1,25 +0,0 @@
-<*>
-+ <*>
-| + pure const
-| ` <*>
-|   + def name_2
-|   | ` <|>
-|   |   + <*>
-|   |   | + <*>
-|   |   | | + pure (.)
-|   |   | | ` <*>
-|   |   | |   + pure cons
-|   |   | |   ` <*>
-|   |   | |     + <*>
-|   |   | |     | + pure const
-|   |   | |     | ` pure Haskell
-|   |   | |     ` def name_1
-|   |   | |       ` satisfy
-|   |   | ` rec name_2
-|   |   ` pure id
-|   ` pure Haskell
-` <*>
-  + <*>
-  | + pure const
-  | ` pure Haskell
-  ` ref name_1
diff --git a/test/Golden/Grammar/many-char-fail.opt.dump b/test/Golden/Grammar/many-char-fail.opt.dump
deleted file mode 100644
--- a/test/Golden/Grammar/many-char-fail.opt.dump
+++ /dev/null
@@ -1,12 +0,0 @@
-<*>
-+ <*>
-| + pure ((flip ($)) (const Haskell) . ((.) . (const . (flip ($)) Haskell)))
-| ` def name_1
-|   ` <|>
-|     + <*>
-|     | + <*>
-|     | | + pure ((.) . (cons . const Haskell))
-|     | | ` satisfy
-|     | ` rec name_1
-|     ` pure id
-` satisfy
diff --git a/test/Golden/Grammar/nandlang.dump b/test/Golden/Grammar/nandlang.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Grammar/nandlang.dump
@@ -0,0 +1,993 @@
+<*>
++ <*>
+| + pure (\u1 -> (\u2 -> u1))
+| ` <*>
+|   + <*>
+|   | + <*>
+|   | | + pure (\u1 -> (\u2 -> u1))
+|   | | ` pure (\u1 -> u1)
+|   | ` def <hidden>
+|   |   ` <*>
+|   |     + <*>
+|   |     | + <*>
+|   |     | | + pure (\u1 -> (\u2 -> u1))
+|   |     | | ` pure (\u1 -> u1)
+|   |     | ` <*>
+|   |     |   + <*>
+|   |     |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|   |     |   | ` def <hidden>
+|   |     |   |   ` pure Term
+|   |     |   ` def <hidden>
+|   |     |     ` <|>
+|   |     |       + <*>
+|   |     |       | + <*>
+|   |     |       | | + 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 <hidden>
+|   |     |       | |     | |   ` <*>
+|   |     |       | |     | |     + <*>
+|   |     |       | |     | |     | + <*>
+|   |     |       | |     | |     | | + pure (\u1 -> (\u2 -> u1))
+|   |     |       | |     | |     | | ` pure (\u1 -> u1)
+|   |     |       | |     | |     | ` def <hidden>
+|   |     |       | |     | |     |   ` satisfy
+|   |     |       | |     | |     ` ref <hidden>
+|   |     |       | |     | ` <*>
+|   |     |       | |     |   + <*>
+|   |     |       | |     |   | + <*>
+|   |     |       | |     |   | | + pure (\u1 -> (\u2 -> u1))
+|   |     |       | |     |   | | ` pure (\u1 -> u1)
+|   |     |       | |     |   | ` <*>
+|   |     |       | |     |   |   + <*>
+|   |     |       | |     |   |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|   |     |       | |     |   |   | ` pure Term
+|   |     |       | |     |   |   ` def <hidden>
+|   |     |       | |     |   |     ` <|>
+|   |     |       | |     |   |       + <*>
+|   |     |       | |     |   |       | + <*>
+|   |     |       | |     |   |       | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
+|   |     |       | |     |   |       | | ` <*>
+|   |     |       | |     |   |       | |   + <*>
+|   |     |       | |     |   |       | |   | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2)))
+|   |     |       | |     |   |       | |   | ` pure (\u1 -> (\u2 -> u1))
+|   |     |       | |     |   |       | |   ` ref <hidden>
+|   |     |       | |     |   |       | ` rec <hidden>
+|   |     |       | |     |   |       ` 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 <hidden>
+|   |     |       | |       |   |     ` <*>
+|   |     |       | |       |   |       + <*>
+|   |     |       | |       |   |       | + pure cons
+|   |     |       | |       |   |       | ` <*>
+|   |     |       | |       |   |       |   + <*>
+|   |     |       | |       |   |       |   | + pure (\u1 -> (\u2 -> u1))
+|   |     |       | |       |   |       |   | ` pure '/'
+|   |     |       | |       |   |       |   ` ref <hidden>
+|   |     |       | |       |   |       ` pure Term
+|   |     |       | |       |   ` <*>
+|   |     |       | |       |     + <*>
+|   |     |       | |       |     | + <*>
+|   |     |       | |       |     | | + pure (\u1 -> (\u2 -> u1))
+|   |     |       | |       |     | | ` pure (\u1 -> u1)
+|   |     |       | |       |     | ` <*>
+|   |     |       | |       |     |   + <*>
+|   |     |       | |       |     |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|   |     |       | |       |     |   | ` ref <hidden>
+|   |     |       | |       |     |   ` def <hidden>
+|   |     |       | |       |     |     ` <|>
+|   |     |       | |       |     |       + <*>
+|   |     |       | |       |     |       | + <*>
+|   |     |       | |       |     |       | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
+|   |     |       | |       |     |       | | ` <*>
+|   |     |       | |       |     |       | |   + <*>
+|   |     |       | |       |     |       | |   | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2)))
+|   |     |       | |       |     |       | |   | ` pure (\u1 -> (\u2 -> u1))
+|   |     |       | |       |     |       | |   ` ref <hidden>
+|   |     |       | |       |     |       | ` rec <hidden>
+|   |     |       | |       |     |       ` pure (\u1 -> u1)
+|   |     |       | |       |     ` ref <hidden>
+|   |     |       | |       ` ref <hidden>
+|   |     |       | ` rec <hidden>
+|   |     |       ` pure (\u1 -> u1)
+|   |     ` ref <hidden>
+|   ` <*>
+|     + <*>
+|     | + <*>
+|     | | + pure (\u1 -> (\u2 -> u1))
+|     | | ` pure (\u1 -> u1)
+|     | ` <*>
+|     |   + <*>
+|     |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |   | ` ref <hidden>
+|     |   ` def <hidden>
+|     |     ` <|>
+|     |       + <*>
+|     |       | + <*>
+|     |       | | + 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 <hidden>
+|     |       | |     |   |   |   |     |     ` <*>
+|     |       | |     |   |   |   |     |       + <*>
+|     |       | |     |   |   |   |     |       | + pure cons
+|     |       | |     |   |   |   |     |       | ` <*>
+|     |       | |     |   |   |   |     |       |   + <*>
+|     |       | |     |   |   |   |     |       |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |   |   |     |       |   | ` pure 'u'
+|     |       | |     |   |   |   |     |       |   ` ref <hidden>
+|     |       | |     |   |   |   |     |       ` <*>
+|     |       | |     |   |   |   |     |         + <*>
+|     |       | |     |   |   |   |     |         | + pure cons
+|     |       | |     |   |   |   |     |         | ` <*>
+|     |       | |     |   |   |   |     |         |   + <*>
+|     |       | |     |   |   |   |     |         |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |   |   |     |         |   | ` pure 'n'
+|     |       | |     |   |   |   |     |         |   ` ref <hidden>
+|     |       | |     |   |   |   |     |         ` <*>
+|     |       | |     |   |   |   |     |           + <*>
+|     |       | |     |   |   |   |     |           | + pure cons
+|     |       | |     |   |   |   |     |           | ` <*>
+|     |       | |     |   |   |   |     |           |   + <*>
+|     |       | |     |   |   |   |     |           |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |   |   |     |           |   | ` pure 'c'
+|     |       | |     |   |   |   |     |           |   ` ref <hidden>
+|     |       | |     |   |   |   |     |           ` <*>
+|     |       | |     |   |   |   |     |             + <*>
+|     |       | |     |   |   |   |     |             | + pure cons
+|     |       | |     |   |   |   |     |             | ` <*>
+|     |       | |     |   |   |   |     |             |   + <*>
+|     |       | |     |   |   |   |     |             |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |   |   |     |             |   | ` pure 't'
+|     |       | |     |   |   |   |     |             |   ` ref <hidden>
+|     |       | |     |   |   |   |     |             ` <*>
+|     |       | |     |   |   |   |     |               + <*>
+|     |       | |     |   |   |   |     |               | + pure cons
+|     |       | |     |   |   |   |     |               | ` <*>
+|     |       | |     |   |   |   |     |               |   + <*>
+|     |       | |     |   |   |   |     |               |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |   |   |     |               |   | ` pure 'i'
+|     |       | |     |   |   |   |     |               |   ` ref <hidden>
+|     |       | |     |   |   |   |     |               ` <*>
+|     |       | |     |   |   |   |     |                 + <*>
+|     |       | |     |   |   |   |     |                 | + pure cons
+|     |       | |     |   |   |   |     |                 | ` <*>
+|     |       | |     |   |   |   |     |                 |   + <*>
+|     |       | |     |   |   |   |     |                 |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |   |   |     |                 |   | ` pure 'o'
+|     |       | |     |   |   |   |     |                 |   ` ref <hidden>
+|     |       | |     |   |   |   |     |                 ` <*>
+|     |       | |     |   |   |   |     |                   + <*>
+|     |       | |     |   |   |   |     |                   | + pure cons
+|     |       | |     |   |   |   |     |                   | ` <*>
+|     |       | |     |   |   |   |     |                   |   + <*>
+|     |       | |     |   |   |   |     |                   |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |   |   |     |                   |   | ` pure 'n'
+|     |       | |     |   |   |   |     |                   |   ` ref <hidden>
+|     |       | |     |   |   |   |     |                   ` def <hidden>
+|     |       | |     |   |   |   |     |                     ` pure Term
+|     |       | |     |   |   |   |     ` def <hidden>
+|     |       | |     |   |   |   |       ` negLook
+|     |       | |     |   |   |   |         ` ref <hidden>
+|     |       | |     |   |   |   ` ref <hidden>
+|     |       | |     |   |   ` def <hidden>
+|     |       | |     |   |     ` <*>
+|     |       | |     |   |       + <*>
+|     |       | |     |   |       | + <*>
+|     |       | |     |   |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |       | | ` pure (\u1 -> u1)
+|     |       | |     |   |       | ` try
+|     |       | |     |   |       |   ` <*>
+|     |       | |     |   |       |     + <*>
+|     |       | |     |   |       |     | + <*>
+|     |       | |     |   |       |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |       |     | | ` pure (\u1 -> u1)
+|     |       | |     |   |       |     | ` ref <hidden>
+|     |       | |     |   |       |     ` <*>
+|     |       | |     |   |       |       + <*>
+|     |       | |     |   |       |       | + <*>
+|     |       | |     |   |       |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |       |       | | ` pure (\u1 -> u1)
+|     |       | |     |   |       |       | ` <*>
+|     |       | |     |   |       |       |   + <*>
+|     |       | |     |   |       |       |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |       | |     |   |       |       |   | ` ref <hidden>
+|     |       | |     |   |       |       |   ` def <hidden>
+|     |       | |     |   |       |       |     ` <|>
+|     |       | |     |   |       |       |       + <*>
+|     |       | |     |   |       |       |       | + <*>
+|     |       | |     |   |       |       |       | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
+|     |       | |     |   |       |       |       | | ` <*>
+|     |       | |     |   |       |       |       | |   + <*>
+|     |       | |     |   |       |       |       | |   | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2)))
+|     |       | |     |   |       |       |       | |   | ` pure (\u1 -> (\u2 -> u1))
+|     |       | |     |   |       |       |       | |   ` ref <hidden>
+|     |       | |     |   |       |       |       | ` rec <hidden>
+|     |       | |     |   |       |       |       ` pure (\u1 -> u1)
+|     |       | |     |   |       |       ` ref <hidden>
+|     |       | |     |   |       ` ref <hidden>
+|     |       | |     |   ` <*>
+|     |       | |     |     + <*>
+|     |       | |     |     | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     | ` <*>
+|     |       | |     |     |   + <*>
+|     |       | |     |     |   | + <*>
+|     |       | |     |     |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |   | | ` pure (\u1 -> u1)
+|     |       | |     |     |   | ` def <hidden>
+|     |       | |     |     |   |   ` <*>
+|     |       | |     |     |   |     + <*>
+|     |       | |     |     |   |     | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |   |     | ` <*>
+|     |       | |     |     |   |     |   + <*>
+|     |       | |     |     |   |     |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |   |     |   | ` pure '('
+|     |       | |     |     |   |     |   ` ref <hidden>
+|     |       | |     |     |   |     ` ref <hidden>
+|     |       | |     |     |   ` <*>
+|     |       | |     |     |     + <*>
+|     |       | |     |     |     | + <*>
+|     |       | |     |     |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     | | ` pure (\u1 -> u1)
+|     |       | |     |     |     | ` def <hidden>
+|     |       | |     |     |     |   ` <|>
+|     |       | |     |     |     |     + <*>
+|     |       | |     |     |     |     | + <*>
+|     |       | |     |     |     |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     | | ` pure Term
+|     |       | |     |     |     |     | ` <*>
+|     |       | |     |     |     |     |   + <*>
+|     |       | |     |     |     |     |   | + <*>
+|     |       | |     |     |     |     |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   | | ` pure (\u1 -> u1)
+|     |       | |     |     |     |     |   | ` def <hidden>
+|     |       | |     |     |     |     |   |   ` <*>
+|     |       | |     |     |     |     |   |     + <*>
+|     |       | |     |     |     |     |   |     | + <*>
+|     |       | |     |     |     |     |   |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |     | | ` pure (\u1 -> u1)
+|     |       | |     |     |     |     |   |     | ` ref <hidden>
+|     |       | |     |     |     |     |   |     ` <|>
+|     |       | |     |     |     |     |   |       + <*>
+|     |       | |     |     |     |     |   |       | + <*>
+|     |       | |     |     |     |     |   |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       | | ` pure Term
+|     |       | |     |     |     |     |   |       | ` def <hidden>
+|     |       | |     |     |     |     |   |       |   ` <*>
+|     |       | |     |     |     |     |   |       |     + <*>
+|     |       | |     |     |     |     |   |       |     | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       |     | ` <*>
+|     |       | |     |     |     |     |   |       |     |   + <*>
+|     |       | |     |     |     |     |   |       |     |   | + <*>
+|     |       | |     |     |     |     |   |       |     |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       |     |   | | ` pure (\u1 -> u1)
+|     |       | |     |     |     |     |   |       |     |   | ` <*>
+|     |       | |     |     |     |     |   |       |     |   |   + <*>
+|     |       | |     |     |     |     |   |       |     |   |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       |     |   |   | ` <*>
+|     |       | |     |     |     |     |   |       |     |   |   |   + <*>
+|     |       | |     |     |     |     |   |       |     |   |   |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       |     |   |   |   | ` pure '['
+|     |       | |     |     |     |     |   |       |     |   |   |   ` ref <hidden>
+|     |       | |     |     |     |     |   |       |     |   |   ` ref <hidden>
+|     |       | |     |     |     |     |   |       |     |   ` <*>
+|     |       | |     |     |     |     |   |       |     |     + <*>
+|     |       | |     |     |     |     |   |       |     |     | + <*>
+|     |       | |     |     |     |     |   |       |     |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       |     |     | | ` pure (\u1 -> u1)
+|     |       | |     |     |     |     |   |       |     |     | ` ref <hidden>
+|     |       | |     |     |     |     |   |       |     |     ` <*>
+|     |       | |     |     |     |     |   |       |     |       + <*>
+|     |       | |     |     |     |     |   |       |     |       | + <*>
+|     |       | |     |     |     |     |   |       |     |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       |     |       | | ` pure (\u1 -> u1)
+|     |       | |     |     |     |     |   |       |     |       | ` <*>
+|     |       | |     |     |     |     |   |       |     |       |   + <*>
+|     |       | |     |     |     |     |   |       |     |       |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |       | |     |     |     |     |   |       |     |       |   | ` pure Term
+|     |       | |     |     |     |     |   |       |     |       |   ` def <hidden>
+|     |       | |     |     |     |     |   |       |     |       |     ` <|>
+|     |       | |     |     |     |     |   |       |     |       |       + <*>
+|     |       | |     |     |     |     |   |       |     |       |       | + <*>
+|     |       | |     |     |     |     |   |       |     |       |       | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
+|     |       | |     |     |     |     |   |       |     |       |       | | ` <*>
+|     |       | |     |     |     |     |   |       |     |       |       | |   + <*>
+|     |       | |     |     |     |     |   |       |     |       |       | |   | + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2)))
+|     |       | |     |     |     |     |   |       |     |       |       | |   | ` pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       |     |       |       | |   ` ref <hidden>
+|     |       | |     |     |     |     |   |       |     |       |       | ` rec <hidden>
+|     |       | |     |     |     |     |   |       |     |       |       ` pure (\u1 -> u1)
+|     |       | |     |     |     |     |   |       |     |       ` pure Term
+|     |       | |     |     |     |     |   |       |     ` <*>
+|     |       | |     |     |     |     |   |       |       + <*>
+|     |       | |     |     |     |     |   |       |       | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       |       | ` <*>
+|     |       | |     |     |     |     |   |       |       |   + <*>
+|     |       | |     |     |     |     |   |       |       |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |   |       |       |   | ` pure ']'
+|     |       | |     |     |     |     |   |       |       |   ` ref <hidden>
+|     |       | |     |     |     |     |   |       |       ` ref <hidden>
+|     |       | |     |     |     |     |   |       ` ref <hidden>
+|     |       | |     |     |     |     |   ` <*>
+|     |       | |     |     |     |     |     + <*>
+|     |       | |     |     |     |     |     | + <*>
+|     |       | |     |     |     |     |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |     | | ` pure (\u1 -> u1)
+|     |       | |     |     |     |     |     | ` <*>
+|     |       | |     |     |     |     |     |   + <*>
+|     |       | |     |     |     |     |     |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |       | |     |     |     |     |     |   | ` ref <hidden>
+|     |       | |     |     |     |     |     |   ` def <hidden>
+|     |       | |     |     |     |     |     |     ` <|>
+|     |       | |     |     |     |     |     |       + <*>
+|     |       | |     |     |     |     |     |       | + <*>
+|     |       | |     |     |     |     |     |       | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
+|     |       | |     |     |     |     |     |       | | ` <*>
+|     |       | |     |     |     |     |     |       | |   + def <hidden>
+|     |       | |     |     |     |     |     |       | |   | ` <*>
+|     |       | |     |     |     |     |     |       | |   |   + pure (\u1 -> (\u2 -> (\u3 -> (u1 u3) u2)))
+|     |       | |     |     |     |     |     |       | |   |   ` pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |     |       | |   ` <*>
+|     |       | |     |     |     |     |     |       | |     + <*>
+|     |       | |     |     |     |     |     |       | |     | + <*>
+|     |       | |     |     |     |     |     |       | |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |     |       | |     | | ` pure (\u1 -> u1)
+|     |       | |     |     |     |     |     |       | |     | ` def <hidden>
+|     |       | |     |     |     |     |     |       | |     |   ` <*>
+|     |       | |     |     |     |     |     |       | |     |     + <*>
+|     |       | |     |     |     |     |     |       | |     |     | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |     |       | |     |     | ` <*>
+|     |       | |     |     |     |     |     |       | |     |     |   + <*>
+|     |       | |     |     |     |     |     |       | |     |     |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |     |     |     |       | |     |     |   | ` pure ','
+|     |       | |     |     |     |     |     |       | |     |     |   ` ref <hidden>
+|     |       | |     |     |     |     |     |       | |     |     ` ref <hidden>
+|     |       | |     |     |     |     |     |       | |     ` ref <hidden>
+|     |       | |     |     |     |     |     |       | ` rec <hidden>
+|     |       | |     |     |     |     |     |       ` pure (\u1 -> u1)
+|     |       | |     |     |     |     |     ` ref <hidden>
+|     |       | |     |     |     |     ` ref <hidden>
+|     |       | |     |     |     ` <|>
+|     |       | |     |     |       + <*>
+|     |       | |     |     |       | + <*>
+|     |       | |     |     |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |       | | ` pure Term
+|     |       | |     |     |       | ` <*>
+|     |       | |     |     |       |   + <*>
+|     |       | |     |     |       |   | + <*>
+|     |       | |     |     |       |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |       |   | | ` pure (\u1 -> u1)
+|     |       | |     |     |       |   | ` <*>
+|     |       | |     |     |       |   |   + <*>
+|     |       | |     |     |       |   |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |       |   |   | ` <*>
+|     |       | |     |     |       |   |   |   + <*>
+|     |       | |     |     |       |   |   |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |     |       |   |   |   | ` pure ':'
+|     |       | |     |     |       |   |   |   ` ref <hidden>
+|     |       | |     |     |       |   |   ` ref <hidden>
+|     |       | |     |     |       |   ` ref <hidden>
+|     |       | |     |     |       ` ref <hidden>
+|     |       | |     |     ` def <hidden>
+|     |       | |     |       ` <*>
+|     |       | |     |         + <*>
+|     |       | |     |         | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |         | ` <*>
+|     |       | |     |         |   + <*>
+|     |       | |     |         |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |     |         |   | ` pure ')'
+|     |       | |     |         |   ` ref <hidden>
+|     |       | |     |         ` ref <hidden>
+|     |       | |     ` def <hidden>
+|     |       | |       ` <*>
+|     |       | |         + <*>
+|     |       | |         | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         | ` <*>
+|     |       | |         |   + <*>
+|     |       | |         |   | + <*>
+|     |       | |         |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |   | | ` pure (\u1 -> u1)
+|     |       | |         |   | ` <*>
+|     |       | |         |   |   + <*>
+|     |       | |         |   |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |   |   | ` <*>
+|     |       | |         |   |   |   + <*>
+|     |       | |         |   |   |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |   |   |   | ` pure '{'
+|     |       | |         |   |   |   ` ref <hidden>
+|     |       | |         |   |   ` ref <hidden>
+|     |       | |         |   ` <*>
+|     |       | |         |     + <*>
+|     |       | |         |     | + <*>
+|     |       | |         |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     | | ` pure (\u1 -> u1)
+|     |       | |         |     | ` <*>
+|     |       | |         |     |   + <*>
+|     |       | |         |     |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |       | |         |     |   | ` ref <hidden>
+|     |       | |         |     |   ` def <hidden>
+|     |       | |         |     |     ` <|>
+|     |       | |         |     |       + <*>
+|     |       | |         |     |       | + <*>
+|     |       | |         |     |       | | + 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 <hidden>
+|     |       | |         |     |       | |     | | | |   |   |   |     |     ` <*>
+|     |       | |         |     |       | |     | | | |   |   |   |     |       + <*>
+|     |       | |         |     |       | |     | | | |   |   |   |     |       | + pure cons
+|     |       | |         |     |       | |     | | | |   |   |   |     |       | ` <*>
+|     |       | |         |     |       | |     | | | |   |   |   |     |       |   + <*>
+|     |       | |         |     |       | |     | | | |   |   |   |     |       |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |   |   |     |       |   | ` pure 'f'
+|     |       | |         |     |       | |     | | | |   |   |   |     |       |   ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |   |   |     |       ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |   |   |     ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |   |   ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |   ` def <hidden>
+|     |       | |         |     |       | |     | | | |   |     ` <*>
+|     |       | |         |     |       | |     | | | |   |       + <*>
+|     |       | |         |     |       | |     | | | |   |       | + <*>
+|     |       | |         |     |       | |     | | | |   |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       | ` def <hidden>
+|     |       | |         |     |       | |     | | | |   |       |   ` <|>
+|     |       | |         |     |       | |     | | | |   |       |     + <|>
+|     |       | |         |     |       | |     | | | |   |       |     | + <*>
+|     |       | |         |     |       | |     | | | |   |       |     | | + <*>
+|     |       | |         |     |       | |     | | | |   |       |     | | | + <*>
+|     |       | |         |     |       | |     | | | |   |       |     | | | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     | | | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |     | | | ` <|>
+|     |       | |         |     |       | |     | | | |   |       |     | | |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |     | | |   | + <*>
+|     |       | |         |     |       | |     | | | |   |       |     | | |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     | | |   | | ` pure '0'
+|     |       | |         |     |       | |     | | | |   |       |     | | |   | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     | | |   ` <*>
+|     |       | |         |     |       | |     | | | |   |       |     | | |     + <*>
+|     |       | |         |     |       | |     | | | |   |       |     | | |     | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     | | |     | ` pure '1'
+|     |       | |         |     |       | |     | | | |   |       |     | | |     ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     | | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     | ` <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     |   | ` <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |   | + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     |   |   | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |     |   |   | ` <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |   |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |   |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     |   |   |   | ` pure '\''
+|     |       | |         |     |       | |     | | | |   |       |     |   |   |   ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     |   |   ` <|>
+|     |       | |         |     |       | |     | | | |   |       |     |   |     + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |     | + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |     | | + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |     | | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     |   |     | | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |     |   |     | | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     |   |     | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     |   |     ` <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |       + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |       | + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     |   |       | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |     |   |       | ` <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |       |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |       |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     |   |       |   | ` pure '\\'
+|     |       | |         |     |       | |     | | | |   |       |     |   |       |   ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     |   |       ` <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |         + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |         | + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |   |         | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     |   |         | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |     |   |         | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     |   |         ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     |   ` <*>
+|     |       | |         |     |       | |     | | | |   |       |     |     + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |     | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     |     | ` <*>
+|     |       | |         |     |       | |     | | | |   |       |     |     |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |     |     |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |     |     |   | ` pure '\''
+|     |       | |         |     |       | |     | | | |   |       |     |     |   ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     |     ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |     ` <*>
+|     |       | |         |     |       | |     | | | |   |       |       + <*>
+|     |       | |         |     |       | |     | | | |   |       |       | + <*>
+|     |       | |         |     |       | |     | | | |   |       |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |       | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |       | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |       ` <|>
+|     |       | |         |     |       | |     | | | |   |       |         + <*>
+|     |       | |         |     |       | |     | | | |   |       |         | + <*>
+|     |       | |         |     |       | |     | | | |   |       |         | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |         | | ` pure Term
+|     |       | |         |     |       | |     | | | |   |       |         | ` <|>
+|     |       | |         |     |       | |     | | | |   |       |         |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |         |   | | ` <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |   | + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |         |   | |   | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |         |   | |   | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |   ` <|>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     | + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     | | ` pure Term
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     | ` <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |   | + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |   | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |   | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |   | ` rec <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |   ` <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     | + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     | ` <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |   + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |   | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |   ` def <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |     ` <|>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | | ` <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | |   + ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | |   ` <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | |     + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | |     | + <*>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | |     | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | |     | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | |     ` rec <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       | ` rec <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     |       ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     |     ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | |     ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         |   ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       |         ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |       ` <*>
+|     |       | |         |     |       | |     | | | |   |         + <*>
+|     |       | |         |     |       | |     | | | |   |         | + <*>
+|     |       | |         |     |       | |     | | | |   |         | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | | |   |         | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |         | ` <*>
+|     |       | |         |     |       | |     | | | |   |         |   + <*>
+|     |       | |         |     |       | |     | | | |   |         |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |       | |         |     |       | |     | | | |   |         |   | ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |         |   ` def <hidden>
+|     |       | |         |     |       | |     | | | |   |         |     ` <|>
+|     |       | |         |     |       | |     | | | |   |         |       + <*>
+|     |       | |         |     |       | |     | | | |   |         |       | + <*>
+|     |       | |         |     |       | |     | | | |   |         |       | | + 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 <hidden>
+|     |       | |         |     |       | |     | | | |   |         |       | |     |   ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |         |       | |     ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   |         |       | ` rec <hidden>
+|     |       | |         |     |       | |     | | | |   |         |       ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     | | | |   |         ` ref <hidden>
+|     |       | |         |     |       | |     | | | |   ` rec <hidden>
+|     |       | |         |     |       | |     | | | ` <|>
+|     |       | |         |     |       | |     | | |   + <*>
+|     |       | |         |     |       | |     | | |   | + <*>
+|     |       | |         |     |       | |     | | |   | | + 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 <hidden>
+|     |       | |         |     |       | |     | | |   |   |   |     |     ` <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |       + <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |       | + pure cons
+|     |       | |         |     |       | |     | | |   |   |   |     |       | ` <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |       |   + <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |       |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | |   |   |   |     |       |   | ` pure 'l'
+|     |       | |         |     |       | |     | | |   |   |   |     |       |   ` ref <hidden>
+|     |       | |         |     |       | |     | | |   |   |   |     |       ` <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |         + <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |         | + pure cons
+|     |       | |         |     |       | |     | | |   |   |   |     |         | ` <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |         |   + <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |         |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | |   |   |   |     |         |   | ` pure 's'
+|     |       | |         |     |       | |     | | |   |   |   |     |         |   ` ref <hidden>
+|     |       | |         |     |       | |     | | |   |   |   |     |         ` <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |           + <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |           | + pure cons
+|     |       | |         |     |       | |     | | |   |   |   |     |           | ` <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |           |   + <*>
+|     |       | |         |     |       | |     | | |   |   |   |     |           |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | | |   |   |   |     |           |   | ` pure 'e'
+|     |       | |         |     |       | |     | | |   |   |   |     |           |   ` ref <hidden>
+|     |       | |         |     |       | |     | | |   |   |   |     |           ` ref <hidden>
+|     |       | |         |     |       | |     | | |   |   |   |     ` ref <hidden>
+|     |       | |         |     |       | |     | | |   |   |   ` ref <hidden>
+|     |       | |         |     |       | |     | | |   |   ` rec <hidden>
+|     |       | |         |     |       | |     | | |   ` ref <hidden>
+|     |       | |         |     |       | |     | | ` <*>
+|     |       | |         |     |       | |     | |   + <*>
+|     |       | |         |     |       | |     | |   | + <*>
+|     |       | |         |     |       | |     | |   | | + 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 <hidden>
+|     |       | |         |     |       | |     | |   |   |   |     |     ` <*>
+|     |       | |         |     |       | |     | |   |   |   |     |       + <*>
+|     |       | |         |     |       | |     | |   |   |   |     |       | + pure cons
+|     |       | |         |     |       | |     | |   |   |   |     |       | ` <*>
+|     |       | |         |     |       | |     | |   |   |   |     |       |   + <*>
+|     |       | |         |     |       | |     | |   |   |   |     |       |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | |   |   |   |     |       |   | ` pure 'h'
+|     |       | |         |     |       | |     | |   |   |   |     |       |   ` ref <hidden>
+|     |       | |         |     |       | |     | |   |   |   |     |       ` <*>
+|     |       | |         |     |       | |     | |   |   |   |     |         + <*>
+|     |       | |         |     |       | |     | |   |   |   |     |         | + pure cons
+|     |       | |         |     |       | |     | |   |   |   |     |         | ` <*>
+|     |       | |         |     |       | |     | |   |   |   |     |         |   + <*>
+|     |       | |         |     |       | |     | |   |   |   |     |         |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | |   |   |   |     |         |   | ` pure 'i'
+|     |       | |         |     |       | |     | |   |   |   |     |         |   ` ref <hidden>
+|     |       | |         |     |       | |     | |   |   |   |     |         ` <*>
+|     |       | |         |     |       | |     | |   |   |   |     |           + <*>
+|     |       | |         |     |       | |     | |   |   |   |     |           | + pure cons
+|     |       | |         |     |       | |     | |   |   |   |     |           | ` <*>
+|     |       | |         |     |       | |     | |   |   |   |     |           |   + <*>
+|     |       | |         |     |       | |     | |   |   |   |     |           |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | |   |   |   |     |           |   | ` pure 'l'
+|     |       | |         |     |       | |     | |   |   |   |     |           |   ` ref <hidden>
+|     |       | |         |     |       | |     | |   |   |   |     |           ` <*>
+|     |       | |         |     |       | |     | |   |   |   |     |             + <*>
+|     |       | |         |     |       | |     | |   |   |   |     |             | + pure cons
+|     |       | |         |     |       | |     | |   |   |   |     |             | ` <*>
+|     |       | |         |     |       | |     | |   |   |   |     |             |   + <*>
+|     |       | |         |     |       | |     | |   |   |   |     |             |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     | |   |   |   |     |             |   | ` pure 'e'
+|     |       | |         |     |       | |     | |   |   |   |     |             |   ` ref <hidden>
+|     |       | |         |     |       | |     | |   |   |   |     |             ` ref <hidden>
+|     |       | |         |     |       | |     | |   |   |   |     ` ref <hidden>
+|     |       | |         |     |       | |     | |   |   |   ` ref <hidden>
+|     |       | |         |     |       | |     | |   |   ` ref <hidden>
+|     |       | |         |     |       | |     | |   ` rec <hidden>
+|     |       | |         |     |       | |     | ` 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 <hidden>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |     ` <*>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |       + <*>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |       | + pure cons
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |       | ` <*>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |       |   + <*>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |       |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |       |   | ` pure 'a'
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |       |   ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |       ` <*>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |         + <*>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |         | + pure cons
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |         | ` <*>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |         |   + <*>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |         |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |         |   | ` pure 'r'
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |         |   ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     |         ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |   |   |   |     ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |   |   |   ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |   |   ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |   ` <*>
+|     |       | |         |     |       | |     |     |   |   |     + <*>
+|     |       | |         |     |       | |     |     |   |   |     | + <*>
+|     |       | |         |     |       | |     |     |   |   |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |   |   |     | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     |     |   |   |     | ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |     ` <*>
+|     |       | |         |     |       | |     |     |   |   |       + <*>
+|     |       | |         |     |       | |     |     |   |   |       | + <*>
+|     |       | |         |     |       | |     |     |   |   |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |   |   |       | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     |     |   |   |       | ` <*>
+|     |       | |         |     |       | |     |     |   |   |       |   + <*>
+|     |       | |         |     |       | |     |     |   |   |       |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |       | |         |     |       | |     |     |   |   |       |   | ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |       |   ` def <hidden>
+|     |       | |         |     |       | |     |     |   |   |       |     ` <|>
+|     |       | |         |     |       | |     |     |   |   |       |       + <*>
+|     |       | |         |     |       | |     |     |   |   |       |       | + <*>
+|     |       | |         |     |       | |     |     |   |   |       |       | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
+|     |       | |         |     |       | |     |     |   |   |       |       | | ` <*>
+|     |       | |         |     |       | |     |     |   |   |       |       | |   + ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |       |       | |   ` <*>
+|     |       | |         |     |       | |     |     |   |   |       |       | |     + <*>
+|     |       | |         |     |       | |     |     |   |   |       |       | |     | + <*>
+|     |       | |         |     |       | |     |     |   |   |       |       | |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |   |   |       |       | |     | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     |     |   |   |       |       | |     | ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |       |       | |     ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   |       |       | ` rec <hidden>
+|     |       | |         |     |       | |     |     |   |   |       |       ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     |     |   |   |       ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |   ` <*>
+|     |       | |         |     |       | |     |     |   |     + <*>
+|     |       | |         |     |       | |     |     |   |     | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |   |     | ` <*>
+|     |       | |         |     |       | |     |     |   |     |   + <*>
+|     |       | |         |     |       | |     |     |   |     |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |   |     |   | ` pure '='
+|     |       | |         |     |       | |     |     |   |     |   ` ref <hidden>
+|     |       | |         |     |       | |     |     |   |     ` ref <hidden>
+|     |       | |         |     |       | |     |     |   ` <*>
+|     |       | |         |     |       | |     |     |     + <*>
+|     |       | |         |     |       | |     |     |     | + <*>
+|     |       | |         |     |       | |     |     |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |     | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     |     |     | ` ref <hidden>
+|     |       | |         |     |       | |     |     |     ` <*>
+|     |       | |         |     |       | |     |     |       + <*>
+|     |       | |         |     |       | |     |     |       | + <*>
+|     |       | |         |     |       | |     |     |       | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |       | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     |     |       | ` <*>
+|     |       | |         |     |       | |     |     |       |   + <*>
+|     |       | |         |     |       | |     |     |       |   | + pure ((\u1 -> (\u2 -> (\u3 -> (u1 u3) u2))) (\u1 -> (\u2 -> u1 u2)))
+|     |       | |         |     |       | |     |     |       |   | ` ref <hidden>
+|     |       | |         |     |       | |     |     |       |   ` def <hidden>
+|     |       | |         |     |       | |     |     |       |     ` <|>
+|     |       | |         |     |       | |     |     |       |       + <*>
+|     |       | |         |     |       | |     |     |       |       | + <*>
+|     |       | |         |     |       | |     |     |       |       | | + pure (\u1 -> (\u2 -> (\u3 -> u1 (u2 u3))))
+|     |       | |         |     |       | |     |     |       |       | | ` <*>
+|     |       | |         |     |       | |     |     |       |       | |   + ref <hidden>
+|     |       | |         |     |       | |     |     |       |       | |   ` <*>
+|     |       | |         |     |       | |     |     |       |       | |     + <*>
+|     |       | |         |     |       | |     |     |       |       | |     | + <*>
+|     |       | |         |     |       | |     |     |       |       | |     | | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |     |       |       | |     | | ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     |     |       |       | |     | ` ref <hidden>
+|     |       | |         |     |       | |     |     |       |       | |     ` ref <hidden>
+|     |       | |         |     |       | |     |     |       |       | ` rec <hidden>
+|     |       | |         |     |       | |     |     |       |       ` pure (\u1 -> u1)
+|     |       | |         |     |       | |     |     |       ` ref <hidden>
+|     |       | |         |     |       | |     |     ` def <hidden>
+|     |       | |         |     |       | |     |       ` <*>
+|     |       | |         |     |       | |     |         + <*>
+|     |       | |         |     |       | |     |         | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |         | ` <*>
+|     |       | |         |     |       | |     |         |   + <*>
+|     |       | |         |     |       | |     |         |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |     |         |   | ` pure ';'
+|     |       | |         |     |       | |     |         |   ` ref <hidden>
+|     |       | |         |     |       | |     |         ` ref <hidden>
+|     |       | |         |     |       | |     ` <*>
+|     |       | |         |     |       | |       + <*>
+|     |       | |         |     |       | |       | + pure (\u1 -> (\u2 -> u1))
+|     |       | |         |     |       | |       | ` ref <hidden>
+|     |       | |         |     |       | |       ` ref <hidden>
+|     |       | |         |     |       | ` rec <hidden>
+|     |       | |         |     |       ` pure (\u1 -> u1)
+|     |       | |         |     ` ref <hidden>
+|     |       | |         ` <*>
+|     |       | |           + <*>
+|     |       | |           | + pure (\u1 -> (\u2 -> u1))
+|     |       | |           | ` <*>
+|     |       | |           |   + <*>
+|     |       | |           |   | + pure (\u1 -> (\u2 -> u1))
+|     |       | |           |   | ` pure '}'
+|     |       | |           |   ` ref <hidden>
+|     |       | |           ` ref <hidden>
+|     |       | ` rec <hidden>
+|     |       ` pure (\u1 -> u1)
+|     ` ref <hidden>
+` eof
diff --git a/test/Golden/Grammar/nandlang.opt.dump b/test/Golden/Grammar/nandlang.opt.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Grammar/nandlang.opt.dump
@@ -0,0 +1,479 @@
+<*>
++ <*>
+| + <*>
+| | + <*>
+| | | + <*>
+| | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4)))))
+| | | | ` def <hidden>
+| | | |   ` <*>
+| | | |     + <*>
+| | | |     | + <*>
+| | | |     | | + pure (\u1 -> (\u2 -> (\u3 -> u3)))
+| | | |     | | ` def <hidden>
+| | | |     | |   ` pure Term
+| | | |     | ` def <hidden>
+| | | |     |   ` <|>
+| | | |     |     + <*>
+| | | |     |     | + <*>
+| | | |     |     | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+| | | |     |     | | ` <|>
+| | | |     |     | |   + <*>
+| | | |     |     | |   | + <*>
+| | | |     |     | |   | | + pure (\u1 -> (\u2 -> Term))
+| | | |     |     | |   | | ` def <hidden>
+| | | |     |     | |   | |   ` <*>
+| | | |     |     | |   | |     + <*>
+| | | |     |     | |   | |     | + pure (\u1 -> (\u2 -> u2))
+| | | |     |     | |   | |     | ` satisfy
+| | | |     |     | |   | |     ` ref <hidden>
+| | | |     |     | |   | ` def <hidden>
+| | | |     |     | |   |   ` <|>
+| | | |     |     | |   |     + <*>
+| | | |     |     | |   |     | + <*>
+| | | |     |     | |   |     | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+| | | |     |     | |   |     | | ` ref <hidden>
+| | | |     |     | |   |     | ` rec <hidden>
+| | | |     |     | |   |     ` pure (\u1 -> u1)
+| | | |     |     | |   ` <*>
+| | | |     |     | |     + <*>
+| | | |     |     | |     | + <*>
+| | | |     |     | |     | | + <*>
+| | | |     |     | |     | | | + <*>
+| | | |     |     | |     | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5)))))
+| | | |     |     | |     | | | | ` try
+| | | |     |     | |     | | | |   ` <*>
+| | | |     |     | |     | | | |     + <*>
+| | | |     |     | |     | | | |     | + pure (\u1 -> (\u2 -> '/' : ('/' : Term)))
+| | | |     |     | |     | | | |     | ` satisfy
+| | | |     |     | |     | | | |     ` satisfy
+| | | |     |     | |     | | | ` ref <hidden>
+| | | |     |     | |     | | ` def <hidden>
+| | | |     |     | |     | |   ` <|>
+| | | |     |     | |     | |     + <*>
+| | | |     |     | |     | |     | + <*>
+| | | |     |     | |     | |     | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+| | | |     |     | |     | |     | | ` satisfy
+| | | |     |     | |     | |     | ` rec <hidden>
+| | | |     |     | |     | |     ` pure (\u1 -> u1)
+| | | |     |     | |     | ` ref <hidden>
+| | | |     |     | |     ` ref <hidden>
+| | | |     |     | ` rec <hidden>
+| | | |     |     ` pure (\u1 -> u1)
+| | | |     ` ref <hidden>
+| | | ` ref <hidden>
+| | ` def <hidden>
+| |   ` <|>
+| |     + <*>
+| |     | + <*>
+| |     | | + <*>
+| |     | | | + <*>
+| |     | | | | + <*>
+| |     | | | | | + <*>
+| |     | | | | | | + <*>
+| |     | | | | | | | + <*>
+| |     | | | | | | | | + <*>
+| |     | | | | | | | | | + 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 <hidden>
+| |     | | | | | | | | |     |       ` pure Term
+| |     | | | | | | | | |     ` def <hidden>
+| |     | | | | | | | | |       ` negLook
+| |     | | | | | | | | |         ` satisfy
+| |     | | | | | | | | ` ref <hidden>
+| |     | | | | | | | ` def <hidden>
+| |     | | | | | | |   ` <*>
+| |     | | | | | | |     + <*>
+| |     | | | | | | |     | + pure (\u1 -> (\u2 -> u2))
+| |     | | | | | | |     | ` try
+| |     | | | | | | |     |   ` <*>
+| |     | | | | | | |     |     + <*>
+| |     | | | | | | |     |     | + <*>
+| |     | | | | | | |     |     | | + <*>
+| |     | | | | | | |     |     | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4))))
+| |     | | | | | | |     |     | | | ` satisfy
+| |     | | | | | | |     |     | | ` ref <hidden>
+| |     | | | | | | |     |     | ` def <hidden>
+| |     | | | | | | |     |     |   ` <|>
+| |     | | | | | | |     |     |     + <*>
+| |     | | | | | | |     |     |     | + <*>
+| |     | | | | | | |     |     |     | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+| |     | | | | | | |     |     |     | | ` satisfy
+| |     | | | | | | |     |     |     | ` rec <hidden>
+| |     | | | | | | |     |     |     ` pure (\u1 -> u1)
+| |     | | | | | | |     |     ` ref <hidden>
+| |     | | | | | | |     ` ref <hidden>
+| |     | | | | | | ` def <hidden>
+| |     | | | | | |   ` <*>
+| |     | | | | | |     + <*>
+| |     | | | | | |     | + pure (\u1 -> (\u2 -> '('))
+| |     | | | | | |     | ` satisfy
+| |     | | | | | |     ` ref <hidden>
+| |     | | | | | ` def <hidden>
+| |     | | | | |   ` <|>
+| |     | | | | |     + <*>
+| |     | | | | |     | + <*>
+| |     | | | | |     | | + <*>
+| |     | | | | |     | | | + <*>
+| |     | | | | |     | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term))))
+| |     | | | | |     | | | | ` def <hidden>
+| |     | | | | |     | | | |   ` <*>
+| |     | | | | |     | | | |     + <*>
+| |     | | | | |     | | | |     | + pure (\u1 -> (\u2 -> u2))
+| |     | | | | |     | | | |     | ` ref <hidden>
+| |     | | | | |     | | | |     ` <|>
+| |     | | | | |     | | | |       + <*>
+| |     | | | | |     | | | |       | + pure (\u1 -> Term)
+| |     | | | | |     | | | |       | ` def <hidden>
+| |     | | | | |     | | | |       |   ` <*>
+| |     | | | | |     | | | |       |     + <*>
+| |     | | | | |     | | | |       |     | + <*>
+| |     | | | | |     | | | |       |     | | + <*>
+| |     | | | | |     | | | |       |     | | | + <*>
+| |     | | | | |     | | | |       |     | | | | + <*>
+| |     | | | | |     | | | |       |     | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term))))))
+| |     | | | | |     | | | |       |     | | | | | ` satisfy
+| |     | | | | |     | | | |       |     | | | | ` ref <hidden>
+| |     | | | | |     | | | |       |     | | | ` def <hidden>
+| |     | | | | |     | | | |       |     | | |   ` satisfy
+| |     | | | | |     | | | |       |     | | ` def <hidden>
+| |     | | | | |     | | | |       |     | |   ` <|>
+| |     | | | | |     | | | |       |     | |     + <*>
+| |     | | | | |     | | | |       |     | |     | + <*>
+| |     | | | | |     | | | |       |     | |     | | + pure (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+| |     | | | | |     | | | |       |     | |     | | ` ref <hidden>
+| |     | | | | |     | | | |       |     | |     | ` rec <hidden>
+| |     | | | | |     | | | |       |     | |     ` pure (\u1 -> u1)
+| |     | | | | |     | | | |       |     | ` satisfy
+| |     | | | | |     | | | |       |     ` ref <hidden>
+| |     | | | | |     | | | |       ` ref <hidden>
+| |     | | | | |     | | | ` ref <hidden>
+| |     | | | | |     | | ` def <hidden>
+| |     | | | | |     | |   ` <|>
+| |     | | | | |     | |     + <*>
+| |     | | | | |     | |     | + <*>
+| |     | | | | |     | |     | | + <*>
+| |     | | | | |     | |     | | | + <*>
+| |     | | | | |     | |     | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5))))))
+| |     | | | | |     | |     | | | | ` def <hidden>
+| |     | | | | |     | |     | | | |   ` pure (\u1 -> (\u2 -> u2))
+| |     | | | | |     | |     | | | ` def <hidden>
+| |     | | | | |     | |     | | |   ` <*>
+| |     | | | | |     | |     | | |     + <*>
+| |     | | | | |     | |     | | |     | + pure (\u1 -> (\u2 -> ','))
+| |     | | | | |     | |     | | |     | ` satisfy
+| |     | | | | |     | |     | | |     ` ref <hidden>
+| |     | | | | |     | |     | | ` ref <hidden>
+| |     | | | | |     | |     | ` rec <hidden>
+| |     | | | | |     | |     ` pure (\u1 -> u1)
+| |     | | | | |     | ` ref <hidden>
+| |     | | | | |     ` ref <hidden>
+| |     | | | | ` <|>
+| |     | | | |   + <*>
+| |     | | | |   | + <*>
+| |     | | | |   | | + <*>
+| |     | | | |   | | | + pure (\u1 -> (\u2 -> (\u3 -> Term)))
+| |     | | | |   | | | ` satisfy
+| |     | | | |   | | ` ref <hidden>
+| |     | | | |   | ` ref <hidden>
+| |     | | | |   ` ref <hidden>
+| |     | | | ` def <hidden>
+| |     | | |   ` <*>
+| |     | | |     + <*>
+| |     | | |     | + pure (\u1 -> (\u2 -> ')'))
+| |     | | |     | ` satisfy
+| |     | | |     ` ref <hidden>
+| |     | | ` def <hidden>
+| |     | |   ` <*>
+| |     | |     + <*>
+| |     | |     | + <*>
+| |     | |     | | + <*>
+| |     | |     | | | + <*>
+| |     | |     | | | | + <*>
+| |     | |     | | | | | + <*>
+| |     | |     | | | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5)))))))
+| |     | |     | | | | | | ` satisfy
+| |     | |     | | | | | ` ref <hidden>
+| |     | |     | | | | ` ref <hidden>
+| |     | |     | | | ` def <hidden>
+| |     | |     | | |   ` <|>
+| |     | |     | | |     + <*>
+| |     | |     | | |     | + <*>
+| |     | |     | | |     | | + 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 <hidden>
+| |     | |     | | |     | |   | | | | |     ` ref <hidden>
+| |     | |     | | |     | |   | | | | ` ref <hidden>
+| |     | |     | | |     | |   | | | ` def <hidden>
+| |     | |     | | |     | |   | | |   ` <*>
+| |     | |     | | |     | |   | | |     + <*>
+| |     | |     | | |     | |   | | |     | + <*>
+| |     | |     | | |     | |   | | |     | | + <*>
+| |     | |     | | |     | |   | | |     | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4))))
+| |     | |     | | |     | |   | | |     | | | ` def <hidden>
+| |     | |     | | |     | |   | | |     | | |   ` <|>
+| |     | |     | | |     | |   | | |     | | |     + <*>
+| |     | |     | | |     | |   | | |     | | |     | + <*>
+| |     | |     | | |     | |   | | |     | | |     | | + pure (\u1 -> (\u2 -> u2))
+| |     | |     | | |     | |   | | |     | | |     | | ` <|>
+| |     | |     | | |     | |   | | |     | | |     | |   + <*>
+| |     | |     | | |     | |   | | |     | | |     | |   | + pure (\u1 -> '0')
+| |     | |     | | |     | |   | | |     | | |     | |   | ` satisfy
+| |     | |     | | |     | |   | | |     | | |     | |   ` <*>
+| |     | |     | | |     | |   | | |     | | |     | |     + pure (\u1 -> '1')
+| |     | |     | | |     | |   | | |     | | |     | |     ` satisfy
+| |     | |     | | |     | |   | | |     | | |     | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |     ` <|>
+| |     | |     | | |     | |   | | |     | | |       + <*>
+| |     | |     | | |     | |   | | |     | | |       | + <*>
+| |     | |     | | |     | |   | | |     | | |       | | + <*>
+| |     | |     | | |     | |   | | |     | | |       | | | + <*>
+| |     | |     | | |     | |   | | |     | | |       | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2))))
+| |     | |     | | |     | |   | | |     | | |       | | | | ` satisfy
+| |     | |     | | |     | |   | | |     | | |       | | | ` <|>
+| |     | |     | | |     | |   | | |     | | |       | | |   + <*>
+| |     | |     | | |     | |   | | |     | | |       | | |   | + <*>
+| |     | |     | | |     | |   | | |     | | |       | | |   | | + pure (\u1 -> (\u2 -> u2))
+| |     | |     | | |     | |   | | |     | | |       | | |   | | ` satisfy
+| |     | |     | | |     | |   | | |     | | |       | | |   | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |       | | |   ` <*>
+| |     | |     | | |     | |   | | |     | | |       | | |     + <*>
+| |     | |     | | |     | |   | | |     | | |       | | |     | + <*>
+| |     | |     | | |     | |   | | |     | | |       | | |     | | + pure (\u1 -> (\u2 -> (\u3 -> u3)))
+| |     | |     | | |     | |   | | |     | | |       | | |     | | ` satisfy
+| |     | |     | | |     | |   | | |     | | |       | | |     | ` satisfy
+| |     | |     | | |     | |   | | |     | | |       | | |     ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |       | | ` satisfy
+| |     | |     | | |     | |   | | |     | | |       | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |       ` <*>
+| |     | |     | | |     | |   | | |     | | |         + <*>
+| |     | |     | | |     | |   | | |     | | |         | + pure (\u1 -> (\u2 -> u2))
+| |     | |     | | |     | |   | | |     | | |         | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |         ` <|>
+| |     | |     | | |     | |   | | |     | | |           + <*>
+| |     | |     | | |     | |   | | |     | | |           | + pure (\u1 -> Term)
+| |     | |     | | |     | |   | | |     | | |           | ` <|>
+| |     | |     | | |     | |   | | |     | | |           |   + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | | + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | | | + pure (\u1 -> (\u2 -> (\u3 -> u2)))
+| |     | |     | | |     | |   | | |     | | |           |   | | | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | | ` <|>
+| |     | |     | | |     | |   | | |     | | |           |   | |   + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | | + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | | | + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term))))
+| |     | |     | | |     | |   | | |     | | |           |   | |   | | | | ` rec <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | | | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | | ` def <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |   ` <|>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     | + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     | | + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     | | | + <*>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5))))))
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     | | | | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     | | | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     | | ` rec <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     | ` rec <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | |   | |     ` pure (\u1 -> u1)
+| |     | |     | | |     | |   | | |     | | |           |   | |   | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | |   ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |           |   ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | |           ` ref <hidden>
+| |     | |     | | |     | |   | | |     | | ` ref <hidden>
+| |     | |     | | |     | |   | | |     | ` def <hidden>
+| |     | |     | | |     | |   | | |     |   ` <|>
+| |     | |     | | |     | |   | | |     |     + <*>
+| |     | |     | | |     | |   | | |     |     | + <*>
+| |     | |     | | |     | |   | | |     |     | | + <*>
+| |     | |     | | |     | |   | | |     |     | | | + <*>
+| |     | |     | | |     | |   | | |     |     | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5)))))
+| |     | |     | | |     | |   | | |     |     | | | | ` satisfy
+| |     | |     | | |     | |   | | |     |     | | | ` ref <hidden>
+| |     | |     | | |     | |   | | |     |     | | ` ref <hidden>
+| |     | |     | | |     | |   | | |     |     | ` rec <hidden>
+| |     | |     | | |     | |   | | |     |     ` pure (\u1 -> u1)
+| |     | |     | | |     | |   | | |     ` ref <hidden>
+| |     | |     | | |     | |   | | ` rec <hidden>
+| |     | |     | | |     | |   | ` <|>
+| |     | |     | | |     | |   |   + <*>
+| |     | |     | | |     | |   |   | + <*>
+| |     | |     | | |     | |   |   | | + <*>
+| |     | |     | | |     | |   |   | | | + 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 <hidden>
+| |     | |     | | |     | |   |   | | |     ` ref <hidden>
+| |     | |     | | |     | |   |   | | ` ref <hidden>
+| |     | |     | | |     | |   |   | ` rec <hidden>
+| |     | |     | | |     | |   |   ` ref <hidden>
+| |     | |     | | |     | |   ` <|>
+| |     | |     | | |     | |     + <*>
+| |     | |     | | |     | |     | + <*>
+| |     | |     | | |     | |     | | + <*>
+| |     | |     | | |     | |     | | | + <*>
+| |     | |     | | |     | |     | | | | + 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 <hidden>
+| |     | |     | | |     | |     | | | |     ` ref <hidden>
+| |     | |     | | |     | |     | | | ` ref <hidden>
+| |     | |     | | |     | |     | | ` ref <hidden>
+| |     | |     | | |     | |     | ` rec <hidden>
+| |     | |     | | |     | |     ` <|>
+| |     | |     | | |     | |       + 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 <hidden>
+| |     | |     | | |     | |       |   | | | | | | | | | | |   | |     ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | | | | | | | |   | ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | | | | | | | |   ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | | | | | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | | | | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | | | | | ` def <hidden>
+| |     | |     | | |     | |       |   | | | | | | | |   ` <|>
+| |     | |     | | |     | |       |   | | | | | | | |     + <*>
+| |     | |     | | |     | |       |   | | | | | | | |     | + <*>
+| |     | |     | | |     | |       |   | | | | | | | |     | | + <*>
+| |     | |     | | |     | |       |   | | | | | | | |     | | | + <*>
+| |     | |     | | |     | |       |   | | | | | | | |     | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5))))))
+| |     | |     | | |     | |       |   | | | | | | | |     | | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | | | | |     | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | | | | |     | | ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | | | | |     | ` rec <hidden>
+| |     | |     | | |     | |       |   | | | | | | | |     ` pure (\u1 -> u1)
+| |     | |     | | |     | |       |   | | | | | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | | | ` satisfy
+| |     | |     | | |     | |       |   | | | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | | ` def <hidden>
+| |     | |     | | |     | |       |   | |   ` <|>
+| |     | |     | | |     | |       |   | |     + <*>
+| |     | |     | | |     | |       |   | |     | + <*>
+| |     | |     | | |     | |       |   | |     | | + <*>
+| |     | |     | | |     | |       |   | |     | | | + <*>
+| |     | |     | | |     | |       |   | |     | | | | + pure (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5))))))
+| |     | |     | | |     | |       |   | |     | | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | |     | | | ` ref <hidden>
+| |     | |     | | |     | |       |   | |     | | ` ref <hidden>
+| |     | |     | | |     | |       |   | |     | ` rec <hidden>
+| |     | |     | | |     | |       |   | |     ` pure (\u1 -> u1)
+| |     | |     | | |     | |       |   | ` ref <hidden>
+| |     | |     | | |     | |       |   ` def <hidden>
+| |     | |     | | |     | |       |     ` <*>
+| |     | |     | | |     | |       |       + <*>
+| |     | |     | | |     | |       |       | + pure (\u1 -> (\u2 -> ';'))
+| |     | |     | | |     | |       |       | ` satisfy
+| |     | |     | | |     | |       |       ` ref <hidden>
+| |     | |     | | |     | |       ` <*>
+| |     | |     | | |     | |         + <*>
+| |     | |     | | |     | |         | + pure (\u1 -> (\u2 -> u1))
+| |     | |     | | |     | |         | ` ref <hidden>
+| |     | |     | | |     | |         ` ref <hidden>
+| |     | |     | | |     | ` rec <hidden>
+| |     | |     | | |     ` pure (\u1 -> u1)
+| |     | |     | | ` ref <hidden>
+| |     | |     | ` satisfy
+| |     | |     ` ref <hidden>
+| |     | ` rec <hidden>
+| |     ` pure (\u1 -> u1)
+| ` ref <hidden>
+` eof
diff --git a/test/Golden/Grammar/string.dump b/test/Golden/Grammar/string.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Grammar/string.dump
@@ -0,0 +1,35 @@
+try
+` <*>
+  + <*>
+  | + pure cons
+  | ` <*>
+  |   + <*>
+  |   | + pure (\u1 -> (\u2 -> u1))
+  |   | ` pure 'a'
+  |   ` def <hidden>
+  |     ` satisfy
+  ` <*>
+    + <*>
+    | + pure cons
+    | ` <*>
+    |   + <*>
+    |   | + pure (\u1 -> (\u2 -> u1))
+    |   | ` pure 'b'
+    |   ` ref <hidden>
+    ` <*>
+      + <*>
+      | + pure cons
+      | ` <*>
+      |   + <*>
+      |   | + pure (\u1 -> (\u2 -> u1))
+      |   | ` pure 'c'
+      |   ` ref <hidden>
+      ` <*>
+        + <*>
+        | + pure cons
+        | ` <*>
+        |   + <*>
+        |   | + pure (\u1 -> (\u2 -> u1))
+        |   | ` pure 'd'
+        |   ` ref <hidden>
+        ` pure Term
diff --git a/test/Golden/Grammar/string.opt.dump b/test/Golden/Grammar/string.opt.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Grammar/string.opt.dump
@@ -0,0 +1,10 @@
+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
new file mode 100644
--- /dev/null
+++ b/test/Golden/Grammar/tokens.dump
@@ -0,0 +1,35 @@
+try
+` <*>
+  + <*>
+  | + pure cons
+  | ` <*>
+  |   + <*>
+  |   | + pure (\u1 -> (\u2 -> u1))
+  |   | ` pure 'a'
+  |   ` def <hidden>
+  |     ` satisfy
+  ` <*>
+    + <*>
+    | + pure cons
+    | ` <*>
+    |   + <*>
+    |   | + pure (\u1 -> (\u2 -> u1))
+    |   | ` pure 'b'
+    |   ` ref <hidden>
+    ` <*>
+      + <*>
+      | + pure cons
+      | ` <*>
+      |   + <*>
+      |   | + pure (\u1 -> (\u2 -> u1))
+      |   | ` pure 'c'
+      |   ` ref <hidden>
+      ` <*>
+        + <*>
+        | + pure cons
+        | ` <*>
+        |   + <*>
+        |   | + pure (\u1 -> (\u2 -> u1))
+        |   | ` pure 'd'
+        |   ` ref <hidden>
+        ` pure Term
diff --git a/test/Golden/Grammar/tokens.opt.dump b/test/Golden/Grammar/tokens.opt.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Grammar/tokens.opt.dump
@@ -0,0 +1,10 @@
+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
--- a/test/Golden/Grammar/unit-unit.dump
+++ b/test/Golden/Grammar/unit-unit.dump
@@ -1,8 +1,8 @@
 <*>
 + <*>
 | + <*>
-| | + pure const
-| | ` pure id
-| ` def name_1
-|   ` pure ()
-` ref name_1
+| | + pure (\u1 -> (\u2 -> u1))
+| | ` pure (\u1 -> u1)
+| ` def <hidden>
+|   ` pure Term
+` ref <hidden>
diff --git a/test/Golden/Grammar/unit-unit.opt.dump b/test/Golden/Grammar/unit-unit.opt.dump
--- a/test/Golden/Grammar/unit-unit.opt.dump
+++ b/test/Golden/Grammar/unit-unit.opt.dump
@@ -1,6 +1,6 @@
 <*>
 + <*>
-| + pure (const id)
-| ` def name_1
-|   ` pure ()
-` ref name_1
+| + pure (\u1 -> (\u2 -> u2))
+| ` def <hidden>
+|   ` pure Term
+` ref <hidden>
diff --git a/test/Golden/Grammar/unit.dump b/test/Golden/Grammar/unit.dump
--- a/test/Golden/Grammar/unit.dump
+++ b/test/Golden/Grammar/unit.dump
@@ -1,1 +1,1 @@
-pure ()
+pure Term
diff --git a/test/Golden/Grammar/unit.opt.dump b/test/Golden/Grammar/unit.opt.dump
--- a/test/Golden/Grammar/unit.opt.dump
+++ b/test/Golden/Grammar/unit.opt.dump
@@ -1,1 +1,1 @@
-pure ()
+pure Term
diff --git a/test/Golden/Machine/a-or-b.dump b/test/Golden/Machine/a-or-b.dump
--- a/test/Golden/Machine/a-or-b.dump
+++ b/test/Golden/Machine/a-or-b.dump
@@ -1,18 +1,18 @@
 catchFail
   <try>
-  | push (const Haskell)
-  | read
-  | lift ($)
+  | push (\u1 -> 'a')
+  | read ('a' ==)
+  | lift (\u1 -> (\u2 -> u1 u2))
   | popFail
   | ret
   <handler>
     pushInput
-    lift InstrPureSameOffset
-    choices [id]
+    lift Term
+    choices [(\u1 -> u1)]
       <branch>
-      | push (const Haskell)
-      | read
-      | lift ($)
+      | push (\u1 -> 'b')
+      | read ('b' ==)
+      | lift (\u1 -> (\u2 -> u1 u2))
       | ret
       <default>
         fail
diff --git a/test/Golden/Machine/app.dump b/test/Golden/Machine/app.dump
--- a/test/Golden/Machine/app.dump
+++ b/test/Golden/Machine/app.dump
@@ -1,2 +1,2 @@
-push (Haskell ())
+push Term
 ret
diff --git a/test/Golden/Machine/boom.dump b/test/Golden/Machine/boom.dump
--- a/test/Golden/Machine/boom.dump
+++ b/test/Golden/Machine/boom.dump
@@ -1,51 +1,51 @@
-push ((.) ((.) (.)) . ((.) ((.) (.)) . (.) ((.) (const id))))
-name_2:
-| push (const id)
+push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (u4 u5) u6))))))
+<hidden>:
+| push (\u1 -> (\u2 -> u2))
 | ret
-call name_2
-lift ($)
-name_5:
-| name_6:
-| | push (const id)
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+<hidden>:
+| <hidden>:
+| | push (\u1 -> (\u2 -> u2))
 | | ret
-| call name_6
-| name_7:
-| | push (const id)
-| | call name_5
-| | lift ($)
-| | call name_7
-| | lift ($)
+| call <hidden>
+| <hidden>:
+| | push (\u1 -> (\u2 -> u2))
+| | call <hidden>
+| | lift (\u1 -> (\u2 -> u1 u2))
+| | call <hidden>
+| | lift (\u1 -> (\u2 -> u1 u2))
 | | ret
-| call name_7
-| lift ($)
-| call name_5
-| lift ($)
+| call <hidden>
+| lift (\u1 -> (\u2 -> u1 u2))
+| call <hidden>
+| lift (\u1 -> (\u2 -> u1 u2))
 | ret
-call name_5
-lift ($)
-name_3:
-| push ()
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+<hidden>:
+| push Term
 | ret
-call name_3
-lift ($)
-call name_2
-lift ($)
-name_1:
-| call name_6
-| name_4:
-| | push (const id)
-| | call name_1
-| | lift ($)
-| | call name_4
-| | lift ($)
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+<hidden>:
+| call <hidden>
+| <hidden>:
+| | push (\u1 -> (\u2 -> u2))
+| | call <hidden>
+| | lift (\u1 -> (\u2 -> u1 u2))
+| | call <hidden>
+| | lift (\u1 -> (\u2 -> u1 u2))
 | | ret
-| call name_4
-| lift ($)
-| call name_1
-| lift ($)
+| call <hidden>
+| lift (\u1 -> (\u2 -> u1 u2))
+| call <hidden>
+| lift (\u1 -> (\u2 -> u1 u2))
 | ret
-call name_1
-lift ($)
-call name_3
-lift ($)
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
 ret
diff --git a/test/Golden/Machine/brainfuck.dump b/test/Golden/Machine/brainfuck.dump
--- a/test/Golden/Machine/brainfuck.dump
+++ b/test/Golden/Machine/brainfuck.dump
@@ -1,159 +1,104 @@
-push ((.) ((.) (const id)) . ((.) (const id) . flip ($)))
-name_2:
-| push ()
+push (\u1 -> (\u2 -> u2))
+<hidden>:
+| push (\u1 -> Term)
+| <hidden>:
+| | catchFail
+| |   <try>
+| |   | push (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+| |   | read Term
+| |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   | call <hidden>
+| |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   | popFail
+| |   | ret
+| |   <handler>
+| |     pushInput
+| |     lift Term
+| |     choices [(\u1 -> u1)]
+| |       <branch>
+| |       | push (\u1 -> u1)
+| |       | ret
+| |       <default>
+| |         fail
+| call <hidden>
+| lift (\u1 -> (\u2 -> u1 u2))
 | ret
-call name_2
-lift ($)
-name_3:
-| catchFail
-|   <try>
-|   | push ((.) (.))
-|   | name_4:
-|   | | push (flip const)
-|   | | ret
-|   | call name_4
-|   | lift ($)
-|   | read
-|   | lift ($)
-|   | call name_3
-|   | lift ($)
-|   | popFail
-|   | ret
-|   <handler>
-|     pushInput
-|     lift InstrPureSameOffset
-|     choices [id]
-|       <branch>
-|       | push id
-|       | ret
-|       <default>
-|         fail
-call name_3
-lift ($)
-call name_2
-lift ($)
-name_7:
-| push ((flip ($)) Haskell)
-| name_1:
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+<hidden>:
+| push (\u1 -> u1 Term)
+| <hidden>:
 | | catchFail
 | |   <try>
-| |   | join_55:
-| |   | | call name_2
-| |   | | lift ($)
-| |   | | name_6:
-| |   | | | catchFail
-| |   | | |   <try>
-| |   | | |   | push ((.) (.))
-| |   | | |   | call name_4
-| |   | | |   | lift ($)
-| |   | | |   | read
-| |   | | |   | lift ($)
-| |   | | |   | call name_6
-| |   | | |   | lift ($)
-| |   | | |   | popFail
-| |   | | |   | ret
-| |   | | |   <handler>
-| |   | | |     pushInput
-| |   | | |     lift InstrPureSameOffset
-| |   | | |     choices [id]
-| |   | | |       <branch>
-| |   | | |       | push id
-| |   | | |       | ret
-| |   | | |       <default>
-| |   | | |         fail
-| |   | | call name_6
-| |   | | lift ($)
-| |   | | call name_2
-| |   | | lift ($)
-| |   | | call name_1
-| |   | | lift ($)
+| |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (u1 u2) (u3 u4)))))
+| |   | <hidden>:
+| |   | | lift (\u1 -> (\u2 -> u1 u2))
+| |   | | call <hidden>
+| |   | | lift (\u1 -> (\u2 -> u1 u2))
+| |   | | call <hidden>
+| |   | | lift (\u1 -> (\u2 -> u1 u2))
 | |   | | popFail
 | |   | | ret
 | |   | pushInput
-| |   | read
+| |   | read ((\u1 -> (\u2 -> u1)) Term)
 | |   | swap
 | |   | loadInput
-| |   | choices [(== Haskell),(== Haskell),(== Haskell),(== Haskell),(== Haskell),(== Haskell),(== Haskell)]
+| |   | choices [(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==),(Term ==)]
 | |   |   <branch>
-| |   |   | push ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-| |   |   | read
-| |   |   | lift ($)
-| |   |   | refJoin join_55
+| |   |   | push (\u1 -> (\u2 -> cons Term))
+| |   |   | read ((\u1 -> (\u2 -> u1)) Term)
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | refJoin <hidden>
 | |   |   <branch>
-| |   |   | push ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-| |   |   | read
-| |   |   | lift ($)
-| |   |   | refJoin join_55
+| |   |   | push (\u1 -> (\u2 -> cons Term))
+| |   |   | read ((\u1 -> (\u2 -> u1)) Term)
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | refJoin <hidden>
 | |   |   <branch>
-| |   |   | push ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-| |   |   | read
-| |   |   | lift ($)
-| |   |   | refJoin join_55
+| |   |   | push (\u1 -> (\u2 -> cons Term))
+| |   |   | read ((\u1 -> (\u2 -> u1)) Term)
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | refJoin <hidden>
 | |   |   <branch>
-| |   |   | push ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-| |   |   | read
-| |   |   | lift ($)
-| |   |   | refJoin join_55
+| |   |   | push (\u1 -> (\u2 -> cons Term))
+| |   |   | read ((\u1 -> (\u2 -> u1)) Term)
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | refJoin <hidden>
 | |   |   <branch>
-| |   |   | push ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-| |   |   | read
-| |   |   | lift ($)
-| |   |   | refJoin join_55
+| |   |   | push (\u1 -> (\u2 -> cons Term))
+| |   |   | read ((\u1 -> (\u2 -> u1)) Term)
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | refJoin <hidden>
 | |   |   <branch>
-| |   |   | push ((.) ((.) ((.) (.))) . ((.) ((.) ((.) cons)) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . (const . const Haskell)))))))
-| |   |   | read
-| |   |   | lift ($)
-| |   |   | refJoin join_55
+| |   |   | push (\u1 -> (\u2 -> cons Term))
+| |   |   | read ((\u1 -> (\u2 -> u1)) Term)
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | refJoin <hidden>
 | |   |   <branch>
-| |   |   | push ((.) ((.) ((.) ((.) ((.) ((.) ((.) ((.) (.)))))))) . ((.) ((.) ((.) ((.) ((.) ((.) ((.) ((.) cons))))))) . ((.) ((.) ((.) ((.) ((.) ((flip ($)) ((.) (const id) . flip ($))))))) . ((.) ((.) ((.) ((.) ((.) (.))))) . ((.) ((.) ((.) ((.) ((.) (.))))) . ((.) ((.) ((.) ((.) ((.) (.))))) . ((.) ((.) ((.) ((.) ((.) const)))) . ((.) ((.) ((.) ((.) ((flip ($)) (const Haskell))))) . ((.) ((.) ((.) ((.) (.)))) . ((.) ((.) ((.) ((.) const))) . ((.) ((.) ((.) ((flip ($)) Haskell))) . ((.) ((.) ((.) (.))) . ((.) ((.) ((.) (const id))) . ((flip ($)) ((.) (const id) . flip ($)) . ((.) . ((.) . ((.) . const)))))))))))))))))
-| |   |   | read
-| |   |   | lift ($)
-| |   |   | call name_2
-| |   |   | lift ($)
-| |   |   | name_5:
-| |   |   | | catchFail
-| |   |   | |   <try>
-| |   |   | |   | push ((.) (.))
-| |   |   | |   | call name_4
-| |   |   | |   | lift ($)
-| |   |   | |   | read
-| |   |   | |   | lift ($)
-| |   |   | |   | call name_5
-| |   |   | |   | lift ($)
-| |   |   | |   | popFail
-| |   |   | |   | ret
-| |   |   | |   <handler>
-| |   |   | |     pushInput
-| |   |   | |     lift InstrPureSameOffset
-| |   |   | |     choices [id]
-| |   |   | |       <branch>
-| |   |   | |       | push id
-| |   |   | |       | ret
-| |   |   | |       <default>
-| |   |   | |         fail
-| |   |   | call name_5
-| |   |   | lift ($)
-| |   |   | call name_2
-| |   |   | lift ($)
-| |   |   | call name_7
-| |   |   | lift ($)
-| |   |   | read
-| |   |   | lift ($)
-| |   |   | refJoin join_55
+| |   |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> cons (Term u3))))))
+| |   |   | read ((\u1 -> (\u2 -> u1)) Term)
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | call <hidden>
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | call <hidden>
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | read (']' ==)
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | refJoin <hidden>
 | |   |   <default>
 | |   |     fail
 | |   <handler>
 | |     pushInput
-| |     lift InstrPureSameOffset
-| |     choices [id]
+| |     lift Term
+| |     choices [(\u1 -> u1)]
 | |       <branch>
-| |       | push id
+| |       | push (\u1 -> u1)
 | |       | ret
 | |       <default>
 | |         fail
-| call name_1
-| lift ($)
+| call <hidden>
+| lift (\u1 -> (\u2 -> u1 u2))
 | ret
-call name_7
-lift ($)
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
 ret
diff --git a/test/Golden/Machine/eof.dump b/test/Golden/Machine/eof.dump
--- a/test/Golden/Machine/eof.dump
+++ b/test/Golden/Machine/eof.dump
@@ -3,20 +3,20 @@
   | catchFail
   |   <try>
   |   | pushInput
-  |   | read
+  |   | read (\u1 -> Term)
   |   | pop
   |   | popFail
   |   | loadInput
   |   | fail
   |   <handler>
   |     loadInput
-  |     push ()
+  |     push Term
   |     popFail
   |     ret
   <handler>
     pushInput
-    lift InstrPureSameOffset
-    choices [id]
+    lift Term
+    choices [(\u1 -> u1)]
       <branch>
       | fail
       <default>
diff --git a/test/Golden/Machine/many-a.dump b/test/Golden/Machine/many-a.dump
--- a/test/Golden/Machine/many-a.dump
+++ b/test/Golden/Machine/many-a.dump
@@ -1,23 +1,23 @@
-push ((flip ($)) Haskell)
-name_1:
+push (\u1 -> u1 Term)
+<hidden>:
 | catchFail
 |   <try>
-|   | push ((.) . (cons . const Haskell))
-|   | read
-|   | lift ($)
-|   | call name_1
-|   | lift ($)
+|   | push (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3)))
+|   | read ('a' ==)
+|   | lift (\u1 -> (\u2 -> u1 u2))
+|   | call <hidden>
+|   | lift (\u1 -> (\u2 -> u1 u2))
 |   | popFail
 |   | ret
 |   <handler>
 |     pushInput
-|     lift InstrPureSameOffset
-|     choices [id]
+|     lift Term
+|     choices [(\u1 -> u1)]
 |       <branch>
-|       | push id
+|       | push (\u1 -> u1)
 |       | ret
 |       <default>
 |         fail
-call name_1
-lift ($)
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
 ret
diff --git a/test/Golden/Machine/many-char-eof.dump b/test/Golden/Machine/many-char-eof.dump
--- a/test/Golden/Machine/many-char-eof.dump
+++ b/test/Golden/Machine/many-char-eof.dump
@@ -1,47 +1,47 @@
-push (const . (flip ($)) Haskell)
-name_1:
+push (\u1 -> (\u2 -> u1 Term))
+<hidden>:
 | catchFail
 |   <try>
-|   | push ((.) . (cons . const Haskell))
-|   | read
-|   | lift ($)
-|   | call name_1
-|   | lift ($)
+|   | push (\u1 -> (\u2 -> (\u3 -> 'r' : u2 u3)))
+|   | read ('r' ==)
+|   | lift (\u1 -> (\u2 -> u1 u2))
+|   | call <hidden>
+|   | lift (\u1 -> (\u2 -> u1 u2))
 |   | popFail
 |   | ret
 |   <handler>
 |     pushInput
-|     lift InstrPureSameOffset
-|     choices [id]
+|     lift Term
+|     choices [(\u1 -> u1)]
 |       <branch>
-|       | push id
+|       | push (\u1 -> u1)
 |       | ret
 |       <default>
 |         fail
-call name_1
-lift ($)
-join_55:
-| lift ($)
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+<hidden>:
+| lift (\u1 -> (\u2 -> u1 u2))
 | ret
 catchFail
   <try>
   | catchFail
   |   <try>
   |   | pushInput
-  |   | read
+  |   | read (\u1 -> Term)
   |   | pop
   |   | popFail
   |   | loadInput
   |   | fail
   |   <handler>
   |     loadInput
-  |     push ()
+  |     push Term
   |     popFail
-  |     refJoin join_55
+  |     refJoin <hidden>
   <handler>
     pushInput
-    lift InstrPureSameOffset
-    choices [id]
+    lift Term
+    choices [(\u1 -> u1)]
       <branch>
       | fail
       <default>
diff --git a/test/Golden/Machine/many-char-fail.dump b/test/Golden/Machine/many-char-fail.dump
--- a/test/Golden/Machine/many-char-fail.dump
+++ b/test/Golden/Machine/many-char-fail.dump
@@ -1,25 +1,25 @@
-push ((flip ($)) (const Haskell) . ((.) . (const . (flip ($)) Haskell)))
-name_1:
+push (\u1 -> (\u2 -> u1 Term))
+<hidden>:
 | catchFail
 |   <try>
-|   | push ((.) . (cons . const Haskell))
-|   | read
-|   | lift ($)
-|   | call name_1
-|   | lift ($)
+|   | push (\u1 -> (\u2 -> (\u3 -> 'a' : u2 u3)))
+|   | read ('a' ==)
+|   | lift (\u1 -> (\u2 -> u1 u2))
+|   | call <hidden>
+|   | lift (\u1 -> (\u2 -> u1 u2))
 |   | popFail
 |   | ret
 |   <handler>
 |     pushInput
-|     lift InstrPureSameOffset
-|     choices [id]
+|     lift Term
+|     choices [(\u1 -> u1)]
 |       <branch>
-|       | push id
+|       | push (\u1 -> u1)
 |       | ret
 |       <default>
 |         fail
-call name_1
-lift ($)
-read
-lift ($)
+call <hidden>
+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
new file mode 100644
--- /dev/null
+++ b/test/Golden/Machine/nandlang.dump
@@ -0,0 +1,938 @@
+push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4)))))
+<hidden>:
+| push (\u1 -> (\u2 -> (\u3 -> u3)))
+| <hidden>:
+| | push Term
+| | ret
+| call <hidden>
+| lift (\u1 -> (\u2 -> u1 u2))
+| <hidden>:
+| | catchFail
+| |   <try>
+| |   | push (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+| |   | <hidden>:
+| |   | | lift (\u1 -> (\u2 -> u1 u2))
+| |   | | call <hidden>
+| |   | | lift (\u1 -> (\u2 -> u1 u2))
+| |   | | popFail
+| |   | | ret
+| |   | catchFail
+| |   |   <try>
+| |   |   | push (\u1 -> (\u2 -> Term))
+| |   |   | <hidden>:
+| |   |   | | push (\u1 -> (\u2 -> u2))
+| |   |   | | read Term
+| |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | | call <hidden>
+| |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | | ret
+| |   |   | call <hidden>
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | <hidden>:
+| |   |   | | catchFail
+| |   |   | |   <try>
+| |   |   | |   | push (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+| |   |   | |   | call <hidden>
+| |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | |   | call <hidden>
+| |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | |   | popFail
+| |   |   | |   | ret
+| |   |   | |   <handler>
+| |   |   | |     pushInput
+| |   |   | |     lift Term
+| |   |   | |     choices [(\u1 -> u1)]
+| |   |   | |       <branch>
+| |   |   | |       | push (\u1 -> u1)
+| |   |   | |       | ret
+| |   |   | |       <default>
+| |   |   | |         fail
+| |   |   | call <hidden>
+| |   |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |   | popFail
+| |   |   | refJoin <hidden>
+| |   |   <handler>
+| |   |     pushInput
+| |   |     lift Term
+| |   |     choices [(\u1 -> u1)]
+| |   |       <branch>
+| |   |       | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5)))))
+| |   |       | catchFail
+| |   |       |   <try>
+| |   |       |   | push (\u1 -> (\u2 -> '/' : ('/' : Term)))
+| |   |       |   | read ('/' ==)
+| |   |       |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |       |   | read ('/' ==)
+| |   |       |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |       |   | popFail
+| |   |       |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |       |   | call <hidden>
+| |   |       |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |       |   | <hidden>:
+| |   |       |   | | catchFail
+| |   |       |   | |   <try>
+| |   |       |   | |   | push (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+| |   |       |   | |   | read Term
+| |   |       |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |       |   | |   | call <hidden>
+| |   |       |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |       |   | |   | popFail
+| |   |       |   | |   | ret
+| |   |       |   | |   <handler>
+| |   |       |   | |     pushInput
+| |   |       |   | |     lift Term
+| |   |       |   | |     choices [(\u1 -> u1)]
+| |   |       |   | |       <branch>
+| |   |       |   | |       | push (\u1 -> u1)
+| |   |       |   | |       | ret
+| |   |       |   | |       <default>
+| |   |       |   | |         fail
+| |   |       |   | call <hidden>
+| |   |       |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |       |   | call <hidden>
+| |   |       |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |       |   | call <hidden>
+| |   |       |   | lift (\u1 -> (\u2 -> u1 u2))
+| |   |       |   | refJoin <hidden>
+| |   |       |   <handler>
+| |   |       |     loadInput
+| |   |       |     fail
+| |   |       <default>
+| |   |         fail
+| |   <handler>
+| |     pushInput
+| |     lift Term
+| |     choices [(\u1 -> u1)]
+| |       <branch>
+| |       | push (\u1 -> u1)
+| |       | ret
+| |       <default>
+| |         fail
+| call <hidden>
+| lift (\u1 -> (\u2 -> u1 u2))
+| call <hidden>
+| lift (\u1 -> (\u2 -> u1 u2))
+| ret
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+<hidden>:
+| catchFail
+|   <try>
+|   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> u9 u10))))))))))
+|   | catchFail
+|   |   <try>
+|   |   | push (\u1 -> (\u2 -> u2))
+|   |   | catchFail
+|   |   |   <try>
+|   |   |   | 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))
+|   |   |   | <hidden>:
+|   |   |   | | push Term
+|   |   |   | | ret
+|   |   |   | call <hidden>
+|   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | popFail
+|   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | <hidden>:
+|   |   |   | | catchFail
+|   |   |   | |   <try>
+|   |   |   | |   | pushInput
+|   |   |   | |   | read Term
+|   |   |   | |   | pop
+|   |   |   | |   | popFail
+|   |   |   | |   | loadInput
+|   |   |   | |   | fail
+|   |   |   | |   <handler>
+|   |   |   | |     loadInput
+|   |   |   | |     push Term
+|   |   |   | |     ret
+|   |   |   | call <hidden>
+|   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | popFail
+|   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | call <hidden>
+|   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | <hidden>:
+|   |   |   | | push (\u1 -> (\u2 -> u2))
+|   |   |   | | catchFail
+|   |   |   | |   <try>
+|   |   |   | |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4))))
+|   |   |   | |   | read Term
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | call <hidden>
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | <hidden>:
+|   |   |   | |   | | catchFail
+|   |   |   | |   | |   <try>
+|   |   |   | |   | |   | push (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+|   |   |   | |   | |   | read Term
+|   |   |   | |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | call <hidden>
+|   |   |   | |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | popFail
+|   |   |   | |   | |   | ret
+|   |   |   | |   | |   <handler>
+|   |   |   | |   | |     pushInput
+|   |   |   | |   | |     lift Term
+|   |   |   | |   | |     choices [(\u1 -> u1)]
+|   |   |   | |   | |       <branch>
+|   |   |   | |   | |       | push (\u1 -> u1)
+|   |   |   | |   | |       | ret
+|   |   |   | |   | |       <default>
+|   |   |   | |   | |         fail
+|   |   |   | |   | call <hidden>
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | call <hidden>
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | popFail
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | call <hidden>
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | ret
+|   |   |   | |   <handler>
+|   |   |   | |     loadInput
+|   |   |   | |     fail
+|   |   |   | call <hidden>
+|   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | <hidden>:
+|   |   |   | | push (\u1 -> (\u2 -> '('))
+|   |   |   | | read ('(' ==)
+|   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | call <hidden>
+|   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | ret
+|   |   |   | call <hidden>
+|   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | <hidden>:
+|   |   |   | | catchFail
+|   |   |   | |   <try>
+|   |   |   | |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term))))
+|   |   |   | |   | <hidden>:
+|   |   |   | |   | | push (\u1 -> (\u2 -> u2))
+|   |   |   | |   | | call <hidden>
+|   |   |   | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | | <hidden>:
+|   |   |   | |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | | | ret
+|   |   |   | |   | | catchFail
+|   |   |   | |   | |   <try>
+|   |   |   | |   | |   | push (\u1 -> Term)
+|   |   |   | |   | |   | <hidden>:
+|   |   |   | |   | |   | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> Term))))))
+|   |   |   | |   | |   | | read ('[' ==)
+|   |   |   | |   | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | call <hidden>
+|   |   |   | |   | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | <hidden>:
+|   |   |   | |   | |   | | | read Term
+|   |   |   | |   | |   | | | ret
+|   |   |   | |   | |   | | call <hidden>
+|   |   |   | |   | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | <hidden>:
+|   |   |   | |   | |   | | | catchFail
+|   |   |   | |   | |   | | |   <try>
+|   |   |   | |   | |   | | |   | push (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+|   |   |   | |   | |   | | |   | call <hidden>
+|   |   |   | |   | |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | |   | call <hidden>
+|   |   |   | |   | |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | |   | popFail
+|   |   |   | |   | |   | | |   | ret
+|   |   |   | |   | |   | | |   <handler>
+|   |   |   | |   | |   | | |     pushInput
+|   |   |   | |   | |   | | |     lift Term
+|   |   |   | |   | |   | | |     choices [(\u1 -> u1)]
+|   |   |   | |   | |   | | |       <branch>
+|   |   |   | |   | |   | | |       | push (\u1 -> u1)
+|   |   |   | |   | |   | | |       | ret
+|   |   |   | |   | |   | | |       <default>
+|   |   |   | |   | |   | | |         fail
+|   |   |   | |   | |   | | call <hidden>
+|   |   |   | |   | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | read (']' ==)
+|   |   |   | |   | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | call <hidden>
+|   |   |   | |   | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | ret
+|   |   |   | |   | |   | call <hidden>
+|   |   |   | |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | popFail
+|   |   |   | |   | |   | refJoin <hidden>
+|   |   |   | |   | |   <handler>
+|   |   |   | |   | |     pushInput
+|   |   |   | |   | |     lift Term
+|   |   |   | |   | |     choices [(\u1 -> u1)]
+|   |   |   | |   | |       <branch>
+|   |   |   | |   | |       | call <hidden>
+|   |   |   | |   | |       | refJoin <hidden>
+|   |   |   | |   | |       <default>
+|   |   |   | |   | |         fail
+|   |   |   | |   | call <hidden>
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | call <hidden>
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | <hidden>:
+|   |   |   | |   | | catchFail
+|   |   |   | |   | |   <try>
+|   |   |   | |   | |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5))))))
+|   |   |   | |   | |   | <hidden>:
+|   |   |   | |   | |   | | push (\u1 -> (\u2 -> u2))
+|   |   |   | |   | |   | | ret
+|   |   |   | |   | |   | call <hidden>
+|   |   |   | |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | <hidden>:
+|   |   |   | |   | |   | | push (\u1 -> (\u2 -> ','))
+|   |   |   | |   | |   | | read (',' ==)
+|   |   |   | |   | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | call <hidden>
+|   |   |   | |   | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | | ret
+|   |   |   | |   | |   | call <hidden>
+|   |   |   | |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | call <hidden>
+|   |   |   | |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | call <hidden>
+|   |   |   | |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | |   | popFail
+|   |   |   | |   | |   | ret
+|   |   |   | |   | |   <handler>
+|   |   |   | |   | |     pushInput
+|   |   |   | |   | |     lift Term
+|   |   |   | |   | |     choices [(\u1 -> u1)]
+|   |   |   | |   | |       <branch>
+|   |   |   | |   | |       | push (\u1 -> u1)
+|   |   |   | |   | |       | ret
+|   |   |   | |   | |       <default>
+|   |   |   | |   | |         fail
+|   |   |   | |   | call <hidden>
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | call <hidden>
+|   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | |   | popFail
+|   |   |   | |   | ret
+|   |   |   | |   <handler>
+|   |   |   | |     pushInput
+|   |   |   | |     lift Term
+|   |   |   | |     choices [(\u1 -> u1)]
+|   |   |   | |       <branch>
+|   |   |   | |       | jump <hidden>
+|   |   |   | |       <default>
+|   |   |   | |         fail
+|   |   |   | call <hidden>
+|   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | <hidden>:
+|   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | <hidden>:
+|   |   |   | | | push (\u1 -> (\u2 -> ')'))
+|   |   |   | | | read (')' ==)
+|   |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | call <hidden>
+|   |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | ret
+|   |   |   | | call <hidden>
+|   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | <hidden>:
+|   |   |   | | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> u5)))))))
+|   |   |   | | | read ('{' ==)
+|   |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | call <hidden>
+|   |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | call <hidden>
+|   |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | <hidden>:
+|   |   |   | | | | catchFail
+|   |   |   | | | |   <try>
+|   |   |   | | | |   | push (\u1 -> (\u2 -> (\u3 -> u2 u3)))
+|   |   |   | | | |   | <hidden>:
+|   |   |   | | | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   | | call <hidden>
+|   |   |   | | | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   | | popFail
+|   |   |   | | | |   | | ret
+|   |   |   | | | |   | catchFail
+|   |   |   | | | |   |   <try>
+|   |   |   | | | |   |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u5)))))
+|   |   |   | | | |   |   | catchFail
+|   |   |   | | | |   |   |   <try>
+|   |   |   | | | |   |   |   | push (\u1 -> (\u2 -> u2))
+|   |   |   | | | |   |   |   | catchFail
+|   |   |   | | | |   |   |   |   <try>
+|   |   |   | | | |   |   |   |   | push (\u1 -> (\u2 -> (\u3 -> 'i' : ('f' : u3))))
+|   |   |   | | | |   |   |   |   | read ('i' ==)
+|   |   |   | | | |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | read ('f' ==)
+|   |   |   | | | |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | popFail
+|   |   |   | | | |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | popFail
+|   |   |   | | | |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | <hidden>:
+|   |   |   | | | |   |   |   |   | | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4))))
+|   |   |   | | | |   |   |   |   | | <hidden>:
+|   |   |   | | | |   |   |   |   | | | catchFail
+|   |   |   | | | |   |   |   |   | | |   <try>
+|   |   |   | | | |   |   |   |   | | |   | push (\u1 -> (\u2 -> u2))
+|   |   |   | | | |   |   |   |   | | |   | <hidden>:
+|   |   |   | | | |   |   |   |   | | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |   | | call <hidden>
+|   |   |   | | | |   |   |   |   | | |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |   | | popFail
+|   |   |   | | | |   |   |   |   | | |   | | ret
+|   |   |   | | | |   |   |   |   | | |   | catchFail
+|   |   |   | | | |   |   |   |   | | |   |   <try>
+|   |   |   | | | |   |   |   |   | | |   |   | push (\u1 -> '0')
+|   |   |   | | | |   |   |   |   | | |   |   | read ('0' ==)
+|   |   |   | | | |   |   |   |   | | |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |   |   | popFail
+|   |   |   | | | |   |   |   |   | | |   |   | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |   |   <handler>
+|   |   |   | | | |   |   |   |   | | |   |     pushInput
+|   |   |   | | | |   |   |   |   | | |   |     lift Term
+|   |   |   | | | |   |   |   |   | | |   |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   | | |   |       <branch>
+|   |   |   | | | |   |   |   |   | | |   |       | push (\u1 -> '1')
+|   |   |   | | | |   |   |   |   | | |   |       | read ('1' ==)
+|   |   |   | | | |   |   |   |   | | |   |       | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |   |       | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |   |       <default>
+|   |   |   | | | |   |   |   |   | | |   |         fail
+|   |   |   | | | |   |   |   |   | | |   <handler>
+|   |   |   | | | |   |   |   |   | | |     pushInput
+|   |   |   | | | |   |   |   |   | | |     lift Term
+|   |   |   | | | |   |   |   |   | | |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   | | |       <branch>
+|   |   |   | | | |   |   |   |   | | |       | catchFail
+|   |   |   | | | |   |   |   |   | | |       |   <try>
+|   |   |   | | | |   |   |   |   | | |       |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> u2))))
+|   |   |   | | | |   |   |   |   | | |       |   | read ('\'' ==)
+|   |   |   | | | |   |   |   |   | | |       |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |   | <hidden>:
+|   |   |   | | | |   |   |   |   | | |       |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |   | | read ('\'' ==)
+|   |   |   | | | |   |   |   |   | | |       |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |   | | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |   | | popFail
+|   |   |   | | | |   |   |   |   | | |       |   | | ret
+|   |   |   | | | |   |   |   |   | | |       |   | catchFail
+|   |   |   | | | |   |   |   |   | | |       |   |   <try>
+|   |   |   | | | |   |   |   |   | | |       |   |   | push (\u1 -> (\u2 -> u2))
+|   |   |   | | | |   |   |   |   | | |       |   |   | read Term
+|   |   |   | | | |   |   |   |   | | |       |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |   |   | popFail
+|   |   |   | | | |   |   |   |   | | |       |   |   | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |       |   |   <handler>
+|   |   |   | | | |   |   |   |   | | |       |   |     pushInput
+|   |   |   | | | |   |   |   |   | | |       |   |     lift Term
+|   |   |   | | | |   |   |   |   | | |       |   |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   | | |       |   |       <branch>
+|   |   |   | | | |   |   |   |   | | |       |   |       | push (\u1 -> (\u2 -> (\u3 -> u3)))
+|   |   |   | | | |   |   |   |   | | |       |   |       | read ('\\' ==)
+|   |   |   | | | |   |   |   |   | | |       |   |       | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |   |       | read Term
+|   |   |   | | | |   |   |   |   | | |       |   |       | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |   |       | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |   |       | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |   |       | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |       |   |       <default>
+|   |   |   | | | |   |   |   |   | | |       |   |         fail
+|   |   |   | | | |   |   |   |   | | |       |   <handler>
+|   |   |   | | | |   |   |   |   | | |       |     pushInput
+|   |   |   | | | |   |   |   |   | | |       |     lift Term
+|   |   |   | | | |   |   |   |   | | |       |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   | | |       |       <branch>
+|   |   |   | | | |   |   |   |   | | |       |       | push (\u1 -> (\u2 -> u2))
+|   |   |   | | | |   |   |   |   | | |       |       | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       | <hidden>:
+|   |   |   | | | |   |   |   |   | | |       |       | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       | | ret
+|   |   |   | | | |   |   |   |   | | |       |       | catchFail
+|   |   |   | | | |   |   |   |   | | |       |       |   <try>
+|   |   |   | | | |   |   |   |   | | |       |       |   | push (\u1 -> Term)
+|   |   |   | | | |   |   |   |   | | |       |       |   | <hidden>:
+|   |   |   | | | |   |   |   |   | | |       |       |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   | | popFail
+|   |   |   | | | |   |   |   |   | | |       |       |   | | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   | catchFail
+|   |   |   | | | |   |   |   |   | | |       |       |   |   <try>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | push (\u1 -> (\u2 -> (\u3 -> u2)))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | <hidden>:
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | | popFail
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   | catchFail
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   <try>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> Term))))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | <hidden>:
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | | catchFail
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   <try>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5))))))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | popFail
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   | ret
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |   <handler>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |     pushInput
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |     lift Term
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |       <branch>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |       | push (\u1 -> u1)
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |       | ret
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |       <default>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | |         fail
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | popFail
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |   <handler>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |     pushInput
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |     lift Term
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |       <branch>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |       | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |       | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |       <default>
+|   |   |   | | | |   |   |   |   | | |       |       |   |   |         fail
+|   |   |   | | | |   |   |   |   | | |       |       |   |   <handler>
+|   |   |   | | | |   |   |   |   | | |       |       |   |     pushInput
+|   |   |   | | | |   |   |   |   | | |       |       |   |     lift Term
+|   |   |   | | | |   |   |   |   | | |       |       |   |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   | | |       |       |   |       <branch>
+|   |   |   | | | |   |   |   |   | | |       |       |   |       | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |       | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |   |       <default>
+|   |   |   | | | |   |   |   |   | | |       |       |   |         fail
+|   |   |   | | | |   |   |   |   | | |       |       |   <handler>
+|   |   |   | | | |   |   |   |   | | |       |       |     pushInput
+|   |   |   | | | |   |   |   |   | | |       |       |     lift Term
+|   |   |   | | | |   |   |   |   | | |       |       |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   | | |       |       |       <branch>
+|   |   |   | | | |   |   |   |   | | |       |       |       | call <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |       | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | | |       |       |       <default>
+|   |   |   | | | |   |   |   |   | | |       |       |         fail
+|   |   |   | | | |   |   |   |   | | |       |       <default>
+|   |   |   | | | |   |   |   |   | | |       |         fail
+|   |   |   | | | |   |   |   |   | | |       <default>
+|   |   |   | | | |   |   |   |   | | |         fail
+|   |   |   | | | |   |   |   |   | | call <hidden>
+|   |   |   | | | |   |   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | call <hidden>
+|   |   |   | | | |   |   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | <hidden>:
+|   |   |   | | | |   |   |   |   | | | catchFail
+|   |   |   | | | |   |   |   |   | | |   <try>
+|   |   |   | | | |   |   |   |   | | |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> u4 u5)))))
+|   |   |   | | | |   |   |   |   | | |   | read ('!' ==)
+|   |   |   | | | |   |   |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |   | call <hidden>
+|   |   |   | | | |   |   |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | |   | popFail
+|   |   |   | | | |   |   |   |   | | |   | ret
+|   |   |   | | | |   |   |   |   | | |   <handler>
+|   |   |   | | | |   |   |   |   | | |     pushInput
+|   |   |   | | | |   |   |   |   | | |     lift Term
+|   |   |   | | | |   |   |   |   | | |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   | | |       <branch>
+|   |   |   | | | |   |   |   |   | | |       | push (\u1 -> u1)
+|   |   |   | | | |   |   |   |   | | |       | ret
+|   |   |   | | | |   |   |   |   | | |       <default>
+|   |   |   | | | |   |   |   |   | | |         fail
+|   |   |   | | | |   |   |   |   | | call <hidden>
+|   |   |   | | | |   |   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | call <hidden>
+|   |   |   | | | |   |   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | ret
+|   |   |   | | | |   |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | <hidden>:
+|   |   |   | | | |   |   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   | | popFail
+|   |   |   | | | |   |   |   |   | | refJoin <hidden>
+|   |   |   | | | |   |   |   |   | catchFail
+|   |   |   | | | |   |   |   |   |   <try>
+|   |   |   | | | |   |   |   |   |   | push (\u1 -> (\u2 -> (\u3 -> Term)))
+|   |   |   | | | |   |   |   |   |   | catchFail
+|   |   |   | | | |   |   |   |   |   |   <try>
+|   |   |   | | | |   |   |   |   |   |   | push (\u1 -> (\u2 -> u2))
+|   |   |   | | | |   |   |   |   |   |   | catchFail
+|   |   |   | | | |   |   |   |   |   |   |   <try>
+|   |   |   | | | |   |   |   |   |   |   |   | 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 <hidden>
+|   |   |   | | | |   |   |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   |   |   |   | popFail
+|   |   |   | | | |   |   |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   |   |   |   | popFail
+|   |   |   | | | |   |   |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   |   |   |   | call <hidden>
+|   |   |   | | | |   |   |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |   |   |   |   |   |   | popFail
+|   |   |   | | | |   |   |   |   |   |   |   | refJoin <hidden>
+|   |   |   | | | |   |   |   |   |   |   |   <handler>
+|   |   |   | | | |   |   |   |   |   |   |     loadInput
+|   |   |   | | | |   |   |   |   |   |   |     fail
+|   |   |   | | | |   |   |   |   |   |   <handler>
+|   |   |   | | | |   |   |   |   |   |     loadInput
+|   |   |   | | | |   |   |   |   |   |     fail
+|   |   |   | | | |   |   |   |   |   <handler>
+|   |   |   | | | |   |   |   |   |     pushInput
+|   |   |   | | | |   |   |   |   |     lift Term
+|   |   |   | | | |   |   |   |   |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |   |   |   |       <branch>
+|   |   |   | | | |   |   |   |   |       | call <hidden>
+|   |   |   | | | |   |   |   |   |       | refJoin <hidden>
+|   |   |   | | | |   |   |   |   |       <default>
+|   |   |   | | | |   |   |   |   |         fail
+|   |   |   | | | |   |   |   |   <handler>
+|   |   |   | | | |   |   |   |     loadInput
+|   |   |   | | | |   |   |   |     fail
+|   |   |   | | | |   |   |   <handler>
+|   |   |   | | | |   |   |     loadInput
+|   |   |   | | | |   |   |     fail
+|   |   |   | | | |   |   <handler>
+|   |   |   | | | |   |     pushInput
+|   |   |   | | | |   |     lift Term
+|   |   |   | | | |   |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |       <branch>
+|   |   |   | | | |   |       | catchFail
+|   |   |   | | | |   |       |   <try>
+|   |   |   | | | |   |       |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> u4))))
+|   |   |   | | | |   |       |   | catchFail
+|   |   |   | | | |   |       |   |   <try>
+|   |   |   | | | |   |       |   |   | push (\u1 -> (\u2 -> u2))
+|   |   |   | | | |   |       |   |   | catchFail
+|   |   |   | | | |   |       |   |   |   <try>
+|   |   |   | | | |   |       |   |   |   | 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 <hidden>
+|   |   |   | | | |   |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |   |   |   | popFail
+|   |   |   | | | |   |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |   |   |   | call <hidden>
+|   |   |   | | | |   |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |   |   |   | popFail
+|   |   |   | | | |   |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |   |   |   | call <hidden>
+|   |   |   | | | |   |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |   |   |   | call <hidden>
+|   |   |   | | | |   |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |   |   |   | call <hidden>
+|   |   |   | | | |   |       |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |   |   |   | popFail
+|   |   |   | | | |   |       |   |   |   | refJoin <hidden>
+|   |   |   | | | |   |       |   |   |   <handler>
+|   |   |   | | | |   |       |   |   |     loadInput
+|   |   |   | | | |   |       |   |   |     fail
+|   |   |   | | | |   |       |   |   <handler>
+|   |   |   | | | |   |       |   |     loadInput
+|   |   |   | | | |   |       |   |     fail
+|   |   |   | | | |   |       |   <handler>
+|   |   |   | | | |   |       |     pushInput
+|   |   |   | | | |   |       |     lift Term
+|   |   |   | | | |   |       |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |       |       <branch>
+|   |   |   | | | |   |       |       | catchFail
+|   |   |   | | | |   |       |       |   <try>
+|   |   |   | | | |   |       |       |   | catchFail
+|   |   |   | | | |   |       |       |   |   <try>
+|   |   |   | | | |   |       |       |   |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (\u6 -> (\u7 -> (\u8 -> (\u9 -> (\u10 -> (\u11 -> (\u12 -> u11))))))))))))
+|   |   |   | | | |   |       |       |   |   | <hidden>:
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | <hidden>:
+|   |   |   | | | |   |       |       |   |   | | | catchFail
+|   |   |   | | | |   |       |       |   |   | | |   <try>
+|   |   |   | | | |   |       |       |   |   | | |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5))))))
+|   |   |   | | | |   |       |       |   |   | | |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | |   | popFail
+|   |   |   | | | |   |       |       |   |   | | |   | ret
+|   |   |   | | | |   |       |       |   |   | | |   <handler>
+|   |   |   | | | |   |       |       |   |   | | |     pushInput
+|   |   |   | | | |   |       |       |   |   | | |     lift Term
+|   |   |   | | | |   |       |       |   |   | | |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |       |       |   |   | | |       <branch>
+|   |   |   | | | |   |       |       |   |   | | |       | push (\u1 -> u1)
+|   |   |   | | | |   |       |       |   |   | | |       | ret
+|   |   |   | | | |   |       |       |   |   | | |       <default>
+|   |   |   | | | |   |       |       |   |   | | |         fail
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | read ('=' ==)
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | <hidden>:
+|   |   |   | | | |   |       |       |   |   | | | catchFail
+|   |   |   | | | |   |       |       |   |   | | |   <try>
+|   |   |   | | | |   |       |       |   |   | | |   | push (\u1 -> (\u2 -> (\u3 -> (\u4 -> (\u5 -> (u1 u3) (u4 u5))))))
+|   |   |   | | | |   |       |       |   |   | | |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | |   | popFail
+|   |   |   | | | |   |       |       |   |   | | |   | ret
+|   |   |   | | | |   |       |       |   |   | | |   <handler>
+|   |   |   | | | |   |       |       |   |   | | |     pushInput
+|   |   |   | | | |   |       |       |   |   | | |     lift Term
+|   |   |   | | | |   |       |       |   |   | | |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |       |       |   |   | | |       <branch>
+|   |   |   | | | |   |       |       |   |   | | |       | push (\u1 -> u1)
+|   |   |   | | | |   |       |       |   |   | | |       | ret
+|   |   |   | | | |   |       |       |   |   | | |       <default>
+|   |   |   | | | |   |       |       |   |   | | |         fail
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | <hidden>:
+|   |   |   | | | |   |       |       |   |   | | | push (\u1 -> (\u2 -> ';'))
+|   |   |   | | | |   |       |       |   |   | | | read (';' ==)
+|   |   |   | | | |   |       |       |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | | ret
+|   |   |   | | | |   |       |       |   |   | | call <hidden>
+|   |   |   | | | |   |       |       |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   | | popFail
+|   |   |   | | | |   |       |       |   |   | | popFail
+|   |   |   | | | |   |       |       |   |   | | refJoin <hidden>
+|   |   |   | | | |   |       |       |   |   | catchFail
+|   |   |   | | | |   |       |       |   |   |   <try>
+|   |   |   | | | |   |       |       |   |   |   | push (\u1 -> (\u2 -> Term))
+|   |   |   | | | |   |       |       |   |   |   | catchFail
+|   |   |   | | | |   |       |       |   |   |   |   <try>
+|   |   |   | | | |   |       |       |   |   |   |   | push (\u1 -> (\u2 -> u2))
+|   |   |   | | | |   |       |       |   |   |   |   | catchFail
+|   |   |   | | | |   |       |       |   |   |   |   |   <try>
+|   |   |   | | | |   |       |       |   |   |   |   |   | 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 <hidden>
+|   |   |   | | | |   |       |       |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   |   |   |   | popFail
+|   |   |   | | | |   |       |       |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   |   |   |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   |   |   |   | popFail
+|   |   |   | | | |   |       |       |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   |   |   |   | call <hidden>
+|   |   |   | | | |   |       |       |   |   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |   |   |   |   |   | popFail
+|   |   |   | | | |   |       |       |   |   |   |   |   | refJoin <hidden>
+|   |   |   | | | |   |       |       |   |   |   |   |   <handler>
+|   |   |   | | | |   |       |       |   |   |   |   |     loadInput
+|   |   |   | | | |   |       |       |   |   |   |   |     fail
+|   |   |   | | | |   |       |       |   |   |   |   <handler>
+|   |   |   | | | |   |       |       |   |   |   |     loadInput
+|   |   |   | | | |   |       |       |   |   |   |     fail
+|   |   |   | | | |   |       |       |   |   |   <handler>
+|   |   |   | | | |   |       |       |   |   |     pushInput
+|   |   |   | | | |   |       |       |   |   |     lift Term
+|   |   |   | | | |   |       |       |   |   |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |       |       |   |   |       <branch>
+|   |   |   | | | |   |       |       |   |   |       | call <hidden>
+|   |   |   | | | |   |       |       |   |   |       | refJoin <hidden>
+|   |   |   | | | |   |       |       |   |   |       <default>
+|   |   |   | | | |   |       |       |   |   |         fail
+|   |   |   | | | |   |       |       |   |   <handler>
+|   |   |   | | | |   |       |       |   |     loadInput
+|   |   |   | | | |   |       |       |   |     fail
+|   |   |   | | | |   |       |       |   <handler>
+|   |   |   | | | |   |       |       |     pushInput
+|   |   |   | | | |   |       |       |     lift Term
+|   |   |   | | | |   |       |       |     choices [(\u1 -> u1)]
+|   |   |   | | | |   |       |       |       <branch>
+|   |   |   | | | |   |       |       |       | push (\u1 -> (\u2 -> u1))
+|   |   |   | | | |   |       |       |       | call <hidden>
+|   |   |   | | | |   |       |       |       | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |       | call <hidden>
+|   |   |   | | | |   |       |       |       | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | |   |       |       |       | refJoin <hidden>
+|   |   |   | | | |   |       |       |       <default>
+|   |   |   | | | |   |       |       |         fail
+|   |   |   | | | |   |       |       <default>
+|   |   |   | | | |   |       |         fail
+|   |   |   | | | |   |       <default>
+|   |   |   | | | |   |         fail
+|   |   |   | | | |   <handler>
+|   |   |   | | | |     pushInput
+|   |   |   | | | |     lift Term
+|   |   |   | | | |     choices [(\u1 -> u1)]
+|   |   |   | | | |       <branch>
+|   |   |   | | | |       | push (\u1 -> u1)
+|   |   |   | | | |       | ret
+|   |   |   | | | |       <default>
+|   |   |   | | | |         fail
+|   |   |   | | | call <hidden>
+|   |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | call <hidden>
+|   |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | read ('}' ==)
+|   |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | call <hidden>
+|   |   |   | | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | | ret
+|   |   |   | | call <hidden>
+|   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | call <hidden>
+|   |   |   | | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   | | popFail
+|   |   |   | | ret
+|   |   |   | catchFail
+|   |   |   |   <try>
+|   |   |   |   | push (\u1 -> (\u2 -> (\u3 -> Term)))
+|   |   |   |   | read (':' ==)
+|   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   |   | call <hidden>
+|   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   |   | call <hidden>
+|   |   |   |   | lift (\u1 -> (\u2 -> u1 u2))
+|   |   |   |   | popFail
+|   |   |   |   | refJoin <hidden>
+|   |   |   |   <handler>
+|   |   |   |     pushInput
+|   |   |   |     lift Term
+|   |   |   |     choices [(\u1 -> u1)]
+|   |   |   |       <branch>
+|   |   |   |       | call <hidden>
+|   |   |   |       | refJoin <hidden>
+|   |   |   |       <default>
+|   |   |   |         fail
+|   |   |   <handler>
+|   |   |     loadInput
+|   |   |     fail
+|   |   <handler>
+|   |     loadInput
+|   |     fail
+|   <handler>
+|     pushInput
+|     lift Term
+|     choices [(\u1 -> u1)]
+|       <branch>
+|       | push (\u1 -> u1)
+|       | ret
+|       <default>
+|         fail
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+<hidden>:
+| lift (\u1 -> (\u2 -> u1 u2))
+| ret
+catchFail
+  <try>
+  | catchFail
+  |   <try>
+  |   | pushInput
+  |   | read (\u1 -> Term)
+  |   | pop
+  |   | popFail
+  |   | loadInput
+  |   | fail
+  |   <handler>
+  |     loadInput
+  |     push Term
+  |     popFail
+  |     refJoin <hidden>
+  <handler>
+    pushInput
+    lift Term
+    choices [(\u1 -> u1)]
+      <branch>
+      | fail
+      <default>
+        fail
diff --git a/test/Golden/Machine/some-string.dump b/test/Golden/Machine/some-string.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Machine/some-string.dump
@@ -0,0 +1,42 @@
+push (\u1 -> (\u2 -> u1 : u2 Term))
+<hidden>:
+| catchFail
+|   <try>
+|   | 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
+|   <handler>
+|     loadInput
+|     fail
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+<hidden>:
+| catchFail
+|   <try>
+|   | push (\u1 -> (\u2 -> (\u3 -> u1 : u2 u3)))
+|   | call <hidden>
+|   | lift (\u1 -> (\u2 -> u1 u2))
+|   | call <hidden>
+|   | lift (\u1 -> (\u2 -> u1 u2))
+|   | popFail
+|   | ret
+|   <handler>
+|     pushInput
+|     lift Term
+|     choices [(\u1 -> u1)]
+|       <branch>
+|       | push (\u1 -> u1)
+|       | ret
+|       <default>
+|         fail
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+ret
diff --git a/test/Golden/Machine/string.dump b/test/Golden/Machine/string.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Machine/string.dump
@@ -0,0 +1,16 @@
+catchFail
+  <try>
+  | 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
+  <handler>
+    loadInput
+    fail
diff --git a/test/Golden/Machine/string.txt b/test/Golden/Machine/string.txt
new file mode 100644
--- /dev/null
+++ b/test/Golden/Machine/string.txt
@@ -0,0 +1,1 @@
+ab
diff --git a/test/Golden/Machine/unit-unit.dump b/test/Golden/Machine/unit-unit.dump
--- a/test/Golden/Machine/unit-unit.dump
+++ b/test/Golden/Machine/unit-unit.dump
@@ -1,9 +1,9 @@
-push (const id)
-name_1:
-| push ()
+push (\u1 -> (\u2 -> u2))
+<hidden>:
+| push Term
 | ret
-call name_1
-lift ($)
-call name_1
-lift ($)
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
+call <hidden>
+lift (\u1 -> (\u2 -> u1 u2))
 ret
diff --git a/test/Golden/Machine/unit.dump b/test/Golden/Machine/unit.dump
--- a/test/Golden/Machine/unit.dump
+++ b/test/Golden/Machine/unit.dump
@@ -1,2 +1,2 @@
-push ()
+push Term
 ret
diff --git a/test/Golden/Parser/alt-right-notry.dump b/test/Golden/Parser/alt-right-notry.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/alt-right-notry.dump
@@ -0,0 +1,1 @@
+ParsingErrorStandard {parsingErrorOffset = 1, parsingErrorUnexpected = Just 'b', parsingErrorExpecting = fromList [ErrorItemToken 'a']}
diff --git a/test/Golden/Parser/alt-right-notry.txt b/test/Golden/Parser/alt-right-notry.txt
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/alt-right-notry.txt
@@ -0,0 +1,1 @@
+ab
diff --git a/test/Golden/Parser/alt-right.dump b/test/Golden/Parser/alt-right.dump
deleted file mode 100644
--- a/test/Golden/Parser/alt-right.dump
+++ /dev/null
@@ -1,1 +0,0 @@
-ParsingErrorStandard {parsingErrorOffset = 1, parsingErrorUnexpected = Just 'b', parsingErrorExpecting = fromList [ErrorItemToken 'a']}
diff --git a/test/Golden/Parser/alt-right.txt b/test/Golden/Parser/alt-right.txt
deleted file mode 100644
--- a/test/Golden/Parser/alt-right.txt
+++ /dev/null
@@ -1,1 +0,0 @@
-ab
diff --git a/test/Golden/Parser/many-oneOf.dump b/test/Golden/Parser/many-oneOf.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/many-oneOf.dump
@@ -0,0 +1,1 @@
+"baacbccbaa"
diff --git a/test/Golden/Parser/many-oneOf.txt b/test/Golden/Parser/many-oneOf.txt
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/many-oneOf.txt
@@ -0,0 +1,1 @@
+baacbccbaa
diff --git a/test/Golden/Parser/some-string-eof-fail.dump b/test/Golden/Parser/some-string-eof-fail.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/some-string-eof-fail.dump
@@ -0,0 +1,1 @@
+ParsingErrorStandard {parsingErrorOffset = 4, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [ErrorItemHorizon 4,ErrorItemEnd]}
diff --git a/test/Golden/Parser/some-string-eof-fail.txt b/test/Golden/Parser/some-string-eof-fail.txt
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/some-string-eof-fail.txt
@@ -0,0 +1,1 @@
+abcdabc
diff --git a/test/Golden/Parser/some-string-fail.dump b/test/Golden/Parser/some-string-fail.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/some-string-fail.dump
@@ -0,0 +1,1 @@
+ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [ErrorItemHorizon 4]}
diff --git a/test/Golden/Parser/some-string-fail.txt b/test/Golden/Parser/some-string-fail.txt
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/some-string-fail.txt
@@ -0,0 +1,1 @@
+abc
diff --git a/test/Golden/Parser/some-string.dump b/test/Golden/Parser/some-string.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/some-string.dump
@@ -0,0 +1,1 @@
+["abcd","abcd","abcd"]
diff --git a/test/Golden/Parser/some-string.txt b/test/Golden/Parser/some-string.txt
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/some-string.txt
@@ -0,0 +1,1 @@
+abcdabcdabcd
diff --git a/test/Golden/Parser/string-fail-horizon.dump b/test/Golden/Parser/string-fail-horizon.dump
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/string-fail-horizon.dump
@@ -0,0 +1,1 @@
+ParsingErrorStandard {parsingErrorOffset = 0, parsingErrorUnexpected = Just 'a', parsingErrorExpecting = fromList [ErrorItemHorizon 3]}
diff --git a/test/Golden/Parser/string-fail-horizon.txt b/test/Golden/Parser/string-fail-horizon.txt
new file mode 100644
--- /dev/null
+++ b/test/Golden/Parser/string-fail-horizon.txt
@@ -0,0 +1,1 @@
+ab
diff --git a/test/Golden/Parser/string.dump b/test/Golden/Parser/string.dump
--- a/test/Golden/Parser/string.dump
+++ b/test/Golden/Parser/string.dump
@@ -1,1 +1,1 @@
-"ab"
+"abc"
diff --git a/test/Golden/Parser/string.txt b/test/Golden/Parser/string.txt
--- a/test/Golden/Parser/string.txt
+++ b/test/Golden/Parser/string.txt
@@ -1,1 +1,1 @@
-ab
+abc
diff --git a/test/Golden/Splice/T1.hs b/test/Golden/Splice/T1.hs
new file mode 100644
--- /dev/null
+++ b/test/Golden/Splice/T1.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnboxedTuples #-}
+module Golden.Splice.T1 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 qualified Parser
+--import Golden.Utils
+
+
+{-
+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 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.
+resetTHNameCounter :: IO ()
+resetTHNameCounter = IORef.writeIORef TH.counter 0
diff --git a/test/Parser.hs b/test/Parser.hs
new file mode 100644
--- /dev/null
+++ b/test/Parser.hs
@@ -0,0 +1,8 @@
+module Parser
+  ( module Parser.Brainfuck
+  , module Parser.Nandlang
+  , module Parser.Playground
+  ) where
+import Parser.Brainfuck
+import Parser.Nandlang
+import Parser.Playground
diff --git a/test/Parser/Brainfuck.hs b/test/Parser/Brainfuck.hs
new file mode 100644
--- /dev/null
+++ b/test/Parser/Brainfuck.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Parser.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 BrainFuckOp
+  = RightPointer
+  | LeftPointer
+  | Increment
+  | Decrement
+  | Output
+  | Input
+  | Loop [BrainFuckOp]
+  deriving (Show, Eq, TH.Lift)
+
+haskell :: TH.Lift a => a -> P.TermGrammar a
+haskell a = H.Term (H.ValueCode a [||a||])
+
+brainfuck :: forall repr.
+  P.Grammar Char repr =>
+  repr [BrainFuckOp]
+brainfuck = whitespace P.*> bf
+  where
+  whitespace = P.skipMany (P.noneOf "<>+-[],.$")
+  lexeme p = p P.<* whitespace
+  bf :: repr [BrainFuckOp]
+  bf = P.many (lexeme (P.match (P.look P.anyChar) (haskell Prelude.<$> "><+-.,[") op P.empty))
+  op :: H.Term H.ValueCode Char -> repr BrainFuckOp
+  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.between (lexeme P.anyChar) (P.char ']') (H.Term (H.ValueCode Loop [||Loop||]) P.<$> bf)
+    _ -> Prelude.undefined
diff --git a/test/Parser/Nandlang.hs b/test/Parser/Nandlang.hs
new file mode 100644
--- /dev/null
+++ b/test/Parser/Nandlang.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnboxedTuples #-}
+module Parser.Nandlang where
+
+import Data.Bool
+import Data.Char (isSpace, isAlpha, isAlphaNum)
+import Data.Char (Char)
+import Data.Eq (Eq(..))
+import Data.Ord (Ord(..))
+import Data.String (String)
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+
+import Symantic.Univariant.Trans
+import qualified Symantic.Parser as P
+import qualified Symantic.Parser.Haskell as H
+
+type Parser a = P.Parser Text.Text a
+
+nandIdentStart :: Char -> Bool
+nandIdentStart c = isAlpha c || c == '_'
+
+nandIdentLetter :: Char -> Bool
+nandIdentLetter c = isAlphaNum c || c == '_'
+
+nandUnreservedName :: String -> Bool
+nandUnreservedName = \s -> not (Set.member s keys)
+  where
+  keys = Set.fromList ["if", "else", "while", "function", "var"]
+
+nandStringLetter :: Char -> Bool
+nandStringLetter c = (c /= '"') && (c /= '\\') && (c > '\026')
+
+nandlang :: forall repr.
+  P.Grammar Char repr =>
+  repr ()
+nandlang = 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)
+
+  exprlist = commaSep expr
+  exprlist1 = commaSep1 expr
+  varlist = commaSep variable
+  varlist1 = commaSep1 variable
+
+  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
+
+  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
+  parens :: repr a -> repr a
+  parens = P.between (symbol '(') (symbol ')')
+  brackets :: repr a -> repr a
+  brackets = P.between (symbol '[') (symbol ']')
+  braces :: repr a -> repr a
+  braces = P.between (symbol '{') (symbol '}')
+  semi :: repr Char
+  semi = symbol ';'
+  comma :: repr Char
+  comma = symbol ','
+  commaSep :: repr a -> repr ()
+  commaSep p = P.optional (commaSep1 p)
+  commaSep1 :: repr a -> repr ()
+  commaSep1 p = p P.*> P.skipMany (comma P.*> p)
+
+  space :: repr ()
+  space = P.void (P.satisfy
+    [P.ErrorItemLabel "space"]
+    (trans (H.ValueCode isSpace [||isSpace||])))
+  whitespace :: repr ()
+  whitespace = P.skipMany (spaces P.<|> oneLineComment)
+  spaces :: repr ()
+  spaces = P.skipSome space
+  oneLineComment :: repr ()
+  oneLineComment = P.void (P.string "//" P.*> P.skipMany (P.satisfy
+    [P.ErrorItemLabel "oneLineComment"]
+    (trans (H.ValueCode (/= '\n') [||(/= '\n')||]))))
diff --git a/test/Parser/Playground.hs b/test/Parser/Playground.hs
new file mode 100644
--- /dev/null
+++ b/test/Parser/Playground.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Parser.Playground where
+
+import Symantic.Parser
+import qualified Symantic.Parser.Haskell as H
+
+boom :: Applicable repr => repr ()
+boom =
+  let foo = (-- newRegister_ unit (\r0 ->
+       let goo = (-- newRegister_ unit (\r1 ->
+             let hoo = {-get r0 <~> get r1 *>-} goo *> hoo in hoo
+            ) *> goo
+       in goo) *> pure H.unit
+  in foo *> foo