doc: fix old names
[haskell/symantic-parser.git] / src / Symantic / Parser / Grammar.hs
index 4f14b477013dfc7ab0effb87d28a6ed2912b0a7a..caf0c1e05f25519bce4735ced680e1853390f939 100644 (file)
@@ -1,44 +1,66 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE AllowAmbiguousTypes #-} -- For grammar
+{-# LANGUAGE ConstraintKinds #-} -- For Grammarable
 module Symantic.Parser.Grammar
- ( module Symantic.Parser.Grammar
- , module Symantic.Parser.Grammar.Combinators
- , module Symantic.Parser.Grammar.Optimize
- , module Symantic.Parser.Grammar.ObserveSharing
- , module Symantic.Parser.Grammar.Write
- , module Symantic.Parser.Grammar.Dump
- ) where
+  ( module Symantic.Parser.Grammar
+  , module Symantic.Parser.Grammar.Combinators
+  , module Symantic.Parser.Grammar.Optimize
+  , module Symantic.Parser.Grammar.ObserveSharing
+  , module Symantic.Parser.Grammar.Production
+  , module Symantic.Parser.Grammar.Write
+  , module Symantic.Parser.Grammar.View
+  , Referenceable(..)
+  , Letsable(..)
+  ) where
 import Symantic.Parser.Grammar.Combinators
-import Symantic.Parser.Grammar.Optimize
 import Symantic.Parser.Grammar.ObserveSharing
+import Symantic.Parser.Grammar.Optimize
+import Symantic.Parser.Grammar.Production
+import Symantic.Parser.Grammar.View
 import Symantic.Parser.Grammar.Write
-import Symantic.Parser.Grammar.Dump
-import Symantic.Univariant.Letable (Letable)
 
+import Control.DeepSeq (NFData)
+import Data.Eq (Eq)
+import Data.Ord (Ord)
 import Data.Function ((.))
 import Data.String (String)
-import System.IO (IO)
+import Data.Typeable (Typeable)
 import Text.Show (Show(..))
-import qualified Data.Functor as Functor
+import Language.Haskell.TH.HideName
 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
+-- * Type 'Grammar'
+type Grammar repr = ObserveSharing TH.Name (OptimizeGrammar repr)
+
+-- ** Class 'Grammarable'
+type Grammarable tok repr =
+  ( CombAlternable repr
+  , CombApplicable repr
+  , CombFoldable repr
+  , Referenceable TH.Name repr
+  , Letsable TH.Name repr
+  , CombLookable repr
+  , CombMatchable repr
+  , CombSatisfiable tok repr
+  , CombSelectable repr
+  --, CombRegisterable repr
+  , CombRegisterableUnscoped repr
+  , Eq tok
+  , Ord tok
+  , TH.Lift tok
+  , NFData tok
+  , Show tok
+  , Typeable tok
   )
 
--- | 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 interpret 'Comb'inators:
+-- 'observeSharing' then 'optimizeGrammar' then a polymorphic @(repr)@.
+grammar :: Grammarable tok repr => Grammar repr a -> repr a
+grammar = optimizeGrammar . 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
+-- | An usual pipeline to show 'Comb'inators:
+-- 'observeSharing' then 'optimizeGrammar' then 'viewGrammar' then 'show'.
+showGrammar :: forall showName a tok.
+  HideableName showName =>
+  Grammarable tok (Grammar (ViewGrammar showName)) =>
+  Grammar (ViewGrammar showName) a -> String
+showGrammar = show . viewGrammar . grammar @tok