rename {hut => code}.sourcephile.fr

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

diff --git a/src/Symantic/Parser/Grammar/Production.hs b/src/Symantic/Parser/Grammar/Production.hs
index 57a3cd3659cf9903a4a2b6c1577bb61fbe20b9d1..a0239aab1832eb53621cf710cdda9463b40d7dc7 100644 (file)
--- a/src/Symantic/Parser/Grammar/Production.hs
+++ b/src/Symantic/Parser/Grammar/Production.hs
@@ -21,10 +21,9 @@ import qualified Language.Haskell.TH as TH
 import qualified Language.Haskell.TH.Syntax as TH
 import qualified Language.Haskell.TH.Show as TH
 
-import Symantic.Typed.Data
-import Symantic.Typed.Lang
-import Symantic.Typed.Optim
-import Symantic.Typed.Trans
+import Symantic.Data
+import Symantic.Lang
+import Symantic.Derive
 
 type Production = Product
   (SomeData Identity)
@@ -49,10 +48,10 @@ prod x = production x [||x||]
 
 {-# INLINE runValue #-}
 runValue :: Production a -> a
-runValue x = runIdentity (trans x)
+runValue (Pair v _c) = runIdentity (derive v)
 {-# INLINE runCode #-}
 runCode :: Production a -> TH.CodeQ a
-runCode = trans
+runCode (Pair _v c) = derive c
 
 -- Missing instances in 'Language.Haskell.TH',
 -- needed for 'prodCon'.
@@ -72,16 +71,11 @@ prodCon name = do
       [| production $(return (TH.ConE n))
            (TH.unsafeCodeCoerce (return (TH.ConE $(TH.lift n)))) |]
 
-instance Trans Production Identity where
-  trans (Pair (SomeData v) _c) = trans v
-instance Trans Production TH.CodeQ where
-  trans (Pair _v (SomeData c)) = trans c
-
 instance Show (SomeData TH.CodeQ a) where
-  -- The 'Trans' constraint contained in 'SomeData'
-  -- is 'TH.CodeQ', hence 'Symantic.Typed.View' cannot be used here.
+  -- The 'Derivable' constraint contained in 'SomeData'
+  -- is 'TH.CodeQ', hence 'Symantic.View' cannot be used here.
   -- Fortunately 'TH.showCode' can be implemented.
-  showsPrec p = showString Fun.. TH.showCode p Fun.. trans
+  showsPrec p = showString Fun.. TH.showCode p Fun.. derive
 
 instance (Abstractable f, Abstractable g) => Abstractable (Product f g) where
   -- Those 'undefined' are not unreachables by 'f'
@@ -123,9 +117,6 @@ instance Listable Production where
 instance Equalable Production where
   equal = Pair equal equal
 
-optimizeProduction :: Production a -> Production a
-optimizeProduction (Pair v c) = Pair (normalOrderReduction v) (normalOrderReduction c)
-
 -- Identity
 instance Anythingable Identity
 instance Abstractable Identity where