From 1a9ebcff81e628a48f8eb4baf55c34fac6ac4331 Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+symantic-parser@sourcephile.fr>
Date: Thu, 15 Oct 2020 02:58:46 +0200
Subject: [PATCH] Rename many things and continue Instr interpretation

---
 src/Symantic/Parser.hs                        |   3 +
 src/Symantic/Parser/Automaton.hs              |  11 +
 src/Symantic/Parser/Automaton/Instructions.hs |  84 +++++--
 src/Symantic/Parser/Grammar.hs                |  34 ++-
 src/Symantic/Parser/Grammar/Dump.hs           |  72 +++---
 src/Symantic/Parser/Grammar/ObserveSharing.hs |   3 +-
 src/Symantic/Parser/Grammar/Optimize.hs       | 205 ++++++++++--------
 src/Symantic/Parser/Grammar/Write.hs          | 150 ++++++-------
 src/Symantic/Univariant/Trans.hs              |   6 +
 symantic-parser.cabal                         |   1 -
 10 files changed, 340 insertions(+), 229 deletions(-)

diff --git a/src/Symantic/Parser.hs b/src/Symantic/Parser.hs
index 721e0e6..0387001 100644
--- a/src/Symantic/Parser.hs
+++ b/src/Symantic/Parser.hs
@@ -1,12 +1,15 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Symantic.Parser
  ( module Symantic.Parser.Grammar
+ , module Symantic.Parser.Automaton
  --, module Symantic.Parser.Staging
  , module Symantic.Parser
  , module Symantic.Univariant.Trans
  ) where
 import Symantic.Univariant.Trans
+import Symantic.Univariant.Letable
 import Symantic.Parser.Grammar
+import Symantic.Parser.Automaton
 import qualified Symantic.Parser.Staging as Hask
 
 --import Prelude hiding (fmap, pure, (<*), (*>), (<*>), (<$>), (<$), pred, repeat)
diff --git a/src/Symantic/Parser/Automaton.hs b/src/Symantic/Parser/Automaton.hs
index 163ee65..811f731 100644
--- a/src/Symantic/Parser/Automaton.hs
+++ b/src/Symantic/Parser/Automaton.hs
@@ -2,3 +2,14 @@ module Symantic.Parser.Automaton
  ( module Symantic.Parser.Automaton.Instructions
  ) where
 import Symantic.Parser.Automaton.Instructions
+
+import Symantic.Parser.Grammar
+import Data.Function ((.))
+import qualified Data.Functor as Functor
+import System.IO (IO)
+import qualified Language.Haskell.TH.Syntax as TH
+
+generateAutomaton ::
+  Grammar repr =>
+  ObserveSharing TH.Name (OptimizeComb TH.Name repr) a -> IO (repr a)
+generateAutomaton = (optimizeComb Functor.<$>) . observeSharing
diff --git a/src/Symantic/Parser/Automaton/Instructions.hs b/src/Symantic/Parser/Automaton/Instructions.hs
index 2585c19..d1da98b 100644
--- a/src/Symantic/Parser/Automaton/Instructions.hs
+++ b/src/Symantic/Parser/Automaton/Instructions.hs
@@ -10,14 +10,10 @@ import Data.Function (($), (.))
 import Symantic.Parser.Grammar
 import qualified Data.Functor as Functor
 import qualified Symantic.Parser.Staging as Hask
+import Symantic.Univariant.Trans
 
