From db70fb1c2dfe059c662fed9731bc9dd7ee380114 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 22 May 2018 15:31:08 +0200
Subject: Work on propL

---
 edit-lens/src/Control/FST.lhs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

(limited to 'edit-lens/src/Control/FST.lhs')

diff --git a/edit-lens/src/Control/FST.lhs b/edit-lens/src/Control/FST.lhs
index d37072f..4f1f364 100644
--- a/edit-lens/src/Control/FST.lhs
+++ b/edit-lens/src/Control/FST.lhs
@@ -10,7 +10,7 @@ module Control.FST
   -- * Constructing FSTs
   , wordFST
   -- * Operations on FSTs
-  , productFST, invertFST, restrictFST
+  , productFST, restrictFST
   -- * Debugging Utilities
   , liveFST
   ) where
@@ -35,8 +35,6 @@ import Control.Monad.State.Strict
 import Text.PrettyPrint.Leijen (Pretty(..))
 import qualified Text.PrettyPrint.Leijen as PP
 
-import Debug.Trace
-
 data FST state input output = FST
   { stInitial :: Set state
   , stTransition :: Map (state, Maybe input) (Set (state, Maybe output))
@@ -45,7 +43,7 @@ data FST state input output = FST
 
 instance (Show state, Show input, Show output) => Pretty (FST state input output) where
   pretty FST{..} = PP.vsep
-    [ PP.text "Initial states:" PP.</> PP.hang 2 (PP.list . map (PP.text . show) $ Set.toAscList stInitial)
+    [ PP.text "Initial states:" PP.</> PP.hang 2 (list . map (PP.text . show) $ Set.toAscList stInitial)
     , PP.text "State transitions:" PP.<$> PP.indent 2 (PP.vsep
         [        PP.text (show st)
           PP.<+> (PP.text "-" PP.<> PP.tupled [label inS, label outS] PP.<> PP.text "→")
@@ -53,14 +51,16 @@ instance (Show state, Show input, Show output) => Pretty (FST state input output
         | ((st, inS), to) <- Map.toList stTransition
         , (st', outS) <- Set.toAscList to
         ])
-    , PP.text "Accepting states:" PP.</> PP.hang 2 (PP.list . map (PP.text . show) $ Set.toAscList stAccept)
+    , PP.text "Accepting states:" PP.</> PP.hang 2 (list . map (PP.text . show) $ Set.toAscList stAccept)
     ]
     where
       label :: Show a => Maybe a -> PP.Doc
       label = maybe (PP.text "ɛ") (PP.text . show)
+      list :: [PP.Doc] -> PP.Doc
+      list = PP.encloseSep (PP.lbracket PP.<> PP.space) (PP.space PP.<> PP.rbracket) (PP.comma PP.<> PP.space)
 
 wordFST :: forall input output. Seq output -> FST Natural input output
--- ^ @wordFST str@ is the minimal FST generating @str@ as output when given no input
+-- ^ @wordFST str@ is the linear FST generating @str@ as output when given no input
 wordFST outs = FST
   { stInitial    = Set.singleton 0
   , stAccept     = Set.singleton l
@@ -77,7 +77,9 @@ wordFST outs = FST
 productFST :: forall state1 state2 input output. (Ord state1, Ord state2, Ord input, Ord output) => FST state1 input output -> FST state2 input output -> FST (state1, state2) input output
 -- ^ Cartesian product on states, logical conjunction on transitions and state-properties (initial and accept)
 --
--- This is most intuitive when thought of as the component-wise product of weighted FSTs with weights in the boolean semiring.
+-- This is the "natural" (that is component-wise) product when considering FSTs to be weighted in the boolean semiring.
+--
+-- Intuitively this corresponds to running both FSTs at the same time requiring them to produce the same output and "agree" (epsilon agreeing with every character) on their input.
 productFST fst1 fst2 = FST
   { stInitial    = stInitial fst1 `setProduct` stInitial fst2
   , stAccept     = stAccept fst1 `setProduct` stAccept fst2
@@ -99,6 +101,7 @@ productFST fst1 fst2 = FST
         out2 = (fromMaybe Set.empty $ stTransition fst2 !? (st2, inS)) `Set.union` (fromMaybe Set.empty $ stTransition fst2 !? (st2, Nothing))
 
 restrictFST :: forall state input output. (Ord state, Ord input, Ord output) => Set state -> FST state input output -> FST state input output
+-- ^ @restrictFST states fst@ removes from @fst@ all states not in @states@ including transitions leading to or originating from them
 restrictFST sts FST{..} = FST
   { stInitial    = stInitial `Set.intersection` sts
   , stAccept     = stAccept  `Set.intersection` sts
@@ -124,11 +127,8 @@ liveFST fst@FST{..} = flip execState Set.empty $ mapM_ (depthSearch Set.empty) s
       let acc' = Set.insert curr acc
           next = fromMaybe Set.empty $ stTransition' !? curr
       alreadyLive <- get
-      when (not . Set.null $ Set.insert curr next `Set.intersection` Set.union stAccept alreadyLive) $
+      when (curr `Set.member` Set.union stAccept alreadyLive) $
         modify $ Set.union acc'
+      alreadyLive <- get
       mapM_ (depthSearch acc') $ next `Set.difference` alreadyLive
-
-
-invertFST :: FST state input output -> Seq output -> Set (Seq input)
-invertFST = undefined
 \end{code}
-- 
cgit v1.2.3