Merge common and core

gigaparsec.cabal

@@ -30,7 +30,7 @@ common common
 
 library
     import:           common
-    exposed-modules:          Gigaparsec, Gigaparsec.Core, Gigaparsec.Common, Gigaparsec.Syntax
+    exposed-modules:          Gigaparsec, Gigaparsec.Core, Gigaparsec.Syntax
     hs-source-dirs:           src
     build-depends:       data-reify ^>= 0.6,
 --                       recover-rtti,

src/Gigaparsec/Core.hs

@@ -7,7 +7,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DerivingVia #-}
 
-module Gigaparsec.Core ( parse, decode ) where
+module Gigaparsec.Core where
 
 import qualified Data.Set as Set
 import Data.Set (Set)
@@ -16,8 +16,42 @@ import Data.Map (Map)
 import Unsafe.Coerce ( unsafeCoerce )
 import GHC.Exts (Any)
 import Data.Maybe (fromMaybe)
-
-import Gigaparsec.Common
+import Data.Kind
+import Control.Applicative
+import Data.Functor.Compose
+
+data ActionF a f = AscendF a | MatchF Char (ActionF (() -> a) f) | forall b. DescendF f (ActionF (b -> a) f)
+instance Show f => Show (ActionF a f) where
+    show AscendF{} = "AscendF"
+    show (MatchF c xs) = "(MatchF "  ++ show c ++ " " ++ show xs ++ ")"
+    show (DescendF x xs) = "(DescendF " ++ show x ++ " " ++ show xs ++ ")"
+data ListF a f = Nil | Cons (a f) (ListF a f) deriving Show
+
+data Action m a where
+    Match :: Char -> Action m ()
+    Descend :: m a -> Action m a 
+
+-- Free alternative, see https://hackage.haskell.org/package/free-5.2/docs/Control-Alternative-Free.html
+-- But this one is higher-order.
+
+type Alt :: (Type -> Type) -> ((Type -> Type) -> Type -> Type) -> Type -> Type
+newtype Alt m f a = Alt [AltF m f a]
+    deriving (Functor, Applicative, Alternative) via Compose [] (AltF m f)
+type AltF :: (Type -> Type) -> ((Type -> Type) -> Type -> Type) -> Type -> Type
+data AltF m f a = Pure a | forall b. Ap (f m b) (AltF m f (b -> a))
+deriving instance Functor (AltF m f)
+instance Applicative (AltF m f) where
+    pure = Pure
+    Pure f <*> q = fmap f q
+    Ap x p <*> q = Ap x (flip <$> p <*> q)
+
+type Name :: Type -> Type -> Type
+newtype Name n a = Name n deriving Show
+
+newtype G n = G (Map n [AltF (Name n) Action Any])
+
+lookupG :: forall n a. Ord n => G n -> Name n a -> [AltF (Name n) Action a]
+lookupG (G m) (Name n) = unsafeCoerce (m Map.! n)
 
 compareName :: Ord n => Name n a -> Name n b -> Ordering
 compareName (Name x) (Name y) = compare x y

src/Gigaparsec/Syntax.hs

@@ -4,7 +4,8 @@
 
 module Gigaparsec.Syntax where
 
-import Gigaparsec.Common
+import Gigaparsec.Core
+
 import GHC.Exts (Any)
 import Control.Applicative
 import Data.Reify