-{-
-class Automatable repr where
-  ret :: repr inp '[ret] n ret a
-  push :: x -> repr inp (x ': vs) n ret a -> repr inp vs n ret a
-  pop :: repr inp vs n ret a -> repr inp (x ': vs) n ret a
--}
-
+-- * Class 'InputPosition'
+-- | TODO
 class InputPosition inp where
 
 -- * Type 'Instr'
@@ -29,8 +25,8 @@ data Instr input valueStack (exceptionStack::Peano) returnValue a where
   Push :: InstrPure x -> Instr inp (x ': vs) es ret a -> Instr inp vs es ret a
   -- | @('Pop' k)@ pushes @(x)@ on the value-stack.
   Pop :: Instr inp vs es ret a -> Instr inp (x ': vs) es ret a
-  -- | @('Lift2' f k)@ pops two values from the value-stack, and pushes the result of @(f)@ applied to them.
-  Lift2 :: InstrPure (x -> y -> z) -> Instr inp (z : vs) es ret a -> Instr inp (y : x : vs) es ret a
+  -- | @('LiftI2' f k)@ pops two values from the value-stack, and pushes the result of @(f)@ applied to them.
+  LiftI2 :: InstrPure (x -> y -> z) -> Instr inp (z : vs) es ret a -> Instr inp (y : x : vs) es ret a
   -- | @('Fail')@ raises an error from the exception-stack.
   Fail :: Instr inp vs ('Succ es) ret a
   -- | @('Commit' k)@ removes an exception from the exception-stack and continues with the next 'Instr'uction @(k)@.
@@ -41,9 +37,11 @@ data Instr input valueStack (exceptionStack::Peano) returnValue a where
   Seek :: Instr inp vs es r a -> Instr inp (inp : vs) es r a
   -- | @('Tell' k)@ pushes the input @(inp)@ on the value-stack and continues with the next 'Instr'uction @(k)@.
   Tell :: Instr inp (inp ': vs) es ret a -> Instr inp vs es ret a
-  Case :: Instr inp (x : vs) n r a -> Instr inp (y : vs) n r a -> Instr inp (Either x y : vs) n r a
+  -- | @('Case' l r)@.
+  Case :: Instr inp (x ': vs) n r a -> Instr inp (y ': vs) n r a -> Instr inp (Either x y ': vs) n r a
   -- | @('Swap' k)@ pops two values on the value-stack, pushes the first popped-out, then the second, and continues with the next 'Instr'uction @(k)@.
-  Swap :: Instr inp (x : y : vs) n r a -> Instr inp (y : x : vs) n r a
+  Swap :: Instr inp (x ': y ': vs) n r a -> Instr inp (y ': x ': vs) n r a
+  -- | @('Choices' ps bs d)@.
   Choices :: [InstrPure (x -> Bool)] -> [Instr inp vs es ret a] -> Instr inp vs es ret a -> Instr inp (x ': vs) es ret a
 
 -- ** Type 'InstrPure'
@@ -51,20 +49,54 @@ data InstrPure a
   =  InstrPureHaskell (Hask.Haskell a)
   |  InstrPureSameOffset
 
+-- * Class 'Executable'
+-- | Tagless-Final encoding of 'Instr'uctions.
+class Executable repr where
+  ret :: repr inp '[ret] (n::Peano) ret a
+  push :: InstrPure x -> repr inp (x ': vs) n ret a -> repr inp vs n ret a
+  pop :: repr inp vs n ret a -> repr inp (x ': vs) n ret a
+  liftI2 :: InstrPure (x -> y -> z) -> repr inp (z ': vs) es ret a -> repr inp (y ': x ': vs) es ret a
+  fail :: repr inp vs ('Succ es) ret a
+  commit :: repr inp vs es ret a -> repr inp vs ('Succ es) ret a
+  catch :: repr inp vs ('Succ es) ret a -> repr inp (inp ': vs) es ret a -> repr inp vs es ret a
+  seek :: repr inp vs es r a -> repr inp (inp ': vs) es r a
+  tell :: repr inp (inp ': vs) es ret a -> repr inp vs es ret a
+  case_ :: repr inp (x ': vs) n r a -> repr inp (y ': vs) n r a -> repr inp (Either x y ': vs) n r a
+  swap :: repr inp (x ': y ': vs) n r a -> repr inp (y ': x ': vs) n r a
+  choices :: [InstrPure (x -> Bool)] -> [repr inp vs es ret a] -> repr inp vs es ret a -> repr inp (x ': vs) es ret a
+
+instance
+  Executable repr =>
+  Trans (Instr inp vs es ret) (repr inp vs es ret) where
+  trans = \case
+    Ret -> ret
+    Push x k -> push x (trans k)
+    Pop k -> pop (trans k)
+    LiftI2 f k -> liftI2 f (trans k)
+    Fail -> fail
+    Commit k -> commit (trans k)
+    Catch l r -> catch (trans l) (trans r)
+    Seek k -> seek (trans k)
+    Tell k -> tell (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)
+
+
 -- ** Type 'Peano'
 -- | Type-level natural numbers, using the Peano recursive encoding.
 data Peano = Zero | Succ Peano
 
 -- | @('App' k)@ pops @(x)@ and @(x2y)@ from the value-stack, pushes @(x2y x)@ and continues with the next 'Instr'uction @(k)@.
 pattern App :: Instr inp (y : vs) es ret a -> Instr inp (x : (x -> y) : vs) es ret a
-pattern App k = Lift2 (InstrPureHaskell (Hask.:$)) k
+pattern App k = LiftI2 (InstrPureHaskell (Hask.:$)) k
 
 -- | @('If' ok ko)@ pops a 'Bool' from the value-stack and continues either with the 'Instr'uction @(ok)@ if it is 'True' or @(ko)@ otherwise.
 pattern If :: Instr inp vs es ret a -> Instr inp vs es ret a -> Instr inp (Bool ': vs) es ret a
 pattern If ok ko = Choices [InstrPureHaskell Hask.Id] [ok] ko
 
 parsecHandler :: InputPosition inp => Instr inp vs ('Succ es) ret a -> Instr inp (inp : vs) ('Succ es) ret a
-parsecHandler k = Tell (Lift2 InstrPureSameOffset (If k Fail))
+parsecHandler k = Tell (LiftI2 InstrPureSameOffset (If k Fail))
 
 -- * Type 'Automaton'
 -- | Making the control-flow explicit.
@@ -74,11 +106,20 @@ data Automaton inp a x = Automaton { unAutomaton ::
   Instr inp vs ('Succ es) ret a
   }
 
+automaton ::
+  forall inp a es repr.
+  Executable repr =>
+  Automaton inp a a -> (repr inp '[] ('Succ es) a) a
+automaton =
+  trans @(Instr inp '[] ('Succ es) a) .
+  ($ Ret) .
+  unAutomaton
+
 instance Applicable (Automaton inp a) where
   pure x = Automaton $ Push (InstrPureHaskell x)
   Automaton f <*> Automaton x = Automaton $ f . x . App
   liftA2 f (Automaton x) (Automaton y) = Automaton $
-    x . y . Lift2 (InstrPureHaskell f)
+    x . y . LiftI2 (InstrPureHaskell f)
   Automaton x *> Automaton y = Automaton $ x . Pop . y
   Automaton x <* Automaton y = Automaton $ x . y . Pop
 instance
@@ -91,13 +132,18 @@ instance
   try (Automaton x) = Automaton $ \k ->
     Catch (x (Commit k)) (Seek Fail)
 instance Selectable (Automaton inp a) where
-  branch (Automaton lr) (Automaton l) (Automaton r) =
-    Automaton $ \k ->
-      -- TODO: join points
-      lr (Case (l (Swap (App k)))
-               (r (Swap (App k))))
+  branch (Automaton lr) (Automaton l) (Automaton r) = Automaton $ \k ->
+    -- TODO: join points
+    lr (Case (l (Swap (App k)))
+             (r (Swap (App k))))
 instance Matchable (Automaton inp a) where
   conditional ps bs (Automaton a) (Automaton def) =
     Automaton $ \k ->
       -- TODO: join points
       a (Choices (InstrPureHaskell Functor.<$> ps) ((\b -> unAutomaton b k) Functor.<$> bs) (def k))
+instance Lookable (Automaton inp a) where
+  look (Automaton x) = Automaton $ \k ->
+    Tell (x (Swap (Seek k)))
+  negLook (Automaton x) = Automaton $ \k ->
+    Catch (Tell (x (Pop (Seek (Commit Fail)))))
+          (Seek (Push (InstrPureHaskell Hask.unit) k))
diff --git a/src/Symantic/Parser/Grammar.hs b/src/Symantic/Parser/Grammar.hs
index 0824cb6..4f14b47 100644
--- a/src/Symantic/Parser/Grammar.hs
+++ b/src/Symantic/Parser/Grammar.hs
@@ -1,5 +1,8 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module Symantic.Parser.Grammar
- ( module Symantic.Parser.Grammar.Combinators
+ ( module Symantic.Parser.Grammar
+ , module Symantic.Parser.Grammar.Combinators
  , module Symantic.Parser.Grammar.Optimize
  , module Symantic.Parser.Grammar.ObserveSharing
  , module Symantic.Parser.Grammar.Write
@@ -10,3 +13,32 @@ import Symantic.Parser.Grammar.Optimize
 import Symantic.Parser.Grammar.ObserveSharing
 import Symantic.Parser.Grammar.Write
 import Symantic.Parser.Grammar.Dump
+import Symantic.Univariant.Letable (Letable)
+
+import Data.Function ((.))
+import Data.String (String)
+import System.IO (IO)
+import Text.Show (Show(..))
+import qualified Data.Functor as Functor
+import qualified Language.Haskell.TH.Syntax as TH
+
+-- Class 'Grammar'
+type Grammar repr =
+  ( Applicable repr
+  , Alternable repr
+  , Charable repr
+  , Letable TH.Name repr
+  , Selectable repr
+  , Matchable repr
+  , Foldable repr
+  , Lookable repr
+  )
+
+-- | A usual pipeline to show 'Comb'inators: 'observeSharing' then 'optimizeComb' then 'dumpComb' then 'show'.
+-- Note that the 'IO' is required to 'observeSharing' which is required to avoid an infinite recursion when generating.
+grammar = (optimizeComb Functor.<$>) . observeSharing
+
+-- | A usual pipeline to show 'Comb'inators: 'observeSharing' then 'optimizeComb' then 'dumpComb' then 'show'.
+-- Note that the 'IO' is required to 'observeSharing' which is required to avoid an infinite recursion when the grammar is recursive.
+showGrammar :: ObserveSharing TH.Name (OptimizeComb TH.Name DumpComb) a -> IO String
+showGrammar = (show . dumpComb . optimizeComb Functor.<$>) . observeSharing
diff --git a/src/Symantic/Parser/Grammar/Dump.hs b/src/Symantic/Parser/Grammar/Dump.hs
index 9a2803e..1c3b9f5 100644
--- a/src/Symantic/Parser/Grammar/Dump.hs
+++ b/src/Symantic/Parser/Grammar/Dump.hs
@@ -11,14 +11,14 @@ import qualified Data.List as List
 import Symantic.Univariant.Letable
 import Symantic.Parser.Grammar.Combinators
 
--- * Type 'DumpGrammar'
-newtype DumpGrammar a = DumpGrammar { unDumpGrammar :: Tree.Tree String }
+-- * Type 'DumpComb'
+newtype DumpComb a = DumpComb { unDumpComb :: Tree.Tree String }
 
-dumpGrammar :: DumpGrammar a -> DumpGrammar a
-dumpGrammar = id
+dumpComb :: DumpComb a -> DumpComb a
+dumpComb = id
 
-instance Show (DumpGrammar a) where
-  show = drawTree . unDumpGrammar
+instance Show (DumpComb a) where
+  show = drawTree . unDumpComb
     where
     drawTree :: Tree.Tree String -> String
     drawTree  = List.unlines . draw
@@ -29,42 +29,42 @@ instance Show (DumpGrammar a) where
       drawSubTrees [t] = shift "` " "  " (draw t)
       drawSubTrees (t:ts) = shift "+ " "| " (draw t) <> drawSubTrees ts
       shift first other = List.zipWith (<>) (first : List.repeat other)
-instance IsString (DumpGrammar a) where
-  fromString s = DumpGrammar $ Tree.Node (fromString s) []
+instance IsString (DumpComb a) where
+  fromString s = DumpComb $ Tree.Node (fromString s) []
 
-instance Show letName => Letable letName DumpGrammar where
-  def name x = DumpGrammar $
+instance Show letName => Letable letName DumpComb where
+  def name x = DumpComb $
     Tree.Node ( "def "
     <> show name
-    ) [unDumpGrammar x]
-  ref rec name = DumpGrammar $
+    ) [unDumpComb x]
+  ref rec name = DumpComb $
     Tree.Node
       ( (if rec then "rec " else "ref ")
       <> show name
       )
       []
-instance Applicable DumpGrammar where
-  _f <$> x = DumpGrammar $ Tree.Node "<$>" [unDumpGrammar x]
-  pure a = DumpGrammar $ Tree.Node ("pure "<>show a) []
-  x <*> y = DumpGrammar $ Tree.Node "<*>" [unDumpGrammar x, unDumpGrammar y]
-instance Alternable DumpGrammar where
-  empty = DumpGrammar $ Tree.Node "empty" []
-  x <|> y = DumpGrammar $ Tree.Node "<|>" [unDumpGrammar x, unDumpGrammar y]
-  try x = DumpGrammar $ Tree.Node "try" [unDumpGrammar x]
-instance Charable DumpGrammar where
-  satisfy _p = DumpGrammar $ Tree.Node "satisfy" []
-instance Selectable DumpGrammar where
-  branch lr l r = DumpGrammar $ Tree.Node "branch"
-    [ unDumpGrammar lr, unDumpGrammar l, unDumpGrammar r ]
-instance Matchable DumpGrammar where
-  conditional _cs bs a b = DumpGrammar $ Tree.Node "conditional"
-    [ Tree.Node "bs" (unDumpGrammar Fct.<$> bs)
-    , unDumpGrammar a
-    , unDumpGrammar b
+instance Applicable DumpComb where
+  _f <$> x = DumpComb $ Tree.Node "<$>" [unDumpComb x]
+  pure a = DumpComb $ Tree.Node ("pure "<>show 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 Charable DumpComb where
+  satisfy _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 DumpGrammar where
-  look x = DumpGrammar $ Tree.Node "look" [unDumpGrammar x]
-  negLook x = DumpGrammar $ Tree.Node "negLook" [unDumpGrammar x]
-instance Foldable DumpGrammar where
-  chainPre f x = DumpGrammar $ Tree.Node "chainPre" [unDumpGrammar f, unDumpGrammar x]
-  chainPost x f = DumpGrammar $ Tree.Node "chainPost" [unDumpGrammar x, unDumpGrammar f]
+instance Lookable DumpComb where
+  look x = DumpComb $ Tree.Node "look" [unDumpComb x]
+  negLook x = DumpComb $ Tree.Node "negLook" [unDumpComb x]
+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
index 0eee103..2c223d4 100644
--- a/src/Symantic/Parser/Grammar/ObserveSharing.hs
+++ b/src/Symantic/Parser/Grammar/ObserveSharing.hs
@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Symantic.Parser.Grammar.ObserveSharing
- ( Symantic.Parser.Grammar.ObserveSharing.observeSharing
+ ( module Symantic.Parser.Grammar.ObserveSharing
+ , ObserveSharing(..)
  ) where
 
 import Control.Monad (mapM)
diff --git a/src/Symantic/Parser/Grammar/Optimize.hs b/src/Symantic/Parser/Grammar/Optimize.hs
index 9149cf6..c83dcfb 100644
--- a/src/Symantic/Parser/Grammar/Optimize.hs
+++ b/src/Symantic/Parser/Grammar/Optimize.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoPolyKinds #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -23,29 +24,35 @@ import Symantic.Univariant.Trans
 import qualified Language.Haskell.TH.Syntax as TH
 import qualified Symantic.Parser.Staging as Hask
 
--- * Type 'Grammar'
-data Grammar a where
-  Pure :: Hask.Haskell a -> Grammar a
-  Satisfy :: Hask.Haskell (Char -> Bool) -> Grammar Char
-  Item :: Grammar Char
-  Try :: Grammar a -> Grammar a
-  Look :: Grammar a -> Grammar a
-  NegLook :: Grammar a -> Grammar ()
-  (:<*>) :: Grammar (a -> b) -> Grammar a -> Grammar b
-  (:<|>) :: Grammar a -> Grammar a -> Grammar a
-  Empty :: Grammar a
-  Branch :: Grammar (Either a b) -> Grammar (a -> c) -> Grammar (b -> c) -> Grammar c
-  Match :: Eq a => [Hask.Haskell (a -> Bool)] -> [Grammar b] -> Grammar a -> Grammar b -> Grammar b
-  ChainPre :: Grammar (a -> a) -> Grammar a -> Grammar a
-  ChainPost :: Grammar a -> Grammar (a -> a) -> Grammar a
-  Def :: TH.Name -> Grammar a -> Grammar a
-  Ref :: Bool -> TH.Name -> Grammar a
+-- * Type 'Comb'
+-- | Pattern-matchable 'Comb'inators of the grammar.
+-- @(repr)@ is not strictly necessary since it's only a phantom type (no alternative use it as a value), but having it:
+--
+-- 1. emphasizes that those 'Comb'inators will be 'trans'formed again (eg. in 'DumpGrammar' or 'Instr'uctions).
+--
+-- 2. Avoid overlapping instances between @('Trans' ('Comb' repr) repr)@ and @('Trans' ('Comb' repr) ('OptimizeComb' letName repr))@
+data Comb (repr :: * -> *) a where
+  Pure :: Hask.Haskell a -> Comb repr a
+  Satisfy :: Hask.Haskell (Char -> Bool) -> Comb repr Char
+  Item :: Comb repr Char
+  Try :: Comb repr a -> Comb repr a
+  Look :: Comb repr a -> Comb repr a
+  NegLook :: Comb repr a -> 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 => [Hask.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
 
-pattern (:<$>) :: Hask.Haskell (a -> b) -> Grammar a -> Grammar b
-pattern (:$>) :: Grammar a -> Hask.Haskell b -> Grammar b
-pattern (:<$) :: Hask.Haskell a -> Grammar b -> Grammar a
-pattern (:*>) :: Grammar a -> Grammar b -> Grammar b
-pattern (:<*) :: Grammar a -> Grammar b -> Grammar a
+pattern (:<$>) :: Hask.Haskell (a -> b) -> Comb repr a -> Comb repr b
+pattern (:$>) :: Comb repr a -> Hask.Haskell b -> Comb repr b
+pattern (:<$) :: Hask.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
@@ -56,33 +63,35 @@ infixl 3 :<|>
 infixl 4 :<*>, :<*, :*>
 infixl 4 :<$>, :<$, :$>
 
-instance Applicable Grammar where
+instance Applicable (Comb repr) where
   pure = Pure
   (<*>) = (:<*>)
-instance Alternable Grammar where
+instance Alternable (Comb repr) where
   (<|>) = (:<|>)
   empty = Empty
   try = Try
-instance Selectable Grammar where
+instance Selectable (Comb repr) where
   branch = Branch
-instance Matchable Grammar where
+instance Matchable (Comb repr) where
   conditional = Match
-instance Foldable Grammar where
+instance Foldable (Comb repr) where
   chainPre = ChainPre
   chainPost = ChainPost
-instance Charable Grammar where
+instance Charable (Comb repr) where
   satisfy = Satisfy
-instance Lookable Grammar where
+instance Lookable (Comb repr) where
   look = Look
   negLook = NegLook
-instance Letable TH.Name Grammar where
+instance Letable TH.Name (Comb repr) where
   def = Def
   ref = Ref
 instance MakeLetName TH.Name where
   makeLetName _ = TH.qNewName "let"
 
-instance Letable letName repr =>
-         Letable letName (Any repr)
+-- Pattern-matchable 'Comb'inators keep enough structure
+-- to have the symantics producing them interpreted again
+-- (eg. after being modified by 'optimizeComb').
+type instance Output (Comb repr) = repr
 instance
   ( Applicable repr
   , Alternable repr
@@ -92,8 +101,7 @@ instance
   , Lookable repr
   , Matchable repr
   , Letable TH.Name repr
-  ) =>
-  Trans Grammar (Any repr) where
+  ) => Trans (Comb repr) repr where
   trans = \case
     Pure a -> pure a
     Satisfy p -> satisfy p
@@ -111,40 +119,45 @@ instance
     Def n x -> def n (trans x)
     Ref r n -> ref r n
 
--- * Type 'OptimizeGrammar'
--- Bottom-up application of 'optimizeGrammarNode'.
-newtype OptimizeGrammar letName a = OptimizeGrammar { unOptimizeGrammar ::
-  Grammar a }
+-- * Type 'OptimizeComb'
+-- Bottom-up application of 'optimizeCombNode'.
+newtype OptimizeComb letName repr a = OptimizeComb { unOptimizeComb :: Comb repr a }
 
-optimizeGrammar :: OptimizeGrammar TH.Name a -> Grammar a
-optimizeGrammar = unOptimizeGrammar
+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
 
-type instance Output (OptimizeGrammar letName) = Grammar
-instance Trans Grammar (OptimizeGrammar letName) where
-  trans = OptimizeGrammar . optimizeGrammarNode
-instance Trans1 Grammar (OptimizeGrammar letName)
-instance Trans2 Grammar (OptimizeGrammar letName)
-instance Trans3 Grammar (OptimizeGrammar letName)
-instance Trans (OptimizeGrammar letName) Grammar where
-  trans = unOptimizeGrammar
+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)
 
 instance
-  Letable letName Grammar =>
-  Letable letName (OptimizeGrammar letName) where
-  -- Disable useless calls to 'optimizeGrammarNode'
+  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 = OptimizeGrammar . def n . unOptimizeGrammar
-  ref r n = OptimizeGrammar (ref r n)
-instance Comb.Applicable (OptimizeGrammar letName)
-instance Comb.Alternable (OptimizeGrammar letName)
-instance Comb.Charable (OptimizeGrammar letName)
-instance Comb.Selectable (OptimizeGrammar letName)
-instance Comb.Matchable (OptimizeGrammar letName)
-instance Comb.Lookable (OptimizeGrammar letName)
-instance Comb.Foldable (OptimizeGrammar letName)
+  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.Charable (OptimizeComb letName repr)
+instance Comb.Selectable (OptimizeComb letName repr)
+instance Comb.Matchable (OptimizeComb letName repr)
+instance Comb.Lookable (OptimizeComb letName repr)
+instance Comb.Foldable (OptimizeComb letName repr)
 
-optimizeGrammarNode :: Grammar a -> Grammar a
-optimizeGrammarNode = \case
+optimizeCombNode :: Comb repr a -> Comb repr a
+optimizeCombNode = \case
   -- Pure merge optimisation
   -- Pure x :<*> Pure y -> Pure (x Hask.:@ y)
 
@@ -155,11 +168,11 @@ optimizeGrammarNode = \case
   -- Functor Commutativity Law
   x :<$ u ->
     trace "Functor Commutativity Law" $
-    optimizeGrammarNode (u :$> x)
+    optimizeCombNode (u :$> x)
   -- Functor Flip Const Law
   Hask.Flip Hask.:@ Hask.Const :<$> u ->
     trace "Functor Flip Const Law" $
-    optimizeGrammarNode (u :*> Pure Hask.Id)
+    optimizeCombNode (u :*> Pure Hask.Id)
   -- Functor Homomorphism Law
   f :<$> Pure x ->
     trace "Functor Homomorphism Law" $
@@ -178,11 +191,11 @@ optimizeGrammarNode = \case
   -- App Composition Law
   u :<*> (v :<*> w) ->
     trace "App Composition Law" $
-    optimizeGrammarNode (optimizeGrammarNode (optimizeGrammarNode ((Hask.:.) :<$> u) :<*> v) :<*> w)
+    optimizeCombNode (optimizeCombNode (optimizeCombNode ((Hask.:.) :<$> u) :<*> v) :<*> w)
   -- App Interchange Law
   u :<*> Pure x ->
     trace "App Interchange Law" $
-    optimizeGrammarNode (Hask.Flip Hask.:@ (Hask.:$) Hask.:@ x :<$> u)
+    optimizeCombNode (Hask.Flip Hask.:@ (Hask.:$) Hask.:@ x :<$> u)
   -- App Left Absorption Law
   p :<* (_ :<$> q) ->
     trace "App Left Absorption Law" $
@@ -206,11 +219,11 @@ optimizeGrammarNode = \case
   -- App Functor Right Identity Law
   u :<* (v :$> _) ->
     trace "App Functor Right Identity Law" $
-    optimizeGrammarNode (u :<* v)
+    optimizeCombNode (u :<* v)
   -- App Left Associativity Law
   (u :<* v) :<* w ->
     trace "App Left Associativity Law" $
-    optimizeGrammarNode (u :<* optimizeGrammarNode (v :<* w))
+    optimizeCombNode (u :<* optimizeCombNode (v :<* w))
 
   -- Alt Left Catch Law
   p@Pure{} :<|> _ ->
@@ -227,7 +240,7 @@ optimizeGrammarNode = \case
   -- Alt Associativity Law
   (u :<|> v) :<|> w ->
     trace "Alt Associativity Law" $
-    u :<|> optimizeGrammarNode (v :<|> w)
+    u :<|> optimizeCombNode (v :<|> w)
 
   -- Look Pure Law
   Look p@Pure{} ->
@@ -248,11 +261,11 @@ optimizeGrammarNode = \case
   -- NegLook Double Negation Law
   NegLook (NegLook p) ->
     trace "NegLook Double Negation Law" $
-    optimizeGrammarNode (Look (Try p) :*> Pure Hask.unit)
+    optimizeCombNode (Look (Try p) :*> Pure Hask.unit)
   -- NegLook Zero Consumption Law
   NegLook (Try p) ->
     trace "NegLook Zero Consumption Law" $
-    optimizeGrammarNode (NegLook p)
+    optimizeCombNode (NegLook p)
   -- Idempotence Law
   Look (Look p) ->
     trace "Look Idempotence Law" $
@@ -260,7 +273,7 @@ optimizeGrammarNode = \case
   -- Look Right Identity Law
   NegLook (Look p) ->
     trace "Look Right Identity Law" $
-    optimizeGrammarNode (NegLook p)
+    optimizeCombNode (NegLook p)
   -- Look Left Identity Law
   Look (NegLook p) ->
     trace "Look Left Identity Law" $
@@ -268,27 +281,27 @@ optimizeGrammarNode = \case
   -- NegLook Transparency Law
   NegLook (Try p :<|> q) ->
     trace "NegLook Transparency Law" $
-    optimizeGrammarNode (optimizeGrammarNode (NegLook p) :*> optimizeGrammarNode (NegLook q))
+    optimizeCombNode (optimizeCombNode (NegLook p) :*> optimizeCombNode (NegLook q))
   -- Look Distributivity Law
   Look p :<|> Look q ->
     trace "Look Distributivity Law" $
-    optimizeGrammarNode (Look (optimizeGrammarNode (Try p :<|> q)))
+    optimizeCombNode (Look (optimizeCombNode (Try p :<|> q)))
   -- Look Interchange Law
   Look (f :<$> p) ->
     trace "Look Interchange Law" $
-    optimizeGrammarNode (f :<$> optimizeGrammarNode (Look p))
+    optimizeCombNode (f :<$> optimizeCombNode (Look p))
   -- NegLook Absorption Law
   p :<*> NegLook q ->
     trace "Neglook Absorption Law" $
-    optimizeGrammarNode (optimizeGrammarNode (p :<*> Pure Hask.unit) :<* NegLook q)
+    optimizeCombNode (optimizeCombNode (p :<*> Pure Hask.unit) :<* NegLook q)
   -- NegLook Idempotence Right Law
   NegLook (_ :<$> p) ->
     trace "NegLook Idempotence Law" $
-    optimizeGrammarNode (NegLook p)
+    optimizeCombNode (NegLook p)
   -- Try Interchange Law
   Try (f :<$> p) ->
     trace "Try Interchange Law" $
-    optimizeGrammarNode (f :<$> optimizeGrammarNode (Try p))
+    optimizeCombNode (f :<$> optimizeCombNode (Try p))
 
   -- Branch Absorption Law
   Branch Empty _ _ ->
@@ -297,26 +310,26 @@ optimizeGrammarNode = \case
   -- Branch Weakening Law
   Branch b Empty Empty ->
     trace "Branch Weakening Law" $
-    optimizeGrammarNode (b :*> Empty)
+    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 -> optimizeGrammarNode (l :<*> Pure (Hask.Haskell (ValueCode (Value v) c)))
+     Left v -> optimizeCombNode (l :<*> Pure (Hask.Haskell (ValueCode (Value v) c)))
       where c = Code [|| case $$(getCode lr) of Left x -> x ||]
-     Right v -> optimizeGrammarNode (r :<*> Pure (Hask.Haskell (ValueCode (Value v) c)))
+     Right v -> optimizeCombNode (r :<*> Pure (Hask.Haskell (ValueCode (Value v) c)))
       where c = Code [|| case $$(getCode lr) of Right x -> x ||]
   -- Branch Generalised Identity Law
   Branch b (Pure (trans -> l)) (Pure (trans -> r)) ->
     trace "Branch Generalised Identity Law" $
-    optimizeGrammarNode (Hask.Haskell (ValueCode v c) :<$> b)
+    optimizeCombNode (Hask.Haskell (ValueCode v c) :<$> b)
     where
     v = Value (either (getValue l) (getValue r))
     c = Code [|| either $$(getCode l) $$(getCode r) ||]
   -- Branch Interchange Law
   Branch (x :*> y) p q ->
     trace "Branch Interchange Law" $
-    optimizeGrammarNode (x :*> optimizeGrammarNode (Branch y p q))
+    optimizeCombNode (x :*> optimizeCombNode (Branch y p q))
   -- Branch Empty Right Law
   Branch b l Empty ->
     trace " Branch Empty Right Law" $
@@ -327,7 +340,7 @@ optimizeGrammarNode = \case
   -- Branch Fusion Law
   Branch (Branch b Empty (Pure (trans -> lr))) Empty br ->
     trace "Branch Fusion Law" $
-    optimizeGrammarNode (Branch (optimizeGrammarNode (Pure (Hask.Haskell (ValueCode (Value v) c)) :<*> b)) Empty br)
+    optimizeCombNode (Branch (optimizeCombNode (Pure (Hask.Haskell (ValueCode (Value v) c)) :<*> b)) Empty br)
     where
     v Left{} = Left ()
     v (Right r) = case getValue lr r of
@@ -340,7 +353,7 @@ optimizeGrammarNode = \case
   -- Branch Distributivity Law
   f :<$> Branch b l r ->
     trace "Branch Distributivity Law" $
-    optimizeGrammarNode (Branch b (optimizeGrammarNode ((Hask..@) (Hask..) f :<$> l)) (optimizeGrammarNode ((Hask..@) (Hask..) f :<$> r)))
+    optimizeCombNode (Branch b (optimizeCombNode ((Hask..@) (Hask..) f :<$> l)) (optimizeCombNode ((Hask..@) (Hask..) f :<$> r)))
 
   -- Match Absorption Law
   Match _ _ Empty d ->
@@ -350,7 +363,7 @@ optimizeGrammarNode = \case
   Match _ bs a Empty
     | all (\case {Empty -> True; _ -> False}) bs ->
       trace "Match Weakening Law" $
-      optimizeGrammarNode (a :*> Empty)
+      optimizeCombNode (a :*> Empty)
   -- Match Pure Law
   Match ps bs (Pure (trans -> a)) d ->
     trace "Match Pure Law" $
@@ -358,7 +371,7 @@ optimizeGrammarNode = \case
   -- Match Distributivity Law
   f :<$> Match ps bs a d ->
     trace "Match Distributivity Law" $
-    Match ps (optimizeGrammarNode . (f :<$>) Functor.<$> bs) a (optimizeGrammarNode (f :<$> d))
+    Match ps (optimizeCombNode . (f :<$>) Functor.<$> bs) a (optimizeCombNode (f :<$> d))
 
   {- Possibly useless laws to be tested
   Empty  :*> _ -> Empty
@@ -377,34 +390,34 @@ optimizeGrammarNode = \case
   -- by the Composition Law and Homomorphism Law)
   f :<$> (g :<$> p) ->
     trace "EXTRALAW: Functor Composition Law" $
-    optimizeGrammarNode ((Hask.:.) Hask.:@ f Hask.:@ g :<$> p)
+    optimizeCombNode ((Hask.:.) Hask.:@ f Hask.:@ g :<$> p)
   -- Applicable Failure Weakening Law
   u :<*  Empty ->
     trace "EXTRALAW: App Failure Weakening Law" $
-    optimizeGrammarNode (u :*> Empty)
+    optimizeCombNode (u :*> Empty)
   Try (p :$> x) ->
     trace "EXTRALAW: Try Interchange Right Law" $
-    optimizeGrammarNode (optimizeGrammarNode (Try p) :$> x)
+    optimizeCombNode (optimizeCombNode (Try p) :$> x)
   -- App Reassociation Law 1
   (u :*> v) :<*> w ->
     trace "EXTRALAW: App Reassociation Law 1" $
-    optimizeGrammarNode (u :*> optimizeGrammarNode (v :<*> w))
+    optimizeCombNode (u :*> optimizeCombNode (v :<*> w))
   -- App Reassociation Law 2
   u :<*> (v :<* w) ->
     trace "EXTRALAW: App Reassociation Law 2" $
-    optimizeGrammarNode (optimizeGrammarNode (u :<*> v) :<* w)
+    optimizeCombNode (optimizeCombNode (u :<*> v) :<* w)
   -- App Right Associativity Law
   u :*> (v :*> w) ->
     trace "EXTRALAW: App Right Associativity Law" $
-    optimizeGrammarNode (optimizeGrammarNode (u :*> v) :*> w)
+    optimizeCombNode (optimizeCombNode (u :*> v) :*> w)
   -- App Reassociation Law 3
   u :<*> (v :$> x) ->
     trace "EXTRALAW: App Reassociation Law 3" $
-    optimizeGrammarNode (optimizeGrammarNode (u :<*> Pure x) :<* v)
+    optimizeCombNode (optimizeCombNode (u :<*> Pure x) :<* v)
 
   Look (p :$> x) ->
-    optimizeGrammarNode (optimizeGrammarNode (Look p) :$> x)
-  NegLook (p :$> _) -> optimizeGrammarNode (NegLook p)
+    optimizeCombNode (optimizeCombNode (Look p) :$> x)
+  NegLook (p :$> _) -> optimizeCombNode (NegLook p)
   -}
 
   x -> x
diff --git a/src/Symantic/Parser/Grammar/Write.hs b/src/Symantic/Parser/Grammar/Write.hs
index 3b66105..f52fcd3 100644
--- a/src/Symantic/Parser/Grammar/Write.hs
+++ b/src/Symantic/Parser/Grammar/Write.hs
@@ -17,62 +17,62 @@ import Symantic.Base.Fixity
 import Symantic.Univariant.Letable
 import Symantic.Parser.Grammar.Combinators
 
--- * Type 'WriteGrammar'
-newtype WriteGrammar a = WriteGrammar { unWriteGrammar :: WriteGrammarInh -> Maybe TLB.Builder }
+-- * Type 'WriteComb'
+newtype WriteComb a = WriteComb { unWriteComb :: WriteCombInh -> Maybe TLB.Builder }
 
-instance IsString (WriteGrammar a) where
-  fromString s = WriteGrammar $ \_inh ->
+instance IsString (WriteComb a) where
+  fromString s = WriteComb $ \_inh ->
     if List.null s then Nothing
     else Just (fromString s)
 
--- ** Type 'WriteGrammarInh'
-data WriteGrammarInh
- =   WriteGrammarInh
- {   writeGrammarInh_indent :: TLB.Builder
- ,   writeGrammarInh_op :: (Infix, Side)
- ,   writeGrammarInh_pair :: Pair
+-- ** Type 'WriteCombInh'
+data WriteCombInh
+ =   WriteCombInh
+ {   writeCombInh_indent :: TLB.Builder
+ ,   writeCombInh_op :: (Infix, Side)
+ ,   writeCombInh_pair :: Pair
  }
 
-emptyWriteGrammarInh :: WriteGrammarInh
-emptyWriteGrammarInh = WriteGrammarInh
- { writeGrammarInh_indent = "\n"
- , writeGrammarInh_op = (infixN0, SideL)
- , writeGrammarInh_pair = pairParen
+emptyWriteCombInh :: WriteCombInh
+emptyWriteCombInh = WriteCombInh
+ { writeCombInh_indent = "\n"
+ , writeCombInh_op = (infixN0, SideL)
+ , writeCombInh_pair = pairParen
  }
 
-writeGrammar :: WriteGrammar a -> TL.Text
-writeGrammar (WriteGrammar r) = TLB.toLazyText $ fromMaybe "" $ r emptyWriteGrammarInh
+writeComb :: WriteComb a -> TL.Text
+writeComb (WriteComb r) = TLB.toLazyText $ fromMaybe "" $ r emptyWriteCombInh
 
-pairWriteGrammarInh ::
+pairWriteCombInh ::
  Semigroup s => IsString s =>
- WriteGrammarInh -> Infix -> Maybe s -> Maybe s
-pairWriteGrammarInh inh op s =
-  if isPairNeeded (writeGrammarInh_op inh) op
+ WriteCombInh -> Infix -> Maybe s -> Maybe s
+pairWriteCombInh inh op s =
+  if isPairNeeded (writeCombInh_op inh) op
   then Just (fromString o<>" ")<>s<>Just (" "<>fromString c)
   else s
-  where (o,c) = writeGrammarInh_pair inh
+  where (o,c) = writeCombInh_pair inh
 
-instance Show letName => Letable letName WriteGrammar where
-  def name x = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
+instance Show letName => Letable letName WriteComb where
+  def name x = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
       Just "def "
       <> Just (fromString (show name))
-      <> unWriteGrammar x inh
+      <> unWriteComb x inh
     where
     op = infixN 9
-  ref rec name = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
+  ref rec name = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
       Just (if rec then "rec " else "ref ") <>
       Just (fromString (show name))
     where
     op = infixN 9
-instance Applicable WriteGrammar where
-  pure _ = WriteGrammar $ return Nothing
+instance Applicable WriteComb where
+  pure _ = WriteComb $ return Nothing
   -- pure _ = "pure"
-  WriteGrammar x <*> WriteGrammar y = WriteGrammar $ \inh ->
+  WriteComb x <*> WriteComb y = WriteComb $ \inh ->
     let inh' side = inh
-         { writeGrammarInh_op = (op, side)
-         , writeGrammarInh_pair = pairParen
+         { writeCombInh_op = (op, side)
+         , writeCombInh_pair = pairParen
          } in
     case x (inh' SideL) of
      Nothing -> y (inh' SideR)
@@ -80,72 +80,72 @@ instance Applicable WriteGrammar where
       case y (inh' SideR) of
        Nothing -> Just xt
        Just yt ->
-        pairWriteGrammarInh inh op $
+        pairWriteCombInh inh op $
           Just $ xt <> ", " <> yt
     where
     op = infixN 1
-instance Alternable WriteGrammar where
+instance Alternable WriteComb where
   empty = "empty"
-  try x = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
-      Just "try " <> unWriteGrammar x inh
+  try x = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
+      Just "try " <> unWriteComb x inh
     where
     op = infixN 9
-  x <|> y = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
-    unWriteGrammar x inh
-     { writeGrammarInh_op = (op, SideL)
-     , writeGrammarInh_pair = pairParen
+  x <|> y = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
+    unWriteComb x inh
+     { writeCombInh_op = (op, SideL)
+     , writeCombInh_pair = pairParen
      } <>
     Just " | " <>
-    unWriteGrammar y inh
-     { writeGrammarInh_op = (op, SideR)
-     , writeGrammarInh_pair = pairParen
+    unWriteComb y inh
+     { writeCombInh_op = (op, SideR)
+     , writeCombInh_pair = pairParen
      }
     where op = infixB SideL 3
-instance Charable WriteGrammar where
+instance Charable WriteComb where
   satisfy _f = "sat"
-instance Selectable WriteGrammar where
-  branch lr l r = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
+instance Selectable WriteComb where
+  branch lr l r = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
       Just "branch " <>
-      unWriteGrammar lr inh <> Just " " <>
-      unWriteGrammar l inh <> Just " " <>
-      unWriteGrammar r inh
+      unWriteComb lr inh <> Just " " <>
+      unWriteComb l inh <> Just " " <>
+      unWriteComb r inh
     where
     op = infixN 9
-instance Matchable WriteGrammar where
-  conditional _ps bs a d = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
+instance Matchable WriteComb where
+  conditional _ps bs a d = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
       Just "conditional " <>
       Just "[" <>
       Just (mconcat (List.intersperse ", " $
       catMaybes $ (Pre.<$> bs) $ \x ->
-        unWriteGrammar x inh{writeGrammarInh_op=(infixN 0, SideL)})) <>
+        unWriteComb x inh{writeCombInh_op=(infixN 0, SideL)})) <>
       Just "] " <>
-      unWriteGrammar a inh <> Just " " <>
-      unWriteGrammar d inh
+      unWriteComb a inh <> Just " " <>
+      unWriteComb d inh
     where
     op = infixN 9
-instance Lookable WriteGrammar where
-  look x = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
-      Just "look " <> unWriteGrammar x inh
+instance Lookable WriteComb where
+  look x = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
+      Just "look " <> unWriteComb x inh
     where op = infixN 9
-  negLook x = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
-      Just "negLook " <> unWriteGrammar x inh
+  negLook x = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
+      Just "negLook " <> unWriteComb x inh
     where op = infixN 9
-instance Foldable WriteGrammar where
-  chainPre f x = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
+instance Foldable WriteComb where
+  chainPre f x = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
       Just "chainPre " <>
-      unWriteGrammar f inh <> Just " " <>
-      unWriteGrammar x inh
+      unWriteComb f inh <> Just " " <>
+      unWriteComb x inh
     where op = infixN 9
-  chainPost f x = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
+  chainPost f x = WriteComb $ \inh ->
+    pairWriteCombInh inh op $
       Just "chainPost " <>
-      unWriteGrammar f inh <> Just " " <>
-      unWriteGrammar x inh
+      unWriteComb f inh <> Just " " <>
+      unWriteComb x inh
     where op = infixN 9
diff --git a/src/Symantic/Univariant/Trans.hs b/src/Symantic/Univariant/Trans.hs
index 2d069b0..d7ae2a1 100644
--- a/src/Symantic/Univariant/Trans.hs
+++ b/src/Symantic/Univariant/Trans.hs
@@ -28,6 +28,12 @@ lift :: forall repr a.
 lift = trans @(Output repr)
 {-# INLINE lift #-}
 
+unlift :: forall repr a.
+  Trans repr (Output repr) =>
+  repr a -> Output repr a
+unlift = trans @repr
+{-# INLINE unlift #-}
+
 -- ** Class 'Unliftable'
 -- | Convenient type class synonym for using 'Output'
 type Unliftable repr = Trans repr (Output repr)
diff --git a/symantic-parser.cabal b/symantic-parser.cabal
index 1904bf3..f0bfb9c 100644
--- a/symantic-parser.cabal
+++ b/symantic-parser.cabal
@@ -40,7 +40,6 @@ library
     LambdaCase,
     MultiParamTypeClasses,
     NoImplicitPrelude,
-    PolyKinds,
     RankNTypes,
     RecordWildCards,
     ScopedTypeVariables,
-- 
2.47.0