summaryrefslogtreecommitdiff
path: root/edit-lens/src/Control
diff options
context:
space:
mode:
Diffstat (limited to 'edit-lens/src/Control')
-rw-r--r--edit-lens/src/Control/DFST.lhs20
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
42toFST :: forall state input output. (Ord state, Ord input, Ord output) => DFST state input output -> FST (state, Natural) input output 42toFST :: 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`)
46toFST DFST{..} = flip execState initialFST $ forM_ (Map.toList stTransition) handleTransition 46toFST 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
62runDFST :: forall state input output. (Ord state, Ord input) => DFST state input output -> Seq input -> Maybe (Seq output) 68runDFST :: forall state input output. (Ord state, Ord input) => DFST state input output -> Seq input -> Maybe (Seq output)
63runDFST dfst@DFST{..} str = let (finalState, str') = runDFST' dfst stInitial str Seq.empty 69runDFST dfst@DFST{..} str = let (finalState, str') = runDFST' dfst stInitial str Seq.empty