53 lines
1.9 KiB
Haskell
53 lines
1.9 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Transducer (
|
|
Transducer
|
|
, fromList
|
|
, run
|
|
) where
|
|
|
|
import Data.Map ((!), insert)
|
|
import Graph (Graph(..), Vertex(..), editVertex, follow, rewind, singleton, weave)
|
|
import Stream (Stream(..), merge)
|
|
import qualified Stream (empty)
|
|
|
|
type Transducer input output = Graph input [output]
|
|
|
|
empty :: Transducer input output
|
|
empty = singleton []
|
|
|
|
entry :: Ord input => Transducer input output -> ([input], output) -> Transducer input output
|
|
entry transducer (path, output) =
|
|
rewind $ editVertex (weave transducer path) pushLabel
|
|
where
|
|
pushLabel vertex = vertex {label = output:(label vertex)}
|
|
|
|
loop :: Ord input => Transducer input output -> ([input], [input]) -> Transducer input output
|
|
loop transducer ([], loopPath) =
|
|
case splitAt (length loopPath - 1) loopPath of
|
|
(_, []) -> transducer
|
|
(loopBegining, lastInput:_) ->
|
|
let end = weave transducer loopBegining in
|
|
rewind $
|
|
editVertex end $ tieKnot lastInput
|
|
where
|
|
tieKnot input vertex =
|
|
vertex {edges = insert input (focus transducer) $ edges vertex}
|
|
loop transducer (prefix, loopPath) = loop (weave transducer prefix) ([], loopPath)
|
|
|
|
fromList :: Ord input => [([input], Either [input] output)] -> Transducer input output
|
|
fromList = foldl add empty
|
|
where
|
|
add transducer (path, Left loopPath) = loop transducer (path, loopPath)
|
|
add transducer (path, Right output) = entry transducer (path, output)
|
|
|
|
run :: (Ord input, Eq output) => Transducer input output -> Stream input -> Stream output
|
|
run transducer (Stream inputs) = foldl (\outputsStream (input, stream) ->
|
|
case follow transducer input of
|
|
Nothing -> Stream.empty
|
|
Just newState@(Graph {vertices, focus}) ->
|
|
let emitted = Stream $ emit stream <$> label (vertices ! focus) in
|
|
emitted `merge` outputsStream `merge` run newState stream
|
|
) Stream.empty inputs
|
|
where
|
|
emit stream output = (output, run (rewind transducer) stream)
|