diff options
-rw-r--r-- | edit-lens/src/Control/DFST.lhs | 20 |
1 files changed, 13 insertions, 7 deletions
diff --git a/edit-lens/src/Control/DFST.lhs b/edit-lens/src/Control/DFST.lhs index aec7bbb..476a8c4 100644 --- a/edit-lens/src/Control/DFST.lhs +++ b/edit-lens/src/Control/DFST.lhs | |||
@@ -39,25 +39,31 @@ data DFST state input output = DFST | |||
39 | } | 39 | } |
40 | 40 | ||
41 | 41 | ||
42 | toFST :: forall state input output. (Ord state, Ord input, Ord output) => DFST state input output -> FST (state, Natural) input output | 42 | toFST :: forall state input output. (Ord state, Ord input, Ord output) => DFST state input output -> FST (state, Maybe (input, Natural)) input output |
43 | -- ^ Split apart non-singleton outputs into a series of epsilon-transitions | 43 | -- ^ Split apart non-singleton outputs into a series of epsilon-transitions |
44 | -- | 44 | -- |
45 | -- This function is currently invalid since multiple out-edges in the `DFST` visit the same intermediate states (we should label intermediate states not only with an ordinal but also with the input Symbol from the `DFST`) | 45 | -- This function is currently invalid since multiple out-edges in the `DFST` visit the same intermediate states (we should label intermediate states not only with an ordinal but also with the input Symbol from the `DFST`) |
46 | toFST DFST{..} = flip execState initialFST $ forM_ (Map.toList stTransition) handleTransition | 46 | toFST DFST{..} = flip execState initialFST $ forM_ (Map.toList stTransition) handleTransition |
47 | where | 47 | where |
48 | initialFST = FST | 48 | initialFST = FST |
49 | { stInitial = (stInitial, 0) | 49 | { stInitial = (stInitial, Nothing) |
50 | , stTransition = Map.empty | 50 | , stTransition = Map.empty |
51 | , stAccept = Set.map (,0) stAccept | 51 | , stAccept = Set.map (, Nothing) stAccept |
52 | } | 52 | } |
53 | addTransition :: forall state input output. (Ord state, Ord input, Ord output) => (state, Maybe input) -> (state, Maybe output) -> State (FST state input output) () | 53 | addTransition :: forall state input output. (Ord state, Ord input, Ord output) => (state, Maybe input) -> (state, Maybe output) -> State (FST state input output) () |
54 | addTransition k v = modify $ \f@FST{ stTransition } -> f { FST.stTransition = Map.insertWith Set.union k (Set.singleton v) stTransition } | 54 | addTransition k v = modify $ \f@FST{ stTransition } -> f { FST.stTransition = Map.insertWith Set.union k (Set.singleton v) stTransition } |
55 | handleTransition :: ((state, input), (state, Seq output)) -> State (FST (state, Natural) input output) () | 55 | handleTransition :: ((state, input), (state, Seq output)) -> State (FST (state, Maybe (input, Natural)) input output) () |
56 | handleTransition ((st, inS), (st', outs)) = handleTransition' (st, 0) (Just inS) outs (st', 0) | 56 | handleTransition ((st, inS), (st', outs)) = handleTransition' (st, Nothing) (Just inS) outs (st', Nothing) |
57 | handleTransition' :: (state, Natural) -> Maybe input -> Seq output -> (state, Natural) -> State (FST (state, Natural) input output) () | 57 | handleTransition' :: (state, Maybe (input, Natural)) -> Maybe input -> Seq output -> (state, Maybe (input, Natural)) -> State (FST (state, Maybe (input, Natural)) input output) () |
58 | handleTransition' from inS Empty to = addTransition (from, inS) (to, Nothing) | 58 | handleTransition' from inS Empty to = addTransition (from, inS) (to, Nothing) |
59 | handleTransition' from inS (outS :<| Empty) to = addTransition (from, inS) (to, Just outS) | 59 | handleTransition' from inS (outS :<| Empty) to = addTransition (from, inS) (to, Just outS) |
60 | handleTransition' from@(st, i) inS (outS :<| oo) to = addTransition (from, inS) ((st, succ i), Just outS) >> handleTransition' (st, succ i) Nothing oo to | 60 | handleTransition' from@(st, chain) inS (outS :<| oo) to = do |
61 | let next | ||
62 | | Just (inS', i) <- chain = (st, Just (inS', succ i)) | ||
63 | | Just inS' <- inS = (st, Just (inS', 0 )) | ||
64 | | otherwise = error "TODO: Can this happen?" | ||
65 | addTransition (from, inS) (next, Just outS) | ||
66 | handleTransition' next Nothing oo to | ||
61 | 67 | ||
62 | runDFST :: forall state input output. (Ord state, Ord input) => DFST state input output -> Seq input -> Maybe (Seq output) | 68 | runDFST :: forall state input output. (Ord state, Ord input) => DFST state input output -> Seq input -> Maybe (Seq output) |
63 | runDFST dfst@DFST{..} str = let (finalState, str') = runDFST' dfst stInitial str Seq.empty | 69 | runDFST dfst@DFST{..} str = let (finalState, str') = runDFST' dfst stInitial str Seq.empty |