-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Parser combinators statically optimized and staged via typed meta-programming -- -- This is a work-in-progress experimental library to generate parsers, -- leveraging Tagless-Final interpreters and Typed Template Haskell -- staging. -- -- This is an alternative but less powerful/reviewed implementation of -- ParsleyHaskell. See the paper by Jamie Willis, Nicolas Wu, and -- Matthew Pickering, admirably well presented at ICFP-2020: Staged -- Selective Parser Combinators. @package symantic-parser @version 0.1.0.20210201 module Symantic.Parser.Grammar.Fixity data Fixity Fixity1 :: Unifix -> Fixity Fixity2 :: Infix -> Fixity data Unifix Prefix :: Precedence -> Unifix [unifix_precedence] :: Unifix -> Precedence Postfix :: Precedence -> Unifix [unifix_precedence] :: Unifix -> Precedence data Infix Infix :: Maybe Associativity -> Precedence -> Infix [infix_associativity] :: Infix -> Maybe Associativity [infix_precedence] :: Infix -> Precedence infixL :: Precedence -> Infix infixR :: Precedence -> Infix infixB :: Side -> Precedence -> Infix infixN :: Precedence -> Infix infixN0 :: Infix infixN5 :: Infix -- | Given Precedence and Associativity of its parent -- operator, and the operand Side it is in, return whether an -- Infix operator needs to be enclosed by a Pair. isPairNeeded :: (Infix, Side) -> Infix -> Bool -- | If isPairNeeded is True, enclose the given -- IsString by given Pair, otherwise returns the same -- IsString. pairIfNeeded :: Semigroup s => IsString s => Pair -> (Infix, Side) -> Infix -> s -> s type Precedence = Int class PrecedenceOf a precedence :: PrecedenceOf a => a -> Precedence data Associativity -- | Associate to the left: a ¹ b ² c == (a ¹ b) ² c AssocL :: Associativity -- | Associate to the right: a ¹ b ² c == a ¹ (b ² c) AssocR :: Associativity -- | Associate to both sides, but to Side when reading. AssocB :: Side -> Associativity data Side -- | Left SideL :: Side -- | Right SideR :: Side type Pair = (String, String) pairAngle :: Pair pairBrace :: Pair pairBracket :: Pair pairParen :: Pair instance GHC.Show.Show Symantic.Parser.Grammar.Fixity.Unifix instance GHC.Classes.Eq Symantic.Parser.Grammar.Fixity.Unifix instance GHC.Show.Show Symantic.Parser.Grammar.Fixity.Side instance GHC.Classes.Eq Symantic.Parser.Grammar.Fixity.Side instance GHC.Show.Show Symantic.Parser.Grammar.Fixity.Associativity instance GHC.Classes.Eq Symantic.Parser.Grammar.Fixity.Associativity instance GHC.Show.Show Symantic.Parser.Grammar.Fixity.Infix instance GHC.Classes.Eq Symantic.Parser.Grammar.Fixity.Infix instance GHC.Show.Show Symantic.Parser.Grammar.Fixity.Fixity instance GHC.Classes.Eq Symantic.Parser.Grammar.Fixity.Fixity instance Symantic.Parser.Grammar.Fixity.PrecedenceOf Symantic.Parser.Grammar.Fixity.Fixity instance Symantic.Parser.Grammar.Fixity.PrecedenceOf Symantic.Parser.Grammar.Fixity.Infix instance Symantic.Parser.Grammar.Fixity.PrecedenceOf Symantic.Parser.Grammar.Fixity.Unifix module Symantic.Parser.Machine.Input class Show cur => Cursorable cur offset :: Cursorable cur => cur -> Int compareOffset :: Cursorable cur => CodeQ (cur -> cur -> Ordering) lowerOffset :: Cursorable cur => CodeQ (cur -> cur -> Bool) sameOffset :: Cursorable cur => CodeQ (cur -> cur -> Bool) shiftRight :: Cursorable cur => CodeQ (Int -> cur -> cur) shiftRightText :: Int -> Text -> Text shiftLeftText :: Int -> Text -> Text shiftRightByteString :: Int -> UnpackedLazyByteString -> UnpackedLazyByteString shiftLeftByteString :: Int -> UnpackedLazyByteString -> UnpackedLazyByteString offWith :: CodeQ (ts -> OffWith ts) newtype Text16 Text16 :: Text -> Text16 newtype CharList CharList :: String -> CharList data Stream (:>) :: {-# UNPACK #-} !Char -> Stream -> Stream nomore :: Stream data OffWith ts OffWith :: {-# UNPACK #-} !Int -> ts -> OffWith ts data OffWithStreamAnd ts OffWithStreamAnd :: {-# UNPACK #-} !Int -> !Stream -> ts -> OffWithStreamAnd ts data UnpackedLazyByteString UnpackedLazyByteString :: {-# UNPACK #-} !Int -> !Addr# -> ForeignPtrContents -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> ByteString -> UnpackedLazyByteString emptyUnpackedLazyByteString :: Int -> UnpackedLazyByteString class Cursorable (Cursor inp) => Input inp where { type family Cursor inp :: Type; type family InputToken inp :: Type; } cursorOf :: Input inp => CodeQ inp -> CodeQ (# Cursor inp, Cursor inp -> Bool, Cursor inp -> (# InputToken inp, Cursor inp #) #) instance GHC.Show.Show ts => GHC.Show.Show (Symantic.Parser.Machine.Input.OffWith ts) instance Symantic.Parser.Machine.Input.Input GHC.Base.String instance Symantic.Parser.Machine.Input.Input (Data.Array.Base.UArray GHC.Types.Int GHC.Types.Char) instance Symantic.Parser.Machine.Input.Input Data.Text.Internal.Text instance Symantic.Parser.Machine.Input.Input Data.ByteString.Internal.ByteString instance Symantic.Parser.Machine.Input.Input Data.ByteString.Lazy.Internal.ByteString instance Symantic.Parser.Machine.Input.Cursorable Symantic.Parser.Machine.Input.UnpackedLazyByteString instance GHC.Show.Show Symantic.Parser.Machine.Input.UnpackedLazyByteString instance Symantic.Parser.Machine.Input.Cursorable (Symantic.Parser.Machine.Input.OffWith GHC.Base.String) instance Symantic.Parser.Machine.Input.Cursorable GHC.Types.Int instance Symantic.Parser.Machine.Input.Cursorable Data.Text.Internal.Text module Symantic.Univariant.Trans type family Output (repr :: Type -> Type) :: Type -> Type -- | A translation from an interpreter (from) to an -- interpreter (to). class Trans from to trans :: Trans from to => from a -> to a -- | Convenient type class synonym. Note that this is not necessarily a -- bijective translation, a trans being not necessarily -- injective nor surjective. type BiTrans from to = (Trans from to, Trans to from) -- | Convenient type class synonym for using Output type Liftable repr = Trans (Output repr) repr lift :: forall repr a. Liftable repr => Output repr a -> repr a unlift :: forall repr a. Trans repr (Output repr) => repr a -> Output repr a -- | Convenient type class synonym for using Output type Unliftable repr = Trans repr (Output repr) class Trans1 from to trans1 :: Trans1 from to => (from a -> from b) -> to a -> to b trans1 :: (Trans1 from to, BiTrans from to) => (from a -> from b) -> to a -> to b -- | Convenient type class synonym for using Output type Liftable1 repr = Trans1 (Output repr) repr lift1 :: forall repr a b. Liftable1 repr => (Output repr a -> Output repr b) -> repr a -> repr b class Trans2 from to trans2 :: Trans2 from to => (from a -> from b -> from c) -> to a -> to b -> to c trans2 :: (Trans2 from to, BiTrans from to) => (from a -> from b -> from c) -> to a -> to b -> to c -- | Convenient type class synonym for using Output type Liftable2 repr = Trans2 (Output repr) repr lift2 :: forall repr a b c. Liftable2 repr => (Output repr a -> Output repr b -> Output repr c) -> repr a -> repr b -> repr c class Trans3 from to trans3 :: Trans3 from to => (from a -> from b -> from c -> from d) -> to a -> to b -> to c -> to d trans3 :: (Trans3 from to, BiTrans from to) => (from a -> from b -> from c -> from d) -> to a -> to b -> to c -> to d -- | Convenient type class synonym for using Output type Liftable3 repr = Trans3 (Output repr) repr lift3 :: forall repr a b c d. Liftable3 repr => (Output repr a -> Output repr b -> Output repr c -> Output repr d) -> repr a -> repr b -> repr c -> repr d -- | A newtype to disambiguate the Trans instance to any other -- interpreter when there is also one or more Transs to other -- interpreters with a different interpretation than the generic one. newtype Any repr a Any :: repr a -> Any repr a [unAny] :: Any repr a -> repr a instance Symantic.Univariant.Trans.Trans (Symantic.Univariant.Trans.Any repr) repr instance Symantic.Univariant.Trans.Trans1 (Symantic.Univariant.Trans.Any repr) repr instance Symantic.Univariant.Trans.Trans2 (Symantic.Univariant.Trans.Any repr) repr instance Symantic.Univariant.Trans.Trans3 (Symantic.Univariant.Trans.Any repr) repr instance Symantic.Univariant.Trans.Trans repr (Symantic.Univariant.Trans.Any repr) instance Symantic.Univariant.Trans.Trans1 repr (Symantic.Univariant.Trans.Any repr) instance Symantic.Univariant.Trans.Trans2 repr (Symantic.Univariant.Trans.Any repr) instance Symantic.Univariant.Trans.Trans3 repr (Symantic.Univariant.Trans.Any repr) module Symantic.Univariant.Letable -- | This class is not for end-users like usual symantic operators, here -- def and ref are introduced by observeSharing. class Letable letName repr -- | (def letName x) let-binds (letName) to be -- equal to (x). def :: Letable letName repr => letName -> repr a -> repr a -- | (ref isRec letName) is a reference to -- (letName). (isRec) is True iif. this -- reference is recursive, ie. is reachable within its -- definition. ref :: Letable letName repr => Bool -> letName -> repr a -- | (def letName x) let-binds (letName) to be -- equal to (x). def :: (Letable letName repr, Liftable1 repr) => Letable letName (Output repr) => letName -> repr a -> repr a -- | (ref isRec letName) is a reference to -- (letName). (isRec) is True iif. this -- reference is recursive, ie. is reachable within its -- definition. ref :: (Letable letName repr, Liftable repr) => Letable letName (Output repr) => Bool -> letName -> repr a class MakeLetName letName makeLetName :: MakeLetName letName => SharingName -> IO letName -- | Useful on golden unit tests because StableName change often -- when changing unrelated source code or even changing basic GHC or -- executable flags. class ShowLetName (showName :: Bool) letName showLetName :: ShowLetName showName letName => letName -> String -- | Note that the observable sharing enabled by StableName is not -- perfect as it will not observe all the sharing explicitely done. -- -- Note also that the observed sharing could be different between ghc and -- ghci. data SharingName SharingName :: StableName a -> SharingName -- | (makeSharingName x) is like (makeStableName -- x) but it also forces evaluation of (x) to ensure that -- the StableName is correct first time, which avoids to produce a -- tree bigger than needed. -- -- Note that this function uses unsafePerformIO instead of -- returning in IO, this is apparently required to avoid infinite -- loops due to unstable StableName in compiled code, and -- sometimes also in ghci. -- -- Note that maybe pseq should be used here. makeSharingName :: a -> SharingName -- | Interpreter detecting some (Haskell embedded) let definitions -- used at least once and/or recursively, in order to replace them with -- the def and ref combinators. See Type-safe observable -- sharing in Haskell newtype ObserveSharing letName repr a ObserveSharing :: ReaderT (HashSet SharingName) (State (ObserveSharingState letName)) (CleanDefs letName repr a) -> ObserveSharing letName repr a [unObserveSharing] :: ObserveSharing letName repr a -> ReaderT (HashSet SharingName) (State (ObserveSharingState letName)) (CleanDefs letName repr a) observeSharing :: Eq letName => Hashable letName => ObserveSharing letName repr a -> repr a data ObserveSharingState letName ObserveSharingState :: HashMap SharingName (letName, Int) -> HashSet SharingName -> ObserveSharingState letName [oss_refs] :: ObserveSharingState letName -> HashMap SharingName (letName, Int) -- | TODO: unused so far, will it be useful somewhere at a later stage? [oss_recs] :: ObserveSharingState letName -> HashSet SharingName observeSharingNode :: Eq letName => Hashable letName => Letable letName repr => MakeLetName letName => ObserveSharing letName repr a -> ObserveSharing letName repr a -- | Remove def when non-recursive or unused. newtype CleanDefs letName repr a CleanDefs :: (HashSet letName -> repr a) -> CleanDefs letName repr a [unCleanDefs] :: CleanDefs letName repr a -> HashSet letName -> repr a instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName) => Symantic.Univariant.Trans.Trans (Symantic.Univariant.Letable.CleanDefs letName repr) (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName) => Symantic.Univariant.Trans.Trans1 (Symantic.Univariant.Letable.CleanDefs letName repr) (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName) => Symantic.Univariant.Trans.Trans2 (Symantic.Univariant.Letable.CleanDefs letName repr) (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName) => Symantic.Univariant.Trans.Trans3 (Symantic.Univariant.Letable.CleanDefs letName repr) (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName) => Symantic.Univariant.Letable.Letable letName (Symantic.Univariant.Letable.ObserveSharing letName repr) instance Symantic.Univariant.Trans.Trans repr (Symantic.Univariant.Letable.CleanDefs letName repr) instance Symantic.Univariant.Trans.Trans1 repr (Symantic.Univariant.Letable.CleanDefs letName repr) instance Symantic.Univariant.Trans.Trans2 repr (Symantic.Univariant.Letable.CleanDefs letName repr) instance Symantic.Univariant.Trans.Trans3 repr (Symantic.Univariant.Letable.CleanDefs letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName) => Symantic.Univariant.Letable.Letable letName (Symantic.Univariant.Letable.CleanDefs letName repr) instance GHC.Classes.Eq Symantic.Univariant.Letable.SharingName instance Data.Hashable.Class.Hashable Symantic.Univariant.Letable.SharingName instance GHC.Show.Show letName => Symantic.Univariant.Letable.ShowLetName 'GHC.Types.True letName instance Symantic.Univariant.Letable.ShowLetName 'GHC.Types.False letName -- | Haskell terms which are interesting to pattern-match when optimizing. module Symantic.Parser.Haskell.Term -- | Single-out some Haskell terms in order to class Termable repr -- | Application, aka. unabstract. (.@) :: Termable repr => repr (a -> b) -> repr a -> repr b -- | Lambda term abstraction, in HOAS (Higher-Order Abstract Syntax) style. lam :: Termable repr => (repr a -> repr b) -> repr (a -> b) -- | Like lam but whose argument is used only once, hence safe to -- beta-reduce (inline) without duplicating work. lam1 :: Termable repr => (repr a -> repr b) -> repr (a -> b) bool :: Termable repr => Bool -> repr Bool char :: (Termable repr, Lift tok, Show tok) => tok -> repr tok cons :: Termable repr => repr (a -> [a] -> [a]) nil :: Termable repr => repr [a] eq :: (Termable repr, Eq a) => repr (a -> a -> Bool) unit :: Termable repr => repr () left :: Termable repr => repr (l -> Either l r) right :: Termable repr => repr (r -> Either l r) nothing :: Termable repr => repr (Maybe a) just :: Termable repr => repr (a -> Maybe a) const :: Termable repr => repr (a -> b -> a) flip :: Termable repr => repr ((a -> b -> c) -> b -> a -> c) id :: Termable repr => repr (a -> a) (.) :: Termable repr => repr ((b -> c) -> (a -> b) -> a -> c) ($) :: Termable repr => repr ((a -> b) -> a -> b) -- | Application, aka. unabstract. (.@) :: (Termable repr, Liftable2 repr) => Termable (Output repr) => repr (a -> b) -> repr a -> repr b -- | Lambda term abstraction, in HOAS (Higher-Order Abstract Syntax) style. lam :: (Termable repr, Liftable repr) => Unliftable repr => Termable (Output repr) => (repr a -> repr b) -> repr (a -> b) -- | Like lam but whose argument is used only once, hence safe to -- beta-reduce (inline) without duplicating work. lam1 :: (Termable repr, Liftable repr) => Unliftable repr => Termable (Output repr) => (repr a -> repr b) -> repr (a -> b) bool :: (Termable repr, Liftable repr) => Termable (Output repr) => Bool -> repr Bool char :: (Termable repr, Liftable repr) => Termable (Output repr) => Lift tok => Show tok => tok -> repr tok cons :: (Termable repr, Liftable repr) => Termable (Output repr) => repr (a -> [a] -> [a]) nil :: (Termable repr, Liftable repr) => Termable (Output repr) => repr [a] eq :: (Termable repr, Liftable repr) => Termable (Output repr) => Eq a => repr (a -> a -> Bool) unit :: (Termable repr, Liftable repr) => Termable (Output repr) => repr () left :: (Termable repr, Liftable repr) => Termable (Output repr) => repr (l -> Either l r) right :: (Termable repr, Liftable repr) => Termable (Output repr) => repr (r -> Either l r) nothing :: (Termable repr, Liftable repr) => Termable (Output repr) => repr (Maybe a) just :: (Termable repr, Liftable repr) => Termable (Output repr) => repr (a -> Maybe a) const :: (Termable repr, Liftable repr) => Termable (Output repr) => repr (a -> b -> a) flip :: (Termable repr, Liftable repr) => Termable (Output repr) => repr ((a -> b -> c) -> b -> a -> c) id :: (Termable repr, Liftable repr) => Termable (Output repr) => repr (a -> a) (.) :: (Termable repr, Liftable repr) => Termable (Output repr) => repr ((b -> c) -> (a -> b) -> a -> c) ($) :: (Termable repr, Liftable repr) => Termable (Output repr) => repr ((a -> b) -> a -> b) infixl 9 .@ infixr 9 . infixr 0 $ data ValueCode a ValueCode :: a -> CodeQ a -> ValueCode a [value] :: ValueCode a -> a [code] :: ValueCode a -> CodeQ a instance Symantic.Parser.Haskell.Term.Termable Symantic.Parser.Haskell.Term.ValueCode instance Symantic.Parser.Haskell.Term.Termable Data.Functor.Identity.Identity instance Symantic.Parser.Haskell.Term.Termable Language.Haskell.TH.Lib.Internal.CodeQ module Symantic.Parser.Haskell.Optimize -- | Initial encoding of some Termable symantics, useful for some -- optimizations in optimizeTerm. data Term repr a -- | Black-box for all terms neither interpreted nor pattern-matched. [Term] :: {unTerm :: repr a} -> Term repr a [:@] :: Term repr (a -> b) -> Term repr a -> Term repr b [Lam] :: (Term repr a -> Term repr b) -> Term repr (a -> b) [Lam1] :: (Term repr a -> Term repr b) -> Term repr (a -> b) [Var] :: String -> Term repr a [Char] :: (Lift tok, Show tok) => tok -> Term repr tok [Cons] :: Term repr (a -> [a] -> [a]) [Eq] :: Eq a => Term repr (a -> a -> Bool) infixl 9 :@ -- | Beta-reduce the left-most outer-most lambda abstraction (aka. -- normal-order reduction), but to avoid duplication of work, only those -- manually marked as using their variable at most once. This is mainly -- to get prettier splices. -- -- DOC: Demonstrating Lambda Calculus Reduction, Peter Sestoft, 2001, -- https://www.itu.dk/people/sestoft/papers/sestoft-lamreduce.pdf optimizeTerm :: Term repr a -> Term repr a instance Symantic.Univariant.Trans.Trans repr (Symantic.Parser.Haskell.Optimize.Term repr) instance Symantic.Parser.Haskell.Term.Termable repr => Symantic.Parser.Haskell.Term.Termable (Symantic.Parser.Haskell.Optimize.Term repr) instance Symantic.Univariant.Trans.Trans (Symantic.Parser.Haskell.Optimize.Term Data.Functor.Identity.Identity) Data.Functor.Identity.Identity instance Symantic.Univariant.Trans.Trans (Symantic.Parser.Haskell.Optimize.Term Language.Haskell.TH.Lib.Internal.CodeQ) Language.Haskell.TH.Lib.Internal.CodeQ instance Symantic.Univariant.Trans.Trans (Symantic.Parser.Haskell.Optimize.Term Symantic.Parser.Haskell.Term.ValueCode) Symantic.Parser.Haskell.Term.ValueCode instance Symantic.Univariant.Trans.Trans (Symantic.Parser.Haskell.Optimize.Term Symantic.Parser.Haskell.Term.ValueCode) (Symantic.Parser.Haskell.Optimize.Term Language.Haskell.TH.Lib.Internal.CodeQ) instance Symantic.Univariant.Trans.Trans (Symantic.Parser.Haskell.Optimize.Term Language.Haskell.TH.Lib.Internal.CodeQ) (Symantic.Parser.Haskell.Optimize.Term Symantic.Parser.Haskell.Term.ValueCode) module Symantic.Parser.Haskell.View newtype ViewTerm a ViewTerm :: (ViewTermInh -> ShowS) -> ViewTerm a [unViewTerm] :: ViewTerm a -> ViewTermInh -> ShowS data ViewTermInh ViewTermInh :: (Infix, Side) -> Pair -> Int -> ViewTermInh [viewTermInh_op] :: ViewTermInh -> (Infix, Side) [viewTermInh_pair] :: ViewTermInh -> Pair [viewTermInh_lamDepth] :: ViewTermInh -> Int pairViewTerm :: ViewTermInh -> Infix -> ShowS -> ShowS instance Data.String.IsString (Symantic.Parser.Haskell.View.ViewTerm a) instance GHC.Show.Show (Symantic.Parser.Haskell.View.ViewTerm a) instance GHC.Show.Show (Symantic.Parser.Haskell.Optimize.Term repr a) module Symantic.Parser.Haskell -- | Semantic of the grammar combinators used to express parsers, in the -- convenient tagless-final encoding. module Symantic.Parser.Grammar.Combinators type TermGrammar = Term ValueCode -- | This is like the usual Functor and Applicative type -- classes from the base package, but using -- (TermGrammar a) instead of just (a) to be -- able to use and pattern match on some usual terms of type (a) -- (like id) and thus apply some optimizations. (repr), -- for "representation", is the usual tagless-final abstraction over the -- many semantics that this syntax (formed by the methods of type class -- like this one) will be interpreted. class Applicable repr -- | (a2b <$> ra) parses like (ra) but maps -- its returned value with (a2b). (<$>) :: Applicable repr => TermGrammar (a -> b) -> repr a -> repr b -- | Like <$> but with its arguments flip-ped. (<&>) :: Applicable repr => repr a -> TermGrammar (a -> b) -> repr b -- | (a <$ rb) parses like (rb) but discards -- its returned value by replacing it with (a). (<$) :: Applicable repr => TermGrammar a -> repr b -> repr a -- | (ra $> b) parses like (ra) but discards -- its returned value by replacing it with (b). ($>) :: Applicable repr => repr a -> TermGrammar b -> repr b -- | (pure a) parses the empty string, always succeeding in -- returning (a). pure :: Applicable repr => TermGrammar a -> repr a -- | (pure a) parses the empty string, always succeeding in -- returning (a). pure :: (Applicable repr, Liftable repr) => Applicable (Output repr) => TermGrammar a -> repr a -- | (ra2b <*> ra) parses sequentially -- (ra2b) and then (ra), and returns the application of -- the function returned by (ra2b) to the value returned by -- (ra). (<*>) :: Applicable repr => repr (a -> b) -> repr a -> repr b -- | (ra2b <*> ra) parses sequentially -- (ra2b) and then (ra), and returns the application of -- the function returned by (ra2b) to the value returned by -- (ra). (<*>) :: (Applicable repr, Liftable2 repr) => Applicable (Output repr) => repr (a -> b) -> repr a -> repr b -- | (liftA2 a2b2c ra rb) parses sequentially (ra) -- and then (rb), and returns the application of -- (a2b2c) to the values returned by those parsers. liftA2 :: Applicable repr => TermGrammar (a -> b -> c) -> repr a -> repr b -> repr c -- | (ra <* rb) parses sequentially (ra) and -- then (rb), and returns like (ra), discarding the -- return value of (rb). (<*) :: Applicable repr => repr a -> repr b -> repr a -- | (ra *> rb) parses sequentially (ra) and -- then (rb), and returns like (rb), discarding the -- return value of (ra). (*>) :: Applicable repr => repr a -> repr b -> repr b -- | Like <*> but with its arguments flip-ped. (<**>) :: Applicable repr => repr a -> repr (a -> b) -> repr b infixl 4 $> infixl 4 <&> infixl 4 <**> infixl 4 <$ infixl 4 <* infixl 4 <$> infixl 4 *> infixl 4 <*> class Alternable repr -- | (rl <|> rr) parses (rl) and return its -- return value or, if it fails, parses (rr) from where -- (rl) has left the input stream, and returns its return value. (<|>) :: Alternable repr => repr a -> repr a -> repr a -- | (empty) parses nothing, always failing to return a value. empty :: Alternable repr => repr a -- | (try ra) records the input stream position, then -- parses like (ra) and either returns its value it it succeeds -- or fails if it fails but with a reset of the input stream to the -- recorded position. Generally used on the first alternative: -- (try rl <|> rr). try :: Alternable repr => repr a -> repr a -- | (rl <|> rr) parses (rl) and return its -- return value or, if it fails, parses (rr) from where -- (rl) has left the input stream, and returns its return value. (<|>) :: (Alternable repr, Liftable2 repr) => Alternable (Output repr) => repr a -> repr a -> repr a -- | (empty) parses nothing, always failing to return a value. empty :: (Alternable repr, Liftable repr) => Alternable (Output repr) => repr a -- | (try ra) records the input stream position, then -- parses like (ra) and either returns its value it it succeeds -- or fails if it fails but with a reset of the input stream to the -- recorded position. Generally used on the first alternative: -- (try rl <|> rr). try :: (Alternable repr, Liftable1 repr) => Alternable (Output repr) => repr a -> repr a -- | Like (<|>) but with different returning types -- for the alternatives, and a return value wrapped in an Either -- accordingly. (<+>) :: (Alternable repr, Applicable repr) => Alternable repr => repr a -> repr b -> repr (Either a b) infixl 3 <+> infixl 3 <|> optionally :: Applicable repr => Alternable repr => repr a -> TermGrammar b -> repr b optional :: Applicable repr => Alternable repr => repr a -> repr () option :: Applicable repr => Alternable repr => TermGrammar a -> repr a -> repr a choice :: Alternable repr => [repr a] -> repr a maybeP :: Applicable repr => Alternable repr => repr a -> repr (Maybe a) manyTill :: Applicable repr => Alternable repr => repr a -> repr b -> repr [a] class Selectable repr branch :: Selectable repr => repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c branch :: (Selectable repr, Liftable3 repr) => Selectable (Output repr) => repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c class Matchable repr conditional :: (Matchable repr, Eq a) => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b conditional :: (Matchable repr, Unliftable repr) => Liftable1 repr => Matchable (Output repr) => Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b match :: (Matchable repr, Eq a) => repr a -> [TermGrammar a] -> (TermGrammar a -> repr b) -> repr b -> repr b class Foldable repr chainPre :: Foldable repr => repr (a -> a) -> repr a -> repr a chainPost :: Foldable repr => repr a -> repr (a -> a) -> repr a chainPre :: (Foldable repr, Applicable repr) => Alternable repr => repr (a -> a) -> repr a -> repr a chainPost :: (Foldable repr, Applicable repr) => Alternable repr => repr a -> repr (a -> a) -> repr a class Satisfiable tok repr satisfy :: Satisfiable tok repr => [ErrorItem tok] -> TermGrammar (tok -> Bool) -> repr tok satisfy :: (Satisfiable tok repr, Liftable repr) => Satisfiable tok (Output repr) => [ErrorItem tok] -> TermGrammar (tok -> Bool) -> repr tok item :: Satisfiable tok repr => repr tok data ErrorItem tok ErrorItemToken :: tok -> ErrorItem tok ErrorItemLabel :: String -> ErrorItem tok ErrorItemHorizon :: Int -> ErrorItem tok ErrorItemEnd :: ErrorItem tok class Lookable repr look :: Lookable repr => repr a -> repr a negLook :: Lookable repr => repr a -> repr () look :: (Lookable repr, Liftable1 repr) => Lookable (Output repr) => repr a -> repr a negLook :: (Lookable repr, Liftable1 repr) => Lookable (Output repr) => repr a -> repr () eof :: Lookable repr => repr () eof :: (Lookable repr, Liftable repr) => Lookable (Output repr) => repr () (<:>) :: Applicable repr => repr a -> repr [a] -> repr [a] infixl 4 <:> sequence :: Applicable repr => [repr a] -> repr [a] traverse :: Applicable repr => (a -> repr b) -> [a] -> repr [b] repeat :: Applicable repr => Int -> repr a -> repr [a] between :: Applicable repr => repr o -> repr c -> repr a -> repr a string :: Applicable repr => Alternable repr => Satisfiable Char repr => [Char] -> repr [Char] oneOf :: Lift tok => Eq tok => Satisfiable tok repr => [tok] -> repr tok noneOf :: Lift tok => Eq tok => Satisfiable tok repr => [tok] -> repr tok ofChars :: Lift tok => Eq tok => [tok] -> CodeQ tok -> CodeQ Bool more :: Applicable repr => Satisfiable Char repr => Lookable repr => repr () char :: Applicable repr => Satisfiable Char repr => Char -> repr Char anyChar :: Satisfiable Char repr => repr Char token :: Lift tok => Show tok => Eq tok => Applicable repr => Satisfiable tok repr => tok -> repr tok tokens :: Lift tok => Eq tok => Show tok => Applicable repr => Alternable repr => Satisfiable tok repr => [tok] -> repr [tok] void :: Applicable repr => repr a -> repr () unit :: Applicable repr => repr () pfoldr :: Applicable repr => Foldable repr => TermGrammar (a -> b -> b) -> TermGrammar b -> repr a -> repr b pfoldr1 :: Applicable repr => Foldable repr => TermGrammar (a -> b -> b) -> TermGrammar b -> repr a -> repr b pfoldl :: Applicable repr => Foldable repr => TermGrammar (b -> a -> b) -> TermGrammar b -> repr a -> repr b pfoldl1 :: Applicable repr => Foldable repr => TermGrammar (b -> a -> b) -> TermGrammar b -> repr a -> repr b chainl1' :: Applicable repr => Foldable repr => TermGrammar (a -> b) -> repr a -> repr (b -> a -> b) -> repr b chainl1 :: Applicable repr => Foldable repr => repr a -> repr (a -> a -> a) -> repr a chainl :: Applicable repr => Alternable repr => Foldable repr => repr a -> repr (a -> a -> a) -> TermGrammar a -> repr a many :: Applicable repr => Foldable repr => repr a -> repr [a] manyN :: Applicable repr => Foldable repr => Int -> repr a -> repr [a] some :: Applicable repr => Foldable repr => repr a -> repr [a] skipMany :: Applicable repr => Foldable repr => repr a -> repr () skipManyN :: Applicable repr => Foldable repr => Int -> repr a -> repr () skipSome :: Applicable repr => Foldable repr => repr a -> repr () sepBy :: Applicable repr => Alternable repr => Foldable repr => repr a -> repr b -> repr [a] sepBy1 :: Applicable repr => Alternable repr => Foldable repr => repr a -> repr b -> repr [a] endBy :: Applicable repr => Alternable repr => Foldable repr => repr a -> repr b -> repr [a] endBy1 :: Applicable repr => Alternable repr => Foldable repr => repr a -> repr b -> repr [a] sepEndBy :: Applicable repr => Alternable repr => Foldable repr => repr a -> repr b -> repr [a] sepEndBy1 :: Applicable repr => Alternable repr => Foldable repr => repr a -> repr b -> repr [a] instance GHC.Classes.Eq tok => GHC.Classes.Eq (Symantic.Parser.Grammar.Combinators.ErrorItem tok) instance GHC.Classes.Ord tok => GHC.Classes.Ord (Symantic.Parser.Grammar.Combinators.ErrorItem tok) instance GHC.Show.Show tok => GHC.Show.Show (Symantic.Parser.Grammar.Combinators.ErrorItem tok) instance Language.Haskell.TH.Syntax.Lift tok => Language.Haskell.TH.Syntax.Lift (Symantic.Parser.Grammar.Combinators.ErrorItem tok) module Symantic.Parser.Grammar.Write newtype WriteGrammar (showName :: Bool) a WriteGrammar :: (WriteGrammarInh -> Maybe Builder) -> WriteGrammar showName :: Bool a [unWriteGrammar] :: WriteGrammar showName :: Bool a -> WriteGrammarInh -> Maybe Builder data WriteGrammarInh WriteGrammarInh :: Builder -> (Infix, Side) -> Pair -> WriteGrammarInh [writeGrammarInh_indent] :: WriteGrammarInh -> Builder [writeGrammarInh_op] :: WriteGrammarInh -> (Infix, Side) [writeGrammarInh_pair] :: WriteGrammarInh -> Pair emptyWriteGrammarInh :: WriteGrammarInh writeGrammar :: WriteGrammar sN a -> Text pairWriteGrammarInh :: Semigroup s => IsString s => WriteGrammarInh -> Infix -> Maybe s -> Maybe s instance Data.String.IsString (Symantic.Parser.Grammar.Write.WriteGrammar sN a) instance Symantic.Univariant.Letable.ShowLetName sN letName => Symantic.Univariant.Letable.Letable letName (Symantic.Parser.Grammar.Write.WriteGrammar sN) instance Symantic.Parser.Grammar.Combinators.Applicable (Symantic.Parser.Grammar.Write.WriteGrammar sN) instance Symantic.Parser.Grammar.Combinators.Alternable (Symantic.Parser.Grammar.Write.WriteGrammar sN) instance Symantic.Parser.Grammar.Combinators.Satisfiable tok (Symantic.Parser.Grammar.Write.WriteGrammar sN) instance Symantic.Parser.Grammar.Combinators.Selectable (Symantic.Parser.Grammar.Write.WriteGrammar sN) instance Symantic.Parser.Grammar.Combinators.Matchable (Symantic.Parser.Grammar.Write.WriteGrammar sN) instance Symantic.Parser.Grammar.Combinators.Lookable (Symantic.Parser.Grammar.Write.WriteGrammar sN) instance Symantic.Parser.Grammar.Combinators.Foldable (Symantic.Parser.Grammar.Write.WriteGrammar sN) module Symantic.Parser.Grammar.View newtype ViewGrammar (showName :: Bool) a ViewGrammar :: Tree String -> ViewGrammar showName :: Bool a [unViewGrammar] :: ViewGrammar showName :: Bool a -> Tree String viewGrammar :: ViewGrammar sN a -> ViewGrammar sN a instance GHC.Show.Show (Symantic.Parser.Grammar.View.ViewGrammar sN a) instance Data.String.IsString (Symantic.Parser.Grammar.View.ViewGrammar sN a) instance Symantic.Univariant.Letable.ShowLetName sN letName => Symantic.Univariant.Letable.Letable letName (Symantic.Parser.Grammar.View.ViewGrammar sN) instance Symantic.Parser.Grammar.Combinators.Applicable (Symantic.Parser.Grammar.View.ViewGrammar sN) instance Symantic.Parser.Grammar.Combinators.Alternable (Symantic.Parser.Grammar.View.ViewGrammar sN) instance Symantic.Parser.Grammar.Combinators.Satisfiable tok (Symantic.Parser.Grammar.View.ViewGrammar sN) instance Symantic.Parser.Grammar.Combinators.Selectable (Symantic.Parser.Grammar.View.ViewGrammar sN) instance Symantic.Parser.Grammar.Combinators.Matchable (Symantic.Parser.Grammar.View.ViewGrammar sN) instance Symantic.Parser.Grammar.Combinators.Lookable (Symantic.Parser.Grammar.View.ViewGrammar sN) instance Symantic.Parser.Grammar.Combinators.Foldable (Symantic.Parser.Grammar.View.ViewGrammar sN) -- | Bottom-up optimization of Combinators, reexamining downward as -- needed after each optimization. module Symantic.Parser.Grammar.Optimize type OptimizeGrammar = SomeComb optimizeGrammar :: Trans (SomeComb repr) repr => SomeComb repr a -> repr a -- | Combinators of the Grammar. This is an extensible -- data-type. data family Comb (comb :: ReprComb -> Constraint) (repr :: ReprComb) :: ReprComb infixl 3 :<|>: infixl 4 :*>: infixl 4 :<*: infixl 4 :<*>: -- | Convenient utility to pattern-match a SomeComb. pattern Comb :: Typeable comb => Comb comb repr a -> SomeComb repr a type ReprComb = Type -> Type -- | Some Combinator existentialized over the actual combinator -- symantic class. Useful to handle a list of Combinators without -- requiring impredicative quantification. Must be used by -- pattern-matching on the SomeComb data-constructor, to bring the -- constraints in scope. -- -- The optimizations are directly applied within it, to avoid introducing -- an extra newtype, this also give a more comprehensible code. data SomeComb repr a SomeComb :: Comb comb repr a -> SomeComb repr a -- | (unSomeComb c :: Maybe (Comb comb repr a)) -- extract the data-constructor from the given SomeComb iif. it -- belongs to the (Comb comb repr a) data-instance. unSomeComb :: forall comb repr a. Typeable comb => SomeComb repr a -> Maybe (Comb comb repr a) pattern (:<$>:) :: TermGrammar (a -> b) -> SomeComb repr a -> Comb Applicable repr b pattern (:$>:) :: SomeComb repr a -> TermGrammar b -> Comb Applicable repr b instance Symantic.Univariant.Trans.Trans (Symantic.Parser.Grammar.Optimize.SomeComb repr) repr instance (Symantic.Parser.Grammar.Combinators.Applicable repr, Symantic.Parser.Grammar.Combinators.Alternable repr, Symantic.Parser.Grammar.Combinators.Lookable repr, Symantic.Parser.Grammar.Combinators.Matchable repr, Symantic.Parser.Grammar.Combinators.Selectable repr) => Symantic.Parser.Grammar.Combinators.Applicable (Symantic.Parser.Grammar.Optimize.SomeComb repr) instance (Symantic.Parser.Grammar.Combinators.Alternable repr, Symantic.Parser.Grammar.Combinators.Applicable repr, Symantic.Parser.Grammar.Combinators.Lookable repr, Symantic.Parser.Grammar.Combinators.Matchable repr, Symantic.Parser.Grammar.Combinators.Selectable repr) => Symantic.Parser.Grammar.Combinators.Alternable (Symantic.Parser.Grammar.Optimize.SomeComb repr) instance (Symantic.Parser.Grammar.Combinators.Applicable repr, Symantic.Parser.Grammar.Combinators.Alternable repr, Symantic.Parser.Grammar.Combinators.Lookable repr, Symantic.Parser.Grammar.Combinators.Selectable repr, Symantic.Parser.Grammar.Combinators.Matchable repr) => Symantic.Parser.Grammar.Combinators.Selectable (Symantic.Parser.Grammar.Optimize.SomeComb repr) instance (Symantic.Parser.Grammar.Combinators.Applicable repr, Symantic.Parser.Grammar.Combinators.Alternable repr, Symantic.Parser.Grammar.Combinators.Lookable repr, Symantic.Parser.Grammar.Combinators.Selectable repr, Symantic.Parser.Grammar.Combinators.Matchable repr) => Symantic.Parser.Grammar.Combinators.Matchable (Symantic.Parser.Grammar.Optimize.SomeComb repr) instance Symantic.Parser.Grammar.Combinators.Foldable repr => Symantic.Parser.Grammar.Combinators.Foldable (Symantic.Parser.Grammar.Optimize.SomeComb repr) instance (Symantic.Parser.Grammar.Combinators.Alternable repr, Symantic.Parser.Grammar.Combinators.Applicable repr, Symantic.Parser.Grammar.Combinators.Lookable repr, Symantic.Parser.Grammar.Combinators.Selectable repr, Symantic.Parser.Grammar.Combinators.Matchable repr) => Symantic.Parser.Grammar.Combinators.Lookable (Symantic.Parser.Grammar.Optimize.SomeComb repr) instance (Symantic.Parser.Grammar.Combinators.Satisfiable tok repr, Data.Typeable.Internal.Typeable tok) => Symantic.Parser.Grammar.Combinators.Satisfiable tok (Symantic.Parser.Grammar.Optimize.SomeComb repr) instance (Symantic.Univariant.Letable.Letable letName repr, Data.Typeable.Internal.Typeable letName) => Symantic.Univariant.Letable.Letable letName (Symantic.Parser.Grammar.Optimize.SomeComb repr) instance Symantic.Parser.Grammar.Combinators.Applicable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Grammar.Optimize.Comb Symantic.Parser.Grammar.Combinators.Applicable repr) repr instance Symantic.Parser.Grammar.Combinators.Alternable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Grammar.Optimize.Comb Symantic.Parser.Grammar.Combinators.Alternable repr) repr instance Symantic.Parser.Grammar.Combinators.Selectable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Grammar.Optimize.Comb Symantic.Parser.Grammar.Combinators.Selectable repr) repr instance Symantic.Parser.Grammar.Combinators.Matchable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Grammar.Optimize.Comb Symantic.Parser.Grammar.Combinators.Matchable repr) repr instance Symantic.Parser.Grammar.Combinators.Foldable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Grammar.Optimize.Comb Symantic.Parser.Grammar.Combinators.Foldable repr) repr instance Symantic.Parser.Grammar.Combinators.Lookable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Grammar.Optimize.Comb Symantic.Parser.Grammar.Combinators.Lookable repr) repr instance Symantic.Parser.Grammar.Combinators.Satisfiable tok repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Grammar.Optimize.Comb (Symantic.Parser.Grammar.Combinators.Satisfiable tok) repr) repr instance Symantic.Univariant.Letable.Letable letName repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Grammar.Optimize.Comb (Symantic.Univariant.Letable.Letable letName) repr) repr instance Symantic.Univariant.Letable.MakeLetName Language.Haskell.TH.Syntax.Name module Symantic.Parser.Grammar.ObserveSharing -- | Remove def when non-recursive or unused. newtype CleanDefs letName repr a CleanDefs :: (HashSet letName -> repr a) -> CleanDefs letName repr a [unCleanDefs] :: CleanDefs letName repr a -> HashSet letName -> repr a data ObserveSharingState letName ObserveSharingState :: HashMap SharingName (letName, Int) -> HashSet SharingName -> ObserveSharingState letName [oss_refs] :: ObserveSharingState letName -> HashMap SharingName (letName, Int) -- | TODO: unused so far, will it be useful somewhere at a later stage? [oss_recs] :: ObserveSharingState letName -> HashSet SharingName -- | Interpreter detecting some (Haskell embedded) let definitions -- used at least once and/or recursively, in order to replace them with -- the def and ref combinators. See Type-safe observable -- sharing in Haskell newtype ObserveSharing letName repr a ObserveSharing :: ReaderT (HashSet SharingName) (State (ObserveSharingState letName)) (CleanDefs letName repr a) -> ObserveSharing letName repr a [unObserveSharing] :: ObserveSharing letName repr a -> ReaderT (HashSet SharingName) (State (ObserveSharingState letName)) (CleanDefs letName repr a) -- | Note that the observable sharing enabled by StableName is not -- perfect as it will not observe all the sharing explicitely done. -- -- Note also that the observed sharing could be different between ghc and -- ghci. data SharingName SharingName :: StableName a -> SharingName -- | Useful on golden unit tests because StableName change often -- when changing unrelated source code or even changing basic GHC or -- executable flags. class ShowLetName (showName :: Bool) letName showLetName :: ShowLetName showName letName => letName -> String class MakeLetName letName makeLetName :: MakeLetName letName => SharingName -> IO letName -- | This class is not for end-users like usual symantic operators, here -- def and ref are introduced by observeSharing. class Letable letName repr -- | (def letName x) let-binds (letName) to be -- equal to (x). def :: Letable letName repr => letName -> repr a -> repr a -- | (ref isRec letName) is a reference to -- (letName). (isRec) is True iif. this -- reference is recursive, ie. is reachable within its -- definition. ref :: Letable letName repr => Bool -> letName -> repr a -- | (def letName x) let-binds (letName) to be -- equal to (x). def :: (Letable letName repr, Liftable1 repr) => Letable letName (Output repr) => letName -> repr a -> repr a -- | (ref isRec letName) is a reference to -- (letName). (isRec) is True iif. this -- reference is recursive, ie. is reachable within its -- definition. ref :: (Letable letName repr, Liftable repr) => Letable letName (Output repr) => Bool -> letName -> repr a -- | (makeSharingName x) is like (makeStableName -- x) but it also forces evaluation of (x) to ensure that -- the StableName is correct first time, which avoids to produce a -- tree bigger than needed. -- -- Note that this function uses unsafePerformIO instead of -- returning in IO, this is apparently required to avoid infinite -- loops due to unstable StableName in compiled code, and -- sometimes also in ghci. -- -- Note that maybe pseq should be used here. makeSharingName :: a -> SharingName observeSharingNode :: Eq letName => Hashable letName => Letable letName repr => MakeLetName letName => ObserveSharing letName repr a -> ObserveSharing letName repr a -- | Like observeSharing but type-binding (letName) to -- Name to avoid the trouble to always set it. observeSharing :: ObserveSharing Name repr a -> repr a instance Data.Hashable.Class.Hashable Language.Haskell.TH.Syntax.Name instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName, Symantic.Parser.Grammar.Combinators.Satisfiable tok repr) => Symantic.Parser.Grammar.Combinators.Satisfiable tok (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName, Symantic.Parser.Grammar.Combinators.Alternable repr) => Symantic.Parser.Grammar.Combinators.Alternable (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName, Symantic.Parser.Grammar.Combinators.Applicable repr) => Symantic.Parser.Grammar.Combinators.Applicable (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName, Symantic.Parser.Grammar.Combinators.Selectable repr) => Symantic.Parser.Grammar.Combinators.Selectable (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName, Symantic.Parser.Grammar.Combinators.Matchable repr) => Symantic.Parser.Grammar.Combinators.Matchable (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName, Symantic.Parser.Grammar.Combinators.Foldable repr, Symantic.Parser.Grammar.Combinators.Applicable repr, Symantic.Parser.Grammar.Combinators.Alternable repr) => Symantic.Parser.Grammar.Combinators.Foldable (Symantic.Univariant.Letable.ObserveSharing letName repr) instance (Symantic.Univariant.Letable.Letable letName repr, Symantic.Univariant.Letable.MakeLetName letName, GHC.Classes.Eq letName, Data.Hashable.Class.Hashable letName, Symantic.Parser.Grammar.Combinators.Lookable repr) => Symantic.Parser.Grammar.Combinators.Lookable (Symantic.Univariant.Letable.ObserveSharing letName repr) instance Symantic.Parser.Grammar.Combinators.Applicable repr => Symantic.Parser.Grammar.Combinators.Applicable (Symantic.Univariant.Letable.CleanDefs letName repr) instance Symantic.Parser.Grammar.Combinators.Alternable repr => Symantic.Parser.Grammar.Combinators.Alternable (Symantic.Univariant.Letable.CleanDefs letName repr) instance Symantic.Parser.Grammar.Combinators.Satisfiable tok repr => Symantic.Parser.Grammar.Combinators.Satisfiable tok (Symantic.Univariant.Letable.CleanDefs letName repr) instance Symantic.Parser.Grammar.Combinators.Selectable repr => Symantic.Parser.Grammar.Combinators.Selectable (Symantic.Univariant.Letable.CleanDefs letName repr) instance Symantic.Parser.Grammar.Combinators.Matchable repr => Symantic.Parser.Grammar.Combinators.Matchable (Symantic.Univariant.Letable.CleanDefs letName repr) instance Symantic.Parser.Grammar.Combinators.Lookable repr => Symantic.Parser.Grammar.Combinators.Lookable (Symantic.Univariant.Letable.CleanDefs letName repr) instance Symantic.Parser.Grammar.Combinators.Foldable repr => Symantic.Parser.Grammar.Combinators.Foldable (Symantic.Univariant.Letable.CleanDefs letName repr) module Symantic.Parser.Grammar type Grammar tok repr = (Applicable repr, Alternable repr, Satisfiable tok repr, Letable Name repr, Selectable repr, Matchable repr, Foldable repr, Lookable repr) -- | A usual pipeline to interpret Combinators: -- observeSharing then optimizeGrammar then a polymorphic -- (repr). grammar :: Grammar tok repr => ObserveSharing Name (OptimizeGrammar repr) a -> repr a -- | An usual pipeline to show Combinators: observeSharing -- then optimizeGrammar then viewGrammar then show. showGrammar :: ObserveSharing Name (OptimizeGrammar (ViewGrammar showName)) a -> String -- | This class is not for end-users like usual symantic operators, here -- def and ref are introduced by observeSharing. class Letable letName repr -- | (def letName x) let-binds (letName) to be -- equal to (x). def :: Letable letName repr => letName -> repr a -> repr a -- | (ref isRec letName) is a reference to -- (letName). (isRec) is True iif. this -- reference is recursive, ie. is reachable within its -- definition. ref :: Letable letName repr => Bool -> letName -> repr a -- | (def letName x) let-binds (letName) to be -- equal to (x). def :: (Letable letName repr, Liftable1 repr) => Letable letName (Output repr) => letName -> repr a -> repr a -- | (ref isRec letName) is a reference to -- (letName). (isRec) is True iif. this -- reference is recursive, ie. is reachable within its -- definition. ref :: (Letable letName repr, Liftable repr) => Letable letName (Output repr) => Bool -> letName -> repr a -- | Semantic of the parsing instructions used to make the parsing -- control-flow explicit, in the convenient tagless-final encoding. module Symantic.Parser.Machine.Instructions type TermInstr = Term CodeQ -- | Type-level natural numbers, using the Peano recursive encoding. data Peano Zero :: Peano Succ :: Peano -> Peano -- | All the Instructions. type Machine tok repr = (Branchable repr, Failable repr, Inputable repr, Joinable repr, Routinable repr, Stackable repr, Readable tok repr) type ReprInstr = Type -> [Type] -> Peano -> Type -> Type -- | Name of a subroutine or defJoin indexed by the -- return type of the factorized Instructions. This helps -- type-inferencing. newtype LetName a LetName :: Name -> LetName a [unLetName] :: LetName a -> Name class Stackable (repr :: ReprInstr) push :: Stackable repr => TermInstr v -> repr inp (v : vs) es a -> repr inp vs es a pop :: Stackable repr => repr inp vs es a -> repr inp (v : vs) es a liftI2 :: Stackable repr => TermInstr (x -> y -> z) -> repr inp (z : vs) es a -> repr inp (y : (x : vs)) es a swap :: Stackable repr => repr inp (x : (y : vs)) es a -> repr inp (y : (x : vs)) es a -- | (mapI f k). mapI :: Stackable repr => TermInstr (x -> y) -> repr inp (y : vs) es a -> repr inp (x : vs) es a -- | (appI k) pops (x) and (x2y) from the -- valueStack, pushes (x2y x) and continues with the -- next Instruction (k). appI :: Stackable repr => repr inp (y : vs) es a -> repr inp (x : ((x -> y) : vs)) es a class Routinable (repr :: ReprInstr) subroutine :: Routinable repr => LetName v -> repr inp '[] ('Succ 'Zero) v -> repr inp vs ('Succ es) a -> repr inp vs ('Succ es) a call :: Routinable repr => LetName v -> repr inp (v : vs) ('Succ es) a -> repr inp vs ('Succ es) a ret :: Routinable repr => repr inp '[a] es a jump :: Routinable repr => LetName a -> repr inp '[] ('Succ es) a class Branchable (repr :: ReprInstr) caseI :: Branchable repr => repr inp (x : vs) es r -> repr inp (y : vs) es r -> repr inp (Either x y : vs) es r choices :: Branchable repr => [TermInstr (v -> Bool)] -> [repr inp vs es a] -> repr inp vs es a -> repr inp (v : vs) es a -- | (ifI ok ko) pops a Bool from the -- valueStack and continues either with the Instruction -- (ok) if it is True or (ko) otherwise. ifI :: Branchable repr => repr inp vs es a -> repr inp vs es a -> repr inp (Bool : vs) es a class Failable (repr :: ReprInstr) fail :: Failable repr => [ErrorItem (InputToken inp)] -> repr inp vs ('Succ es) a popFail :: Failable repr => repr inp vs es a -> repr inp vs ('Succ es) a catchFail :: Failable repr => repr inp vs ('Succ es) a -> repr inp (Cursor inp : vs) es a -> repr inp vs es a class Inputable (repr :: ReprInstr) loadInput :: Inputable repr => repr inp vs es a -> repr inp (Cursor inp : vs) es a pushInput :: Inputable repr => repr inp (Cursor inp : vs) es a -> repr inp vs es a class Joinable (repr :: ReprInstr) defJoin :: Joinable repr => LetName v -> repr inp (v : vs) es a -> repr inp vs es a -> repr inp vs es a refJoin :: Joinable repr => LetName v -> repr inp (v : vs) es a class Readable (tok :: Type) (repr :: ReprInstr) read :: (Readable tok repr, tok ~ InputToken inp) => [ErrorItem tok] -> TermInstr (tok -> Bool) -> repr inp (tok : vs) ('Succ es) a -> repr inp vs ('Succ es) a instance GHC.Show.Show (Symantic.Parser.Machine.Instructions.LetName a) instance GHC.Classes.Eq (Symantic.Parser.Machine.Instructions.LetName a) module Symantic.Parser.Machine.View newtype ViewMachine (showName :: Bool) inp (vs :: [Type]) (es :: Peano) a ViewMachine :: (Forest String -> Forest String) -> ViewMachine showName :: Bool inp vs :: [Type] es :: Peano a [unViewMachine] :: ViewMachine showName :: Bool inp vs :: [Type] es :: Peano a -> Forest String -> Forest String viewMachine :: ViewMachine sN inp vs es a -> ViewMachine sN inp vs es a -- | Helper to view a command. viewInstrCmd :: String -> Forest String -> Tree String -- | Helper to view an argument. viewInstrArg :: String -> Forest String -> Tree String instance GHC.Show.Show (Symantic.Parser.Machine.View.ViewMachine sN inp vs es a) instance Data.String.IsString (Symantic.Parser.Machine.View.ViewMachine sN inp vs es a) instance Symantic.Parser.Machine.Instructions.Stackable (Symantic.Parser.Machine.View.ViewMachine sN) instance Symantic.Parser.Machine.Instructions.Branchable (Symantic.Parser.Machine.View.ViewMachine sN) instance Symantic.Parser.Machine.Instructions.Failable (Symantic.Parser.Machine.View.ViewMachine sN) instance Symantic.Parser.Machine.Instructions.Inputable (Symantic.Parser.Machine.View.ViewMachine sN) instance Symantic.Univariant.Letable.ShowLetName sN Language.Haskell.TH.Syntax.Name => Symantic.Parser.Machine.Instructions.Routinable (Symantic.Parser.Machine.View.ViewMachine sN) instance Symantic.Univariant.Letable.ShowLetName sN Language.Haskell.TH.Syntax.Name => Symantic.Parser.Machine.Instructions.Joinable (Symantic.Parser.Machine.View.ViewMachine sN) instance Symantic.Parser.Machine.Instructions.Readable tok (Symantic.Parser.Machine.View.ViewMachine sN) -- | Initial encoding with bottom-up optimizations of Instructions, -- re-optimizing downward as needed after each optimization. There is -- only one optimization (for push) so far, but the introspection -- enabled by the Instr data-type is also useful to optimize with -- more context in the Machine. module Symantic.Parser.Machine.Optimize -- | Instructions of the Machine. This is an extensible -- data-type. data family Instr (instr :: ReprInstr -> Constraint) (repr :: ReprInstr) :: ReprInstr -- | Convenient utility to pattern-match a SomeInstr. pattern Instr :: Typeable comb => Instr comb repr inp vs es a -> SomeInstr repr inp vs es a -- | Some Instruction existantialized over the actual instruction -- symantic class. Useful to handle a list of Instructions without -- requiring impredicative quantification. Must be used by -- pattern-matching on the SomeInstr data-constructor, to bring -- the constraints in scope. -- -- As in SomeComb, a first pass of optimizations is directly -- applied in it to avoid introducing an extra newtype, this also give a -- more comprehensible code. data SomeInstr repr inp vs es a SomeInstr :: Instr instr repr inp vs es a -> SomeInstr repr inp vs es a -- | (unSomeInstr i :: Maybe (Instr comb repr inp vs es -- a)) extract the data-constructor from the given SomeInstr -- iif. it belongs to the (Instr comb repr a) -- data-instance. unSomeInstr :: forall instr repr inp vs es a. Typeable instr => SomeInstr repr inp vs es a -> Maybe (Instr instr repr inp vs es a) instance Symantic.Univariant.Trans.Trans (Symantic.Parser.Machine.Optimize.SomeInstr repr inp vs es) (repr inp vs es) instance Symantic.Parser.Machine.Instructions.Stackable repr => Symantic.Parser.Machine.Instructions.Stackable (Symantic.Parser.Machine.Optimize.SomeInstr repr) instance Symantic.Parser.Machine.Instructions.Routinable repr => Symantic.Parser.Machine.Instructions.Routinable (Symantic.Parser.Machine.Optimize.SomeInstr repr) instance Symantic.Parser.Machine.Instructions.Branchable repr => Symantic.Parser.Machine.Instructions.Branchable (Symantic.Parser.Machine.Optimize.SomeInstr repr) instance Symantic.Parser.Machine.Instructions.Failable repr => Symantic.Parser.Machine.Instructions.Failable (Symantic.Parser.Machine.Optimize.SomeInstr repr) instance Symantic.Parser.Machine.Instructions.Inputable repr => Symantic.Parser.Machine.Instructions.Inputable (Symantic.Parser.Machine.Optimize.SomeInstr repr) instance Symantic.Parser.Machine.Instructions.Joinable repr => Symantic.Parser.Machine.Instructions.Joinable (Symantic.Parser.Machine.Optimize.SomeInstr repr) instance (Symantic.Parser.Machine.Instructions.Readable tok repr, Data.Typeable.Internal.Typeable tok) => Symantic.Parser.Machine.Instructions.Readable tok (Symantic.Parser.Machine.Optimize.SomeInstr repr) instance Symantic.Parser.Machine.Instructions.Stackable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Machine.Optimize.Instr Symantic.Parser.Machine.Instructions.Stackable repr inp vs es) (repr inp vs es) instance Symantic.Parser.Machine.Instructions.Routinable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Machine.Optimize.Instr Symantic.Parser.Machine.Instructions.Routinable repr inp vs es) (repr inp vs es) instance Symantic.Parser.Machine.Instructions.Branchable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Machine.Optimize.Instr Symantic.Parser.Machine.Instructions.Branchable repr inp vs es) (repr inp vs es) instance Symantic.Parser.Machine.Instructions.Failable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Machine.Optimize.Instr Symantic.Parser.Machine.Instructions.Failable repr inp vs es) (repr inp vs es) instance Symantic.Parser.Machine.Instructions.Inputable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Machine.Optimize.Instr Symantic.Parser.Machine.Instructions.Inputable repr inp vs es) (repr inp vs es) instance Symantic.Parser.Machine.Instructions.Joinable repr => Symantic.Univariant.Trans.Trans (Symantic.Parser.Machine.Optimize.Instr Symantic.Parser.Machine.Instructions.Joinable repr inp vs es) (repr inp vs es) instance (Symantic.Parser.Machine.Instructions.Readable tok repr, tok GHC.Types.~ Symantic.Parser.Machine.Input.InputToken inp) => Symantic.Univariant.Trans.Trans (Symantic.Parser.Machine.Optimize.Instr (Symantic.Parser.Machine.Instructions.Readable tok) repr inp vs es) (repr inp vs es) -- | Build the Instruction Program of a Machine from -- the Combinators of a Grammar. Instructions are -- kept introspectable to enable more optimizations now possible because -- of a broader knowledge of the Instructions around those -- generated (eg. by using joinNext). module Symantic.Parser.Machine.Program -- | A Program is a tree of Instructions, where each -- Instruction is built by a continuation to be able to -- introspect, duplicate and/or change the next Instruction. data Program repr inp a Program :: (forall vs es ret. SomeInstr repr inp (a : vs) ('Succ es) ret -> SomeInstr repr inp vs ('Succ es) ret) -> Program repr inp a [unProgram] :: Program repr inp a -> forall vs es ret. SomeInstr repr inp (a : vs) ('Succ es) ret -> SomeInstr repr inp vs ('Succ es) ret -- | Build an interpreter of the Program of the given -- Machine. optimizeMachine :: forall inp es repr a. Machine (InputToken inp) repr => Program repr inp a -> repr inp '[] ('Succ es) a -- | If no input has been consumed by the failing alternative then continue -- with the given continuation. Otherwise, propagate the Failure. failIfConsumed :: Cursorable (Cursor inp) => Branchable repr => Failable repr => Inputable repr => Stackable repr => SomeInstr repr inp vs ('Succ es) ret -> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret -- | (joinNext m) factorize the next Instruction to -- be able to reuse it multiple times without duplication. It does so by -- introducing a defJoin and passing the corresponding -- refJoin as next Instruction to (m), unless -- factorizing is useless because the next Instruction is already -- a refJoin or a ret. It should be used each time the next -- Instruction is used multiple times. joinNext :: Joinable repr => Program repr inp v -> Program repr inp v instance Symantic.Parser.Machine.Instructions.Stackable repr => Symantic.Parser.Grammar.Combinators.Applicable (Symantic.Parser.Machine.Program.Program repr inp) instance (Symantic.Parser.Machine.Input.Cursorable (Symantic.Parser.Machine.Input.Cursor inp), Symantic.Parser.Machine.Instructions.Branchable repr, Symantic.Parser.Machine.Instructions.Failable repr, Symantic.Parser.Machine.Instructions.Inputable repr, Symantic.Parser.Machine.Instructions.Joinable repr, Symantic.Parser.Machine.Instructions.Stackable repr) => Symantic.Parser.Grammar.Combinators.Alternable (Symantic.Parser.Machine.Program.Program repr inp) instance (tok GHC.Types.~ Symantic.Parser.Machine.Input.InputToken inp, Symantic.Parser.Machine.Instructions.Readable tok repr, Data.Typeable.Internal.Typeable tok) => Symantic.Parser.Grammar.Combinators.Satisfiable tok (Symantic.Parser.Machine.Program.Program repr inp) instance (Symantic.Parser.Machine.Instructions.Branchable repr, Symantic.Parser.Machine.Instructions.Joinable repr, Symantic.Parser.Machine.Instructions.Stackable repr) => Symantic.Parser.Grammar.Combinators.Selectable (Symantic.Parser.Machine.Program.Program repr inp) instance (Symantic.Parser.Machine.Instructions.Branchable repr, Symantic.Parser.Machine.Instructions.Joinable repr) => Symantic.Parser.Grammar.Combinators.Matchable (Symantic.Parser.Machine.Program.Program repr inp) instance (GHC.Classes.Ord (Symantic.Parser.Machine.Input.InputToken inp), Symantic.Parser.Machine.Input.Cursorable (Symantic.Parser.Machine.Input.Cursor inp), Symantic.Parser.Machine.Instructions.Branchable repr, Symantic.Parser.Machine.Instructions.Failable repr, Symantic.Parser.Machine.Instructions.Inputable repr, Symantic.Parser.Machine.Instructions.Joinable repr, Symantic.Parser.Machine.Instructions.Readable (Symantic.Parser.Machine.Input.InputToken inp) repr, Data.Typeable.Internal.Typeable (Symantic.Parser.Machine.Input.InputToken inp), Symantic.Parser.Machine.Instructions.Stackable repr) => Symantic.Parser.Grammar.Combinators.Lookable (Symantic.Parser.Machine.Program.Program repr inp) instance Symantic.Parser.Machine.Instructions.Routinable repr => Symantic.Univariant.Letable.Letable Language.Haskell.TH.Syntax.Name (Symantic.Parser.Machine.Program.Program repr inp) instance (Symantic.Parser.Machine.Input.Cursorable (Symantic.Parser.Machine.Input.Cursor inp), Symantic.Parser.Machine.Instructions.Branchable repr, Symantic.Parser.Machine.Instructions.Failable repr, Symantic.Parser.Machine.Instructions.Inputable repr, Symantic.Parser.Machine.Instructions.Joinable repr, Symantic.Parser.Machine.Instructions.Stackable repr) => Symantic.Parser.Grammar.Combinators.Foldable (Symantic.Parser.Machine.Program.Program repr inp) module Symantic.Parser.Machine.Generate genCode :: TermInstr a -> CodeQ a -- | Generate the CodeQ parsing the input. data Gen inp vs es a Gen :: (Map Name Horizon -> Horizon) -> (GenCtx inp vs es a -> CodeQ (Either (ParsingError inp) a)) -> Gen inp vs es a -- | Synthetized (bottom-up) minimal input length required by the parser to -- not fail. This requires a minHorizonByName containing the -- minimal Horizons of all the Names this parser -- calls, jumps or refJoins to. [minHorizon] :: Gen inp vs es a -> Map Name Horizon -> Horizon [unGen] :: Gen inp vs es a -> GenCtx inp vs es a -> CodeQ (Either (ParsingError inp) a) data ParsingError inp ParsingErrorStandard :: Offset -> Maybe (InputToken inp) -> Set (ErrorItem (InputToken inp)) -> ParsingError inp [parsingErrorOffset] :: ParsingError inp -> Offset -- | Note that if an ErrorItemHorizon greater than 1 is amongst the -- parsingErrorExpecting then this is only the InputToken -- at the begining of the expected Horizon. [parsingErrorUnexpected] :: ParsingError inp -> Maybe (InputToken inp) [parsingErrorExpecting] :: ParsingError inp -> Set (ErrorItem (InputToken inp)) type Offset = Int -- | Synthetized minimal input length required for a successful parsing. -- Used with checkedHorizon to factorize input length checks, -- instead of checking the input length one InputToken at a time -- at each read. type Horizon = Offset type Cont inp v a = Cursor inp -> [ErrorItem (InputToken inp)] -> v -> Cursor inp -> Either (ParsingError inp) a type FailHandler inp a = Cursor inp -> Cursor inp -> [ErrorItem (InputToken inp)] -> Either (ParsingError inp) a -- | (generateCode input mach) generates -- TemplateHaskell code parsing the given input according -- to the given Machine. generateCode :: forall inp ret. Ord (InputToken inp) => Show (InputToken inp) => Lift (InputToken inp) => Input inp => CodeQ inp -> Show (Cursor inp) => Gen inp '[] ('Succ 'Zero) ret -> CodeQ (Either (ParsingError inp) ret) -- | This is an inherited (top-down) context only present at compile-time, -- to build TemplateHaskell splices. data GenCtx inp vs (es :: Peano) a GenCtx :: ValueStack vs -> FailStack inp a es -> CodeQ (Cont inp a a) -> CodeQ (Cursor inp) -> CodeQ (Cursor inp -> Bool) -> CodeQ (Cursor inp -> (# InputToken inp, Cursor inp #)) -> CodeQ (Cursor inp) -> CodeQ [ErrorItem (InputToken inp)] -> Offset -> Map Name Offset -> GenCtx inp vs es :: Peano a [valueStack] :: GenCtx inp vs es :: Peano a -> ValueStack vs [failStack] :: GenCtx inp vs es :: Peano a -> FailStack inp a es [retCode] :: GenCtx inp vs es :: Peano a -> CodeQ (Cont inp a a) [input] :: GenCtx inp vs es :: Peano a -> CodeQ (Cursor inp) [moreInput] :: GenCtx inp vs es :: Peano a -> CodeQ (Cursor inp -> Bool) [nextInput] :: GenCtx inp vs es :: Peano a -> CodeQ (Cursor inp -> (# InputToken inp, Cursor inp #)) [farthestInput] :: GenCtx inp vs es :: Peano a -> CodeQ (Cursor inp) [farthestExpecting] :: GenCtx inp vs es :: Peano a -> CodeQ [ErrorItem (InputToken inp)] -- | Remaining horizon already checked. Updated by checkHorizon and -- reset elsewhere when needed. [checkedHorizon] :: GenCtx inp vs es :: Peano a -> Offset -- | Minimal horizon for each subroutine or defJoin. This can -- be done as an inherited attribute because OverserveSharing -- introduces def as an ancestor node of all the refs -- pointing to it. Same for defJoin and its refJoins. [minHorizonByName] :: GenCtx inp vs es :: Peano a -> Map Name Offset data ValueStack vs [ValueStackEmpty] :: ValueStack '[] [ValueStackCons] :: {valueStackHead :: TermInstr v, valueStackTail :: ValueStack vs} -> ValueStack (v : vs) data FailStack inp a es [FailStackEmpty] :: FailStack inp a 'Zero [FailStackCons] :: {failStackHead :: CodeQ (FailHandler inp a), failStackTail :: FailStack inp a es} -> FailStack inp a ('Succ es) -- | Generate a continuation to be called with generateResume, used -- when call returns. The return value is -- pushed on the valueStack. generateSuspend :: Gen inp (v : vs) es a -> GenCtx inp vs es a -> CodeQ (Cont inp v a) -- | Generate a call to the generateSuspend continuation. Used when -- call returns. generateResume :: CodeQ (Cont inp v a) -> Gen inp (v : vs) es a checkHorizon :: Lift (InputToken inp) => Gen inp vs ('Succ es) a -> Gen inp vs ('Succ es) a checkToken :: forall inp vs es a. Ord (InputToken inp) => Lift (InputToken inp) => [ErrorItem (InputToken inp)] -> TermInstr (InputToken inp -> Bool) -> Gen inp (InputToken inp : vs) ('Succ es) a -> Gen inp vs ('Succ es) a instance GHC.Show.Show (Symantic.Parser.Machine.Input.InputToken inp) => GHC.Show.Show (Symantic.Parser.Machine.Generate.ParsingError inp) instance Symantic.Parser.Machine.Instructions.Stackable Symantic.Parser.Machine.Generate.Gen instance Symantic.Parser.Machine.Instructions.Branchable Symantic.Parser.Machine.Generate.Gen instance Symantic.Parser.Machine.Instructions.Failable Symantic.Parser.Machine.Generate.Gen instance Symantic.Parser.Machine.Instructions.Inputable Symantic.Parser.Machine.Generate.Gen instance Symantic.Parser.Machine.Instructions.Routinable Symantic.Parser.Machine.Generate.Gen instance Symantic.Parser.Machine.Instructions.Joinable Symantic.Parser.Machine.Generate.Gen instance Symantic.Parser.Machine.Instructions.Readable GHC.Types.Char Symantic.Parser.Machine.Generate.Gen module Symantic.Parser.Machine -- | Like a Parser but not bound to the Gen interpreter. type ParserRepr repr inp = ObserveSharing Name (OptimizeGrammar (Program repr inp)) type Parser inp = ParserRepr Gen inp -- | Build a Machine able to generateCode for the given -- Parser. machine :: forall inp repr a. Ord (InputToken inp) => Show (InputToken inp) => Lift (InputToken inp) => Grammar (InputToken inp) (Program repr inp) => Machine (InputToken inp) repr => ParserRepr repr inp a -> repr inp '[] ('Succ 'Zero) a module Symantic.Parser runParser :: forall inp a. Ord (InputToken inp) => Show (InputToken inp) => Lift (InputToken inp) => Typeable (InputToken inp) => Input inp => Readable (InputToken inp) Gen => Parser inp a -> CodeQ (inp -> Either (ParsingError inp) a)