parsers: commit missing file

[haskell/symantic-parser.git] / src / Symantic / Parser / Grammar / Optimize.hs

diff --git a/src/Symantic/Parser/Grammar/Optimize.hs b/src/Symantic/Parser/Grammar/Optimize.hs
index c5e3d42a0ac9e1c13852ac5e5848b1b4d5318cb4..3d5c19184a2e5f847807d3b3f3ab32035222228d 100644 (file)
--- a/src/Symantic/Parser/Grammar/Optimize.hs
+++ b/src/Symantic/Parser/Grammar/Optimize.hs
@@ -14,18 +14,18 @@ import Data.Kind (Constraint)
 import Data.Maybe (Maybe(..))
 import Data.Set (Set)
 import Data.Functor.Identity (Identity(..))
+import Data.Functor.Product (Product(..))
 import Type.Reflection (Typeable, typeRep, eqTypeRep, (:~~:)(..))
 import qualified Data.Foldable as Foldable
 import qualified Data.Functor as Functor
 import qualified Data.List as List
 
-import Symantic.Parser.Grammar.Combinators hiding (code)
-import qualified Symantic.Parser.Grammar.Production as Prod
+import Symantic.Parser.Grammar.Combinators
 import Symantic.Parser.Grammar.Production
-import Symantic.Univariant.Letable
-import Symantic.Univariant.Trans
-import qualified Symantic.Univariant.Lang as H
-import qualified Symantic.Univariant.Data as H
+import Symantic.Typed.Letable
+import Symantic.Typed.Trans
+import qualified Symantic.Typed.Data as Prod
+import qualified Symantic.Typed.Lang as Prod
 
 {-
 import Data.Function (($), flip)
@@ -158,8 +158,8 @@ instance
   pure = SomeComb . Pure
   f <$> Comb (Branch b l r) =
     branch b
-      ((H..) H..@ f <$> l)
-      ((H..) H..@ f <$> r)
+      ((Prod..) Prod..@ f <$> l)
+      ((Prod..) Prod..@ f <$> r)
     -- & trace "Branch Distributivity Law"
   f <$> Comb (Conditional a ps bs d) =
     conditional a ps
@@ -178,19 +178,19 @@ instance
     -- & 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)
+  Comb (Pure f) <*> Comb (Pure x) = pure (f Prod..@ x)
     -- & trace "Homomorphism Law"
   {-
   Comb (Pure f) <*> Comb (g :<$>: p) =
     -- This is basically a shortcut,
     -- it can be caught by one Composition Law
     -- and two Homomorphism Law.
-    (H..) H..@ f H..@ g <$> p
+    (Prod..) Prod..@ f Prod..@ g <$> p
     -- & trace "Functor Composition Law"
   -}
-  u <*> Comb (Pure x) = H.flip H..@ (H.$) H..@ x <$> u
+  u <*> Comb (Pure x) = Prod.flip Prod..@ (Prod.$) Prod..@ x <$> u
     -- & trace "Interchange Law"
-  u <*> Comb (v :<*>: w) = (((H..) <$> u) <*> v) <*> w
+  u <*> Comb (v :<*>: w) = (((Prod..) <$> u) <*> v) <*> w
     -- & trace "Composition Law"
   Comb (u :*>: v) <*> w = u *> (v <*> w)
     -- & trace "Reassociation Law 1"
@@ -199,7 +199,7 @@ instance
   u <*> Comb (v :$>: x) = (u <*> pure x) <* v
     -- & trace "Reassociation Law 3"
   p <*> Comb (NegLook q) =
-    (p <*> pure H.unit) <* negLook q
+    (p <*> pure Prod.unit) <* negLook q
     -- & trace "Absorption Law"
   x <*> y = SomeComb (x :<*>: y)
 
@@ -304,9 +304,9 @@ instance
 
   negLook (Comb Pure{}) = empty
     -- & trace "Pure Negative-Look"
