Implement outputing the matching path along with the label

This commit is contained in:
Tissevert 2019-05-09 18:27:23 +02:00
parent 5954c12c30
commit f66d22af08

View file

@ -11,6 +11,13 @@ import Stream (Stream(..), merge)
import qualified Stream (empty) import qualified Stream (empty)
type Transducer input output = Graph input [output] type Transducer input output = Graph input [output]
newtype Stack a = Stack [a]
push :: a -> Stack a -> Stack a
push a (Stack s) = Stack (a:s)
content :: Stack a -> [a]
content (Stack s) = reverse s
empty :: Transducer input output empty :: Transducer input output
empty = singleton [] empty = singleton []
@ -40,13 +47,17 @@ fromList = foldl add empty
add transducer (path, Left loopPath) = loop transducer (path, loopPath) add transducer (path, Left loopPath) = loop transducer (path, loopPath)
add transducer (path, Right output) = entry transducer (path, output) add transducer (path, Right output) = entry transducer (path, output)
run :: (Ord input, Eq output) => Transducer input output -> Stream input -> Stream output run :: (Ord input, Eq output) => Transducer input output -> Stream input -> Stream ([input], output)
run transducer (Stream inputs) = foldl (\outputsStream (input, stream) -> run transducer = runWithStack initState
case follow transducer input of where
initState = (transducer, Stack [])
emit stack stream output = ((content stack, output), runWithStack initState stream)
runWithStack (state, stack) (Stream inputs) = foldl (\outputsStream (input, stream) ->
case follow state input of
Nothing -> Stream.empty Nothing -> Stream.empty
Just newState@(Graph {vertices, focus}) -> Just newState@(Graph {vertices, focus}) ->
let emitted = Stream $ emit stream <$> label (vertices ! focus) in let newStack = push input stack in
emitted `merge` outputsStream `merge` run newState stream let emitted = Stream $ emit newStack stream <$> label (vertices ! focus) in
let continue = runWithStack (newState, newStack) stream in
emitted `merge` continue `merge` outputsStream
) Stream.empty inputs ) Stream.empty inputs
where
emit stream output = (output, run (rewind transducer) stream)