diff --git a/haskell/nfker7h/lib/Language/Yanais/Fusion.hs b/haskell/nfker7h/lib/Language/Yanais/Fusion.hs index 24612a5..335cde9 100644 --- a/haskell/nfker7h/lib/Language/Yanais/Fusion.hs +++ b/haskell/nfker7h/lib/Language/Yanais/Fusion.hs @@ -4,11 +4,16 @@ module Language.Yanais.Fusion ( Step(..), stepState, + runSteps, StepFun(..), Stream, - embedTfs + runStream, + embedTfs, + step ) where +import Control.Applicative (Alternative(..)) +import Prelude hiding (filter) import Data.Bifunctor import qualified Data.Text.Internal.Fusion as TF @@ -52,22 +57,47 @@ instance Monad (StepFun s) where Skip st2 -> Skip st2 Yield x st2 -> let (StepFun f3) = (f2 x) in f3 st2 +-- this makes `guard` work +instance Alternative (StepFun s) where + empty = StepFun $ Skip + {-# INLINE empty #-} + + StepFun f1 <|> StepFun f2 = StepFun $ \st -> + case f1 st of + Yield a st2 -> Yield a st2 + -- backtracking + Done -> f2 st + Skip _ -> f2 st + +runSteps :: StepFun s a -> s -> [a] +runSteps (StepFun sf) = go + where + go st = case sf st of + Done -> [] + Skip st2 -> go st2 + Yield a st2 -> a:(go st2) + data Stream a = forall s. Stream - (StepFun s a) -- stepper function - !s -- current state + (StepFun s a) -- ^ stepper function + !s -- ^ current state instance Functor Stream where - fmap f (Stream step cst) = Stream (fmap f step) cst + fmap f (Stream step_ cst) = Stream (fmap f step_) cst + +runStream :: Stream a -> [a] +runStream (Stream sf ctx) = runSteps sf ctx +{-# INLINE runStream #-} smap :: TF.Step s a -> Step s a smap TF.Done = Done smap (TF.Skip st) = Skip st smap (TF.Yield av st) = Yield av st +-- | embed a stream from Data.Text into our stream type embedTfs :: TF.Stream x -> Stream x -embedTfs (TF.Stream step st _) = Stream (StepFun (smap . step)) st +embedTfs (TF.Stream step_ st _) = Stream (StepFun (smap . step_)) st --- step an inner stream +-- | step an inner stream; -- forwards skips and turns Done into Nothing-yields step :: StepFun (Stream a) (Maybe a) step = StepFun $ \(Stream (StepFun f) st) -> case f st of diff --git a/haskell/nfker7h/lib/Language/Yanais/Parser.hs b/haskell/nfker7h/lib/Language/Yanais/Parser.hs index 993dbf5..5f0b3a9 100644 --- a/haskell/nfker7h/lib/Language/Yanais/Parser.hs +++ b/haskell/nfker7h/lib/Language/Yanais/Parser.hs @@ -5,6 +5,7 @@ module Language.Yanais.Parser ( Text, Ident(..), Parser(..), + Parser', ParserEnv(..), Span(..), makeParseEnv, @@ -72,12 +73,14 @@ data ParserEnv = ParserEnv { peText :: Text } +type Parser' e a = Parser ParserEnv e a + makeParseEnv :: B.ByteString -> ParserEnv makeParseEnv bs = ParserEnv { peOffset = 0, peText = U.fromRep bs } -- some simple parser combinators -shiftEnv :: (Int, Text) -> Parser ParserEnv e () +shiftEnv :: (Int, Text) -> Parser' e () shiftEnv (ll, r) = Parser $ modify go where go :: ParserEnv -> ParserEnv @@ -86,20 +89,20 @@ shiftEnv (ll, r) = Parser $ modify go slen :: Text -> Int slen = C.length . U.toRep -takeUntil :: (Char -> Bool) -> Parser ParserEnv e Text +takeUntil :: (Char -> Bool) -> Parser' e Text takeUntil f = takeWhile (not . f) -takeWhile :: (Char -> Bool) -> Parser ParserEnv e Text +takeWhile :: (Char -> Bool) -> Parser' e Text takeWhile f = do env <- Parser $ get let (l, r) = U.span f (peText env) shiftEnv (slen l, r) return l -takeWithProperty :: IC.Bool_ -> Parser ParserEnv e Text +takeWithProperty :: IC.Bool_ -> Parser' e Text takeWithProperty p = takeWhile $ IC.property p -takeIdent :: Parser ParserEnv e (Maybe Ident) +takeIdent :: Parser' e (Maybe Ident) takeIdent = do env <- Parser $ get let start_ = peOffset env @@ -119,11 +122,11 @@ takeIdent = do return (Just . (\s -> Ident (Span { start = start_, end = end_ }) s) . U.fromRep . B.fromString . T.unpack . IN.nfc . T.pack $ fi:(B.toString $ U.toRep rest)) ) else return Nothing)) -skipWhiteSpace :: Parser ParserEnv e () +skipWhiteSpace :: Parser' e () skipWhiteSpace = takeWithProperty IC.WhiteSpace >> pure () -- try to parse the first character as a token -tryOne :: (Char -> Maybe tok) -> Parser ParserEnv e (Maybe tok) +tryOne :: (Char -> Maybe tok) -> Parser' e (Maybe tok) tryOne f = do env <- Parser $ get let (l, r) = U.splitAt 1 (peText env) diff --git a/haskell/nfker7h/yanais-nfker7h.cabal b/haskell/nfker7h/yanais-nfker7h.cabal index 60d4b55..5d8d2d7 100644 --- a/haskell/nfker7h/yanais-nfker7h.cabal +++ b/haskell/nfker7h/yanais-nfker7h.cabal @@ -84,7 +84,7 @@ library , generic-data ^>= 1.1.0.0 , hashable ^>= 1.4.3.0 , mtl ^>= 2.3.1 - , text ^>= 1.2.5.0 + , text (>= 1.2.5.0 && < 2.2) , text-icu ^>= 0.8.0.0 , transformers ^>= 0.5.6.0 , utf8-string ^>= 1.0.0 @@ -112,7 +112,7 @@ executable yanais-nfker7h -- Other library packages from which modules are imported. build-depends: - base ^>=4.16.0.0, + base (>=4.16.0.0 && <4.18), yanais-nfker7h -- Directories containing source files.