-  negLook (Comb Empty) = pure H.unit
+  negLook (Comb Empty) = pure Prod.unit
     -- & trace "Dead Negative-Look"
-  negLook (Comb (NegLook x)) = look (try x *> pure H.unit)
+  negLook (Comb (NegLook x)) = look (try x *> pure Prod.unit)
     -- & trace "Double Negation Law"
   negLook (Comb (Try x)) = negLook x
     -- & trace "Zero Consumption Law"
@@ -352,7 +352,7 @@ instance
       -- & trace "Conditional Weakening Law"
   conditional (Comb (Pure a)) ps bs d =
     Foldable.foldr (\(p, b) next ->
-      if runValue (p H..@ a) then b else next
+      if runValue (p Prod..@ a) then b else next
     ) d (List.zip ps bs)
     -- & trace "Conditional Pure Law"
   conditional a ps bs d = SomeComb (Conditional a ps bs d)
@@ -404,42 +404,42 @@ instance
     -- & trace "Branch Weakening Law"
   branch (Comb (Pure lr)) l r =
     case runValue lr of
-      Left value -> l <*> pure Production{..}
+      Left value -> l <*> pure (Pair v c)
         where
-        prodValue = H.SomeData $ H.Var $ Identity value
-        prodCode = H.SomeData $ H.Var
+        v = Prod.SomeData $ Prod.Var $ Identity value
+        c = Prod.SomeData $ Prod.Var
           [|| case $$(runCode lr) of Left x -> x ||]
-      Right value -> r <*> pure Production{..}
+      Right value -> r <*> pure (Pair v c)
         where
-        prodValue = H.SomeData $ H.Var $ Identity value
-        prodCode = H.SomeData $ H.Var
+        v = Prod.SomeData $ Prod.Var $ Identity value
+        c = Prod.SomeData $ Prod.Var
           [|| case $$(runCode lr) of Right x -> x ||]
     -- & trace "Branch Pure Either Law"
   branch b (Comb (Pure l)) (Comb (Pure r)) =
-    Production{..} <$> b
+    Pair v c <$> b
     -- & trace "Branch Generalised Identity Law"
     where
-    prodValue = H.SomeData $ H.Var $ Identity $ either (runValue l) (runValue r)
-    prodCode = H.SomeData $ H.Var [|| either $$(runCode l) $$(runCode r) ||]
+    v = Prod.SomeData $ Prod.Var $ Identity $ either (runValue l) (runValue r)
+    c = Prod.SomeData $ Prod.Var [|| either $$(runCode l) $$(runCode r) ||]
   branch (Comb (x :*>: y)) p q = x *> branch y p q
     -- & trace "Interchange Law"
   branch b l (Comb Empty) =
-    branch (pure Production{..} <*> b) empty l
+    branch (pure (Pair v c) <*> b) empty l
     -- & trace "Negated Branch Law"
     where
-    prodValue = H.SomeData $ H.Var $ Identity $ either Right Left
-    prodCode = H.SomeData $ H.Var $ [||either Right Left||]
+    v = Prod.SomeData $ Prod.Var $ Identity $ either Right Left
+    c = Prod.SomeData $ Prod.Var $ [||either Right Left||]
   branch (Comb (Branch b (Comb Empty) (Comb (Pure lr)))) (Comb Empty) br =
-    branch (pure Production{..} <*> b) empty br
+    branch (pure (Pair v c) <*> b) empty br
     -- & trace "Branch Fusion Law"
     where
-    prodValue = H.SomeData $ H.Var $ Identity $ \case
+    v = Prod.SomeData $ Prod.Var $ Identity $ \case
       Left{} -> Left ()
       Right r ->
         case runValue lr r of
           Left{} -> Left ()
           Right rr -> Right rr
-    prodCode = H.SomeData $ H.Var
+    c = Prod.SomeData $ Prod.Var
       [|| \case Left{} -> Left ()
                 Right r -> case $$(runCode lr) r of
                              Left{} -> Left ()