diff --git a/FST/Arguments.hs b/FST/Arguments.hs --- a/FST/Arguments.hs +++ b/FST/Arguments.hs @@ -1,51 +1,81 @@ -{- - ************************************************************** - * Filename : Arguments.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : - * - ************************************************************** +{- | +Helper functions for handling shell/command-line options -} +module FST.Arguments ( -module FST.Arguments ( parseInteractive, - InteractiveCommand(..), - isFST, - isDAT, - isNET, - isTHIS, - parseBatch, - inputB, - outputB, - isUpB - ) where + -- * Commands ADT + InteractiveCommand (..), + BatchCommand (..), -import FST.GetOpt + -- * Helper functions + parseInteractive, + isFST, + isDAT, + isNET, + isTHIS, + parseBatch, + inputB, + outputB, + isUpB + ) where -data InteractiveCommand = BuildTransducer | - BuildNTransducer | - Minimize | - Determinize | - StdInReg String | - Load FilePath | - LUnion FilePath FilePath | - LProduct FilePath FilePath | - LStar FilePath | - LComposition FilePath FilePath | - Save FilePath | - ApplyDown | - ApplyUp | - ApplyD [String] | - ApplyU [String] | - ViewReg | - ViewInput | - ViewOutput | - ViewTransducer | - Help | - ClearMemory | - Quit | - NoCommand +import System.Console.GetOpt +import Data.List +import Data.Maybe +-- | ADT for a shell command +data InteractiveCommand = + -- | Build an epsilon-free, deterministic, minimal transducer from a + -- loaded/typed regular relation. + BuildTransducer + -- | Build an epsilon-free, possibly non-deterministic, non-minimal + -- transducer from a load/typed regular relation. + | BuildNTransducer + -- | Minimize a built transducer. + | Minimize + -- | Determinize a built transducer. + | Determinize + -- | Read a regular relation from standard input. + | StdInReg String + -- | Load from FILE. + | Load FilePath + -- | Load and union two transducers. + | LUnion FilePath FilePath + -- | Load and concatenate two transducers. + | LProduct FilePath FilePath + -- | Load and apply Kleene's star on a transducer. + | LStar FilePath + -- | Load and compose two transducers. + | LComposition FilePath FilePath + -- | Save to file. + | Save FilePath + -- | Apply transducer down with loaded input. + | ApplyDown + -- | Apply transducer up with loaded input. + | ApplyUp + -- | Apply tranducer down with given symbols. + | ApplyD [String] + -- | Apply tranducer up with given symbols. + | ApplyU [String] + -- | View loaded/typed regular relation. + | ViewReg + -- | View loaded input. + | ViewInput + -- | View prodeced output. + | ViewOutput + -- | View loaded/built transducer. + | ViewTransducer + -- | List commands. + | Help + -- | Clear loaded transducers/input/output. + | ClearMemory + -- | Quit the shell + | Quit + -- | Unparseable command + | NoCommand + deriving (Eq, Show) + +-- | Parse input string into a command parseInteractive :: [String] -> InteractiveCommand parseInteractive ["b"] = BuildTransducer parseInteractive ["bn"] = BuildNTransducer @@ -71,61 +101,69 @@ parseInteractive ["c"] = ClearMemory parseInteractive _ = NoCommand +-- | Does the file end with .fst? isFST :: String -> Bool -isFST str = case (reverse str) of - ('t':'s':'f':'.':_) -> True - _ -> False +isFST = isSuffixOf ".fst" +-- | Does the file end with .dat? isDAT :: String -> Bool -isDAT str = case (reverse str) of - ('t':'a':'d':'.':_) -> True - _ -> False +isDAT = isSuffixOf ".dat" +-- | Does the file end with .net? isNET :: String -> Bool -isNET str = case (reverse str) of - ('t':'e':'n':'.':_) -> True - _ -> False +isNET = isSuffixOf ".net" +-- | Is the internal transducer being specified? isTHIS :: String -> Bool isTHIS = (== "*") +-- | Is apply up? isApplyUp :: [String] -> Bool isApplyUp = elem "-u" -data BatchCommand = DownB | - UpB | - InvalidCommand | - Input String | - Output String | - HelpB - deriving Show +-- | Batch command ADT +data BatchCommand = + -- | Apply down + DownB + -- | Apply up + | UpB + -- | Invalid command + | InvalidCommand + -- | Take input from given file + | Input String + -- | Write output to file + | Output String + -- | Display help + | HelpB + deriving (Eq, Show) +-- | Information for parsing batch options batchOptions :: [OptDescr BatchCommand] -batchOptions = [Option ['u'] ["up"] (NoArg UpB) "apply the transducer up (default is down)", - Option ['d'] ["down"] (NoArg DownB) "apply the transducer down (default)", - Option ['i'] ["input"] (ReqArg Input "FILE") "read input from FILE", - Option ['o'] ["output"] (ReqArg Output "FILE") "write output to FILE"] +batchOptions = [ + Option ['u'] ["up"] (NoArg UpB) "apply the transducer up (default is down)", + Option ['d'] ["down"] (NoArg DownB) "apply the transducer down (default)", + Option ['i'] ["input"] (ReqArg Input "FILE") "read input from FILE", + Option ['o'] ["output"] (ReqArg Output "FILE") "write output to FILE" + ] +-- | Parse batch commands parseBatch :: [String] -> Either String (FilePath,[BatchCommand]) parseBatch cmdline = case getOpt Permute batchOptions cmdline of - (o,[file],[]) -> Right (file,o) - (_,_,errs) -> Left $ concat errs ++ usageInfo header batchOptions - where header = "Usage: fst [FILE.net or FILE.fst] [OPTIONS...]" + (o, [file], []) -> Right (file, o) + (_, _, errs) -> Left (concat errs ++ usageInfo header batchOptions) where + header = "Usage: fst [FILE.net or FILE.fst] [OPTIONS...]" -inputB :: [BatchCommand] -> Maybe FilePath -inputB [] = Nothing -inputB ((Input file):_) = return file -inputB (_:xs) = inputB xs +-- | Handle batch input command +inputB :: [BatchCommand] -> Maybe FilePath +inputB cs = listToMaybe [ file | Input file <- cs ] +-- | Handle batch output command outputB :: [BatchCommand] -> Maybe FilePath -outputB [] = Nothing -outputB ((Output file):_) = return file -outputB (_:xs) = outputB xs +outputB cs = listToMaybe [ file | Output file <- cs ] +-- | Is batch command apply up? isUpB :: [BatchCommand] -> Bool -isUpB [] = False -isUpB (UpB:_) = True -isUpB (_:xs) = isUpB xs +isUpB = elem UpB {- ----------------------------------------------------------------------------------------- diff --git a/FST/Automaton.hs b/FST/Automaton.hs --- a/FST/Automaton.hs +++ b/FST/Automaton.hs @@ -1,63 +1,57 @@ -{- - ************************************************************** - * Filename : Automaton.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 120 * - ************************************************************** +{- | +Finite state automatons -} - -module FST.Automaton ( module FST.AutomatonTypes, - Automaton, -- data type for an automaton - construct, -- construct an automaton. - Convertable, -- type class for conversion to - -- an from an 'Automaton'. - decode, -- from an automaton to an structure. - encode, -- from a structure to an Automaton. - rename, - showAutomaton - ) where +module FST.Automaton ( + module FST.AutomatonTypes, + + -- * Types + Automaton, + Convertable (decode, encode), + + -- * Automaton construction + construct, + + -- * Actions on automatons + rename, + showAutomaton, + + ) where import FST.AutomatonTypes import FST.Utils (tagging) - -import Data.Maybe (fromJust) +import Data.Maybe (fromJust, maybeToList) --- data type for an automaton +-- | Data type for an automaton data Automaton a = Automaton { - stateTrans :: TransitionTable a, - initialStates :: InitialStates, - finalStates :: FinalStates, - alpha :: Sigma a, - firstS :: FirstState, - lastS :: LastState - } - deriving (Show,Read) + stateTrans :: TransitionTable a, + initialStates :: InitialStates, + finalStates :: FinalStates, + alpha :: Sigma a, + firstS :: FirstState, + lastS :: LastState + } deriving (Show,Read) -- | Construct an automaton construct :: (FirstState,LastState) -> TransitionTable a -> Sigma a -> InitialStates -> FinalStates -> Automaton a construct bs table sigma inits fs = Automaton { - stateTrans = table, - initialStates = inits, - finalStates = fs, - alpha = sigma, - firstS = fst bs, - lastS = snd bs - } + stateTrans = table, + initialStates = inits, + finalStates = fs, + alpha = sigma, + firstS = fst bs, + lastS = snd bs + } --- |Instance of AutomatonFunctions +-- | Instance of AutomatonFunctions instance AutomatonFunctions Automaton where - states = (map fst).stateTrans - isFinal auto s = elem s (finalStates auto) + states = map fst . stateTrans + isFinal auto s = s `elem` finalStates auto initials = initialStates finals = finalStates transitionTable = stateTrans - transitionList auto s = case (lookup s (stateTrans auto)) of - Just tl -> tl - _ -> [] - transitions auto (s,a) = map snd $ filter (\(b,_) -> b == a) $ transitionList auto s + transitionList auto s = maybe [] id (lookup s (stateTrans auto)) + transitions auto (s,a) = [ st | (b, st) <- transitionList auto s, b == a ] firstState = firstS lastState = lastS alphabet = alpha @@ -65,32 +59,33 @@ -- | Convert automaton labelled with something other than -- states to an 'Automaton'. rename :: Eq b => [(b,[(a,b)])] -> Sigma a -> [b] -> [b] -> - State -> Automaton a + StateTy -> Automaton a rename tTable sigma initS fs s - = let (maxS,table) = tagging (map fst tTable) s - nI = map (\b -> lookupState b table) initS - nfs = map (\b -> lookupState b table) fs - nTrans = renameTable tTable table - in construct (s,maxS) nTrans sigma nI nfs - where lookupState st tab = fromJust $ lookup st tab + = let (maxS, table) = tagging (map fst tTable) s + nI = map (`lookupState` table) initS + nfs = map (`lookupState` table) fs + nTrans = renameTable tTable table + in construct (s, maxS) nTrans sigma nI nfs + where lookupState st tab = fromJust (lookup st tab) renameTable [] _ = [] renameTable ((b,tl):tll) table = let s1 = lookupState b table - ntl = map (\(a,b1) -> (a,lookupState b1 table)) tl - in (s1,ntl):renameTable tll table + ntl = map (\(a, b1) -> (a, lookupState b1 table)) tl + in (s1, ntl):renameTable tll table --- | Type class Convertable +-- | Type class for conversion to/from an automaton class Convertable f where - encode :: Eq a => f a -> Automaton a - decode :: Eq a => Automaton a -> f a + encode :: Eq a => f a -> Automaton a -- ^ From an automaton to an structure + decode :: Eq a => Automaton a -> f a -- ^ From a structure to an Automaton -- | Display the automaton showAutomaton :: Show a => Automaton a -> String -showAutomaton auto - = "\n>>>> Automaton Construction <<<<" ++ - "\n\nTransitions:\n" ++ aux (stateTrans auto) ++ - "\nNumber of States => " ++ show (length (stateTrans auto)) ++ - "\nInitials => " ++ show (initials auto) ++ - "\nFinals => " ++ show (finals auto) ++ "\n" - where aux [] = [] - aux ((s,tl):xs) = show s ++" => " ++ show tl ++ "\n" ++ aux xs +showAutomaton auto = unlines + [ "Transitions:" + , aux (stateTrans auto) + , "Number of States => " ++ show (length (stateTrans auto)) + , "Initials => " ++ show (initials auto) + , "Finals => " ++ show (finals auto) + ] + where + aux tr = unlines [ show s ++ " => " ++ show tl | (s, tl) <- tr ] diff --git a/FST/AutomatonInterface.hs b/FST/AutomatonInterface.hs --- a/FST/AutomatonInterface.hs +++ b/FST/AutomatonInterface.hs @@ -1,58 +1,65 @@ -{- - ************************************************************** - * Filename : AutomatonInterface.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 58 * - ************************************************************** +{- | +API for finite state automatons -} - -module FST.AutomatonInterface ( compileNFA, - minimize, - complete, - determinize, - compile, - Automaton, --- states, --- isFinal, - initial, --- finals, --- transitionList, --- transitions, - showAutomaton, - module FST.RegTypes, - module FST.AutomatonTypes, - numberOfStates, - numberOfTransitions - ) where +module FST.AutomatonInterface ( + module FST.RegTypes, + module FST.AutomatonTypes, + + -- * Types + Automaton, + + -- * Construction of automatons + compile, + compileNFA, + + -- * Transformation of automatons + determinize, + minimize, + complete, + + -- * Query inforation about automatons + initial, + numberOfStates, + numberOfTransitions, + showAutomaton, + ) where import FST.Automaton import FST.AutomatonTypes -import qualified FST.MinimalBrzozowski as M import FST.Complete import qualified FST.Deterministic as D import qualified FST.LBFA as L -import FST.RegTypes +import FST.RegTypes hiding (reversal) +import FST.Reversal (reversal) -compileNFA :: Ord a => Reg a -> Sigma a -> State -> Automaton a -compileNFA reg sigma s = L.compileToAutomaton reg sigma s +-- | Compile a non-deterministic finite-state automaton +compileNFA :: Ord a => Reg a -> Sigma a -> StateTy -> Automaton a +compileNFA = L.compileToAutomaton +-- | Minimize an automaton using the Brzozowski algorithm. Note that +-- the determinize function must construct an automaton with the +-- usefulS property. minimize :: Ord a => Automaton a -> Automaton a -minimize automaton = M.minimize automaton +minimize = determinize . reversal . determinize . reversal +{-# SPECIALIZE minimize :: Automaton String -> Automaton String #-} +-- | Make a non-deterministic finite-state automaton deterministic determinize :: Ord a => Automaton a -> Automaton a -determinize automaton = D.determinize automaton +determinize = D.determinize -compile :: Ord a => Reg a -> Sigma a -> State -> Automaton a +-- | Compile a minimized non-deterministic finite-state automaton +compile :: Ord a => Reg a -> Sigma a -> StateTy -> Automaton a compile reg sigma s = minimize $ L.compileToAutomaton reg sigma s -initial :: Automaton a -> State +-- | Get the initial state of a finite-state automaton +initial :: Automaton a -> StateTy initial automaton = head $ initials automaton +-- | Count the number of states in a finite-state automaton numberOfStates :: Ord a => Automaton a -> Int numberOfStates auto = length $ states auto +-- | Count the number of transitions in a finite-state automaton numberOfTransitions :: Ord a => Automaton a -> Int -numberOfTransitions auto = sum [length (transitionList auto s) | - s <- states auto] +numberOfTransitions auto = sum [length (transitionList auto s) + | s <- states auto] diff --git a/FST/AutomatonTypes.hs b/FST/AutomatonTypes.hs --- a/FST/AutomatonTypes.hs +++ b/FST/AutomatonTypes.hs @@ -1,63 +1,61 @@ -{- - ************************************************************** - * Filename : AutomatonTypes.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 71 * - ************************************************************** +{- | +Types for Automaton -} +module FST.AutomatonTypes ( -module FST.AutomatonTypes ( State, -- State. - FirstState, -- the first state. - LastState, -- the last state. - InitialStates, -- the initial states. - FinalStates, -- set of final states. - Transitions, -- set of transitions. - TransitionTable, -- table of transitions. - Sigma, -- the alphabet of an automaton. - AutomatonFunctions, -- Type class of automaton - -- functions. - states, -- get the states of an automaton. - isFinal, -- is the given state a final state? - initials, -- get the initial states of an automaton. - finals, -- get the final states of an automaton. - transitionTable, -- get the transitionTable. - transitionList, -- get the transitions w.r.t. a state. - transitions, -- get the transitions - -- w.r.t. a state and a symbol. - firstState, - lastState, -- get the maximum state of a automaton. - alphabet -- get the alphabet of an automaton. - ) where + -- * Types + StateTy, FirstState, LastState, InitialStates, FinalStates, + Transitions, TransitionTable, + Sigma, --- Types for Automaton + -- * Type class + AutomatonFunctions (..) + ) where -type State = Int +-- | A state +type StateTy = Int +-- | First state type FirstState = Int +-- | Last state type LastState = Int -type InitialStates = [State] +-- | Initial states +type InitialStates = [StateTy] -type FinalStates = [State] +-- | Final states +type FinalStates = [StateTy] -type Transitions a = [(a,State)] +-- | Transitions +type Transitions a = [(a, StateTy)] -type TransitionTable a = [(State,Transitions a)] +-- | Table of transitions +type TransitionTable a = [(StateTy, Transitions a)] +-- | The alphabet of an automaton type Sigma a = [a] -- | Class of AutomatonFunctions class AutomatonFunctions f where - states :: f a -> [State] - isFinal :: f a -> State -> Bool - finals :: f a -> FinalStates - initials :: f a -> InitialStates - transitionList :: f a -> State -> Transitions a - transitionTable :: f a -> TransitionTable a - transitions :: Eq a => f a -> (State, a) -> [State] - firstState :: Eq a => f a -> State - lastState :: Eq a => f a -> State - alphabet :: f a -> Sigma a + -- | Get the states of an automaton + states :: f a -> [StateTy] + -- | Is the given state a final state? + isFinal :: f a -> StateTy -> Bool + -- | Get the final states of an automaton + finals :: f a -> FinalStates + -- | Get the initial states of an automaton + initials :: f a -> InitialStates + -- | Get the transitions w.r.t. a state + transitionList :: f a -> StateTy -> Transitions a + -- | Get the transitionTable + transitionTable :: f a -> TransitionTable a + -- | Get the transitions w.r.t. a state and a symbol + transitions :: Eq a => f a -> (StateTy, a) -> [StateTy] + -- | Get the first state of a automaton + firstState :: Eq a => f a -> StateTy + -- | Get the last state of a automaton + lastState :: Eq a => f a -> StateTy + -- | Get the alphabet of an automaton + alphabet :: f a -> Sigma a + diff --git a/FST/Complete.hs b/FST/Complete.hs --- a/FST/Complete.hs +++ b/FST/Complete.hs @@ -1,28 +1,29 @@ -{- - ************************************************************** - * Filename : Complete.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 29 * - ************************************************************** --} +{-# LANGUAGE TupleSections #-} -module FST.Complete ( complete -- Makes a automaton complete (transition on every symbol at every state) - ) where +{- | +Function for making an automaton complete (transition on every symbol at every state) +-} +module FST.Complete ( + complete + ) where import FST.Automaton import Data.List ( (\\) ) +-- | Make a automaton complete (transition on every symbol at every state) complete :: Eq a => Automaton a -> Automaton a -complete auto = let sink = lastState auto + 1 - sinkTr = (sink,map (\a -> (a,sink)) (alphabet auto)) - newTrans = sinkTr:completeStates auto sink (states auto) [] - in construct (firstState auto,sink) newTrans (alphabet auto) (initials auto) (finals auto) +complete auto = + construct (firstState auto, sink) newTrans + (alphabet auto) (initials auto) + (finals auto) where + sink = lastState auto + 1 + sinkTr = (sink, map (,sink) (alphabet auto)) + newTrans = sinkTr:completeStates auto sink (states auto) [] -completeStates :: Eq a => Automaton a -> State -> [State] -> [(State,Transitions a)] -> [(State,Transitions a)] -completeStates _ _ [] trans = trans -completeStates auto sink (s:sts) trans - = let tr = transitionList auto s - nTr = map (\a -> (a,sink)) ((alphabet auto) \\ (map fst tr)) - in completeStates auto sink sts ((s,tr++nTr):trans) +completeStates :: Eq a => Automaton a -> StateTy -> [StateTy] -> [(StateTy,Transitions a)] -> [(StateTy,Transitions a)] +completeStates _ _ [] trans = trans +completeStates auto sink (state:states) trans + = completeStates auto sink states ((state, tr ++ nTr):trans) + where + tr = transitionList auto state + nTr = map (,sink) (alphabet auto \\ map fst tr) diff --git a/FST/Deterministic.hs b/FST/Deterministic.hs --- a/FST/Deterministic.hs +++ b/FST/Deterministic.hs @@ -1,49 +1,42 @@ -{- - ************************************************************** - * Filename : Deterministic.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 78 * - ************************************************************** +{- | +Function for making automatons deterministic -} - -module FST.Deterministic ( determinize -- Makes an automaton deterministic and usefulS. - ) where +module FST.Deterministic ( + determinize + ) where import FST.Automaton import Data.List (sort, nub) -{- ************************************* - * Types for subsets. * - ************************************* --} +-- | A subset is an ordered set without duplication +newtype SubSet = SubSet [StateTy] -newtype SubSet = SubSet [State] -- a subset is an ordered set - -- without duplication. -type SubSets = [SubSet] -type Done = SubSets -type UnDone = SubSets -type SubTransitions a = [(SubSet, [(a,SubSet)])] +-- | A list of subets +type SubSets = [SubSet] +-- | List of processed states +type Done = SubSets + +-- | List of unprocessed states +type UnDone = SubSets + +-- | Subset transitions +type SubTransitions a = [(SubSet, [(a, SubSet)])] + instance Eq (SubSet) where - (SubSet xs) == (SubSet ys) = xs == ys + SubSet xs == SubSet ys = xs == ys -sub :: [State] -> SubSet +sub :: [StateTy] -> SubSet sub sts = SubSet $ sort $ nub sts containsFinal :: Automaton a -> SubSet -> Bool -containsFinal automaton (SubSet xs) = or $ map (isFinal automaton) xs - -{- ************************************************ - * Construct a deterministic, usefulS automaton. * - ************************************************ --} +containsFinal automaton (SubSet xs) = any (isFinal automaton) xs +-- | Make an automaton deterministic and usefulS determinize :: Ord a => Automaton a -> Automaton a -determinize automaton = let inS = sub $ initials automaton in - det automaton ([],[inS]) [] +determinize automaton = let inS = sub $ initials automaton + in det automaton ([],[inS]) [] det :: Ord a => Automaton a -> (Done,UnDone) -> SubTransitions a -> Automaton a @@ -61,10 +54,10 @@ getTransitions :: Ord a => Automaton a -> SubSet -> SubTransitions a -> (SubSets, SubTransitions a) getTransitions auto subset@(SubSet xs) trans - = let tr = groupBySymbols (concat $ map (transitionList auto) xs) [] in - (map snd tr, ((subset,tr):trans)) + = let tr = groupBySymbols (concat $ map (transitionList auto) xs) [] + in (map snd tr, (subset,tr):trans) -groupBySymbols :: Eq a => [(a,State)] -> [(a,[State])] -> [(a,SubSet)] +groupBySymbols :: Eq a => [(a,StateTy)] -> [(a,[StateTy])] -> [(a,SubSet)] groupBySymbols [] tr = map (\(a,xs) -> (a,sub xs)) tr groupBySymbols ((a,s):xs) tr = groupBySymbols xs (ins (a,s) tr) where ins (a1,s1) [] = [(a1,[s1])] diff --git a/FST/DeterministicT.hs b/FST/DeterministicT.hs --- a/FST/DeterministicT.hs +++ b/FST/DeterministicT.hs @@ -1,48 +1,39 @@ -{- - ************************************************************** - * Filename : DeterministicT.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 78 * - ************************************************************** +{- | +Function for making transducers deterministic -} - -module FST.DeterministicT ( determinize, -- Makes an transducer deterministic - -- and usefulS. - ) where +module FST.DeterministicT ( + determinize + ) where import FST.Transducer import Data.List (sort, nub) +-- | A subset is an ordered set without duplication +newtype SubSet = SubSet [StateTy] -{- ************************************* - * Types for subsets. * - ************************************* --} +-- | A list of subets +type SubSets = [SubSet] -newtype SubSet = SubSet [State] -- a subset is an ordered set - -- without duplication. -type SubSets = [SubSet] -type Done = SubSets -type UnDone = SubSets -type SubTransitions a = [(SubSet, [(Relation a,SubSet)])] +-- | List of processed states +type Done = SubSets +-- | List of unprocessed states +type UnDone = SubSets + +-- | Subset transitions +type SubTransitions a = [(SubSet, [(Relation a,SubSet)])] + instance Eq (SubSet) where (SubSet xs) == (SubSet ys) = xs == ys -sub :: [State] -> SubSet +sub :: [StateTy] -> SubSet sub sts = SubSet $ sort $ nub sts containsFinal :: Transducer a -> SubSet -> Bool containsFinal automaton (SubSet xs) = or $ map (isFinal automaton) xs -{- ************************************************ - * Construct a deterministic, usefulS automaton. * - ************************************************ --} - +-- | Construct a deterministic, usefulS transducer determinize :: Ord a => Transducer a -> Transducer a determinize automaton = let inS = sub $ initials automaton in det automaton ([],[inS]) [] @@ -66,7 +57,7 @@ = let tr = groupBySymbols (concat $ map (transitionList auto) xs) [] in (map snd tr, ((subset,tr):trans)) -groupBySymbols :: Eq a => [(a,State)] -> [(a,[State])] -> [(a,SubSet)] +groupBySymbols :: Eq a => [(a,StateTy)] -> [(a,[StateTy])] -> [(a,SubSet)] groupBySymbols [] tr = map (\(a,xs) -> (a,sub xs)) tr groupBySymbols ((a,s):xs) tr = groupBySymbols xs (ins (a,s) tr) where ins (a1,s1) [] = [(a1,[s1])] diff --git a/FST/EpsilonFreeT.hs b/FST/EpsilonFreeT.hs --- a/FST/EpsilonFreeT.hs +++ b/FST/EpsilonFreeT.hs @@ -1,46 +1,40 @@ -{- - ************************************************************** - * Filename : EpsilonFreeT.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 7 July, 2001 * - * Lines : 46 * - ************************************************************** --} - -module FST.EpsilonFreeT (epsilonfree -- construct an epsilonfree, - -- usefulS transducer. - ) where - -import FST.Transducer -import Data.List (partition) - -epsilonfree :: Eq a => Transducer a -> Transducer a -epsilonfree transducer - = epsFree transducer ([],initials transducer) [] [] - -epsFree :: Eq a => Transducer a -> ([State],[State]) -> FinalStates -> - [(State,[(Relation a,State)])] -> Transducer a -epsFree transducer (_,[]) fs table - = construct (firstState transducer, lastState transducer) - table (alphabet transducer) (initials transducer) fs -epsFree transducer (done,(s:undone)) fs table - = let (newtl,fsB) = stateEpsRemove [] (transitionList transducer s) - ([],False) - newSts = map snd $ filter (\(_,s1) -> not (elem s1 (s:done))) newtl - in epsFree transducer (s:done,newSts ++ undone) - (if (fsB || isFinal transducer s) then (s:fs) else fs) - ((s,newtl):table) - where epsTransitions = ( \ ((a,b),_) -> (a == Eps) && (b == Eps) ) - stateEpsRemove _ [] (tl,fsB) = (tl,fsB) - stateEpsRemove history tlist (tl,fsB) - = case (partition epsTransitions tlist) of - ( [],ntl) -> (tl++ntl,fsB) - (epstl,ntl) -> let newSts = map snd $ - filter (\(_,s1) -> not (elem s1 history)) - epstl - fsBnew = or $ map (isFinal transducer) newSts - in stateEpsRemove (newSts++history) - (concat (map (transitionList transducer) - newSts)) - (ntl++tl,fsB || fsBnew) +{- | +Function for constructing an epsilon-free transducer +-} +module FST.EpsilonFreeT ( + epsilonfree + ) where + +import FST.Transducer +import Data.List (partition) + +-- | Construct an epsilon-free, usefulS transducer +epsilonfree :: Eq a => Transducer a -> Transducer a +epsilonfree transducer + = epsFree transducer ([],initials transducer) [] [] + +epsFree :: Eq a => Transducer a -> ([StateTy],[StateTy]) -> FinalStates -> + [(StateTy,[(Relation a,StateTy)])] -> Transducer a +epsFree transducer (_,[]) fs table + = construct (firstState transducer, lastState transducer) + table (alphabet transducer) (initials transducer) fs +epsFree transducer (done,(s:undone)) fs table + = let (newtl, fsB) = stateEpsRemove [] (transitionList transducer s) + ([], False) + newSts = filter (`notElem` s:done) (map snd newtl) + in epsFree transducer (s:done, newSts ++ undone) + (if fsB || isFinal transducer s then s:fs else fs) + ((s,newtl):table) + where + epsTransitions :: Eq a => ((Symbol a, Symbol a), t) -> Bool + epsTransitions (eps, _) = eps == (Eps, Eps) + + stateEpsRemove _ [] (tl, fsB) = (tl,fsB) + stateEpsRemove history tlist (tl, fsB) + = case partition epsTransitions tlist of + ([], ntl) -> (tl ++ ntl, fsB) + (epstl, ntl) -> let newSts = filter (`notElem` history) (map snd epstl) + fsBnew = any (isFinal transducer) newSts + in stateEpsRemove (newSts ++ history) + (concatMap (transitionList transducer) newSts) + (ntl ++ tl, fsB || fsBnew) diff --git a/FST/FSTStudio.hs b/FST/FSTStudio.hs new file mode 100644 --- /dev/null +++ b/FST/FSTStudio.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE DoAndIfThenElse, FlexibleContexts, GeneralizedNewtypeDeriving #-} + +{- | +fstStudio takes a program consisting of regular relations that denotes +the relation between two regular languages and constructs a +transducer. If a regular expression, not a relation, is given, then it +is interpreted as the identity relation. The syntax is very similar to +Xerox's finite state transducer syntax with two fundamental +differences: a distinction is made between functions (definitions) and +strings, and fststudio allows functional definitions. + +[@\"a\"@] A symbol. Example: @[\"b\"]@ denotes the language @{\"b\"}@. + +[@a@] A variable. A symbol without quotes is a variable. + +[@\"a\":\"b\"@] Describes a relation between the symbol @a@ and @b@. +This relation is ordered and @a@ is said to be a part of the /upper +language/ and @b@ is said to be part of the /lower language/. +Example: @[\"a\":\"b\"]@ denotes the relation @{(\"a\",\"b\")}@. + +[@0@] Epsilon symbol. The epsilon symbol denotes the string with no +symbols. Example: @[0]@ denotes the language @{\"\"}@. + +[@?@] All symbol. The all symbol denotes the union of all symbols in +the alphabet. Example: @[?]@ and an alphabet @{a,b,c}@ denotes the +language @{\"a\",\"b\",\"c\"}@. + +[@\"\"@] quotes cancel every special meaning of the symbols. Example: +@[\"? 0\"]@ denotes the language @{\"? 0\"}@. + +[@\[A\]@] brackets are used to change the precedence of a regular +relation. + +[@(A)@] parenthesis expresses optionality, and has the same meaning as +@[A|0]@. + +[@A B@] Concatenation of the expressions or relations A and +B. Example: @[[a b] [c d]]@ denotes the language @{\"ac\", \"ad\", \"bc\", +\"bd\"}@ + +[@A^n@] Concatenation of @A@ /n/ times. @A^0@ is defined as the empty +string. Example: @[a]^3@ describes the language @{\"aaa\"}@. + +[@A|B@] Union of the languages or relations @A@ and @B@. Example: @[a|b]@ +describes the language @{\"a\",\"b\"}@. + +[@A & B@] Intersection of the languages @A@ and @B@. Example: @[a b] +& [a]@ describes the language @{\"a\"}@. + +[@A - B@] Minus of the languages @A@ and @B@, and has the same meaning as +@[A & B]@. Example: @[a b] - [a]@ describes the language @{\"b\"}@. + +[@~A@] Describes the complement of an expression, and has the same +meaning as @[?* - A]@. Note that complement is always defined over +an alphabet. The expression @[A]@ is only unambiguous with respect to +an alphabet. Example: @[a]@ denotes the language that doesn't contain +the string @\"a\"@. If the alphabet is @{\"a\",\"b\"}@ then @[a]@ +denotes the language @{\"\",\"b\",\"aa\",\"ba\",...}@. + +[@A+@] Repetition (Kleenes plus). A concatenated with itself an +arbitrary number of times, including zero times. Example: @[a]+@ denotes +the infinite language @{\"a\",\"aa\",\"aaa\",...}@ + +[@A*@] Kleene’s star: @[A+ | 0]@. Example: @[a]*@ denotes the infinite +language @{\"\",\"a\",\"aa\",...}@ + +[@$A@] Containment. The set of strings where @A@ appear at least once +as a substring. Containment is the same thing as @[?* A ?*]@. + +[@A .x. B@] Cross product of the languages @A@ and @B@. Example: @[[a b] +.x. c]@ describes the relations @{(\"a\",\"c\"), (\"b\",\"c\")}@. + +[@A .o. B@] Composition of the relations @A@ and @B@. Example: @[a:b c:d] +.o. [d:e]@ describes the relation @{(\"c\",\"e\")}@. + +The precedence of the operators is as follows, where 4 is the highest +precedence: + + 1. @.x.@ @.o.@ + + 2. @&@ @-@ + + 3. /Concatenation/ + + 4. @~@ @^@ @*@ @+@ @$@ + +A file containing a program must end with @.fst@, and an input file +mustend with @.dat@. A program is a collection of functions defining +regular relations. A function with zero arguments is called a +definition or a macro. A definition, or a macro, can for example look +like this: + +> ::= "1" | "2" | "3" | "4" | "5" | +> "6" | "7" | "8" | "9" | "0" ; + +and a function can look like this: + +> ::= b a ; + +Note that strings are marked with quotes, and variables have no +quotes. Every program must contain a @\@ definition (a program +without one will result in a parse error). + +>
::= ... ; + +The alphabet of a program is the symbols in the regular relation +defined in the program. + +/Example program/ + +> ::= ["n" .x. "c"^5]; +> ::= ["d" .x. "c"^10]; +> ::= ["q" .x. "c"^25]; +> ::= ["c" .x. "c"]; +> ::= [ | | | ]*; +> ::= ["c"^65 .x. "PLONK"]; +>
::= [ .o. ]; + +/Batch mode/ + +Usage: @fst FILE [Options]@. FILE must end with @.fst@, which defines +an FstStudio program, or @.net@, which defines a saved transducer. If +no options are given, then input is taken from standard input, the +transducer is applied down, and the output, if any, is produced on +standard output. + +[@-u@] Apply the transducer up + +[@-d@] Apply the transducer down + +[@-i FILE@] Take input from FILE + +[@-o FILE@] Write output to FILE + +/Interactive mode - list of commands/ + +[@r REG@] Read a regular relation from standard input. If a regular +expression is typed, then it is interpreted as the identity relation. + +[@b@] Build an epsilon-free, deterministic, minimal transducer from a +loaded/typed regular relation. + +[@bn@] Build an epsilon-free, possibly non-deterministic, non-minimal +transducer from a load/typed regular relation. + +[@m@] Minimize a built transducer. + +[@det@] Determinize a built transducer. + +[@s FILE@] Save to @FILE@. If @FILE@ ends with @.net@, then the built +transducer is saved. Any other suffix saves the produced output in the +system to @FILE@, if any. + +[@l FILE@] Load from @FILE@. @FILE@ must end with @.fst@, @.net@ or +@.dat@. If @FILE@ ends with @.fst@, then a FstStudio program is loaded +into FstStudio. If @FILE@ ends with @.net@, then a transducer is loaded +into FstStudio. If @FILE@ ends with @.dat@, then input is loaded into +FstStudio. + +[@l a | b@] Load and union two transducers. a and b must either be a +file ending with @.net@ or the symbol @*@, which refers to the interior +transducer. The produced transducer is possibly non-deterministic and +non-minimal. + +[@l a b@] Load and concatenate two transducers. a and b must either be +ale ending with @.net@ or the symbol @*@, which refers to the interior +transducer. The produced transducer is possibly non-deterministicand +non-minimal. + +[@l a*@] Load and apply Kleene’s star on a transducer. a must either +be a file ending with @.net@ or the symbol @*@, which refers to the +interior transducer. The produced transducer is possibly +non-deterministicand non-minimal. + +[@l a .o. b@] Load and compose two transducers. a and b must either be +a file ending with @.net@ or the symbol @*@, which refers to the +interior transducer. The produced transducer is possibly +non-deterministic andnon-minimal. + +[@vt@] View loaded/built transducer. + +[@vr@] View loaded/typed regular relation. + +[@vi@] View loaded input. + +[@vo@] View produced output. + +[@d@] Apply transducer down with loaded input. + +[@u@] Apply transducer up with loaded input. + +[@d SYMBOLS@] Apply tranducer down with @SYMBOLS@. + +[@u SYMBOLS@] Apply transducer up with @SYMBOLS@. + +[@c@] Clear memory. + +[@h@] List commands. + +[@q@] End session. + +-} +module FST.FSTStudio where + +-- This is a dummy module for the sake of documenation + diff --git a/FST/FileImport.hs b/FST/FileImport.hs deleted file mode 100644 --- a/FST/FileImport.hs +++ /dev/null @@ -1,24 +0,0 @@ -{- - ************************************************************** - * Filename : FileImport.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 25 * - ************************************************************** --} - -module FST.FileImport (open,saveToFile) where -import System.IO.Error (try) - -open :: FilePath -> IO (Either String String) -open file = do res <- try (readFile file) - case res of - Right res -> return $ Right res - Left res -> return $ Left $ "\nError:\tUnable to open \"" ++ file ++"\".\n" - -saveToFile :: FilePath -> String -> IO (Either String ()) -saveToFile file str = do res <- try (writeFile file str) - case res of - Right res -> return $ Right () - Left res -> return $ Left $ "\nError:\tUnable to save to \"" ++ file ++"\".\n" diff --git a/FST/GetOpt.hs b/FST/GetOpt.hs deleted file mode 100644 --- a/FST/GetOpt.hs +++ /dev/null @@ -1,154 +0,0 @@ ------------------------------------------------------------------------------------------ --- A Haskell port of GNU's getopt library --- --- Sven Panne Oct. 1996; last change: Jul. 1998 --- --- Two rather obscure features are missing: The Bash 2.0 non-option hack (if you don't --- already know it, you probably don't want to hear about it...) and the recognition of --- long options with a single dash (e.g. '-help' is recognised as '--help', as long as --- there is no short option 'h'). --- --- Other differences between GNU's getopt and this implementation: --- * To enforce a coherent description of options and arguments, there are explanation --- fields in the option/argument descriptor. --- * Error messages are now more informative, but no longer POSIX compliant... :-( --- --- And a final Haskell advertisement: The GNU C implementation uses well over 1100 lines, --- we need only 199 here, including a 46 line example! :-) ------------------------------------------------------------------------------------------ - -module FST.GetOpt ( - ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, getOpt - ) where - -import Data.List (isPrefixOf) - -data ArgOrder a -- what to do with options following non-options: - = RequireOrder -- no option processing after first non-option - | Permute -- freely intersperse options and non-options - | ReturnInOrder (String -> a) -- wrap non-options into options - -data OptDescr a = -- description of a single options: - Option [Char] -- list of short option characters - [String] -- list of long option strings (without "--") - (ArgDescr a) -- argument descriptor - String -- explanation of option for user - -data ArgDescr a -- description of an argument option: - = NoArg a -- no argument expected - | ReqArg (String -> a) String -- option requires argument - | OptArg (Maybe String -> a) String -- optional argument - -data OptKind a -- kind of cmd line arg (internal use only): - = Opt a -- an option - | NonOpt String -- a non-option - | EndOfOpts -- end-of-options marker (i.e. "--") - | OptErr String -- something went wrong... - -usageInfo :: String -- header - -> [OptDescr a] -- option descriptors - -> String -- nicely formatted decription of options -usageInfo header optDescr = unlines (header:table) - where (ss,ls,ds) = (unzip3 . map fmtOpt) optDescr - table = zipWith3 paste (sameLen ss) (sameLen ls) (sameLen ds) - paste x y z = " " ++ x ++ " " ++ y ++ " " ++ z - sameLen xs = flushLeft ((maximum . map length) xs) xs - flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ] - -fmtOpt :: OptDescr a -> (String,String,String) -fmtOpt (Option sos los ad descr) = (sepBy ", " (map (fmtShort ad) sos), - sepBy ", " (map (fmtLong ad) los), - descr) - where sepBy _ [] = "" - sepBy _ [x] = x - sepBy sep (x:xs) = x ++ sep ++ sepBy sep xs - -fmtShort :: ArgDescr a -> Char -> String -fmtShort (NoArg _ ) so = "-" ++ [so] -fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad -fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]" - -fmtLong :: ArgDescr a -> String -> String -fmtLong (NoArg _ ) lo = "--" ++ lo -fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad -fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]" - -getOpt :: ArgOrder a -- non-option handling - -> [OptDescr a] -- option descriptors - -> [String] -- the commandline arguments - -> ([a],[String],[String]) -- (options,non-options,error messages) -getOpt _ _ [] = ([],[],[]) -getOpt ordering optDescr args = procNextOpt opt ordering - where procNextOpt (Opt o) _ = (o:os,xs,es) - procNextOpt (NonOpt x) RequireOrder = ([],x:rest,[]) - procNextOpt (NonOpt x) Permute = (os,x:xs,es) - procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,es) - procNextOpt EndOfOpts RequireOrder = ([],rest,[]) - procNextOpt EndOfOpts Permute = ([],rest,[]) - procNextOpt EndOfOpts (ReturnInOrder f) = (map f rest,[],[]) - procNextOpt (OptErr e) _ = (os,xs,e:es) - - (opt,rest) = getNext args optDescr - (os,xs,es) = getOpt ordering optDescr rest - --- take a look at the next cmd line arg and decide what to do with it -getNext :: [String] -> [OptDescr a] -> (OptKind a,[String]) -getNext (('-':'-':[]):rest) _ = (EndOfOpts,rest) -getNext (('-':'-':xs):rest) optDescr = longOpt xs rest optDescr -getNext (('-':x:xs) :rest) optDescr = shortOpt x xs rest optDescr -getNext (a :rest) _ = (NonOpt a,rest) -getNext [] _ = error "getNext: impossible" - --- handle long option -longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) -longOpt xs rest optDescr = long ads arg rest - where (opt,arg) = break (=='=') xs - options = [ o | o@(Option _ ls _ _) <- optDescr, l <- ls, opt `isPrefixOf` l ] - ads = [ ad | Option _ _ ad _ <- options ] - optStr = ("--"++opt) - - long (_:_:_) _ rest1 = (errAmbig options optStr,rest1) - long [NoArg a ] [] rest1 = (Opt a,rest1) - long [NoArg _ ] ('=':_) rest1 = (errNoArg optStr,rest1) - long [ReqArg _ d] [] [] = (errReq d optStr,[]) - long [ReqArg f _] [] (r:rest1) = (Opt (f r),rest1) - long [ReqArg f _] ('=':ys) rest1 = (Opt (f ys),rest1) - long [OptArg f _] [] rest1 = (Opt (f Nothing),rest1) - long [OptArg f _] ('=':ys) rest1 = (Opt (f (Just ys)),rest1) - long [_] (_ :_) _ = error "long: impossible" - long [] _ rest1 = (errUnrec optStr,rest1) - --- handle short option -shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String]) -shortOpt x xs rest optDescr = short ads xs rest - where options = [ o | o@(Option ss _ _ _) <- optDescr, s <- ss, x == s ] - ads = [ ad | Option _ _ ad _ <- options ] - optStr = '-':[x] - - short (_:_:_) _ rest1 = (errAmbig options optStr,rest1) - short (NoArg a :_) [] rest1 = (Opt a,rest1) - short (NoArg a :_) ys rest1 = (Opt a,('-':ys):rest1) - short (ReqArg _ d:_) [] [] = (errReq d optStr,[]) - short (ReqArg f _:_) [] (r:rest1) = (Opt (f r),rest1) - short (ReqArg f _:_) ys rest1 = (Opt (f ys),rest1) - short (OptArg f _:_) [] rest1 = (Opt (f Nothing),rest1) - short (OptArg f _:_) ys rest1 = (Opt (f (Just ys)),rest1) - short [] [] rest1 = (errUnrec optStr,rest1) - short [] ys rest1 = (errUnrec optStr,('-':ys):rest1) - --- miscellaneous error formatting - -errAmbig :: [OptDescr a] -> String -> OptKind a -errAmbig ods optStr = OptErr (usageInfo header ods) - where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:" - -errReq :: String -> String -> OptKind a -errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n") - -errUnrec :: String -> OptKind a -errUnrec optStr = OptErr ("unrecognized option `" ++ optStr ++ "'\n") - -errNoArg :: String -> OptKind a -errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n") - - diff --git a/FST/Info.hs b/FST/Info.hs --- a/FST/Info.hs +++ b/FST/Info.hs @@ -1,122 +1,72 @@ -{- - ************************************************************** - * Filename : Info.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 89 * - ************************************************************** +{- | +State data structure for the interactive shell -} - module FST.Info where import FST.TransducerInterface +-- | State in interactive shell data Info = Info { - transducer :: (Transducer String,Bool), - expression :: (RReg String,Bool), - input :: ([String],Bool), - outputs :: ([String],Bool) - } - -clearInfo :: Info -> Info -clearInfo info = info { transducer = (emptyTransducer,False), - expression = (empty,False), - input = ([],False), - outputs = ([],False) } + transducer :: (Transducer String, Bool), + expression :: (RReg String, Bool), + input :: ([String], Bool), + outputs :: ([String], Bool) + } deriving (Show) +-- | Empty information emptyInfo :: Info emptyInfo = Info { - transducer = (emptyTransducer,False), - expression = (empty,False), - input = ([],False), - outputs = ([],False) - } + transducer = (emptyTransducer, False), + expression = (empty, False), + input = ([], False), + outputs = ([], False) + } +-- | Is there a built transducer in the state? transducerBuilt :: Info -> Bool -transducerBuilt info = snd $ transducer info +transducerBuilt = snd . transducer +-- | Is there a read expression in the state? expressionRead :: Info -> Bool -expressionRead info = snd $ expression info +expressionRead = snd . expression +-- | Is there an input in the state? inputRead :: Info -> Bool -inputRead info = snd $ input info +inputRead = snd . input +-- | Is there an output in the state? outputsRead :: Info -> Bool -outputsRead info = snd $ outputs info +outputsRead = snd . outputs +-- | Set transducer in state updateTransducer :: Transducer String -> Info -> Info -updateTransducer t info = info {transducer = (t,True)} +updateTransducer t info = info { transducer = (t, True) } +-- | Set expression in state updateExpression :: RReg String -> Info -> Info -updateExpression r info = info {expression = (r,True)} +updateExpression r info = info { expression = (r, True) } +-- | Set input in state updateInput :: [String] -> Info -> Info -updateInput inp info = info {input = (inp,True)} +updateInput inp info = info { input = (inp, True) } +-- | Set outputs in state updateOutputs :: [String] -> Info -> Info -updateOutputs out info = info { outputs = (out,True)} +updateOutputs out info = info { outputs = (out, True) } +-- | Get transducer from state getTransducer :: Info -> Transducer String -getTransducer = fst.transducer +getTransducer = fst . transducer +-- | Get expression from state getExpression :: Info -> RReg String -getExpression = fst.expression +getExpression = fst . expression +-- | Get input from state getInput :: Info -> [String] -getInput = fst.input +getInput = fst . input +-- | Get outputs from state getOutputs :: Info -> [String] -getOutputs = fst.outputs - -noTransducer :: IO () -noTransducer = do putStrLn "No transducer has been loaded/built." - -noExpression :: IO () -noExpression = do putStrLn "No regular expression has been typed/loaded into fstStudio." - -noInput :: IO () -noInput = do putStrLn "No input has been loaded into fstStudio." - -noOutputs :: IO () -noOutputs = do putStrLn "No outputs has been produced." - -help :: IO () -help = do putStrLn "\nList of Commands:" - putStrLn "r : read a regular relation from standard input." - putStrLn "b : build a deterministic, minimal transducer." - putStrLn "bn : build a possibly non-deterministic, non-minimal transducer." - putStrLn "m : minimize loaded/built transducer." - putStrLn "det : determinize loaded/built transducer." - putStrLn "s : save to file." - putStrLn "l : load from file." - putStrLn "l a | b : load and union." - putStrLn "l a b : load and concatenate." - putStrLn "l a * : load and apply Kleene's star." - putStrLn "l a .o. b : load and compose." - putStrLn "vt : view loaded/built transducer." - putStrLn "vr : view typed/loaded regular relation." - putStrLn "vi : view loaded input." - putStrLn "vo : view produced output." - putStrLn "d : apply transducer down with loaded input." - putStrLn "u : apply transducer up with loaded input." - putStrLn "d : apply transducer down with symbols." - putStrLn "u : apply transducer up with symbols." - putStrLn "c : Clear memory." - putStrLn "h : display list of commands." - putStrLn "q : end session.\n" - -prompt :: IO () -prompt = do putStr ">" +getOutputs = fst . outputs -fstStudio :: IO () -fstStudio = do putStrLn "\n*****************************************************" - putStrLn "* Welcome to Finite State Transducer Studio! *" - putStrLn "* Written purely in Haskell. *" - putStrLn "* Version : 0.9 *" - putStrLn "* Date : 11 August 2001 *" - putStrLn "* Author : Markus Forsberg *" - putStrLn "* Please send bug reports/suggestions to: *" - putStrLn "* d97forma@dtek.chalmers.se *" - putStrLn "*****************************************************\n" - putStrLn "Type 'h' for help.\n" diff --git a/FST/LBFA.hs b/FST/LBFA.hs --- a/FST/LBFA.hs +++ b/FST/LBFA.hs @@ -1,30 +1,21 @@ -{- - ************************************************************** - * Filename : LBFA.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 7 July, 2001 * - * Lines : 279 * - ************************************************************** +{- | +Left-biased finite automata -} +module FST.LBFA ( + module FST.Automaton, -module FST.LBFA ( module FST.Automaton, - LBFA, -- Data type for LBFA --- states, -- get the states of a LBFA --- finals, -- get the final states of a LBFA --- isFinal, -- check if a state is a final state. --- transitionTable, --- transitionList, -- get the transitions of a state. --- transitions, -- get the transitions of a state and a symbol --- alphabet, -- get the alphabet of a LBFA. - initial, -- get the initial state of a LBFA. --- lastState, -- get the max state of a LBFA. - compileToLBFA, - compileToAutomaton - ) where + -- * Types + LBFA, + -- * Functions on LBFA + initial, + compileToLBFA, + compileToAutomaton + ) where + +import Control.Monad.State + import FST.RegTypes -import FST.StateMonad import FST.Automaton import FST.Deterministic import FST.Complete @@ -32,234 +23,216 @@ import Data.List (delete,nub,(\\)) -{- ********************************************************** - * data type for a LBFA * - ********************************************************** --} - +-- | Data type for LBFA (left-biased finite automata) data LBFA a = LBFA { - trans :: [(State, Transitions a)], - initS :: State, - finalS :: [State], - alpha :: Sigma a, - lastS :: State - } - -{- ********************************************************** - * LBFA functions * - ********************************************************** --} + trans :: [(StateTy, Transitions a)], + initS :: StateTy, + finalS :: [StateTy], + alpha :: Sigma a, + lastS :: StateTy + } instance AutomatonFunctions LBFA where - states lbfa = map fst $ trans lbfa - isFinal lbfa s = elem s (finals lbfa) - initials lbfa = [(initS lbfa)] - finals = finalS - transitionTable = trans - transitionList lbfa s = case(lookup s (trans lbfa)) of - Just tl -> tl - _ -> [] - transitions lbfa (s,a) = map snd $ filter (\(b,_) -> a == b) $ transitionList lbfa s - firstState = minimum.states - lastState = lastS - alphabet = alpha + -- | Get the states of a LBFA + states lbfa = map fst (trans lbfa) + -- | Check if a state is a final state. + isFinal lbfa s = elem s (finals lbfa) + -- | Get the initial states of a LBFA + initials lbfa = [(initS lbfa)] + -- | Get the final states of a LBFA + finals = finalS + -- | Get the transition table + transitionTable = trans + -- | Get the transitions of a state + transitionList lbfa s = case lookup s (trans lbfa) of + Just tl -> tl + _ -> [] + -- | Get the transitions of a state and a symbol + transitions lbfa (s, a) = [ st | (b, st) <- transitionList lbfa s, a == b ] + -- | + firstState = minimum . states + -- | Get the max state of a LBFA + lastState = lastS + -- | Get the alphabet of a LBFA + alphabet = alpha -initial :: LBFA a -> State -initial lbfa = (initS lbfa) +-- | Get the initial state of a LBFA +initial :: LBFA a -> StateTy +initial = initS +-- | Does the LBFA accept epsilon? acceptEpsilon :: LBFA a -> Bool acceptEpsilon lbfa = isFinal lbfa (initial lbfa) -{- ********************************************************** - * compile a regular expression to a LBFA * - ********************************************************** --} - -compileToLBFA :: Ord a => Reg a -> Sigma a -> State -> LBFA a -compileToLBFA reg sigma s = run (build reg (nub (sigma++symbols reg))) s - -{- ************************************************************************ - * compile a regular expression to an minimal, useful and deterministic * - * Automaton, using the LBFA algorithm while building. * - ************************************************************************ --} -compileToAutomaton :: Ord a => Reg a -> Sigma a -> State -> Automaton a -compileToAutomaton reg sigma s = encode $ compileToLBFA reg sigma s - -{- ************************************************************************ - * Building a LBFA from a regular expression * - ************************************************************************ --} - -build :: Ord a => Reg a -> Sigma a -> STM (LBFA a) -build (Empty) sigma = do s <- fetchState - return $ LBFA { - trans = [(s,[])], - initS = s, - finalS = [], - alpha = sigma, - lastS = s - } +-- | Compile a regular expression to a LBFA +compileToLBFA :: Ord a => Reg a -> Sigma a -> StateTy -> LBFA a +compileToLBFA reg sigma = evalState $ build reg $ nub $ sigma ++ symbols reg -build (Epsilon) sigma = do s <- fetchState - return $ LBFA { - trans = [(s,[])], - initS = s, - finalS = [s], - alpha = sigma, - lastS = s - } +-- | Compile a regular expression to an minimal, useful and +-- deterministic automaton, using the LBFA algorithm while building. +compileToAutomaton :: Ord a => Reg a -> Sigma a -> StateTy -> Automaton a +compileToAutomaton reg sigma s = encode (compileToLBFA reg sigma s) -build (Symbol a) sigma = do s1 <- fetchState - s2 <- fetchState - return $ LBFA { - trans = [(s1,[(a,s2)]),(s2,[])], - initS = s1, - finalS = [s2], - alpha = sigma, - lastS = s2 - } +fetchState :: State StateTy StateTy +fetchState = do + state <- get + put (state + 1) + return state -build (All) sigma = build (allToSymbols sigma) sigma +-- | Build a LBFA from a regular expression +build :: Ord a => Reg a -> Sigma a -> State StateTy (LBFA a) +build Empty sigma = do + s <- fetchState + return $ LBFA { + trans = [(s, [])], + initS = s, + finalS = [], + alpha = sigma, + lastS = s + } + +build Epsilon sigma = do + s <- fetchState + return LBFA { + trans = [(s, [])], + initS = s, + finalS = [s], + alpha = sigma, + lastS = s + } -build (r1 :.: r2) sigma - = do lbfa1 <- build r1 sigma - lbfa2 <- build r2 sigma - s <- fetchState - let transUnion = (remove (initial lbfa1) (trans lbfa1)) ++ - (remove (initial lbfa2) (trans lbfa2)) - transConc = let t = (transitionList lbfa2 (initial lbfa2)) in - [(f,t)| f <- (finals lbfa1)] - transInit = [(s, transitionList lbfa1 (initial lbfa1) ++ - listEps lbfa1 (transitionList lbfa2 (initial lbfa2)))] - fs = finals lbfa2 ++ listEps lbfa2 (finals lbfa1) ++ - if (acceptEpsilon lbfa1 && acceptEpsilon lbfa2) - then [s] else [] - return $ LBFA { - trans = transInit ++ merge transConc transUnion, - finalS = fs \\ [(initial lbfa1),(initial lbfa2)], - alpha = sigma, - initS = s, - lastS = s - } +build (Symbol a) sigma = do + s1 <- fetchState + s2 <- fetchState + return LBFA { + trans = [(s1, [(a, s2)]), (s2, [])], + initS = s1, + finalS = [s2], + alpha = sigma, + lastS = s2 + } -build (r1 :|: r2) sigma - = do lbfa1 <- build r1 sigma - lbfa2 <- build r2 sigma - s <- fetchState - let transUnion = (remove (initial lbfa1) (trans lbfa1)) ++ - (remove (initial lbfa2) (trans lbfa2)) - transInit = [(s, transitionList lbfa1 (initial lbfa1) ++ - transitionList lbfa2 (initial lbfa2))] - fs = finals lbfa1 ++ finals lbfa2 ++ - if (acceptEpsilon lbfa1 || acceptEpsilon lbfa2) - then [s] else [] - return $ LBFA { - trans = transInit ++ transUnion, - finalS = fs \\ [(initial lbfa1),(initial lbfa2)], - alpha = sigma, - initS = s, - lastS = s - } +build All sigma = build (allToSymbols sigma) sigma +build (r1 :.: r2) sigma = do + lbfa1 <- build r1 sigma + lbfa2 <- build r2 sigma + s <- fetchState + let transUnion = (remove (initial lbfa1) (trans lbfa1)) ++ + (remove (initial lbfa2) (trans lbfa2)) + transConc = let t = transitionList lbfa2 (initial lbfa2) in + [ (f,t) | f <- finals lbfa1 ] + transInit = [(s, transitionList lbfa1 (initial lbfa1) ++ + listEps lbfa1 (transitionList lbfa2 (initial lbfa2)))] + fs = finals lbfa2 ++ listEps lbfa2 (finals lbfa1) ++ + [ s | acceptEpsilon lbfa1 && acceptEpsilon lbfa2 ] + return $ LBFA { + trans = transInit ++ merge transConc transUnion, + finalS = fs \\ [(initial lbfa1), (initial lbfa2)], + alpha = sigma, + initS = s, + lastS = s + } -build (Star r1) sigma - = do lbfa1 <- build r1 sigma - s <- fetchState - let transUnion = remove (initial lbfa1) (trans lbfa1) - transLoop = let t = transitionList lbfa1 (initial lbfa1) in - (s,t): [(f,t) | f <- finals lbfa1] - return $ LBFA { - trans = merge transLoop transUnion, - finalS = (s:(delete (initial lbfa1) (finals lbfa1))), - alpha = sigma, - initS = s, - lastS = s - } +build (r1 :|: r2) sigma = do + lbfa1 <- build r1 sigma + lbfa2 <- build r2 sigma + s <- fetchState + let transUnion = (remove (initial lbfa1) (trans lbfa1)) ++ + (remove (initial lbfa2) (trans lbfa2)) + transInit = [(s, transitionList lbfa1 (initial lbfa1) ++ + transitionList lbfa2 (initial lbfa2))] + fs = finals lbfa1 ++ finals lbfa2 ++ + [ s | acceptEpsilon lbfa1 || acceptEpsilon lbfa2 ] + return $ LBFA { + trans = transInit ++ transUnion, + finalS = fs \\ [(initial lbfa1),(initial lbfa2)], + alpha = sigma, + initS = s, + lastS = s + } -build (Complement r1) sigma - = do lbfa <- build r1 sigma - let lbfa1 = decode $ determinize $ complete $ encode lbfa - setState $ lastState lbfa1 +1 - return $ LBFA { - trans = trans lbfa1, - finalS = (states lbfa1) \\ (finals lbfa1), - alpha = sigma, - initS = initial lbfa1, - lastS = lastState lbfa1 - } +build (Star r1) sigma = do + lbfa1 <- build r1 sigma + s <- fetchState + let transUnion = remove (initial lbfa1) (trans lbfa1) + transLoop = let t = transitionList lbfa1 (initial lbfa1) + in (s,t) : [ (f,t) | f <- finals lbfa1 ] + return $ LBFA { + trans = merge transLoop transUnion, + finalS = s:(delete (initial lbfa1) (finals lbfa1)), + alpha = sigma, + initS = s, + lastS = s + } -build (r1 :&: r2) sigma - = do lbfa1 <- build r1 sigma - lbfa2 <- build r2 sigma - let minS1 = firstState lbfa1 - minS2 = firstState lbfa2 - name (s1,s2) = (lastState lbfa2 - minS2 +1) * - (s1 - minS1) + s2 - minS2 + minS1 - nS = name (lastState lbfa1,lastState lbfa2) +1 - transInit = (nS,[(a,name (s1,s2)) | (a,s1) <- transitionList - lbfa1 (initial lbfa1), - (b,s2) <- transitionList - lbfa2 (initial lbfa2), - a == b]) - transTable = [(name (s1,s2),[(a,name (s3,s4)) | (a,s3) <- tl1, - (b,s4) <- tl2, - a == b ]) | - (s1,tl1) <- trans lbfa1, - (s2,tl2) <- trans lbfa2, - s1 /= initial lbfa1 || - s2 /= initial lbfa2 - ] - transUnion = transInit:transTable - fs = (if (acceptEpsilon lbfa1 && acceptEpsilon lbfa2) - then [nS] else []) ++ - [name (f1,f2)| f1 <- finals lbfa1, - f2 <- finals lbfa2] - setState $ nS +1 - return LBFA { - trans = merge [(s,[]) | s <- fs] transUnion, - finalS = fs, - alpha = sigma, - initS = nS, - lastS = nS - } +build (Complement r1) sigma = do + lbfa <- build r1 sigma + let lbfa1 = decode $ determinize $ complete $ encode lbfa + put (lastState lbfa1 + 1) + return $ LBFA { + trans = trans lbfa1, + finalS = states lbfa1 \\ finals lbfa1, + alpha = sigma, + initS = initial lbfa1, + lastS = lastState lbfa1 + } -{- ********************************************************** - * Instance of Convertable (LBFA a) * - ********************************************************** --} +build (r1 :&: r2) sigma = do + lbfa1 <- build r1 sigma + lbfa2 <- build r2 sigma + let minS1 = firstState lbfa1 + minS2 = firstState lbfa2 + name (s1,s2) = (lastState lbfa2 - minS2 +1) * + (s1 - minS1) + s2 - minS2 + minS1 + nS = name (lastState lbfa1,lastState lbfa2) +1 + transInit = (nS, [ (a, name (s1, s2)) + | (a,s1) <- transitionList + lbfa1 (initial lbfa1) + , (b,s2) <- transitionList + lbfa2 (initial lbfa2) + , a == b]) + transTable = [(name (s1, s2), + [(a, name (s3, s4)) + | (a,s3) <- tl1 + , (b,s4) <- tl2, a == b ]) + | (s1,tl1) <- trans lbfa1 + , (s2,tl2) <- trans lbfa2 + , s1 /= initial lbfa1 || s2 /= initial lbfa2 ] + transUnion = transInit:transTable + fs = [ nS | acceptEpsilon lbfa1 && acceptEpsilon lbfa2 ] + ++ + [ name (f1,f2) | f1 <- finals lbfa1, f2 <- finals lbfa2 ] + put (nS + 1) + return LBFA { + trans = merge [ (s, []) | s <- fs ] transUnion, + finalS = fs, + alpha = sigma, + initS = nS, + lastS = nS + } instance Convertable LBFA where - encode lbfa = construct (firstState lbfa,lastState lbfa) (trans lbfa) - (alphabet lbfa) (initials lbfa) (finals lbfa) - decode auto = LBFA { - trans = transitionTable auto, - initS = head (initials auto), - finalS = finals auto, - alpha = alphabet auto, - lastS = lastState auto - } - -{- ********************************************************** - * Instance of Show (LBFA a) * - ********************************************************** --} + encode lbfa = construct (firstState lbfa,lastState lbfa) (trans lbfa) + (alphabet lbfa) (initials lbfa) (finals lbfa) + decode auto = LBFA { + trans = transitionTable auto, + initS = head (initials auto), + finalS = finals auto, + alpha = alphabet auto, + lastS = lastState auto + } instance (Eq a,Show a) => Show (LBFA a) where - show auto = "\n>>>> LBFA Construction <<<<" ++ - "\n\nTransitions:\n" ++ aux (trans auto) ++ - "\nNumber of States => " ++ show countStates ++ - "\nInitial => " ++ show (initial auto) ++ - "\nFinals => " ++ show (finals auto) ++ "\n" - where aux [] = [] - aux ((s,tl):xs) = show s ++" => " ++ show tl ++ "\n" ++ aux xs - countStates = length $ nub $ map fst (trans auto) ++ - finals auto - -{- ********************************************************** - * Auxiliary functions * - ********************************************************** --} + show auto = unlines [ + "Transitions:", aux (trans auto), + "Number of States => " ++ show countStates, + "Initial => " ++ show (initial auto), + "Finals => " ++ show (finals auto) + ] where + aux xs = unlines [show s ++" => " ++ show tl | (s, tl) <- xs ] + countStates = length $ nub $ map fst (trans auto) ++ finals auto +-- | If the LBFA accepts epsilon, return second argument listEps :: LBFA a -> [b] -> [b] listEps lbfa xs | acceptEpsilon lbfa = xs diff --git a/FST/LBFT.hs b/FST/LBFT.hs --- a/FST/LBFT.hs +++ b/FST/LBFT.hs @@ -1,188 +1,175 @@ -{- - ************************************************************** - * Filename : LBFT.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 7 July, 2001 * - * Lines : 277 * - ************************************************************** +{- | +Left-biased finite transducers -} +module FST.LBFT ( + module FST.Transducer, -module FST.LBFT ( LBFT (..), - module FST.Transducer, - compileToLBFT, - compileToTransducer - ) where + -- * Types + LBFT (..), + -- * Compile functions + compileToLBFT, + compileToTransducer + ) where + import Data.List (delete,nub,(\\)) +import Control.Monad.State + import FST.EpsilonFreeT import FST.RRegTypes -import FST.StateMonad import FST.Transducer import FST.Utils (merge,remove) import qualified FST.AutomatonInterface as A -{- ********************************************************** - * data type for a LBFT * - ********************************************************** --} - +-- | Data type for a LBFT (left-biased finite transducer) data LBFT a = LBFT { trans :: TTransitionTable a, - initS :: State, - finalS :: [State], + initS :: StateTy, + finalS :: [StateTy], alpha :: Sigma a, - lastS :: State + lastS :: StateTy } -{- ********************************************************** - * LBFT functions * - ********************************************************** --} - +-- | LBFT functions instance TransducerFunctions LBFT where - states = (map fst).trans - isFinal t s = elem s (finals t) - initials t = [initS t] - finals = finalS - transitionTable = trans - transitionList t s = case (lookup s (trans t)) of - Just xs -> xs - _ -> [] - transitionsU t (s,a) = map (\((_,c),s1) -> (c,s1)) $ - filter (\((b,_),_) -> a == b) $ transitionList t s - transitionsD t (s,a) = map (\((c,_),s1) -> (c,s1)) $ - filter (\((_,b),_) -> a == b) $ transitionList t s - lastState = lastS - firstState = minimum.states - alphabet = alpha + states = (map fst).trans + isFinal t s = elem s (finals t) + initials t = [initS t] + finals = finalS + transitionTable = trans + transitionList t s = case (lookup s (trans t)) of + Just xs -> xs + _ -> [] + transitionsU t (s,a) = map (\((_,c),s1) -> (c,s1)) $ + filter (\((b,_),_) -> a == b) $ transitionList t s + transitionsD t (s,a) = map (\((c,_),s1) -> (c,s1)) $ + filter (\((_,b),_) -> a == b) $ transitionList t s + lastState = lastS + firstState = minimum.states + alphabet = alpha +-- | Does the LBFT accept epsilon? acceptEpsilon :: LBFT a -> Bool acceptEpsilon lbft = isFinal lbft (initialLBFT lbft) -initialLBFT :: LBFT a -> State +-- | Get the initial state of a LBFT +initialLBFT :: LBFT a -> StateTy initialLBFT = initS -{- ********************************************************** - * compile a regular relation to a LBFT * - ********************************************************** --} - +-- | Compile a regular relation to a LBFT compileToLBFT :: Ord a => RReg a -> Sigma a -> LBFT a -compileToLBFT reg sigma = run (build reg (nub (sigma++symbols reg))) 0 +compileToLBFT reg sigma = evalState (build reg (nub (sigma++symbols reg))) 0 -{- ************************************************************************ - * compile a regular relation to an minimal, useful and deterministic * - * transducer, using the LBFT algorithm while building. * - ************************************************************************ --} +-- | Compile a regular relation to an minimal, useful and +-- deterministic transducer, using the LBFT algorithm while building. compileToTransducer :: Ord a => RReg a -> Sigma a -> Transducer a compileToTransducer reg sigma = encode $ compileToLBFT reg sigma -{- ************************************************************************ - * Building a LBFT from a regular relation * - ************************************************************************ --} - -build :: Ord a => RReg a -> Sigma a -> STM (LBFT a) -build (EmptyR) sigma = do s <- fetchState - return $ LBFT { - trans = [(s,[])], - initS = s, - finalS = [], - alpha = sigma, - lastS = s - } +fetchState :: State StateTy StateTy +fetchState = do + state <- get + put (state + 1) + return state -build (Relation a b) sigma - = do s1 <- fetchState - s2 <- fetchState - return $ LBFT { - trans = [(s1,[((a,b),s2)]),(s2,[])], - initS = s1, - finalS = [s2], - alpha = sigma, - lastS = s2 - } +-- | Build a LBFT from a regular relation +build :: Ord a => RReg a -> Sigma a -> State StateTy (LBFT a) +build (EmptyR) sigma = do + s <- fetchState + return $ LBFT { + trans = [(s, [])], + initS = s, + finalS = [], + alpha = sigma, + lastS = s + } -build (Identity r1) sigma - = do s <- fetchState - let auto = A.compileNFA r1 sigma s - nTrans = [(s1,map (\(a,s2) -> ((S a, S a),s2)) - (A.transitionList auto s1)) | s1 <- A.states auto] - setState (A.lastState auto+1) - return $ LBFT { - trans = nTrans, - initS = head (A.initials auto), - finalS = A.finals auto, - alpha = sigma, - lastS = A.lastState auto - } +build (Relation a b) sigma = do + s1 <- fetchState + s2 <- fetchState + return $ LBFT { + trans = [(s1, [((a, b), s2)]), (s2, [])], + initS = s1, + finalS = [s2], + alpha = sigma, + lastS = s2 + } -build (ProductR r1 r2) sigma - = do lbft1 <- build r1 sigma - lbft2 <- build r2 sigma - s <- fetchState - let transUnion = (remove (initialLBFT lbft1) (trans lbft1)) ++ - (remove (initialLBFT lbft2) (trans lbft2)) - transConc = let t = (transitionList lbft2 (initialLBFT lbft2)) in - [(f,t)| f <- (finals lbft1)] - transInit = [(s, transitionList lbft1 (initialLBFT lbft1) ++ - listEps lbft1 (transitionList lbft2 (initialLBFT lbft2)))] - fs = finals lbft2 ++ listEps lbft2 (finals lbft1) ++ - if (acceptEpsilon lbft1 && acceptEpsilon lbft2) - then [s] else [] - return $ LBFT { - trans = transInit ++ merge transConc transUnion, - finalS = fs \\ [(initialLBFT lbft1),(initialLBFT lbft2)], - alpha = sigma, - initS = s, - lastS = s - } +build (Identity r1) sigma = do + s <- fetchState + let auto = A.compileNFA r1 sigma s + nTrans = [(s1, map (\(a,s2) -> ((S a, S a), s2)) (A.transitionList auto s1)) + | s1 <- A.states auto ] + put (A.lastState auto + 1) + return $ LBFT { + trans = nTrans, + initS = head (A.initials auto), + finalS = A.finals auto, + alpha = sigma, + lastS = A.lastState auto + } -build (UnionR r1 r2) sigma - = do lbft1 <- build r1 sigma - lbft2 <- build r2 sigma - s <- fetchState - let transUnion = (remove (initialLBFT lbft1) (trans lbft1)) ++ - (remove (initialLBFT lbft2) (trans lbft2)) - transInit = [(s, transitionList lbft1 (initialLBFT lbft1) ++ - transitionList lbft2 (initialLBFT lbft2))] - fs = finals lbft1 ++ finals lbft2 ++ - if (acceptEpsilon lbft1 || acceptEpsilon lbft2) - then [s] else [] - return $ LBFT { - trans = transInit ++ transUnion, - finalS = fs \\ [(initialLBFT lbft1),(initialLBFT lbft2)], - alpha = sigma, - initS = s, - lastS = s - } +build (ProductR r1 r2) sigma = do + lbft1 <- build r1 sigma + lbft2 <- build r2 sigma + s <- fetchState + let transUnion = (remove (initialLBFT lbft1) (trans lbft1)) ++ + (remove (initialLBFT lbft2) (trans lbft2)) + transConc = let t = (transitionList lbft2 (initialLBFT lbft2)) + in [ (f,t) | f <- finals lbft1 ] + transInit = [(s, transitionList lbft1 (initialLBFT lbft1) ++ + listEps lbft1 (transitionList lbft2 (initialLBFT lbft2)))] + fs = finals lbft2 ++ listEps lbft2 (finals lbft1) ++ + [ s | acceptEpsilon lbft1 && acceptEpsilon lbft2 ] + return $ LBFT { + trans = transInit ++ merge transConc transUnion, + finalS = fs \\ [(initialLBFT lbft1),(initialLBFT lbft2)], + alpha = sigma, + initS = s, + lastS = s + } + +build (UnionR r1 r2) sigma = do + lbft1 <- build r1 sigma + lbft2 <- build r2 sigma + s <- fetchState + let transUnion = (remove (initialLBFT lbft1) (trans lbft1)) ++ + (remove (initialLBFT lbft2) (trans lbft2)) + transInit = [(s, transitionList lbft1 (initialLBFT lbft1) ++ + transitionList lbft2 (initialLBFT lbft2))] + fs = finals lbft1 ++ finals lbft2 ++ + [ s | acceptEpsilon lbft1 || acceptEpsilon lbft2 ] + return $ LBFT { + trans = transInit ++ transUnion, + finalS = fs \\ [(initialLBFT lbft1), (initialLBFT lbft2)], + alpha = sigma, + initS = s, + lastS = s + } -build (StarR r1) sigma - = do lbft1 <- build r1 sigma - s <- fetchState - let transUnion = remove (initialLBFT lbft1) (trans lbft1) - transLoop = let t = transitionList lbft1 (initialLBFT lbft1) in - (s,t): [(f,t) | f <- finals lbft1] - return $ LBFT { - trans = merge transLoop transUnion, - finalS = (s:(delete (initialLBFT lbft1) (finals lbft1))), - alpha = sigma, - initS = s, - lastS = s - } +build (StarR r1) sigma = do + lbft1 <- build r1 sigma + s <- fetchState + let transUnion = remove (initialLBFT lbft1) (trans lbft1) + transLoop = let t = transitionList lbft1 (initialLBFT lbft1) + in (s,t) : [(f,t) | f <- finals lbft1] + return $ LBFT { + trans = merge transLoop transUnion, + finalS = s:(delete (initialLBFT lbft1) (finals lbft1)), + alpha = sigma, + initS = s, + lastS = s + } -build (Cross r1 r2) sigma = - do s <- fetchState - let auto1 = A.compileNFA r1 sigma s - auto2 = A.compileNFA r2 sigma s - (trTable,fs) = cross auto1 auto2 +build (Cross r1 r2) sigma = do + s <- fetchState + let auto1 = A.compileNFA r1 sigma s + auto2 = A.compileNFA r2 sigma s + (trTable,fs) = cross auto1 auto2 ([],[(A.initial auto1,A.initial auto2)]) ([],[]) - lbft = decode $ rename trTable sigma - [(A.initial auto1,A.initial auto2)] fs s - setState $ lastState lbft + 1 - return lbft + lbft = decode $ rename trTable sigma + [(A.initial auto1,A.initial auto2)] fs s + put (lastState lbft + 1) + return lbft where cross _ _ (_,[]) result = result cross auto1 auto2 (done,((s1,s2):undone)) (tr,fs) = let tl = combine auto1 auto2 (A.transitionList auto1 s1) @@ -201,75 +188,62 @@ (if (A.isFinal auto2 s2) then [((S a,Eps),(s3,s2)) | (a,s3) <- xs] else []) -build (Comp r1 r2) sigma - = do lbft1 <- build r1 sigma - lbft2 <- build r2 sigma - let minS1 = firstState lbft1 - minS2 = firstState lbft2 - name (s1,s2) = (lastState lbft2 - minS2 +1) * - (s1 - minS1) + s2 - minS2 + minS1 - nS = name (lastState lbft1,lastState lbft2) +1 - transInit = (nS,[((a,d),name (s1,s2)) | - ((a,b),s1) <- ((Eps,Eps),initialLBFT lbft1):transitionList - lbft1 (initialLBFT lbft1), - ((c,d),s2) <- ((Eps,Eps),initialLBFT lbft2):transitionList - lbft2 (initialLBFT lbft2), - ((a,b) /= (Eps,Eps)) || ((c,d) /= (Eps,Eps)), - b == c]) - transTable = [(name (s1,s2),[((a,d),name (s3,s4)) | ((a,b),s3) <- ((Eps,Eps),s1):tl1, - ((c,d),s4) <- ((Eps,Eps),s2):tl2, - ((a,b) /= (Eps,Eps)) || ((c,d) /= (Eps,Eps)), - b == c]) | - (s1,tl1) <- trans lbft1, - (s2,tl2) <- trans lbft2, - s1 /= initialLBFT lbft1 || - s2 /= initialLBFT lbft2] - transUnion = transInit : transTable - fs = (if (acceptEpsilon lbft1 && acceptEpsilon lbft2) - then [nS] else []) ++ - [name (f1,f2)| f1 <- finals lbft1, f2 <- finals lbft2] - setState $ nS +1 - return $ decode $ epsilonfree $ encode $ - LBFT {trans = merge [(s,[]) | s <- fs] transUnion - ,finalS = fs,alpha = sigma, - initS = nS,lastS = nS} - -{- ********************************************************** - * Instance of Convertable (LBFT a) * - ********************************************************** --} +build (Comp r1 r2) sigma = do + lbft1 <- build r1 sigma + lbft2 <- build r2 sigma + let minS1 = firstState lbft1 + minS2 = firstState lbft2 + name (s1,s2) = (lastState lbft2 - minS2 +1) * + (s1 - minS1) + s2 - minS2 + minS1 + nS = name (lastState lbft1,lastState lbft2) +1 + transInit = (nS,[ ((a, d), name (s1,s2)) + | ((a, b), s1) <- ((Eps, Eps),initialLBFT lbft1):transitionList lbft1 (initialLBFT lbft1) + , ((c, d), s2) <- ((Eps,Eps),initialLBFT lbft2):transitionList lbft2 (initialLBFT lbft2) + , ((a,b) /= (Eps,Eps)) || ((c,d) /= (Eps,Eps)), b == c]) + transTable = [(name (s1,s2),[ ((a, d), name (s3,s4)) + | ((a, b), s3) <- ((Eps,Eps),s1):tl1 + , ((c,d),s4) <- ((Eps,Eps),s2):tl2 + , ((a,b) /= (Eps,Eps)) || ((c,d) /= (Eps,Eps)) + , b == c]) + | (s1,tl1) <- trans lbft1 + , (s2,tl2) <- trans lbft2 + , s1 /= initialLBFT lbft1 || s2 /= initialLBFT lbft2] + transUnion = transInit : transTable + fs = [ nS | acceptEpsilon lbft1 && acceptEpsilon lbft2 ] + ++ + [ name (f1,f2) | f1 <- finals lbft1, f2 <- finals lbft2 ] + put (nS + 1) + return $ decode $ epsilonfree $ encode $ + LBFT { + trans = merge [ (s, []) | s <- fs ] transUnion, + finalS = fs, + alpha = sigma, + initS = nS, + lastS = nS + } instance TConvertable LBFT where - encode lbft = rename (trans lbft) (alphabet lbft) (initials lbft) - (finals lbft) (firstState lbft) - decode t = LBFT { - trans = transitionTable t, - initS = head (initials t), - finalS = finals t, - alpha = alphabet t, - lastS = lastState t - } - -{- ********************************************************** - * Instance of Show (LBFT a) * - ********************************************************** --} + encode lbft = rename (trans lbft) (alphabet lbft) (initials lbft) + (finals lbft) (firstState lbft) + decode t = LBFT { + trans = transitionTable t, + initS = head (initials t), + finalS = finals t, + alpha = alphabet t, + lastS = lastState t + } instance (Eq a,Show a) => Show (LBFT a) where - show t = "\n>>>> LBFT Construction <<<<" ++ - "\n\nTransitions:\n" ++ aux (trans t) ++ - "\nNumber of States => " ++ show (length (trans t)) ++ - "\nInitial => " ++ show (initialLBFT t) ++ - "\nFinals => " ++ show (finals t) ++ "\n" - where aux [] = [] - aux ((s,tl):xs) = show s ++" => " ++ show tl ++ "\n" ++ aux xs - - -{- ********************************************************** - * Auxiliary functions * - ********************************************************** --} + show t = unlines [ + "Transitions:" + , aux (trans t) + , "Number of States => " ++ show (length (trans t)) + , "Initial => " ++ show (initialLBFT t) + , "Finals => " ++ show (finals t) + ] where + aux xs = unlines [ show s ++ " => " ++ show tl | (s, tl) <- xs ] +-- | If the LBFT accepts epsilon, return second argument listEps :: LBFT a -> [b] -> [b] listEps lbft xs | acceptEpsilon lbft = xs diff --git a/FST/Lexer.hs b/FST/Lexer.hs --- a/FST/Lexer.hs +++ b/FST/Lexer.hs @@ -1,3 +1,6 @@ +{- | +Lexer file generated by Alex +-} module FST.Lexer where @@ -121,7 +124,39 @@ TokenDef Int | -- '::=' TokenVar (Int,String) | -- Variable Err String - deriving (Eq,Show) + deriving (Eq) + +instance Show Token where + show = prettyPrint + +-- | Pretty print, for more helpful parse error messages +prettyPrint :: Token -> String +prettyPrint (TokenSemi _) = ";" +prettyPrint (TokenHOB _) = "[" +prettyPrint (TokenHCB _) = "]" +prettyPrint (TokenSOB _) = "(" +prettyPrint (TokenSCB _) = ")" +prettyPrint (TokenConcatS (_,str)) = "{"++str++"}" +prettyPrint (TokenStar _) = "*" +prettyPrint (TokenComplement _) = "~" +prettyPrint (TokenContainment _) = "$" +prettyPrint (TokenMinus _) = "-" +prettyPrint (TokenIntersect _) = "&" +prettyPrint (TokenUnion _) = "|" +prettyPrint (TokenPlus _) = "+" +prettyPrint (TokenEps _) = "0" +prettyPrint (TokenAll _) = "?" +prettyPrint (TokenS (_,str)) = str +prettyPrint (TokenRelation _) = ":" +prettyPrint (TokenCrossproduct _) = ".x." +prettyPrint (TokenComposition _) = ".o." +prettyPrint (TokenRepeat _) = "^" +prettyPrint (TokenNum (_,int)) = show int +prettyPrint (TokenFun (_,(name,args))) = "<"++name++(concatMap ((++) ",") args)++">" +prettyPrint (TokenMain _) = "
" +prettyPrint (TokenDef _) = "::=" +prettyPrint (TokenVar (_,str)) = str +prettyPrint (Err str) = str lexer :: String -> [Token] lexer inp = scan tokens_scan inp diff --git a/FST/Main.hs b/FST/Main.hs deleted file mode 100644 --- a/FST/Main.hs +++ /dev/null @@ -1,346 +0,0 @@ -{- - ************************************************************** - * Filename : Main.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 346 * - ************************************************************** --} - -module Main where - -import FST.TransducerInterface -import FST.FileImport -import FST.RRegTypes -import System.Environment (getArgs) - -import FST.Arguments -import FST.Info - -main :: IO() -main = do args <- getArgs - case args of - [] -> do fstStudio - run emptyInfo - as -> batchMode as - -batchMode :: [String] -> IO () -batchMode cmdopt = case parseBatch cmdopt of - Left err -> putStrLn err - Right (file,cmd) - | isFST file -> do res <- open file - case res of - Right str -> case (parseProgram str) of - Left err -> putStrLn err - Right reg - | isUpB cmd -> let tr = compile reg [] in - case inputB cmd of - Just file -> do res <- open file - case res of - Right str -> case outputB cmd of - Just f -> do res <- saveToFile f str - case res of - Left err -> putStrLn err - _ -> return () - _ -> putStrLn $ upB tr str - Left err -> putStrLn err - Nothing -> do interact (upB tr) - | otherwise -> let tr = compile reg [] in - case inputB cmd of - Just file -> do res <- open file - case res of - Right str -> case outputB cmd of - Just f -> do res <- saveToFile f str - case res of - Left err -> putStrLn err - _ -> return () - _ -> putStrLn $ downB tr str - Left err -> putStrLn err - Nothing -> do interact (downB tr) - Left err -> do putStrLn err - | isNET file -> do tr <- load file - case tr of - Right tr - | isUpB cmd -> case inputB cmd of - Just file -> do res <- open file - case res of - Right str -> case outputB cmd of - Just f -> do res <- saveToFile f str - case res of - Left err -> putStrLn err - _ -> return () - _ -> putStrLn $ upB tr str - Left err -> putStrLn err - Nothing -> do interact (upB tr) - | otherwise -> case inputB cmd of - Just file -> do res <- open file - case res of - Right str -> case outputB cmd of - Just f -> do res <- saveToFile f str - case res of - Left err -> putStrLn err - _ -> return () - _ -> putStrLn $ downB tr str - Left err -> putStrLn err - Nothing -> do interact (downB tr) - Left err -> putStrLn err - | otherwise -> putStrLn "Input file must end with *.fst or *.net" - -upB :: Transducer String -> String -> String -upB transducer str = case (applyUp transducer (words str)) of - Just xs -> unlines $ map unwords xs - Nothing -> [] - -downB :: Transducer String -> String -> String -downB transducer str = case (applyDown transducer (words str)) of - Just xs -> unlines $ map unwords xs - Nothing -> [] - -run :: Info -> IO () -run info - = do prompt - com <- getLine - case (parseInteractive (words com)) of - BuildTransducer - | expressionRead info -> - do let tNew = compile (getExpression info) [] - putStrLn ("\nBuilt a deterministic, minimal transducer with " - ++ (show (numberOfStates tNew)) ++ " states and " - ++ (show (numberOfTransitions tNew)) ++ " transitions.\n") - run $ updateTransducer tNew info - | otherwise -> - do noExpression - run info - BuildNTransducer - | expressionRead info -> - do let tNew = compileN (getExpression info) [] - putStrLn ("\nBuilt a possibly non-deterministic, non-minimal transducer with " - ++ (show (numberOfStates tNew)) ++ " states and " - ++ (show (numberOfTransitions tNew)) ++ " transitions.\n") - run $ updateTransducer tNew info - | otherwise -> - do noExpression - run info - Minimize - | transducerBuilt info -> - do let tNew = minimize (getTransducer info) - putStrLn ("\nMinimized loaded/built transducer resulting in a transducer with " - ++ (show (numberOfStates tNew)) ++ " states and " - ++ (show (numberOfTransitions tNew)) ++ " transitions.\n") - run $ updateTransducer tNew info - | otherwise -> - do noTransducer - run info - Determinize - | transducerBuilt info -> - do let tNew = determinize (getTransducer info) - putStrLn ("\nDeterminized loaded/built transducer resulting in a transducer with " - ++ (show (numberOfStates tNew)) ++ " states and " - ++ (show (numberOfTransitions tNew)) ++ " transitions.\n") - run $ updateTransducer tNew info - | otherwise -> - do noTransducer - run info - ViewTransducer - | transducerBuilt info -> - do putStrLn (showTransducer (getTransducer info)) - run info - | otherwise -> - do noTransducer - run info - Load file - | isFST file -> do res <- open file - case (res) of - Right str -> case (parseProgram str) of - Left err -> do putStrLn err - run info - Right reg -> do putStrLn ("\nLoaded a regular relation from " ++file ++".\n") - run $ updateExpression reg info - Left err -> do putStrLn err - run info - | isNET file -> do res <- load file - case res of - Right t -> do putStrLn ("\nLoaded transducer from file " ++ file ++".\n") - run $ updateTransducer t info - Left err -> do putStrLn err - run info - | isDAT file -> do res <- open file - case (res) of - Right str -> do putStrLn ("\nRead input from file "++file++".\n") - run $ updateInput (words str) info - Left err -> do putStrLn err - run info - | otherwise -> do putStrLn ("\nUnable to load from " ++ file ++ ". The filename must end with *.fst, *.net or *.dat.\n") - run info - LUnion file1 file2 - | isNET file1 && isNET file2 -> do res1 <- load file1 - res2 <- load file2 - case (res1,res2) of - (Left err,_) -> do putStrLn err - run info - (_,Left err) -> do putStrLn err - run info - (Right t1, Right t2) -> do putStrLn "\nLoaded and unified two transducers.\n" - run $ updateTransducer (unionT t1 t2) info - | transducerBuilt info && isNET file1 && isTHIS file2 - -> do res <- load file1 - case res of - (Left err) -> do putStrLn err - run info - (Right t1) -> do putStrLn "\nLoaded a transducer, and unified it with the interior transducer.\n" - run $ updateTransducer (unionT t1 (getTransducer info)) info - | transducerBuilt info && isTHIS file1 && isNET file2 - -> do res <- load file2 - case res of - (Left err) -> do putStrLn err - run info - (Right t1) -> do putStrLn "\nLoaded a transducer, and unified it with the interior transducer.\n" - run $ updateTransducer (unionT t1 (getTransducer info)) info - | otherwise -> do putStrLn $ "\nUnable to union " ++ file1 ++ " and " ++file2++".\n" - run info - LProduct file1 file2 - | isNET file1 && isNET file2 -> do res1 <- load file1 - res2 <- load file2 - case (res1,res2) of - (Left err,_) -> do putStrLn err - run info - (_,Left err) -> do putStrLn err - run info - (Right t1, Right t2) -> do putStrLn "\nLoaded and concatenated two transducers.\n" - run $ updateTransducer (productT t1 t2) info - | transducerBuilt info && isNET file1 && isTHIS file2 - -> do res <- load file1 - case res of - (Left err) -> do putStrLn err - run info - (Right t1) -> do putStrLn "\nLoaded a transducer, and concatenated it with the interior transducer.\n" - run $ updateTransducer (productT t1 (getTransducer info)) info - | transducerBuilt info && isTHIS file1 && isNET file2 - -> do res <- load file2 - case res of - (Left err) -> do putStrLn err - run info - (Right t1) -> do putStrLn "\nLoaded a transducer, and concatenated it with the interior transducer.\n" - run $ updateTransducer (productT t1 (getTransducer info)) info - | otherwise -> do putStrLn $ "\nUnable to concatenate " ++ file1 ++ " and " ++file2++".\n" - run info - LStar file - | isNET file -> do res <- load file - case res of - (Left err) -> do putStrLn err - run info - (Right t1) -> do putStrLn "\nLoaded a transducer, and applied Kleene's star.\n" - run $ updateTransducer (starT t1) info - | transducerBuilt info && isTHIS file -> do putStrLn "\nApplied Kleene's star on interior transducer.\n" - run $ updateTransducer (starT (getTransducer info)) info - | otherwise -> do putStrLn $ "\nUnable to apply Kleene's star on " ++ file ++ ".\n" - run info - LComposition file1 file2 - | isNET file1 && isNET file2 -> do res1 <- load file1 - res2 <- load file2 - case (res1,res2) of - (Left err,_) -> do putStrLn err - run info - (_,Left err) -> do putStrLn err - run info - (Right t1, Right t2) -> do putStrLn "\nLoaded and composed two transducers.\n" - run $ updateTransducer (compositionT t1 t2) info - | transducerBuilt info && isNET file1 && isTHIS file2 - -> do res <- load file1 - case res of - (Left err) -> do putStrLn err - run info - (Right t1) -> do putStrLn "\nLoaded a transducer, and composed it with the interior transducer.\n" - run $ updateTransducer (compositionT t1 (getTransducer info)) info - | transducerBuilt info && isTHIS file1 && isNET file2 - -> do res <- load file2 - case res of - (Left err) -> do putStrLn err - run info - (Right t1) -> do putStrLn "\nLoaded a transducer, and composed it with the interior transducer.\n" - run $ updateTransducer (compositionT t1 (getTransducer info)) info - | otherwise -> do putStrLn $ "\nUnable to compose " ++ file1 ++ " and " ++file2++".\n" - run info - Save file - | isNET file -> do res <- save file (getTransducer info) - case res of - Right t -> do putStrLn ("\nSaved transducer to file "++file++".\n") - run info - Left err -> do putStrLn err - run info - | outputsRead info -> do res <- saveToFile file (unlines (getOutputs info)) - case res of - Right _ -> do putStrLn ("\nSaved outputs to file " ++ file ++".\n") - run info - Left err -> do putStrLn err - run info - | otherwise -> do noOutputs - run info - StdInReg str -> case (parseExp str) of - Left err -> do putStrLn err - run info - Right reg -> do putStrLn "\nRead a regular relation.\n" - run $ updateExpression reg info - ViewReg - | expressionRead info -> do putStrLn ("\nExpression:\n" ++ (show (getExpression info)) ++ "\n") - run info - | otherwise -> do noExpression - run info - Quit -> do putStr "\nDo you really want to quit? (y): " - s <- getLine - case s of - "y" -> putStrLn "\nSession ended.\n" - "Y" -> putStrLn "\nSession ended.\n" - _ -> run info - ClearMemory -> do run $ clearInfo info - NoCommand -> do putStrLn "\nInvalid Command. Type 'h' for help.\n" - run info - ViewInput - | inputRead info -> do putStrLn ("\nInput: \n" ++ (unwords (getInput info))) - run info - | otherwise -> do noInput - run info - ViewOutput - | outputsRead info -> do putStrLn ("\nOutputs : \n" ++ (unlines (getOutputs info))) - run info - | otherwise -> do noOutputs - run info - Help -> do help - run info - ApplyUp - | transducerBuilt info && inputRead info -> case (applyUp (getTransducer info) (getInput info)) of - Just res -> do putStrLn "\nInput accepted. Type 'vo' to view outputs.\n" - run (updateOutputs (map unwords res) info) - Nothing -> do putStrLn "\nInput rejected.\n" - run info - | transducerBuilt info -> do noTransducer - run info - | otherwise -> do noInput - run info - ApplyDown - | transducerBuilt info && inputRead info -> case (applyDown (getTransducer info) (getInput info)) of - Just res -> do putStrLn "\nInput accepted. Type 'vo' to view outputs.\n" - run (updateOutputs (map unwords res) info) - Nothing -> do putStrLn "\nInput rejected.\n" - run info - | transducerBuilt info -> do noTransducer - run info - | otherwise -> do noInput - run info - ApplyU inp - | transducerBuilt info -> case (applyUp (getTransducer info) inp) of - Just res -> do putStrLn "\nInput accepted. Type 'vo' to view outputs.\n" - run (updateOutputs (map unwords res) info) - Nothing -> do putStrLn "\nInput rejected.\n" - run info - | otherwise -> do noTransducer - run info - ApplyD inp - | transducerBuilt info -> case (applyDown (getTransducer info) inp) of - Just res -> do putStrLn "\nInput accepted. Type 'vo' to view outputs.\n" - run (updateOutputs (map unwords res) info) - Nothing -> do putStrLn "\nInput rejected.\n" - run info - | otherwise -> do noTransducer - run info diff --git a/FST/MinimalBrzozowski.hs b/FST/MinimalBrzozowski.hs deleted file mode 100644 --- a/FST/MinimalBrzozowski.hs +++ /dev/null @@ -1,23 +0,0 @@ -{- - ************************************************************** - * Filename : MinimalBrzozowski.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 7 July, 2001 * - * Lines : 20 * - ************************************************************** --} - -module FST.MinimalBrzozowski ( minimize -- minimize an automaton. - ) where - -import FST.Automaton -import FST.Reversal -import FST.Deterministic - -{- An algorithm due to Brzozowski. - Note that the determinize function must construct a - automaton with the usefulS property. -} -{-# SPECIALIZE minimize :: Automaton String -> Automaton String #-} -minimize :: Ord a => Automaton a -> Automaton a -minimize = determinize.reversal.determinize.reversal diff --git a/FST/MinimalTBrzozowski.hs b/FST/MinimalTBrzozowski.hs deleted file mode 100644 --- a/FST/MinimalTBrzozowski.hs +++ /dev/null @@ -1,23 +0,0 @@ -{- - ************************************************************** - * Filename : MinimalTBrzozowski.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 7 July, 2001 * - * Lines : 20 * - ************************************************************** --} - -module FST.MinimalTBrzozowski ( minimize -- minimize an automaton. - ) where - -import FST.Transducer -import FST.DeterministicT -import FST.ReversalT - -{- An algorithm due to Brzozowski -} - -{-# SPECIALIZE minimize :: Transducer String -> Transducer String #-} - -minimize :: Ord a => Transducer a -> Transducer a -minimize = determinize.reversal.determinize.reversal diff --git a/FST/NReg.hs b/FST/NReg.hs --- a/FST/NReg.hs +++ b/FST/NReg.hs @@ -1,83 +1,72 @@ -{- - ************************************************************** - * Filename : NReg.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 5 July, 2001 * - * Lines : 78 * - ************************************************************** +{- | +Neutral regular expressions -} +module FST.NReg ( + -- * Types + NReg(..), -module FST.NReg ( NReg(..), -- Neutral Regular expression. - toRReg, -- If possible, converts NReg to RReg - toReg, -- If possible, converts NReg to Reg - nVarToSymbol - ) where + -- * Conversion functions + toRReg, + toReg, + nVarToSymbol + ) where +import Control.Monad import FST.RegTypes import FST.RRegTypes -{- ******************************************* - * Datatype for neutral regular expression * - ******************************************* --} - -data NReg a = NCross (NReg a) (NReg a) | - NComp (NReg a) (NReg a) | - NUnion (NReg a) (NReg a) | - NProduct (NReg a) (NReg a) | - NStar (NReg a) | - NIntersect (NReg a) (NReg a) | - NComplement (NReg a) | - NSymbol a | - NRelation a a | - NEpsilon | - NEmptySet | - NVar String | - Fun String [NReg a] | - NAll - -{- ************************************** - * Convert functions toRReg and toReg * - ************************************** --} - --- If possible, build a regular expression instead of a --- regular relation. +-- | Neutral regular expressions +data NReg a = NCross (NReg a) (NReg a) + | NComp (NReg a) (NReg a) + | NUnion (NReg a) (NReg a) + | NProduct (NReg a) (NReg a) + | NIntersect (NReg a) (NReg a) + | NStar (NReg a) + | NComplement (NReg a) + | NSymbol a + | NRelation a a + | NEpsilon + | NEmptySet + | NVar String + | Fun String [NReg a] + | NAll +-- | If possible, build a regular expression instead of a regular relation toRReg :: Eq a => NReg a -> Maybe (RReg a) -toRReg reg = maybe (nRReg reg) (return.idR) (toReg reg) - where nRReg (NEmptySet) = return EmptyR - nRReg (NRelation a b) = return $ r a b - nRReg (NComp n1 n2) = do r1 <- toRReg n1; r2 <- toRReg n2; return $ r1 <.> r2 - nRReg (NCross n1 n2) = do r1 <- toReg n1; r2 <- toReg n2; return $ r1 <*> r2 - nRReg (NUnion n1 n2) = case (toRReg n1,toRReg n2) of - (Just r1,Just r2) -> return $ r1 <|> r2 - _ -> do r1 <- toReg n1; r2 <- toReg n2 - return $ idR $ r1 <|> r2 - nRReg (NProduct n1 n2) = case (toRReg n1,toRReg n2) of - (Just r1,Just r2) -> return $ r1 |> r2 - _ -> do r1 <- toReg n1;r2 <- toReg n2; return $ idR $ r1 |> r2 - nRReg (NStar n1) = case (toRReg n1) of - (Just r1) -> return $ star r1 - _ -> do r1 <- toReg n1; return $ idR $ star r1 - nRReg (NIntersect n1 n2) = do r1 <- toReg n1; r2 <- toReg n2 - return $ idR $ r1 <&> r2 - nRReg (NComplement n1) = do r1 <- toReg n1; return $ idR $ complement r1 - nRReg _ = Nothing +toRReg reg = maybe (nRReg reg) (return . idR) (toReg reg) + where + nRReg :: Eq a => NReg a -> Maybe (RReg a) + nRReg NEmptySet = Just EmptyR + nRReg (NRelation a b) = Just (r a b) + nRReg (NComp n1 n2) = liftM2 (<.>) (toRReg n1) (toRReg n2) + nRReg (NCross n1 n2) = liftM2 (<*>) (toReg n1) (toReg n2) + nRReg (NUnion n1 n2) = case (toRReg n1, toRReg n2) of + (Just r1, Just r2) -> Just (r1 <|> r2) + _ -> fmap idR $ liftM2 (<|>) (toReg n1) (toReg n2) + nRReg (NProduct n1 n2) = case (toRReg n1, toRReg n2) of + (Just r1,Just r2) -> Just (r1 |> r2) + _ -> fmap idR $ liftM2 (|>) (toReg n1) (toReg n2) + nRReg (NStar n1) = case toRReg n1 of + Just r1 -> Just (star r1) + _ -> liftM (idR . star) (toReg n1) + nRReg (NIntersect n1 n2) = fmap idR $ liftM2 (<&>) (toReg n1) (toReg n2) + nRReg (NComplement n1) = fmap (idR . complement) (toReg n1) + nRReg _ = Nothing +-- | If possible, converts NReg to Reg toReg :: Eq a => NReg a -> Maybe (Reg a) -toReg (NEmptySet) = return empty -toReg (NEpsilon) = return eps -toReg (NSymbol a) = return $ s a -toReg (NAll) = return allS -toReg (NUnion n1 n2) = do r1 <- toReg n1; r2 <- toReg n2; return $ r1 <|> r2 -toReg (NProduct n1 n2) = do r1 <- toReg n1; r2 <- toReg n2; return $ r1 |> r2 -toReg (NStar n1) = do r1 <- toReg n1; return $ star r1 -toReg (NIntersect n1 n2) = do r1 <- toReg n1; r2 <- toReg n2; return $ r1 <&> r2 -toReg (NComplement n1) = do r1 <- toReg n1; return $ complement r1 +toReg NEmptySet = return empty +toReg NEpsilon = return eps +toReg NAll = return allS +toReg (NSymbol a) = return (s a) +toReg (NStar n1) = liftM star (toReg n1) +toReg (NComplement n1) = liftM complement (toReg n1) +toReg (NUnion n1 n2) = liftM2 (<|>) (toReg n1) (toReg n2) +toReg (NIntersect n1 n2) = liftM2 (<&>) (toReg n1) (toReg n2) +toReg (NProduct n1 n2) = liftM2 (|>) (toReg n1) (toReg n2) toReg _ = Nothing +-- | Convert variables to symbols nVarToSymbol :: NReg String -> NReg String nVarToSymbol (NCross n1 n2) = NCross (nVarToSymbol n1) (nVarToSymbol n2) nVarToSymbol (NComp n1 n2) = NComp (nVarToSymbol n1) (nVarToSymbol n2) diff --git a/FST/Parse.hs b/FST/Parse.hs --- a/FST/Parse.hs +++ b/FST/Parse.hs @@ -1,5 +1,6 @@ --- parser produced by Happy Version 1.10 - +{- | +Parser produced by Happy Version 1.10 +-} module FST.Parse where import FST.NReg @@ -467,7 +468,7 @@ happyReduction_6 ((HappyTerminal (TokenFun happy_var_1)) `HappyStk` happyRest) = happyThen ( case (parseList (snd $ snd happy_var_1) []) of - FailE str -> failE $ "\nfstStudio failed to parse.\nParse error at line: "++ show (fst happy_var_1) ++"\n" + FailE str -> failE $ "Parse failure: parse error at line "++ show (fst happy_var_1) Ok list -> returnE $ Fun (fst $ snd happy_var_1) list ) (\r -> happyReturn (HappyAbsSyn7 r)) @@ -675,7 +676,36 @@ parseNReg tks = happyThen (happyParse action_1 tks) (\x -> case x of {HappyAbsSyn7 z -> happyReturn z; _other -> notHappyAtAll }) happyError :: [Token] -> E a -happyError _ = failE $ "\nfstStudio failed to parse.\n No useful message can be printed.\n" +happyError [] = failE $ "Parse failure" +happyError (t:_) = failE $ "Parse failure at symbol '"++ show t ++"' on line " ++ show (getLineNo t) + where + getLineNo :: Token -> Int + getLineNo (TokenSemi l) = l + getLineNo (TokenHOB l) = l + getLineNo (TokenHCB l) = l + getLineNo (TokenSOB l) = l + getLineNo (TokenSCB l) = l + getLineNo (TokenConcatS (l,_)) = l + getLineNo (TokenStar l) = l + getLineNo (TokenComplement l) = l + getLineNo (TokenContainment l) = l + getLineNo (TokenMinus l) = l + getLineNo (TokenIntersect l) = l + getLineNo (TokenUnion l) = l + getLineNo (TokenPlus l) = l + getLineNo (TokenEps l) = l + getLineNo (TokenAll l) = l + getLineNo (TokenS (l,_)) = l + getLineNo (TokenRelation l) = l + getLineNo (TokenCrossproduct l) = l + getLineNo (TokenComposition l) = l + getLineNo (TokenRepeat l) = l + getLineNo (TokenNum (l,_)) = l + getLineNo (TokenFun (l,_)) = l + getLineNo (TokenMain l) = l + getLineNo (TokenDef l) = l + getLineNo (TokenVar (l,_)) = l + getLineNo (Err str) = 0 data E a = Ok a | FailE String @@ -702,7 +732,7 @@ FailE str -> FailE str functional (FailE str) = FailE str -getMain [] = failE "\nfstStudio failed to parse.\nNo main function exists.\n" +getMain [] = failE "Parse failure: no main function exists." getMain ((Main n1):xs) = Ok n1 getMain (_:xs) = getMain xs @@ -717,7 +747,7 @@ apply (Fun str ns) env = do applyFun (str,ns) env env apply n1 _ = returnE n1 -applyFun (str,_) [] _ = failE $ "\nfstStudio failed to parse.\nFound a unidentified function: " ++ str ++ "\n" +applyFun (str,_) [] _ = failE $ "Parse failure: unidentified function: " ++ str applyFun (str,ns) ((Function name vars n1):xs) env | str == name = do res <- (replace n1 (zip vars ns)) apply res env @@ -734,7 +764,7 @@ replace (NComplement n1) env = do liftM NComplement (replace n1 env) replace (NVar str) env = case (lookup str env) of Just n1 -> returnE n1 - Nothing -> failE $ "\nfstStudio failed to parse.\nFound a unidentified variable: " ++ str ++"\n" + Nothing -> failE $ "Parse failure: unidentified variable: " ++ str replace n1 env = returnE n1 parseList :: [String] -> [NReg String] -> E ([NReg String]) @@ -743,19 +773,21 @@ FailE str -> FailE str Ok n1 -> parseList list (n1:res) +-- | Parse a regular expression from a string parseExp :: String -> Either String (RReg String) parseExp str = case ((parseNReg.lexer) str) of - FailE str -> Left "\nfstStudio failed to parse given expression.\n" + FailE str -> Left $ "Failed to parse expression: " ++ str Ok n1 -> case (toRReg (nVarToSymbol n1)) of Just rreg -> Right rreg - Nothing -> Left "\nfstStudio failed to parse given expression.\n" + Nothing -> Left $ "Failed to parse expression: " ++ str +-- | Parse a program from a string parseProgram :: String -> Either String (RReg String) parseProgram str = case ((functional.parse.lexer) str) of FailE str -> Left str Ok n1 -> case (toRReg n1) of Just rreg -> Right rreg - Nothing -> Left "\nfstStudio failed to parse.\nNo main function exists.\n" + Nothing -> Left "Parse failure." {-# LINE 1 "GenericTemplate.hs" -} {-# LINE 1 "GenericTemplate.hs" -} -- $Id: GenericTemplate.hs,v 1.11 2001/03/30 14:24:07 simonmar Exp $ diff --git a/FST/RRegTypes.hs b/FST/RRegTypes.hs --- a/FST/RRegTypes.hs +++ b/FST/RRegTypes.hs @@ -1,113 +1,89 @@ -{- - ************************************************************** - * Filename : RRegTypes.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 5 July, 2001 * - * Lines : 113 * - ************************************************************** +{- | +Functions for constructing a simplified regular relation. -} - -module FST.RRegTypes ( module FST.RegTypes, - RReg(..), -- data type for regular relations. --- (<|>), -- union combinator for regular relations. --- (|>), -- product combinator for regular relations. --- star, -- Kleene's star for regular relations. --- plus, -- Kleene's plus for regular relations. --- empty, -- The empty set of regular relations. - (<*>), -- Cross product opertor. - (<.>), -- Composition operator. - idR, -- Identity relation. - r, -- Relation. --- symbols -- Collect the symbols in a regular relations. - ) where +module FST.RRegTypes ( + module FST.RegTypes, + -- * Types + RReg(..), + -- * Combinators + (<*>), (<.>), + -- * Constructors + idR, r, + ) where import FST.RegTypes import FST.TransducerTypes (Symbol(..)) -import Data.List(nub) +import Data.List (nub) -{- ************************************* - * Datatype for a regular relations * - ************************************* --} +-- | Datatype for a regular relations +data RReg a = + Cross (Reg a) (Reg a) -- ^ Cross product + | Comp (RReg a) (RReg a) -- ^ Composition + | ProductR (RReg a) (RReg a) -- ^ Concatenation + | UnionR (RReg a) (RReg a) -- ^ Union + | StarR (RReg a) -- ^ Kleene star + | Identity (Reg a) -- ^ Identity relation + | Relation (Symbol a) (Symbol a) -- ^ (a:b) + | EmptyR -- ^ Empty language + deriving (Eq) -data RReg a - = Cross (Reg a) (Reg a) -- ^ Cross product - | Comp (RReg a) (RReg a) -- ^ Composition - | ProductR (RReg a) (RReg a) -- ^ Concatenation - | UnionR (RReg a) (RReg a) -- ^ Union - | StarR (RReg a) -- ^ Kleene star - | Identity (Reg a) -- ^ Identity relation - | Relation (Symbol a) (Symbol a) -- ^ (a:b) - | EmptyR -- ^ Empty language - deriving (Eq) +instance Eq a => Combinators (RReg a) where + -- Union + EmptyR <|> r2 = r2 -- [ r1 | [] ] = r1 + r1 <|> EmptyR = r1 -- [ [] | r2 ] = r2 + r1 <|> r2 = if r1 == r2 then r1 else UnionR r1 r2 -- [ r1 | r1 ] = r1 -{- ************************************* - * Instance of Combinators (RReg a) * - ************************************* --} + -- Concatenation + EmptyR |> _ = EmptyR -- [ [] r2 ] = [] + _ |> EmptyR = EmptyR -- [ r1 [] ] = [] + r1 |> r2 = ProductR r1 r2 -instance Eq a => Combinators (RReg a) where - EmptyR <|> r2 = r2 -- [ r1 | [] ] = r1 - r1 <|> EmptyR = r1 -- [ [] | r2 ] = r2 - r1 <|> r2 - | r1 == r2 = r1 -- [ r1 | r1 ] = r1 - | otherwise = UnionR r1 r2 - EmptyR |> _ = EmptyR -- [ [] r2 ] = [] - _ |> EmptyR = EmptyR -- [ r1 [] ] = [] - r1 |> r2 = ProductR r1 r2 - star (StarR r1) = star r1 -- [ r1* ]* = r1* - star r1 = StarR r1 - plus r1 = r1 |> star r1 - empty = EmptyR + -- Kleene's star + star (StarR r1) = star r1 -- [ r1* ]* = r1* + star r1 = StarR r1 + -- Kleene's plus + plus r1 = r1 |> star r1 + empty = EmptyR + infixl 2 <*> infixl 1 <.> --- Cross product operator. +-- | Cross product operator (<*>) :: Eq a => Reg a -> Reg a -> RReg a (<*>) = Cross --- Composition operator +-- | Composition operator (<.>) :: Eq a => RReg a -> RReg a -> RReg a (<.>) = Comp --- Identity relation. +-- | Identity relation idR :: Eq a => Reg a -> RReg a idR = Identity +-- | Relation r :: Eq a => a -> a -> RReg a r a b = Relation (S a) (S b) -{- ************************************* - * Instance of Symbols (RReg a) * - ************************************* --} - instance Symbols RReg where - symbols (Cross r1 r2) = nub $ symbols r1 ++ symbols r2 - symbols (Comp r1 r2) = nub $ symbols r1 ++ symbols r2 - symbols (ProductR r1 r2) = nub $ symbols r1 ++ symbols r2 - symbols (UnionR r1 r2) = nub $ symbols r1 ++ symbols r2 - symbols (StarR r1) = symbols r1 - symbols (Identity r1) = symbols r1 - symbols (Relation a b) = let sym (S c) = [c] - sym _ = [] + symbols (Cross r1 r2) = nub $ symbols r1 ++ symbols r2 + symbols (Comp r1 r2) = nub $ symbols r1 ++ symbols r2 + symbols (ProductR r1 r2) = nub $ symbols r1 ++ symbols r2 + symbols (UnionR r1 r2) = nub $ symbols r1 ++ symbols r2 + symbols (StarR r1) = symbols r1 + symbols (Identity r1) = symbols r1 + symbols (Relation a b) = let sym (S c) = [c] + sym _ = [] in nub $ sym a ++ sym b - symbols _ = [] - -{- ************************************* - * Instance of Show (RReg a) * - ************************************* --} + symbols _ = [] instance Show a => Show (RReg a) where - show (Cross r1 r2) = "[ " ++ show r1 ++ " .x. " ++ show r2 ++ " ]" - show (Comp r1 r2) = "[ " ++ show r1 ++ " .o. " ++ show r2 ++ " ]" - show (UnionR r1 r2) = "[ " ++ show r1 ++ " | " ++ show r2 ++ " ]" - show (ProductR r1 r2)= "[ " ++ show r1 ++ " " ++ show r2 ++ " ]" - show (Identity r) = show r - show (StarR r) = "[ " ++ show r ++ " ]*" - show (Relation a b) = "[ " ++ show a ++":"++show b ++" ]" - show (EmptyR) = "[]" + show (Cross r1 r2) = "[ " ++ show r1 ++ " .x. " ++ show r2 ++ " ]" + show (Comp r1 r2) = "[ " ++ show r1 ++ " .o. " ++ show r2 ++ " ]" + show (UnionR r1 r2) = "[ " ++ show r1 ++ " | " ++ show r2 ++ " ]" + show (ProductR r1 r2) = "[ " ++ show r1 ++ " " ++ show r2 ++ " ]" + show (Identity r) = show r + show (StarR r) = "[ " ++ show r ++ " ]*" + show (Relation a b) = "[ " ++ show a ++":"++show b ++" ]" + show EmptyR = "[]" diff --git a/FST/RegTypes.hs b/FST/RegTypes.hs --- a/FST/RegTypes.hs +++ b/FST/RegTypes.hs @@ -1,115 +1,95 @@ -{- - ************************************************************** - * Filename : RegTypes.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 5 July, 2001 * - * Lines : 219 * - ************************************************************** +{- | +Functions for constructing a simplified regular expression. -} - -module FST.RegTypes ( Reg(..), -- data type for the regular expression - Combinators, -- Type class for Combinators. - (<|>), -- Union combinator - (|>), -- Concatenation combinator - (<&>), -- Intersection combinator - (<->), -- Minus combinator - s, -- Symbol - eps, -- Epsilon - empty, -- Empty - complement, -- Complement - star, -- Star - plus, -- Plus - allS, -- All Symbol - allToSymbols, -- transform the 'all' symbol to union over - -- alphabet. - allFree, -- free a regular expression from 'all' - -- symbols. - reversal, -- reverse a regular expression. - acceptEps, -- Does the regular expression accept epsilon? - Symbols, -- Type class for Symbols. - symbols -- Collect the symbols in a - -- regular expression. - ) where +module FST.RegTypes ( + -- * Type classes + Combinators ( + (<|>), (|>), star, plus, empty + ), + Symbols (symbols), + + -- * Types + Reg(..), + + -- * Combinators + (<&>), (<->), + complement, reversal, allFree, + + -- * Constructors + s, eps, allS, + allToSymbols, + + -- * Query functions + acceptEps, + ) where import Data.List (nub) -{- ********************************************************** - * Data type for a regular expression. * - ********************************************************** --} - -data Reg a = Empty | -- [] - Epsilon | -- 0 - All | -- ? - Symbol a | -- a - Reg a :|: Reg a | -- [ r1 | r2 ] - Reg a :.: Reg a | -- [ r1 r2 ] - Reg a :&: Reg a | -- [ r1 & r2 ] - Complement (Reg a) | -- ~[ r1 ] - Star (Reg a) -- [ r2 ]* - deriving (Eq) - -{- ********************************************************** - * Combinators. * - * The regular expressions are simplified while combined. * - ********************************************************** --} +-- | Data type for a regular expression. +data Reg a = + Empty -- ^ [ ] + | Epsilon -- ^ 0 + | All -- ^ ? + | Symbol a -- ^ a + | Reg a :|: Reg a -- ^ [ r1 | r2 ] + | Reg a :.: Reg a -- ^ [ r1 r2 ] + | Reg a :&: Reg a -- ^ [ r1 & r2 ] + | Complement (Reg a) -- ^ ~[ r1 ] + | Star (Reg a) -- ^ [ r2 ]* + deriving (Eq) -infixl 5 |> -- Concatenation infixl 4 <|> -- Union +infixl 5 |> -- Concatenation infixl 3 <&> -- Intersection infixl 3 <-> -- Set minus +-- | Combinators. The regular expressions are simplified while combined. class Combinators a where - (<|>) :: a -> a -> a -- Union - (|>) :: a -> a -> a -- Concatenation - star :: a -> a -- Kleene's star - plus :: a -> a -- Kleene's plus - empty :: a + (<|>) :: a -> a -> a -- ^ Union + (|>) :: a -> a -> a -- ^ Concatenation + star :: a -> a -- ^ Kleene's star + plus :: a -> a -- ^ Kleene's plus + empty :: a -- ^ Empty language instance Eq a => Combinators (Reg a) where - Empty <|> b = b -- [ [] | r1 ] = r1 - a <|> Empty = a -- [ r1 | [] ] = r1 - _ <|> (Star All) = Star All - (Star All) <|> _ = Star All - a1@(a :.: b) <|> a2@(c :.: d) - | a1 == a2 = a1 - | a == c = a |> (b <|> d) - | b == d = (a <|> c) |> b - | otherwise = a1 :|: a2 - a <|> b - | a == b = a -- [ r1 | r1 ] = r1 - | otherwise = a :|: b + Empty <|> b = b -- [ [] | r1 ] = r1 + a <|> Empty = a -- [ r1 | [] ] = r1 + _ <|> Star All = Star All + Star All <|> _ = Star All - Empty |> _ = empty -- [ [] r1 ] = [] - _ |> Empty = empty -- [ r1 [] ] = [] - Epsilon |> b = b -- [ 0 r1 ] = r1 - a |> Epsilon = a -- [ r1 0 ] = r1 - a |> b = a :.: b + a@(a1 :.: a2) <|> b@(b1 :.: b2) + | a == b = a + | a1 == b1 = a1 |> (a2 <|> b2) + | a2 == b2 = (a1 <|> b1) |> a2 + | otherwise = a :|: b + a <|> b = if a == b then a else a :|: b -- [ r1 | r1 ] = r1 - star (Star a) = star a -- [r1]** = [r1]* - star (Epsilon) = eps -- [0]* = 0 - star (Empty) = eps -- [ [] ]* = 0 - star a = Star a + Empty |> _ = empty -- [ [] r1 ] = [] + _ |> Empty = empty -- [ r1 [] ] = [] + Epsilon |> b = b -- [ 0 r1 ] = r1 + a |> Epsilon = a -- [ r1 0 ] = r1 + a |> b = a :.: b - plus a = a |> star a + star (Star a) = star a -- [r1]** = [r1]* + star (Epsilon) = eps -- [0]* = 0 + star (Empty) = eps -- [ [] ]* = 0 + star a = Star a - empty = Empty + plus a = a |> star a -{- Intersection -} + empty = Empty +-- | Intersection (<&>) :: Eq a => Reg a -> Reg a -> Reg a -_ <&> Empty = Empty -- [ r1 & [] ] = [] -Empty <&> _ = Empty -- [ [] & r1 ] = [] -(Star All) <&> a = a -a <&> (Star All) = a -a <&> b +_ <&> Empty = Empty -- [ r1 & [] ] = [] +Empty <&> _ = Empty -- [ [] & r1 ] = [] +Star All <&> a = a +a <&> Star All = a +a <&> b | a == b = a -- [ r1 & r1 ] = r1 | otherwise = a :&: b -{- Minus. Definition A - B = A & ~B -} - +-- | Minus. Definition A - B = A & ~B (<->) :: Eq a => Reg a -> Reg a -> Reg a Empty <-> _ = empty -- [ [] - r1 ] = [] a <-> Empty = a -- [ r1 - [] ] = r1 @@ -117,102 +97,80 @@ | a == b = empty -- [ r1 - r1 ] = [] | otherwise = a <&> (complement b) +-- | Symbol s :: a -> Reg a s a = Symbol a - + +-- | Epsilon eps :: Reg a eps = Epsilon +-- | All symbol allS :: Reg a allS = All +-- | Complement complement :: Eq a => Reg a -> Reg a -complement Empty = star allS -- ~[ [] ] = ?* -complement Epsilon = plus allS -- ~[ 0 ] = [? ?*] -complement (Star All) = empty +complement Empty = star allS -- ~[ [] ] = ?* +complement Epsilon = plus allS -- ~[ 0 ] = [? ?*] +complement (Star All) = empty complement (Complement a) = a -complement a = Complement a - -{- ******************************************************************* - * allToSymbols: ? -> [a|..] with respect to an alphabet [a] * - * allFreeReg: Construct a ?-free regular expression with respect * - * to an alphabet [a] * - ******************************************************************* --} +complement a = Complement a +-- | Transform the 'all' symbol to union over alphabet. ? -> [a|..] with respect to an alphabet [a] allToSymbols :: Eq a => [a] -> Reg a -allToSymbols sigma = case sigma of - [] -> empty - ys -> foldr1 (:|:) [s a| a <- ys] +allToSymbols [] = empty +allToSymbols ys = foldr1 (:|:) (map s ys) +-- | Construct a ?-free regular expression with respect to an alphabet [a] allFree :: Eq a => Reg a -> [a] -> Reg a -allFree (a :|: b) sigma = (allFree a sigma) :|: (allFree b sigma) -allFree (a :.: b) sigma = (allFree a sigma) :.: (allFree b sigma) -allFree (a :&: b) sigma = (allFree a sigma) :&: (allFree b sigma) +allFree (a :|: b) sigma = allFree a sigma :|: allFree b sigma +allFree (a :.: b) sigma = allFree a sigma :.: allFree b sigma +allFree (a :&: b) sigma = allFree a sigma :&: allFree b sigma allFree (Complement a) sigma = Complement (allFree a sigma) allFree (Star a) sigma = Star (allFree a sigma) -allFree (All) sigma = allToSymbols sigma -allFree r _ = r - -{- ********************************************************** - * reversal: reverse the language denoted by the regular * - * expression. * - ********************************************************** --} +allFree All sigma = allToSymbols sigma +allFree r _ = r +-- | Reverse the language denoted by the regular expression. reversal :: Eq a => Reg a -> Reg a -reversal (a :|: b) = (reversal a) :|: (reversal b) -reversal (a :.: b) = (reversal b) :.: (reversal a) -reversal (a :&: b) = (reversal a) :&: (reversal b) +reversal (a :|: b) = reversal a :|: reversal b +reversal (a :.: b) = reversal b :.: reversal a +reversal (a :&: b) = reversal a :&: reversal b reversal (Complement a) = Complement (reversal a) reversal (Star a) = Star (reversal a) reversal r = r -{- *********************************************************** - * acceptEps: Examines if a regular expression accepts * - * the empty string. * - *********************************************************** --} - +-- | Examines if a regular expression accepts the empty string. acceptEps :: Eq a => Reg a -> Bool -acceptEps (Epsilon) = True -acceptEps (Star _) = True -acceptEps (a :|: b) = acceptEps a || acceptEps b -acceptEps (a :.: b) = acceptEps a && acceptEps b -acceptEps (a :&: b) = acceptEps a && acceptEps b -acceptEps (Complement a) = not (acceptEps a) -acceptEps _ = False - -{- ********************************************************** - * Symbols: type class for the collection of symbols in a * - * expression. * - ********************************************************** --} +acceptEps Epsilon = True +acceptEps (Star _) = True +acceptEps (a :|: b) = acceptEps a || acceptEps b +acceptEps (a :.: b) = acceptEps a && acceptEps b +acceptEps (a :&: b) = acceptEps a && acceptEps b +acceptEps (Complement a) = not (acceptEps a) +acceptEps _ = False +-- | Type class for the collection of symbols in an expression. class Symbols f where - symbols :: Eq a => f a -> [a] - -instance Symbols Reg where - symbols (Symbol a) = [a] - symbols (a :.: b) = nub $ (symbols a) ++ (symbols b) - symbols (a :|: b) = nub $ (symbols a) ++ (symbols b) - symbols (a :&: b) = nub $ (symbols a) ++ (symbols b) - symbols (Complement a) = symbols a - symbols (Star a) = symbols a - symbols _ = [] + symbols :: Eq a => f a -> [a] -- ^ Collect the symbols in a regular expression. -{- ********************************************************** - * Instance of Show (Reg a) * - ********************************************************** --} +instance Symbols Reg where + symbols (Symbol a) = [a] + symbols (a :.: b) = nub (symbols a ++ symbols b) + symbols (a :|: b) = nub (symbols a ++ symbols b) + symbols (a :&: b) = nub (symbols a ++ symbols b) + symbols (Complement a) = symbols a + symbols (Star a) = symbols a + symbols _ = [] instance Show a => Show (Reg a) where - show (Empty) = "[0 - 0]" - show (Epsilon) = "0" - show (Symbol a) = show a - show (All) = "?" - show (Complement a) = "~" ++ "[" ++ show a ++ "]" - show (Star a) = "[" ++ show a ++ "]* " - show (a :|: b) = "[" ++ show a ++ " | " ++ show b ++ "]" - show (a :.: b) = "[" ++ show a ++ " " ++ show b ++ "]" - show (a :&: b) = "[" ++ show a ++ " & " ++ show b ++ "]" + show Empty = "[0 - 0]" + show Epsilon = "0" + show (Symbol a) = show a + show All = "?" + show (Complement a) = "~[" ++ show a ++ "]" + show (Star a) = "[" ++ show a ++ "]* " + show (a :|: b) = "[" ++ show a ++ " | " ++ show b ++ "]" + show (a :.: b) = "[" ++ show a ++ " " ++ show b ++ "]" + show (a :&: b) = "[" ++ show a ++ " & " ++ show b ++ "]" diff --git a/FST/Reversal.hs b/FST/Reversal.hs --- a/FST/Reversal.hs +++ b/FST/Reversal.hs @@ -1,30 +1,36 @@ -{- - ************************************************************** - * Filename : Reversal.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 7 July, 2001 * - * Lines : 28 * - ************************************************************** +{- | +Reverse an automaton -} - -module FST.Reversal ( reversal -- Reverse an automaton. - ) where +module FST.Reversal ( + reversal + ) where import FST.Automaton import Data.Array +-- | Reverse an automaton reversal :: Eq a => Automaton a -> Automaton a -reversal automaton = reverseTrans (rename (transitionTable automaton) - (alphabet automaton) - (finals automaton) - (initials automaton) - (firstState automaton)) +reversal automaton = + reverseTrans $ + rename (transitionTable automaton) + (alphabet automaton) + (finals automaton) + (initials automaton) + (firstState automaton) +-- | Helper function for automaton reversal reverseTrans :: Eq a => Automaton a -> Automaton a -reverseTrans automaton = let bs = (firstState automaton, lastState automaton) - table = assocs $ accumArray (\tl1 tl2 -> tl1 ++ tl2) [] - bs [(s1,[(a,s)]) | (s,tl) <- transitionTable automaton, - (a,s1) <- tl] - in construct bs table (alphabet automaton) (initials automaton) (finals automaton) +reverseTrans automaton = + construct bs table + (alphabet automaton) + (initials automaton) + (finals automaton) where + bs :: (StateTy, StateTy) + bs = (firstState automaton, lastState automaton) + + table = assocs $ accumArray (++) [] bs + [(s1,[(a,s)]) + | (s,tl) <- transitionTable automaton + , (a,s1) <- tl] + diff --git a/FST/ReversalT.hs b/FST/ReversalT.hs --- a/FST/ReversalT.hs +++ b/FST/ReversalT.hs @@ -1,20 +1,15 @@ -{- - ************************************************************** - * Filename : ReversalT.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 7 July, 2001 * - * Lines : 30 * - ************************************************************** +{- | +Reverse an transducer -} - -module FST.ReversalT ( reversal -- Reverse a transducer. - ) where +module FST.ReversalT ( + reversal + ) where import FST.Transducer import Data.Array +-- | Reverse a transducer reversal :: Eq a => Transducer a -> Transducer a reversal transducer = reverseTrans (rename (transitionTable transducer) (alphabet transducer) @@ -22,6 +17,7 @@ (initials transducer) (firstState transducer)) +-- | Helper function for transducer reversal reverseTrans :: Eq a => Transducer a -> Transducer a reverseTrans transducer = let bs = (firstState transducer, lastState transducer) table = assocs $ accumArray (\tl1 tl2 -> tl1 ++ tl2) [] diff --git a/FST/RunTransducer.hs b/FST/RunTransducer.hs --- a/FST/RunTransducer.hs +++ b/FST/RunTransducer.hs @@ -1,66 +1,61 @@ -{- - ************************************************************** - * Filename : RunTransducer.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 88 * - ************************************************************** +{- | +Running a transducer with some input -} - -module FST.RunTransducer ( applyUp, - applyDown - ) where +module FST.RunTransducer ( + -- * Run functions + applyUp, applyDown + ) where import FST.Transducer import Data.Maybe (catMaybes) -type TransitionFunction a = (Transducer a -> (State,Symbol a) -> - [(Symbol a,State)]) +-- | A transition betwee states in a transducer +type TransitionFunction a = (Transducer a -> (StateTy,Symbol a) -> + [(Symbol a,StateTy)]) +-- | Apply a transducer upwards applyUp :: Eq a => Transducer a -> [a] -> Maybe [[a]] applyUp transducer input = apply transducer transitionsD input (initial transducer) [] +-- | Apply a transducer downwards applyDown :: Eq a => Transducer a -> [a] -> Maybe [[a]] applyDown transducer input = apply transducer transitionsU input (initial transducer) [] -apply :: Eq a => Transducer a -> TransitionFunction a -> [a] -> State -> +-- | Generic function for applying a transducer +apply :: Eq a => Transducer a -> TransitionFunction a -> [a] -> StateTy -> [Symbol a] -> Maybe [[a]] -apply transducer transFun input s result = +apply transducer transFun input s result = case (runEpsilon transducer transFun input s result, - runSymbol transducer transFun input s result) of - (Just xs, Just ys) -> Just $ xs ++ ys - (a, Nothing) -> a - (Nothing, b) -> b + runSymbol transducer transFun input s result) of + (Just xs, Just ys) -> Just (xs ++ ys) + (a, Nothing) -> a + (Nothing, b ) -> b -runEpsilon :: Eq a => Transducer a -> TransitionFunction a -> [a] -> State -> +runEpsilon :: Eq a => Transducer a -> TransitionFunction a -> [a] -> StateTy -> [Symbol a] -> Maybe [[a]] runEpsilon transducer transFun input s result = - case (transFun transducer (s,Eps)) of + case transFun transducer (s, Eps) of [] -> Nothing - tl -> case (concat $ catMaybes $ - map (\(a,s1) -> apply transducer transFun input s1 (a:result)) tl) of + tl -> case concat $ catMaybes $ + map (\(a,s1) -> apply transducer transFun input s1 (a:result)) tl of [] -> Nothing - xs -> return xs + xs -> Just xs -runSymbol :: Eq a => Transducer a -> TransitionFunction a -> [a] -> State -> +runSymbol :: Eq a => Transducer a -> TransitionFunction a -> [a] -> StateTy -> [Symbol a] -> Maybe [[a]] runSymbol transducer _ [] s result - | isFinal transducer s = return [transform result] + | isFinal transducer s = Just [transform result] | otherwise = Nothing runSymbol transducer transFun (i:input) s result = case (transFun transducer (s,S i)) of [] -> Nothing - tl -> case (concat $ catMaybes $ - map (\(a,s1) -> apply transducer transFun input s1 (a:result)) tl) of + tl -> case concat $ catMaybes $ + map (\(a,s1) -> apply transducer transFun input s1 (a:result)) tl of [] -> Nothing - xs -> return xs + xs -> Just xs transform :: [Symbol a] -> [a] -transform ys = transform' ys [] - where transform' [] res = res - transform' ((S a):xs) res = transform' xs (a:res) - transform' ((_:xs)) res = transform' xs res +transform ys = reverse [ a | S a <- ys ] diff --git a/FST/StateMonad.hs b/FST/StateMonad.hs deleted file mode 100644 --- a/FST/StateMonad.hs +++ /dev/null @@ -1,46 +0,0 @@ -{- - ************************************************************** - * Filename : StateMonad.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 5 July, 2001 * - * Lines : 47 * - ************************************************************** --} - -module FST.StateMonad ( STM(..), -- type for the state monad. - setState, -- set the internal state. - fetchState, -- fetch and increment the internal state. - run -- run the state monad. - ) where - -import FST.AutomatonTypes (State) - -{- ********************************************************** - * Type and instance of the State Monad * - ********************************************************** --} - -newtype STM a = STM(State -> (a,State)) - -instance Monad STM where - return x = STM(\s -> (x,s)) - (STM m) >>= f = STM(\s -> let (a,s1) = m s in - unSTM (f a) s1) - -unSTM :: STM a -> State -> (a,State) -unSTM (STM f) = f - -{- ********************************************************** - * Functions on the state monad. * - ********************************************************** --} - -setState :: State -> STM () -setState s = STM (\_ -> ((),s)) - -fetchState :: STM State -fetchState = STM (\s -> (s,(s+1))) - -run :: STM a -> State -> a -run stM s = let (a,_) = (unSTM stM) s in a diff --git a/FST/Transducer.hs b/FST/Transducer.hs --- a/FST/Transducer.hs +++ b/FST/Transducer.hs @@ -1,187 +1,156 @@ -{- - ************************************************************** - * Filename : Transducer.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 144 * - ************************************************************** +{- | +Transducers and their functions -} +module FST.Transducer ( + module FST.TransducerTypes, -module FST.Transducer ( module FST.TransducerTypes, - Transducer, -- data type for a transducer - construct, -- construct a transducer. - TConvertable, -- type class for conversion to - -- an from a 'Transducer'. - decode, -- from a transducer to an structure. - encode, -- from a structure to a transducer. - rename, - initial, - transitions, - nullFirstState, - productT, - unionT, - starT, - compositionT, - showTransducer - ) where + -- * Types + Transducer, + TConvertable (decode, encode), + -- * Transducer construction + construct, + + -- * Actions on transducers + rename, + initial, + transitions, + nullFirstState, + productT, + unionT, + starT, + compositionT, + showTransducer + ) where + import FST.TransducerTypes -import FST.Utils (tagging,remove,merge) +import FST.Utils (tagging, remove, merge) import Data.Maybe (fromJust) -import Data.List ((\\),nub,delete) - -{- ********************************************************** - * data types for a transducer * - ********************************************************** --} +import Data.List ((\\), nub, delete) +-- | Data type for a transducer data Transducer a = Transducer { - stateTrans :: TTransitionTable a, - initS :: InitialStates, - finalStates :: FinalStates, - alpha :: Sigma a, - firstS :: FirstState, - lastS :: LastState - } - deriving (Show,Read) - -{- ********************************************************** - * Instance of TransducerFunctions * - ********************************************************** --} + stateTrans :: TTransitionTable a, + initS :: InitialStates, + finalStates :: FinalStates, + alpha :: Sigma a, + firstS :: FirstState, + lastS :: LastState + } deriving (Show,Read) instance TransducerFunctions Transducer where - states = (map fst).stateTrans - isFinal a s = elem s (finalStates a) - initials = initS - finals = finalStates - transitionTable = stateTrans - transitionList a s = case (lookup s (stateTrans a)) of - Just xs -> xs - _ -> [] - transitionsU auto (s,a) = map (\((_,c),s1) -> (c,s1)) $ - filter (\((b,_),_) -> a == b) (transitionList auto s) - transitionsD auto (s,a) = map (\((c,_),s1) -> (c,s1)) $ - filter (\((_,b),_) -> a == b) (transitionList auto s) - lastState = lastS - firstState = firstS - alphabet = alpha + states = map fst . stateTrans + isFinal a s = s `elem` finalStates a + initials = initS + finals = finalStates + transitionTable = stateTrans + transitionList a s = case lookup s (stateTrans a) of + Just xs -> xs + _ -> [] + transitionsU auto (s,a) = [ (c, s1) + | ((b, c), s1) <- transitionList auto s, a == b ] + transitionsD auto (s,a) = [ (b, s1) + | ((b, c), s1) <- transitionList auto s, a == c ] + lastState = lastS + firstState = firstS + alphabet = alpha -initial :: Transducer a -> State -initial = head.initials +-- | Initial state +initial :: Transducer a -> StateTy +initial = head . initials +-- | Set first state to null nullFirstState :: Transducer a -> Transducer a -nullFirstState transducer = transducer {firstS = 0} - -transitions :: Eq a => Transducer a -> (State,Relation a) -> [State] -transitions transducer (s,r) = map snd $ filter (\(r1,_) -> r == r1) - (transitionList transducer s) +nullFirstState transducer = transducer { firstS = 0 } -{- ********************************************************** - * Construct a transducer * - ********************************************************** --} +-- | Get transition as a list of states +transitions :: Eq a => Transducer a -> (StateTy,Relation a) -> [StateTy] +transitions transducer (s,r) = + [ r2 | (r1, r2) <- transitionList transducer s, r == r1 ] -construct :: (State,State) -> TTransitionTable a -> Sigma a -> +-- | Construct a transducer +construct :: (StateTy, StateTy) -> TTransitionTable a -> Sigma a -> InitialStates -> FinalStates -> Transducer a -construct bs table sigma is fs = Transducer { - stateTrans = table, - initS = is, - finalStates = fs, - firstS = fst bs, - lastS = snd bs, - alpha = sigma - } - -{- ********************************************************** - * Type class TConvertable * - ********************************************************** --} +construct (first, last) table sigma is fs = + Transducer { + stateTrans = table, + initS = is, + finalStates = fs, + firstS = first, + lastS = last, + alpha = sigma + } +-- | Type class TConvertable class TConvertable f where encode :: Eq a => f a -> Transducer a decode :: Eq a => Transducer a -> f a -{- ********************************************************** - * Convert automaton labelled with something other than * - * states to an 'Automaton'. * - ********************************************************** --} - +-- | Convert transducer labelled with something other than states to a Transducer rename :: Eq b => [(b,[(Relation a,b)])] -> Sigma a -> [b] -> [b] -> - State -> Transducer a + StateTy -> Transducer a rename tTable sigma initS fs s - = let (maxS,table) = tagging (map fst tTable) s - nI = map (\b -> lookupState b table) initS - nfs = map (\b -> lookupState b table) fs - nTrans = renameTable tTable table - in construct (s,maxS) nTrans sigma nI nfs - where lookupState st tab = fromJust $ lookup st tab + = let (maxS, table) = tagging (map fst tTable) s + nI = map (`lookupState` table) initS + nfs = map (`lookupState` table) fs + nTrans = renameTable tTable table + in construct (s, maxS) nTrans sigma nI nfs + where lookupState st tab = fromJust (lookup st tab) + renameTable [] _ = [] renameTable ((b,tl):tll) table = let s1 = lookupState b table - ntl = map (\(a,b1) -> (a,lookupState b1 table)) tl + ntl = [ (a, lookupState b table) | (a, b) <- tl ] in (s1,ntl):renameTable tll table -{- *********************************************************** - * Combine transducers * - *********************************************************** --} - -renameT :: Transducer a -> Transducer a -> (Transducer a,Transducer a,State) -renameT transducer1 transducer2 = let tr2 = rename - (transitionTable transducer2) - (alphabet transducer2) - (initials transducer2) - (finals transducer2) - (lastState transducer1 +1) - in (transducer1,tr2,lastState tr2 +1) +-- | +renameT :: Transducer a -> Transducer a -> (Transducer a,Transducer a,StateTy) +renameT transd1 transd2 = (transd1, tr2, lastState tr2 + 1) where + tr2 = rename (transitionTable transd2) + (alphabet transd2) (initials transd2) + (finals transd2) (lastState transd1 + 1) +-- | Product of two transducers productT :: Eq a => Transducer a -> Transducer a -> Transducer a -productT transducer1 transducer2 = productT' $ renameT transducer1 - transducer2 - where productT' (t1,t2,s) = - let transUnion = (remove (initial t1) (transitionTable t1)) ++ - (remove (initial t2) (transitionTable t2)) - transConc = let t = (transitionList t2 (initial t2)) in - [(f,t)| f <- (finals t1)] - transInit = [(s, transitionList t1 (initial t1) ++ - listEps t1 (transitionList t2 (initial t2)))] - fs = finals t2 ++ listEps t2 (finals t1) ++ - if (acceptEpsilon t1 && acceptEpsilon t2) - then [s] else [] - in Transducer - { - stateTrans = transInit ++ merge transConc transUnion, - finalStates = fs \\ [(initial t1),(initial t2)], - alpha = nub $ alphabet t1 ++ alphabet t2, - initS = [s], - firstS = firstState t1, - lastS = s - } +productT transd1 transd2 = productT' (renameT transd1 transd2) where + productT' (t1,t2,s) = let + transUnion = remove (initial t1) (transitionTable t1) ++ + remove (initial t2) (transitionTable t2) + transConc = let t = (transitionList t2 (initial t2)) + in [(f, t)| f <- finals t1] + transInit = [(s, transitionList t1 (initial t1) ++ + listEps t1 (transitionList t2 (initial t2)))] + fs = finals t2 ++ listEps t2 (finals t1) ++ + [ s | acceptEpsilon t1 && acceptEpsilon t2] + in Transducer { + stateTrans = transInit ++ merge transConc transUnion, + finalStates = fs \\ [initial t1, initial t2], + alpha = nub $ alphabet t1 ++ alphabet t2, + initS = [s], + firstS = firstState t1, + lastS = s + } +-- | Union of two transducers unionT :: Eq a => Transducer a -> Transducer a -> Transducer a -unionT transducer1 transducer2 = unionT' $ renameT transducer1 transducer2 +unionT transducer1 transducer2 = unionT' (renameT transducer1 transducer2) where unionT' (t1,t2,s) = - let transUnion = (remove (initial t1) (transitionTable t1)) ++ - (remove (initial t2) (transitionTable t2)) + let transUnion = remove (initial t1) (transitionTable t1) ++ + remove (initial t2) (transitionTable t2) transInit = [(s, transitionList t1 (initial t1) ++ transitionList t2 (initial t2))] - fs = finals t1 ++ finals t2 ++ - if (acceptEpsilon t1 || acceptEpsilon t2) - then [s] else [] - in Transducer - { - stateTrans = transInit ++ transUnion, - finalStates = fs \\ [(initial t1),(initial t2)], - alpha = nub $ alphabet t1 ++ alphabet t2, - initS = [s], - firstS = firstState t1, - lastS = s - } + fs = finals t1 ++ finals t2 ++ [ s | acceptEpsilon t1 || acceptEpsilon t2 ] + in Transducer { + stateTrans = transInit ++ transUnion, + finalStates = fs \\ [initial t1, initial t2], + alpha = nub (alphabet t1 ++ alphabet t2), + initS = [s], + firstS = firstState t1, + lastS = s + } +-- | Kleene star of two transducers starT :: Eq a => Transducer a -> Transducer a starT t1 = let s = lastState t1 +1 @@ -189,14 +158,15 @@ transLoop = let t = transitionList t1 (initial t1) in (s,t): [(f,t) | f <- finals t1] in Transducer { - stateTrans = merge transLoop transUnion, - finalStates = (s:(delete (initial t1) (finals t1))), - alpha = alphabet t1, - initS = [s], - firstS = firstState t1, - lastS = s - } + stateTrans = merge transLoop transUnion, + finalStates = s:(delete (initial t1) (finals t1)), + alpha = alphabet t1, + initS = [s], + firstS = firstState t1, + lastS = s + } +-- | Compose two transducers compositionT :: Eq a => Transducer a -> Transducer a -> Transducer a compositionT t1 t2 = let minS1 = firstState t1 @@ -204,59 +174,50 @@ name (s1,s2) = (lastState t2 - minS2 +1) * (s1 - minS1) + s2 - minS2 + minS1 nS = name (lastState t1,lastState t2) +1 - transInit = (nS,[((a,d),name (s1,s2)) | - ((a,b),s1) <- ((Eps,Eps),initial t1):transitionList - t1 (initial t1), - ((c,d),s2) <- ((Eps,Eps),initial t2):transitionList - t2 (initial t2), - ((a,b) /= (Eps,Eps)) || ((c,d) /= (Eps,Eps)), - b == c]) - transTable = [(name (s1,s2),[((a,d),name (s3,s4)) | ((a,b),s3) <- ((Eps,Eps),s1):tl1, - ((c,d),s4) <- ((Eps,Eps),s2):tl2, - ((a,b) /= (Eps,Eps)) || ((c,d) /= (Eps,Eps)), - b == c]) | - (s1,tl1) <- transitionTable t1, - (s2,tl2) <- transitionTable t2, - s1 /= initial t1 || - s2 /= initial t2 - ] + transInit = (nS, [ ((a, d), name (s1, s2)) + | ((a, b), s1) <- ((Eps,Eps), initial t1):transitionList t1 (initial t1) + , ((c, d), s2) <- ((Eps,Eps), initial t2):transitionList t2 (initial t2) + , (a, b) /= (Eps, Eps) || (c,d) /= (Eps,Eps) + , b == c ]) + transTable = [(name (s1,s2),[ ((a, d), name (s3, s4)) + | ((a, b), s3) <- ((Eps, Eps), s1):tl1 + , ((c, d), s4) <- ((Eps, Eps), s2):tl2 + , (a, b) /= (Eps, Eps) || (c,d) /= (Eps, Eps) + , b == c]) + | (s1, tl1) <- transitionTable t1 + , (s2, tl2) <- transitionTable t2 + , s1 /= initial t1 || s2 /= initial t2 ] transUnion = transInit:transTable - fs = (if (acceptEpsilon t1 && acceptEpsilon t2) - then [nS] else []) ++ - [name (f1,f2)| f1 <- finals t1, - f2 <- finals t2] - in Transducer - { - stateTrans = merge [(s,[]) | s <- fs] transUnion, - finalStates = fs, - alpha = nub $ alphabet t1 ++ alphabet t2 , - initS = [nS], - firstS = min (firstState t1) (firstState t2), - lastS = nS - } + fs = [ nS | acceptEpsilon t1 && acceptEpsilon t2 ] ++ + [name (f1, f2) | f1 <- finals t1, f2 <- finals t2] + in Transducer { + stateTrans = merge [(s, []) | s <- fs] transUnion, + finalStates = fs, + alpha = nub $ alphabet t1 ++ alphabet t2 , + initS = [nS], + firstS = min (firstState t1) (firstState t2), + lastS = nS + } +-- | Does a transducer accept epsilon acceptEpsilon :: Transducer a -> Bool acceptEpsilon transducer = isFinal transducer (initial transducer) +-- | If the transducer accepts epsilon, return second argument listEps :: Transducer a -> [b] -> [b] -listEps transducer xs - | acceptEpsilon transducer = xs - | otherwise = [] - -{- *********************************************************** - * Display a transducer * - *********************************************************** --} +listEps transducer xs = if acceptEpsilon transducer then xs else [] +-- | Show a transducer showTransducer :: Show a => Transducer a -> String -showTransducer transducer - = "\n>>>> Transducer Construction <<<<" ++ - "\n\nTransitions:\n" ++ aux (stateTrans transducer) ++ - "\nNumber of States => " ++ show (length (transitionTable transducer)) ++ - "\nNumber of Transitions => " ++ show (sum [length tl | (s,tl) <- transitionTable transducer]) ++ - "\nAlphabet => " ++ show (alphabet transducer) ++ - "\nInitials => " ++ show (initials transducer) ++ - "\nFinals => " ++ show (finals transducer) ++ "\n" +showTransducer transducer = unlines + [ "Transitions:" + , aux (stateTrans transducer) + , "Number of States => " ++ show (length (transitionTable transducer)) + , "Number of Transitions => " ++ show (sum [length tl | (s,tl) <- transitionTable transducer]) + , "Alphabet => " ++ show (alphabet transducer) + , "Initials => " ++ show (initials transducer) + , "Finals => " ++ show (finals transducer) + ] where aux [] = [] aux ((s,tl):xs) = show s ++" => " ++ aux2 tl ++ "\n" ++ aux xs aux2 [] = [] diff --git a/FST/TransducerInterface.hs b/FST/TransducerInterface.hs --- a/FST/TransducerInterface.hs +++ b/FST/TransducerInterface.hs @@ -1,88 +1,180 @@ -{- - ************************************************************** - * Filename : TransducerInterface.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 85 * - ************************************************************** +{-# LANGUAGE ScopedTypeVariables #-} +{- | +Main API for finite-state transducer library. +Importing this module gives you access to the folllowing functions. + +/Regular expressions/ + +Functions for constructing a simplified regular expression. + +> s :: a -> Reg a -- symbol +> eps :: Reg a -- epsilon +> empty :: Reg a -- empty set +> allS :: Reg a -- all symbol +> star :: Reg a -> Reg a -- kleene’s star +> plus :: Reg a -> Reg a -- kleene’s plus +> complement :: Reg a -> Reg a -- complement +> (<|>) :: Reg a -> Reg a -> Reg a -- union +> (|>) :: Reg a -> Reg a -> Reg a -- product +> (<&>) :: Reg a -> Reg a -> Reg a -- intersection +> (<->) :: Reg a -> Reg a -> Reg a -- set minus +> symbols :: Reg a -> a -- collect all symbols. + +/Regular relations/ + +Functions for constructing a simplified regular relation. + +> r :: a -> a -> Reg a -- relation +> empty :: RReg a -- empty set +> idR :: Reg a -> RReg a -- identity +> star :: RReg a -> RReg a -- kleene’s star +> plus :: RReg a -> RReg a -- kleene’s plus +> (<|>) :: RReg a -> RReg a -> RReg a -- union +> (|>) :: RReg a -> RReg a -> RReg a -- product +> (<*>) :: Reg a -> Reg a -> RReg a -- cross product +> (<.>) :: RReg a -> RReg a -> RReg a -- composition +> symbols :: RReg a -> a -- collect all symbols + +/Parsing regular relations/ + +Functions for parsing regular relations. + +'parseProgram' takes a string containing a fstStudio program, and try +to parse it - if unsuccessful, it returns a error message. 'parseExp' parses a +string containing a regular relation. + +> parseProgram :: String -> Either String (RReg String) +> parseExp :: String -> Either String (RReg String) + +/Construction and running/ + +Functions for constructing and running a nite state transducer. +The function 'compile' construct a deterministic, epsilonfree, minimal +transducer, and 'compileN' construct a epsilonfree, possibly non-deterministic, +non-minimal transducer. The 'Sigma' type provides a way to add symbols +that is not present in the regular relation. 'applyDown' and 'applyUp' are +used to run the transducer. + +> type Sigma a = [a] +> +> compile :: Ord a => RReg a -> Sigma a -> Transducer a +> compileN :: Ord a => RReg a -> Sigma a -> Transducer a +> determinize :: Ord a => Transducer a -> Transducer a +> minimize :: Ord a => Transducer a -> Transducer a +> unionT :: Ord a => Transducer a -> Transducer a -> Transducer a +> productT :: Ord a => Transducer a -> Transducer a -> Transducer a +> starT :: Ord a => Transducer a -> Transducer a +> compositionT :: Ord a => Transducer a -> Transducer a -> Transducer a +> emptyTransducer :: Transducer a +> applyDown :: Ord a => Transducer a -> [a] -> Maybe [[a]] +> applyUp :: Ord a => Transducer a -> [a] -> Maybe [[a]] +> load :: FilePath -> IO (Either String (Transducer String)) +> save :: FilePath -> Transducer String -> IO (Either String ()) + +/Transducer Information/ + +Functions for getting information about a built transducer. + +type StateTy = Int + +> states :: Transducer a -> [StateTy] +> isFinal :: Transducer a -> StateTy -> Bool +> initial :: Transducer a -> StateTy +> finals :: Transducer a -> [StateTy] +> transitonsU :: Transducer a -> (StateTy,a) -> [(a,StateTy)] +> transitionsD :: Transducer a -> (StateTy,a) -> [(a,StateTy)] +> showTransducer :: Transducer a -> String +> numberOfStates :: Transducer a -> Int +> numberOfTransitions :: Transducer a -> Int + -} +module FST.TransducerInterface ( + -- * Functions on regular expressions and relations + module FST.RRegTypes, -module FST.TransducerInterface ( compile, - compileN, - minimize, - determinize, - Transducer, --- states, --- isFinal, --- initial, --- finals, - transitions, --- transitionList, --- transitionsU, --- transitionsD, - showTransducer, - module FST.RRegTypes, - module FST.TransducerTypes, - numberOfStates, - numberOfTransitions, - applyUp, - applyDown, - load, - save, - emptyTransducer, - parseProgram, - parseExp, - unionT, - productT, - starT, - compositionT - ) where + -- * Types + Transducer, -import FST.Parse -import FST.RRegTypes + -- * Transducer-building functions + compile, compileN, minimize, determinize, + emptyTransducer, + + -- * Query functions on transducer + numberOfStates, numberOfTransitions, + transitions, showTransducer, + + -- * Transducer combinators + unionT, productT, starT, compositionT, + + -- * File IO functions + load, save, open, saveToFile, + + -- * Parse functions + parseProgram, parseExp, + + -- * Run functions + applyUp, applyDown, + ) where + +import Prelude hiding (catch) +import FST.Parse (parseProgram, parseExp) +import FST.RRegTypes hiding (reversal) import FST.RunTransducer import FST.Transducer import FST.TransducerTypes -import System.IO.Error (try) import qualified FST.DeterministicT as D import qualified FST.LBFT as L -import qualified FST.MinimalTBrzozowski as M +import FST.ReversalT +import Control.Exception (IOException, catch, try) +import Control.Monad.Error + +-- | Construct a deterministic, epsilon-free, minimal transducer +compile :: Ord a => RReg a -> Sigma a -> Transducer a +compile rreg sigma = minimize $ nullFirstState $ L.compileToTransducer rreg sigma + +-- | Construct an epsilon-free, possibly non-deterministic, non-minimal transducer compileN :: Ord a => RReg a -> Sigma a -> Transducer a -compileN reg sigma = L.compileToTransducer reg sigma +compileN = L.compileToTransducer +-- | Make a transducer deterministic determinize :: Ord a => Transducer a -> Transducer a -determinize transducer = D.determinize transducer +determinize = D.determinize +-- | Make a transducer minimal minimize :: Ord a => Transducer a -> Transducer a -minimize transducer = M.minimize transducer - -compile :: Ord a => RReg a -> Sigma a -> Transducer a -compile rreg sigma = M.minimize $ nullFirstState $ L.compileToTransducer rreg sigma +minimize = D.determinize . reversal . D.determinize . reversal +{-# SPECIALIZE minimize :: Transducer String -> Transducer String #-} +-- | Return the number of states in a transducer numberOfStates :: Ord a => Transducer a -> Int -numberOfStates transducer = length $ states transducer +numberOfStates = length . states +-- | Return the number of transitions in a transducer numberOfTransitions :: Ord a => Transducer a -> Int -numberOfTransitions transducer = sum [length (transitionList transducer s) | - s <- states transducer] +numberOfTransitions transducer = sum [ length (transitionList transducer s) + | s <- states transducer] -load :: FilePath -> IO (Either String (Transducer String)) -load file - = do res <- try (readFile file) - case res of - Right str -> return $ Right (read str) - Left _ -> return $ Left $ - "\nError:\tUnable to open \"" ++ file ++"\".\n" +-- | Load a transducer from file +load :: FilePath -> ErrorT String IO (Transducer String) +load = fmap read . open -save :: FilePath -> Transducer String -> IO (Either String ()) -save file auto - = do res <- try (writeFile file $ show auto) - case res of - Right _ -> return $ Right () - Left _ -> return $ Left $ - "\nError:\tUnable to save to \"" ++ file ++"\".\n" +-- | Save a transducer from file +save :: FilePath -> Transducer String -> ErrorT String IO () +save file auto = saveToFile file (show auto) +-- | Open a file and return contents as string +open :: FilePath -> ErrorT String IO String +open file = ErrorT $ catch + (Right `liftM` readFile file) + (\(e :: IOException) -> return $ throwError $ "Error: Unable to open \"" ++ file ++ "\"") + +-- | Save contents (as string) to a file +saveToFile :: FilePath -> String -> ErrorT String IO () +saveToFile file str = ErrorT $ catch + (Right `liftM` writeFile file str) + (\(e :: IOException) -> return $ throwError $ "Error: Unable to save to \"" ++ file ++ "\"") + +-- | The empty transucer emptyTransducer :: Ord a => Transducer a emptyTransducer = compile EmptyR [] diff --git a/FST/TransducerTypes.hs b/FST/TransducerTypes.hs --- a/FST/TransducerTypes.hs +++ b/FST/TransducerTypes.hs @@ -1,74 +1,57 @@ -{- - ************************************************************** - * Filename : TransducerTypes.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 6 July, 2001 * - * Lines : 75 * - ************************************************************** +{- | +Type system for transducers -} - -module FST.TransducerTypes ( State, - FinalStates, - FirstState, - LastState, - Sigma, - Relation, - Upper, - Lower, - Symbol (..), - TTransitions, - TTransitionTable, - InitialStates, - TransducerFunctions, - states, - isFinal, - initials, - finals, - transitionTable, - transitionList, - transitionsU, - transitionsD, - firstState, - lastState, - alphabet - ) where +module FST.TransducerTypes ( -import FST.AutomatonTypes (State,FinalStates,Sigma,FirstState,LastState, - InitialStates) + -- * Types + StateTy, + FinalStates, + FirstState, + LastState, + Sigma, + Relation, + Upper, + Lower, + Symbol (..), + TTransitions, + TTransitionTable, + InitialStates, + TransducerFunctions (..), + ) where -{- ********************************************************** - * Transducer types * - ********************************************************** --} +import FST.AutomatonTypes ( + StateTy, FinalStates, Sigma, FirstState, LastState, InitialStates + ) +-- | A relation between upper/lower languages type Relation a = (Upper a, Lower a) + +-- | Upper language type Upper a = Symbol a -type Lower a = Symbol a -data Symbol a - = S a | - Eps - deriving (Show,Read,Eq) +-- | Lower language +type Lower a = Symbol a -type TTransitions a = [(Relation a,State)] +-- | A symbol +data Symbol a = S a | Eps + deriving (Show, Read, Eq) -type TTransitionTable a = [(State,[(Relation a,State)])] +-- | Transducer transitions +type TTransitions a = [(Relation a, StateTy)] -{- ********************************************************** - * Class of TransducerFunctions * - ********************************************************** --} +-- | Transducer transition table +type TTransitionTable a = [(StateTy, [(Relation a, StateTy)])] +-- | Class of TransducerFunctions class TransducerFunctions f where - states :: f a -> [State] - isFinal :: f a -> State -> Bool - initials :: f a -> InitialStates - finals :: f a -> FinalStates - transitionTable :: f a -> TTransitionTable a - transitionList :: f a -> State -> TTransitions a - transitionsU :: Eq a => f a -> (State, Symbol a) -> [(Symbol a, State)] - transitionsD :: Eq a => f a -> (State, Symbol a) -> [(Symbol a, State)] - firstState :: f a -> State - lastState :: f a -> State - alphabet :: f a -> Sigma a + states :: f a -> [StateTy] + isFinal :: f a -> StateTy -> Bool + initials :: f a -> InitialStates + finals :: f a -> FinalStates + transitionTable :: f a -> TTransitionTable a + transitionList :: f a -> StateTy -> TTransitions a + transitionsU :: Eq a => f a -> (StateTy, Symbol a) -> [(Symbol a, StateTy)] + transitionsD :: Eq a => f a -> (StateTy, Symbol a) -> [(Symbol a, StateTy)] + firstState :: f a -> StateTy + lastState :: f a -> StateTy + alphabet :: f a -> Sigma a diff --git a/FST/Utils.hs b/FST/Utils.hs --- a/FST/Utils.hs +++ b/FST/Utils.hs @@ -1,65 +1,43 @@ -{- - ************************************************************** - * Filename : Utils.hs * - * Author : Markus Forsberg * - * d97forma@dtek.chalmers.se * - * Last Modified : 22 July, 2001 * - * Lines : 66 * - ************************************************************** +{- | +General utility functions -} - module FST.Utils ( - cross, -- cross product of two lists. - insert, - merge, - remove, - tagging - ) where - -{- ********************************************************** - * cross: cartesian product of two lists. * - ********************************************************** --} - -{-# SPECIALIZE cross :: [Int] -> [Int] -> [(Int,Int)] #-} + cross, + insert, + merge, + remove, + tagging + ) where +-- | Cartesian product of two lists cross :: [a] -> [b] -> [(a,b)] cross as bs = [(a,b) | a <- as, b <- bs] - -{- ********************************************************** - * insert, merge, remove: aux. functions for transition * - * tables. * - ********************************************************** --} - -{-# SPECIALIZE insert :: (Int,[(String,Int)]) -> [(Int,[(String,Int)])] -> [(Int,[(String,Int)])] #-} +-- {-# SPECIALIZE cross :: [Int] -> [Int] -> [(Int,Int)] #-} +-- | Insert an entry into a transition table insert :: Eq b => (b,[(a,b)]) -> [(b,[(a,b)])] -> [(b,[(a,b)])] -insert (s,t1) [] = [(s,t1)] -insert (s,t1) ((s1,t2):xs) +insert (s, t1) [] = [(s,t1)] +insert (s, t1) ((s1,t2):xs) | s == s1 = (s1, t1++t2):xs | otherwise = (s1,t2):insert (s,t1) xs - -{-# SPECIALIZE merge :: [(Int,[(String,Int)])] -> [(Int,[(String,Int)])] -> [(Int,[(String,Int)])] #-} +{-# SPECIALIZE insert :: (Int,[(String,Int)]) -> [(Int,[(String,Int)])] -> [(Int,[(String,Int)])] #-} +-- | Merge two transition tables merge :: Eq b => [(b,[(a,b)])] -> [(b,[(a,b)])] -> [(b,[(a,b)])] merge [] table2 = table2 merge (a:table1) table2 = merge table1 (insert a table2) - -{-# SPECIALIZE remove :: Int -> [(Int,[(String,Int)])] -> [(Int,[(String,Int)])] #-} +{-# SPECIALIZE merge :: [(Int,[(String,Int)])] -> [(Int,[(String,Int)])] -> [(Int,[(String,Int)])] #-} +-- | Remove transitions from state b from a transition table remove :: Eq b => b -> [(b,[(a,b)])] -> [(b,[(a,b)])] remove _ [] = [] remove s ((s1,tl):xs) | s == s1 = xs | otherwise = (s1,tl):remove s xs - -{- ********************************************************** - * tagging: Tag a list of polymorphic type with integers. * - ********************************************************** --} +{-# SPECIALIZE remove :: Int -> [(Int,[(String,Int)])] -> [(Int,[(String,Int)])] #-} +-- | Tag a list of polymorphic type with integers tagging :: [a] -> Int -> (Int,[(a,Int)]) -tagging xs s = tag xs s [] - where tag [] s1 ys = ((s1-1),ys) - tag (a:zs) s1 ys = tag zs (s1+1) ((a,s1):ys) +tagging xs s = tag xs s [] where + tag [] s1 ys = ((s1-1),ys) + tag (a:zs) s1 ys = tag zs (s1+1) ((a,s1):ys) diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,574 @@ +{-# LANGUAGE DoAndIfThenElse, FlexibleContexts, GeneralizedNewtypeDeriving #-} + +{- | +fstStudio takes a program consisting of regular relations that denotes +the relation between two regular languages and constructs a +transducer. If a regular expression, not a relation, is given, then it +is interpreted as the identity relation. The syntax is very similar to +Xerox's finite state transducer syntax with two fundamental +differences: a distinction is made between functions (definitions) and +strings, and fststudio allows functional definitions. + +[@\"a\"@] A symbol. Example: @[\"b\"]@ denotes the language @{\"b\"}@. + +[@a@] A variable. A symbol without quotes is a variable. + +[@\"a\":\"b\"@] Describes a relation between the symbol @a@ and @b@. +This relation is ordered and @a@ is said to be a part of the /upper +language/ and @b@ is said to be part of the /lower language/. +Example: @[\"a\":\"b\"]@ denotes the relation @{(\"a\",\"b\")}@. + +[@0@] Epsilon symbol. The epsilon symbol denotes the string with no +symbols. Example: @[0]@ denotes the language @{\"\"}@. + +[@?@] All symbol. The all symbol denotes the union of all symbols in +the alphabet. Example: @[?]@ and an alphabet @{a,b,c}@ denotes the +language @{\"a\",\"b\",\"c\"}@. + +[@\"\"@] quotes cancel every special meaning of the symbols. Example: +@[\"? 0\"]@ denotes the language @{\"? 0\"}@. + +[@\[A\]@] brackets are used to change the precedence of a regular +relation. + +[@(A)@] parenthesis expresses optionality, and has the same meaning as +@[A|0]@. + +[@A B@] Concatenation of the expressions or relations A and +B. Example: @[[a b] [c d]]@ denotes the language @{\"ac\", \"ad\", \"bc\", +\"bd\"}@ + +[@A^n@] Concatenation of @A@ /n/ times. @A^0@ is defined as the empty +string. Example: @[a]^3@ describes the language @{\"aaa\"}@. + +[@A|B@] Union of the languages or relations @A@ and @B@. Example: @[a|b]@ +describes the language @{\"a\",\"b\"}@. + +[@A & B@] Intersection of the languages @A@ and @B@. Example: @[a b] +& [a]@ describes the language @{\"a\"}@. + +[@A - B@] Minus of the languages @A@ and @B@, and has the same meaning as +@[A & B]@. Example: @[a b] - [a]@ describes the language @{\"b\"}@. + +[@~A@] Describes the complement of an expression, and has the same +meaning as @[?* - A]@. Note that complement is always defined over +an alphabet. The expression @[A]@ is only unambiguous with respect to +an alphabet. Example: @[a]@ denotes the language that doesn't contain +the string @\"a\"@. If the alphabet is @{\"a\",\"b\"}@ then @[a]@ +denotes the language @{\"\",\"b\",\"aa\",\"ba\",...}@. + +[@A+@] Repetition (Kleenes plus). A concatenated with itself an +arbitrary number of times, including zero times. Example: @[a]+@ denotes +the infinite language @{\"a\",\"aa\",\"aaa\",...}@ + +[@A*@] Kleene’s star: @[A+ | 0]@. Example: @[a]*@ denotes the infinite +language @{\"\",\"a\",\"aa\",...}@ + +[@$A@] Containment. The set of strings where @A@ appear at least once +as a substring. Containment is the same thing as @[?* A ?*]@. + +[@A .x. B@] Cross product of the languages @A@ and @B@. Example: @[[a b] +.x. c]@ describes the relations @{(\"a\",\"c\"), (\"b\",\"c\")}@. + +[@A .o. B@] Composition of the relations @A@ and @B@. Example: @[a:b c:d] +.o. [d:e]@ describes the relation @{(\"c\",\"e\")}@. + +The precedence of the operators is as follows, where 4 is the highest +precedence: + + 1. @.x.@ @.o.@ + + 2. @&@ @-@ + + 3. /Concatenation/ + + 4. @~@ @^@ @*@ @+@ @$@ + +A file containing a program must end with @.fst@, and an input file +mustend with @.dat@. A program is a collection of functions defining +regular relations. A function with zero arguments is called a +definition or a macro. A definition, or a macro, can for example look +like this: + +> ::= "1" | "2" | "3" | "4" | "5" | +> "6" | "7" | "8" | "9" | "0" ; + +and a function can look like this: + +> ::= b a ; + +Note that strings are marked with quotes, and variables have no +quotes. Every program must contain a @\@ definition (a program +without one will result in a parse error). + +>
::= ... ; + +The alphabet of a program is the symbols in the regular relation +defined in the program. + +/Example program/ + +> ::= ["n" .x. "c"^5]; +> ::= ["d" .x. "c"^10]; +> ::= ["q" .x. "c"^25]; +> ::= ["c" .x. "c"]; +> ::= [ | | | ]*; +> ::= ["c"^65 .x. "PLONK"]; +>
::= [ .o. ]; + +/Batch mode/ + +Usage: @fst FILE [Options]@. FILE must end with @.fst@, which defines +an FstStudio program, or @.net@, which defines a saved transducer. If +no options are given, then input is taken from standard input, the +transducer is applied down, and the output, if any, is produced on +standard output. + +[@-u@] Apply the transducer up + +[@-d@] Apply the transducer down + +[@-i FILE@] Take input from FILE + +[@-o FILE@] Write output to FILE + +/Interactive mode - list of commands/ + +[@r REG@] Read a regular relation from standard input. If a regular +expression is typed, then it is interpreted as the identity relation. + +[@b@] Build an epsilon-free, deterministic, minimal transducer from a +loaded/typed regular relation. + +[@bn@] Build an epsilon-free, possibly non-deterministic, non-minimal +transducer from a load/typed regular relation. + +[@m@] Minimize a built transducer. + +[@det@] Determinize a built transducer. + +[@s FILE@] Save to @FILE@. If @FILE@ ends with @.net@, then the built +transducer is saved. Any other suffix saves the produced output in the +system to @FILE@, if any. + +[@l FILE@] Load from @FILE@. @FILE@ must end with @.fst@, @.net@ or +@.dat@. If @FILE@ ends with @.fst@, then a FstStudio program is loaded +into FstStudio. If @FILE@ ends with @.net@, then a transducer is loaded +into FstStudio. If @FILE@ ends with @.dat@, then input is loaded into +FstStudio. + +[@l a | b@] Load and union two transducers. a and b must either be a +file ending with @.net@ or the symbol @*@, which refers to the interior +transducer. The produced transducer is possibly non-deterministic and +non-minimal. + +[@l a b@] Load and concatenate two transducers. a and b must either be +ale ending with @.net@ or the symbol @*@, which refers to the interior +transducer. The produced transducer is possibly non-deterministicand +non-minimal. + +[@l a*@] Load and apply Kleene’s star on a transducer. a must either +be a file ending with @.net@ or the symbol @*@, which refers to the +interior transducer. The produced transducer is possibly +non-deterministicand non-minimal. + +[@l a .o. b@] Load and compose two transducers. a and b must either be +a file ending with @.net@ or the symbol @*@, which refers to the +interior transducer. The produced transducer is possibly +non-deterministic andnon-minimal. + +[@vt@] View loaded/built transducer. + +[@vr@] View loaded/typed regular relation. + +[@vi@] View loaded input. + +[@vo@] View produced output. + +[@d@] Apply transducer down with loaded input. + +[@u@] Apply transducer up with loaded input. + +[@d SYMBOLS@] Apply tranducer down with @SYMBOLS@. + +[@u SYMBOLS@] Apply transducer up with @SYMBOLS@. + +[@c@] Clear memory. + +[@h@] List commands. + +[@q@] End session. + +-} +module Main where + +import FST.TransducerInterface +import FST.RRegTypes +import FST.Arguments +import FST.Info + +import Text.Printf + +import Control.Monad (liftM) +import Control.Monad.State +import Control.Monad.Error +import Control.Monad.IO.Class (liftIO) +import System.Environment (getArgs) +import System.Console.Haskeline + +-- | Main entry point +main :: IO () +main = do + args <- getArgs + case args of + [] -> do + welcome + runInputT defaultSettings (evalStateT loop emptyInfo) + as -> do + ret <- runErrorT (batchMode as) + case ret of + Left err -> putStrLn err + Right _ -> return () + +-- | Display welcome message +welcome :: IO () +welcome = putStr $ unlines [ + "***********************************************************", + "* Finite State Transducer Studio", + "* Written purely in Haskell.", + "* Version : 0.10", + "* Updated : 17 March 2013", + "* Author : Markus Forsberg", + "* With contributions by Baldur Blöndal & John J. Camilleri", + "***********************************************************", + "", + "Type 'h' for help." + ] + +-- | Run in batch mode with given arguments +batchMode :: [String] -> ErrorT String IO () +batchMode cmdopt = do + (file, cmd) <- (ErrorT . return . parseBatch) cmdopt + + -- Only accept .NET or .FST files + when (not (isNET file) && not (isFST file)) $ + throwError "Input file must end with *.fst or *.net" + + transducer <- if isFST file + then do str <- open file + fmap (flip compile []) $ ErrorT $ return $ parseProgram str + + -- Load transducer directly from .NET files + else load file + + let action = if isUpB cmd then upB else downB + inputFile = inputB cmd + outputFile = outputB cmd + + case inputFile of + Just file -> do + str <- open file + case outputFile of + Just f -> saveToFile f str + Nothing -> throwError $ action transducer str + Nothing -> liftIO $ interact (action transducer) + +-- | Apply up in batch mode +upB :: Transducer String -> String -> String +upB transducer str = + case applyUp transducer (words str) of + Just xs -> unlines (map unwords xs) + Nothing -> [] + +-- | Apply down in batch mode +downB :: Transducer String -> String -> String +downB transducer str = + case applyDown transducer (words str) of + Just xs -> unlines (map unwords xs) + Nothing -> [] + +-- | Error when there is no built transducer +noTransducer :: String +noTransducer = "No transducer has been loaded/built." + +-- | Error when there is no regular expression +noExpression :: String +noExpression = "No regular expression has been typed/loaded into fstStudio." + +-- | Error when there is no loaded input +noInput :: String +noInput = "No input has been loaded." + +-- | Error when no output has been produced +noOutputs :: String +noOutputs = "No outputs has been produced." + +-- | Adds a new transducer to the environment and returns it +mkTransducer :: MonadState Info m => Transducer String -> m (Transducer String) +mkTransducer newTransducer = do + modify (updateTransducer newTransducer) + return newTransducer + +-- | Main interactive-shell loop +loop :: StateT Info (InputT IO) () +loop = do + input <- lift $ getInputLine "> " + let command = fmap (parseInteractive . words) input + case command of + Nothing -> return () + Just Quit -> lift $ outputStrLn "Session ended." + Just cmd -> do + -- Run a single command entered at the prompt + result <- runErrorT $ runCmd cmd + + -- Print the resulting output or error message + lift (either outputStrLn outputStrLn result) + loop + +-- | Called for each user command +runCmd :: InteractiveCommand -> ErrorT String (StateT Info (InputT IO)) String +runCmd BuildTransducer = do + info <- get + unless (expressionRead info) $ throwError noExpression + + let newTransducer = compile (getExpression info) [] + modify (updateTransducer newTransducer) + return $ printf "Built a deterministic, minimal transducer with %d states and %d transitions." + (numberOfStates newTransducer) (numberOfTransitions newTransducer) + +runCmd BuildNTransducer = do + info <- get + unless (expressionRead info) $ throwError noExpression + + newTransducer <- mkTransducer $ compileN (getExpression info) [] + + return $ printf "Built a possibly non-deterministic, non-minimal transducer with %d states and %d transitions." + (numberOfStates newTransducer) (numberOfTransitions newTransducer) + +runCmd Minimize = do + info <- get + unless (transducerBuilt info) $ throwError noTransducer + newTransducer <- mkTransducer $ minimize $ getTransducer info + + return $ + printf "Minimized loaded/built transducer resulting in a transducer with %d states and %d transitions." + (numberOfStates newTransducer) (numberOfTransitions newTransducer) + +runCmd Determinize = do + info <- get + unless (transducerBuilt info) $ throwError noTransducer + newTransducer <- mkTransducer $ determinize $ getTransducer info + return $ + printf "Determinized loaded/built transducer resulting in a transducer with %d states and %d transitions." + (numberOfStates newTransducer) (numberOfTransitions newTransducer) + + +runCmd ViewTransducer = do + info <- get + + if transducerBuilt info + then return $ showTransducer $ getTransducer info + else throwError $ noTransducer + +runCmd (Load file) + | isFST file = do + res <- liftIO $ runErrorT $ open file + str <- ErrorT $ return res + reg <- ErrorT $ return $ parseProgram str + modify (updateExpression reg) + return (printf "Loaded a regular relation from %s." file) + | isNET file = do + res <- liftIO $ runErrorT $ load file + transd <- ErrorT $ return res + modify (updateTransducer transd) + return (printf "Loaded transducer from file %s." file) + | isDAT file = do + res <- liftIO $ runErrorT $ open file + str <- ErrorT $ return res + modify $ updateInput $ words str + return $ printf "Read input from file %s." file + | otherwise = + throwError $ "Unable to load from "++file++". The filename must end with *.fst, *.net or *.dat." + +runCmd (LUnion file1 file2) + | isNET file1 && isNET file2 = do + res1 <- liftIO $ runErrorT $ load file1 + res2 <- liftIO $ runErrorT $ load file2 + t1 <- ErrorT $ return res1 + t2 <- ErrorT $ return res2 + modify $ updateTransducer (unionT t1 t2) + return "Loaded and unified two transducers." + + | isNET file1 && isTHIS file2 = unionWith file1 + | isTHIS file1 && isNET file2 = unionWith file2 + | otherwise = return $ printf "Unable to union %s and %s." file1 file2 where + unionWith file = do + info <- get + res <- liftIO $ runErrorT $ load file + unless (transducerBuilt info) $ throwError "No interior transducer built." + r1 <- ErrorT $ return res + modify $ \info -> updateTransducer (unionT r1 (getTransducer info)) info + return "Loaded a transducer, and unified it with the interior transducer." + +runCmd (LProduct file1 file2) + | isNET file1 && isNET file2 = do + res1 <- liftIO $ runErrorT $ load file1 + res2 <- liftIO $ runErrorT $ load file2 + t1 <- ErrorT (return res1) + t2 <- ErrorT (return res2) + modify (updateTransducer (productT t1 t2)) + return "Loaded and concatenated two transducers." + | isNET file1 && isTHIS file2 = productWith file1 + | isTHIS file1 && isNET file2 = productWith file2 + | otherwise = return $ printf "Unable to concatenate %s and %s." file1 file2 where + productWith file = do + info <- get + res <- liftIO $ runErrorT $ load file + unless (transducerBuilt info) $ throwError "No interior transducer built." + t1 <- ErrorT $ return res + modify $ \info -> updateTransducer (productT t1 (getTransducer info)) info + return "Loaded a transducer, and concatenated it with the interior transducer." + +runCmd (LStar file) + | isNET file = do + res <- liftIO $ runErrorT $ load file + t1 <- ErrorT (return res) + modify $ updateTransducer (starT t1) + return "Loaded a transducer, and applied Kleene's star." + | isTHIS file = do + info <- get + unless (transducerBuilt info) $ throwError "No interior transducer built." + modify $ updateTransducer (starT (getTransducer info)) + return "Applied Kleene's star on interior transducer." + | otherwise = return $ printf "Unable to apply Kleene's star on %s." file + +runCmd (LComposition file1 file2) + | isNET file1 && isNET file2 = do + res1 <- liftIO $ runErrorT $ load file1 + res2 <- liftIO $ runErrorT $ load file2 + t1 <- ErrorT (return res1) + t2 <- ErrorT (return res2) + modify $ updateTransducer (compositionT t1 t2) + return "Loaded and composed two transducers." + | isNET file1 && isTHIS file2 = composeWith file1 + | isTHIS file1 && isNET file2 = composeWith file2 + | otherwise = return $ printf "Unable to compose %s and %s." file1 file2 where + composeWith file = do + info <- get + res <- liftIO $ runErrorT $ load file + unless (transducerBuilt info) $ throwError "No interior transducer built." + t1 <- ErrorT (return res) + modify $ \info -> updateTransducer (compositionT t1 (getTransducer info)) info + return "Loaded a transducer, and composed it with the interior transducer." + +runCmd (Save file) = do + info <- get + case () of + _ | isNET file -> do + res <- liftIO $ runErrorT $ save file $ getTransducer info + _ <- ErrorT (return res) + return $ printf "Saved transducer to file %s." file + | outputsRead info -> do + res <- liftIO $ runErrorT $ saveToFile file $ unlines $ getOutputs info + _ <- ErrorT (return res) + return $ printf "Saved outputs to file %s." file + | otherwise -> return noOutputs + +runCmd (StdInReg f) = + case parseExp f of + Left err -> throwError err + Right reg -> modify (updateExpression reg) >> return "Read a regular relation." + +runCmd ViewReg = do + info <- get + if expressionRead info + then return $ show (getExpression info) + else throwError noExpression + +runCmd Quit = return "Session ended." +runCmd ClearMemory = modify (const emptyInfo) >> return "" +runCmd NoCommand = throwError "Invalid Command. Type 'h' for help." +runCmd Help = return help +runCmd ViewInput = do + info <- get + if inputRead info + then return $ unwords $ getInput info + else throwError noInput + +runCmd ViewOutput = do + info <- get + if outputsRead info + then return $ unlines $ getOutputs info + else throwError noOutputs + +runCmd ApplyUp = do + info <- get + case (transducerBuilt info, inputRead info) of + (True, True) -> + case applyUp (getTransducer info) (getInput info) of + Just res -> do + modify $ updateOutputs $ map unwords res + return "Input accepted. Type 'vo' to view outputs." + Nothing -> throwError "Input rejected." + (True, False) -> throwError noTransducer + _ -> throwError noInput + +runCmd ApplyDown = do + info <- get + case (transducerBuilt info, inputRead info) of + (True, True) -> + case applyDown (getTransducer info) (getInput info) of + Just res -> do + modify (updateOutputs (map unwords res)) + return "Input accepted. Type 'vo' to view outputs." + Nothing -> throwError "Input rejected." + (True, False) -> throwError noTransducer + _ -> throwError noInput + +runCmd (ApplyU inp) = do + info <- get + unless (transducerBuilt info) $ throwError noTransducer + + case applyUp (getTransducer info) inp of + Just res -> do + modify $ updateOutputs $ map unwords res + return "Input accepted. Type 'vo' to view outputs." + Nothing -> return "Input rejected." + +runCmd (ApplyD inp) = do + info <- get + unless (transducerBuilt info) $ throwError noTransducer + + case applyDown (getTransducer info) inp of + Just res -> do + modify $ updateOutputs $ map unwords res + return "Input accepted. Type 'vo' to view outputs." + Nothing -> return "Input rejected." + +-- | Dislay list of shell commands for user +help :: String +help = unlines [ + "List of Commands:", + "r : read a regular relation from standard input.", + "b : build a deterministic, minimal transducer.", + "bn : build a possibly non-deterministic, non-minimal transducer.", + "m : minimize loaded/built transducer.", + "det : determinize loaded/built transducer.", + "s : save to file.", + "l : load from file.", + "l a | b : load and union.", + "l a b : load and concatenate.", + "l a * : load and apply Kleene's star.", + "l a .o. b : load and compose.", + "vt : view loaded/built transducer.", + "vr : view typed/loaded regular relation.", + "vi : view loaded input.", + "vo : view produced output.", + "d : apply transducer down with loaded input.", + "u : apply transducer up with loaded input.", + "d : apply transducer down with symbols.", + "u : apply transducer up with symbols.", + "c : Clear memory.", + "h : display list of commands.", + "q : end session." + ] diff --git a/doc/Interface0.9.ps b/doc/Interface0.9.ps deleted file mode 100644 --- a/doc/Interface0.9.ps +++ /dev/null @@ -1,655 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dvips(k) 5.86 Copyright 1999 Radical Eye Software -%%Title: Interface0.9.dvi -%%Pages: 3 -%%PageOrder: Ascend -%%BoundingBox: 0 0 596 842 -%%EndComments -%DVIPSWebPage: (www.radicaleye.com) -%DVIPSCommandLine: dvips -f Interface0.9.dvi -%DVIPSParameters: dpi=600, compressed -%DVIPSSource: TeX output 2001.10.01:1124 -%%BeginProcSet: texc.pro -%! -/TeXDict 300 dict def TeXDict begin/N{def}def/B{bind def}N/S{exch}N/X{S -N}B/A{dup}B/TR{translate}N/isls false N/vsize 11 72 mul N/hsize 8.5 72 -mul N/landplus90{false}def/@rigin{isls{[0 landplus90{1 -1}{-1 1}ifelse 0 -0 0]concat}if 72 Resolution div 72 VResolution div neg scale isls{ -landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div hsize -mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul TR[ -matrix currentmatrix{A A round sub abs 0.00001 lt{round}if}forall round -exch round exch]setmatrix}N/@landscape{/isls true N}B/@manualfeed{ -statusdict/manualfeed true put}B/@copies{/#copies X}B/FMat[1 0 0 -1 0 0] -N/FBB[0 0 0 0]N/nn 0 N/IEn 0 N/ctr 0 N/df-tail{/nn 8 dict N nn begin -/FontType 3 N/FontMatrix fntrx N/FontBBox FBB N string/base X array -/BitMaps X/BuildChar{CharBuilder}N/Encoding IEn N end A{/foo setfont}2 -array copy cvx N load 0 nn put/ctr 0 N[}B/sf 0 N/df{/sf 1 N/fntrx FMat N -df-tail}B/dfs{div/sf X/fntrx[sf 0 0 sf neg 0 0]N df-tail}B/E{pop nn A -definefont setfont}B/Cw{Cd A length 5 sub get}B/Ch{Cd A length 4 sub get -}B/Cx{128 Cd A length 3 sub get sub}B/Cy{Cd A length 2 sub get 127 sub} -B/Cdx{Cd A length 1 sub get}B/Ci{Cd A type/stringtype ne{ctr get/ctr ctr -1 add N}if}B/id 0 N/rw 0 N/rc 0 N/gp 0 N/cp 0 N/G 0 N/CharBuilder{save 3 -1 roll S A/base get 2 index get S/BitMaps get S get/Cd X pop/ctr 0 N Cdx -0 Cx Cy Ch sub Cx Cw add Cy setcachedevice Cw Ch true[1 0 0 -1 -.1 Cx -sub Cy .1 sub]/id Ci N/rw Cw 7 add 8 idiv string N/rc 0 N/gp 0 N/cp 0 N{ -rc 0 ne{rc 1 sub/rc X rw}{G}ifelse}imagemask restore}B/G{{id gp get/gp -gp 1 add N A 18 mod S 18 idiv pl S get exec}loop}B/adv{cp add/cp X}B -/chg{rw cp id gp 4 index getinterval putinterval A gp add/gp X adv}B/nd{ -/cp 0 N rw exit}B/lsh{rw cp 2 copy get A 0 eq{pop 1}{A 255 eq{pop 254}{ -A A add 255 and S 1 and or}ifelse}ifelse put 1 adv}B/rsh{rw cp 2 copy -get A 0 eq{pop 128}{A 255 eq{pop 127}{A 2 idiv S 128 and or}ifelse} -ifelse put 1 adv}B/clr{rw cp 2 index string putinterval adv}B/set{rw cp -fillstr 0 4 index getinterval putinterval adv}B/fillstr 18 string 0 1 17 -{2 copy 255 put pop}for N/pl[{adv 1 chg}{adv 1 chg nd}{1 add chg}{1 add -chg nd}{adv lsh}{adv lsh nd}{adv rsh}{adv rsh nd}{1 add adv}{/rc X nd}{ -1 add set}{1 add clr}{adv 2 chg}{adv 2 chg nd}{pop nd}]A{bind pop} -forall N/D{/cc X A type/stringtype ne{]}if nn/base get cc ctr put nn -/BitMaps get S ctr S sf 1 ne{A A length 1 sub A 2 index S get sf div put -}if put/ctr ctr 1 add N}B/I{cc 1 add D}B/bop{userdict/bop-hook known{ -bop-hook}if/SI save N @rigin 0 0 moveto/V matrix currentmatrix A 1 get A -mul exch 0 get A mul add .99 lt{/QV}{/RV}ifelse load def pop pop}N/eop{ -SI restore userdict/eop-hook known{eop-hook}if showpage}N/@start{ -userdict/start-hook known{start-hook}if pop/VResolution X/Resolution X -1000 div/DVImag X/IEn 256 array N 2 string 0 1 255{IEn S A 360 add 36 4 -index cvrs cvn put}for pop 65781.76 div/vsize X 65781.76 div/hsize X}N -/p{show}N/RMat[1 0 0 -1 0 0]N/BDot 260 string N/Rx 0 N/Ry 0 N/V{}B/RV/v{ -/Ry X/Rx X V}B statusdict begin/product where{pop false[(Display)(NeXT) -(LaserWriter 16/600)]{A length product length le{A length product exch 0 -exch getinterval eq{pop true exit}if}{pop}ifelse}forall}{false}ifelse -end{{gsave TR -.1 .1 TR 1 1 scale Rx Ry false RMat{BDot}imagemask -grestore}}{{gsave TR -.1 .1 TR Rx Ry scale 1 1 false RMat{BDot} -imagemask grestore}}ifelse B/QV{gsave newpath transform round exch round -exch itransform moveto Rx 0 rlineto 0 Ry neg rlineto Rx neg 0 rlineto -fill grestore}B/a{moveto}B/delta 0 N/tail{A/delta X 0 rmoveto}B/M{S p -delta add tail}B/b{S p tail}B/c{-4 M}B/d{-3 M}B/e{-2 M}B/f{-1 M}B/g{0 M} -B/h{1 M}B/i{2 M}B/j{3 M}B/k{4 M}B/w{0 rmoveto}B/l{p -4 w}B/m{p -3 w}B/n{ -p -2 w}B/o{p -1 w}B/q{p 1 w}B/r{p 2 w}B/s{p 3 w}B/t{p 4 w}B/x{0 S -rmoveto}B/y{3 2 roll p a}B/bos{/SS save N}B/eos{SS restore}B end - -%%EndProcSet -TeXDict begin 39158280 55380996 1000 600 600 (Interface0.9.dvi) -@start -%DVIPSBitmapFont: Fa cmtt10 10.95 52 -/Fa 52 125 df38 -DI<141E147F14FF5BEB03 -FEEB07F8EB0FF0EB1FE0EB3FC0EB7F80EBFF005B485A485A5B12075B120F5B121F5B123F -90C7FCA25A127EA412FE5AAB7E127EA4127F7EA27F121F7F120F7F12077F12037F6C7E6C -7E7FEB7F80EB3FC0EB1FE0EB0FF0EB07F8EB03FEEB01FF7F147F141E184771BE30>I<12 -7812FE7E7F6C7EEA1FE06C7E6C7E6C7E6C7E6C7E7FEB3F80EB1FC0130F14E0130714F013 -0314F8130114FC1300A214FE147EA4147F143FAB147F147EA414FE14FCA2130114F81303 -14F0130714E0130F14C0131FEB3F80EB7F005B485A485A485A485A485AEA7FC0485A90C7 -FC5A1278184778BE30>I<14E0497EA70030EC0180007CEC07C000FFEC1FE00181133F01 -E113FF267FF9F313C0261FFDF713000007B512FC000114F06C5C013F1380D90FFEC7FC90 -383FFF8090B512E04880000714FC391FFDF7FF267FF9F313C026FFE1F013E00181133F01 -01131F007CEC07C00030EC0180000091C7FCA76D5A23277AAE30>I44 D<003FB612E04815F0B712F8A36C15F06C15E025 -077B9E30>I<120EEA3F80EA7FC0EAFFE0A5EA7FC0EA3F80EA0E000B0B6E8A30>I<120EEA -3F80EA7FC0EAFFE0A5EA7FC0EA3F80EA0E00C7FCB1120EEA3F80EA7FC0EAFFE0A5EA7FC0 -EA3F80EA0E000B276EA630>58 D<16E0ED01F0ED07F8150F153FEDFFF04A13E0020713C0 -4A1300EC3FFEEC7FF8903801FFE0495B010F90C7FC495AEB7FF8495A000313C0485BD81F -FEC8FC485AEA7FF0485A138013E06C7EEA3FFC6C7E3807FF806C7FC613F06D7EEB1FFE6D -7E010313C06D7F9038007FF8EC3FFEEC0FFF6E13C0020113E06E13F0ED3FF8150F1507ED -01F0ED00E0252F7BB230>60 D<003FB612FE4881B81280A36C16006C5DCBFCA7003FB612 -FE4881B81280A36C16006C5D29157DA530>I<1238127CB4FC7F13E0EA7FF86C7E6CB4FC -00077F6C13E0C67FEB3FFC6D7E903807FF806D7F010013F06E7EEC1FFE6E7E020313C06E -13E09138007FF0ED3FF8150F153FED7FF0913801FFE04A13C0020F13004A5AEC7FF84A5A -010313C0495BD91FFEC7FC495AEBFFF000035B481380001F90C8FCEA3FFC485AEAFFE013 -8090C9FC127C1238252F7BB230>I<007FB512F0B612FE6F7E82826C813A03F0001FF815 -076F7E1501150082167EA516FE5E15015E15074B5AED7FE090B65A5E4BC7FC6F7E16E082 -9039F0000FF8ED03FCED00FE167E167F82A2EE1F80A6163F17005EA2ED01FE1503ED0FFC -007FB65AB7FC16E05E93C7FC6C14FC29387EB730>66 D<007FB512E015FCB67E6F7E6C81 -823A03F0007FF0ED1FF815076F7E6F7E1500167FA2EE3F80A2161F17C0A2160FA317E016 -07AB160F17C0A3161F1780163FA2EE7F00A216FE15014B5A1507ED1FF8ED7FF0007FB65A -5EB75A93C7FC6C14FC15E02B387FB730>68 D<007FB612FEB8FCA47ED803F0C7123FA816 -1E93C7FCA4157815FCA490B5FCA6EBF000A4157892C8FCA5EE0780EE0FC0A9007FB7FCB8 -FCA46C16802A387DB730>I<007FB7128017C0B8FCA27EA2D801F8C7120FA8EE078093C7 -FCA5151E153FA490B6FCA69038F8003FA4151E92C8FCAE387FFFF080B5FCA27E5C2A387E -B730>I<007FB512FEB7FCA46C14FE390007E000B3B3A8007FB512FEB7FCA46C14FE2038 -78B730>73 D77 DI<90383FFF -E048B512FC000714FF4815804815C04815E09038F0007F01C0131F4848EB0FF090C71207 -A2007E1403A300FE15F8481401B3A96C1403A2007E15F0A3007F1407A26D130F6C6CEB1F -E001F813FF90B6FC6C15C06C15806C1500000114FCD8003F13E0253A7BB830>I<007FB5 -12E0B612FC15FF16C016E06C15F03903F0003FED0FF8ED03FC1501ED00FEA2167E167F16 -3FA6167F167E16FEA2ED01FC1503ED0FF8ED3FF090B6FC16E016C0160015FC15E001F0C8 -FCB0387FFF80B57EA46C5B28387DB730>I<007FB5FCB612E015F815FE816C812603F001 -7F6E6C7E151F6F7E15071503821501A515035E1507150F4B5A157F4A485A90B65A93C7FC -5D5D8181D9F0017FEC007FED1FC0150F821507A917F0EEE1F8A316F13A7FFF8003F3B500 -C0EBFFF0A26F13E0816C49EB7FC0C9EA1F002D397EB730>82 D<90390FF801C090397FFF -03E048B512C34814F74814FF5A381FF007383FE001903880007F48C7123F007E141F12FE -48140FA21507A46CEC03C0007E91C7FC127F6C7E13E0EA1FF86CB47E6C13F86CEBFF806C -14F0D8003F13FC01077F9038007FFF020713809138007FC0153FED0FE0ED07F01503A216 -F80078140112FCA56C140316F06C14077F6DEB0FE001F0EB3FC001FE13FF90B612801600 -00FD5CD8F87F13F8011F13E0D870011380253A7BB830>I<007FB712C0B812E0A53AFC00 -1F8007A80078ED03C0C791C7FCB3B1010FB5FC4980A46D91C7FC2B387EB730>I<3B7FFF -800FFFF0B56C4813F8A46C496C13F0D803F0C7EA7E00B3B16D14FE00015DA26D1301A26C -6C495AA2017F495A90393FC01FE0ECF07F6DB55A6D5C6D91C7FC6D5B010013F8EC1FC02D -397FB730>I<007FB5FCB61280A4150000FCC8FCB3B3B3A5B6FC1580A46C140019476DBE -30>91 D<007FB5FCB61280A47EC7121FB3B3B3A5007FB5FCB6FCA46C140019477DBE30> -93 D97 DI<49B47E010F13F0013F13FC497F48B6FC4815803907FE007F13F8485A485A49EB3F -004848130C90C9FC5A127EA212FE5AA87E127EA2127FED07806C6CEB0FC07F6C6C131F6C -6C148001FC133F6CB4EBFF006C90B5FC6C5C6C5C013F13F0010F13C0D901FEC7FC222A79 -A830>I<913803FFC0825CA280A2EC0007AAEB01FC90380FFF87013F13E790B512F74814 -FF5A3807FE03380FF80049137F4848133F4848131F49130F48C7FC1507127E12FEA25AA7 -7E150F127EA2007F141F7E6D133F6C6C137F6D13FF380FF8012607FE07EBFFC06CB7FC6C -02F713E06C14E76D01C713C0011F1303D903F8C8FC2B397DB730>II<157F913803FFE0020F13F0143F4A13F8A2EC -FF07EB01FE9138FC03F0903903F800C04A1300A8007FB612C0B712E0A46C15C0260003F0 -C7FCB3A9003FB6FCA2481580A26C1500A225397DB830>IIII107 -D<387FFFF0B57EA47EEA0001B3B3A8007FB612E0B712F0A46C15E024387AB730>I<9039 -01F001F03A7F8FFC0FFC3AFFDFFE1FFE90B5487E92B51280A23A7FFE1FFE1F3B07FC0FFC -0FC001F813F89039F007F00701E013E0A401C013C0B3A23B7FFC1FFC1FFC3BFFFE3FFE3F -FEA43B7FFC1FFC1FFC2F2880A730>IIII114 -D<90381FFC0E90B5129F000714FF5A5A5A387FE007EB800100FEC77E5A81A37E007F141E -01C090C7FCEA3FF8381FFFE06C13FF000314C0C614F0010F13FC9038007FFEEC03FFEC00 -7F0078EC3F8000FC141FED0FC0A27EA27E151F01C0EB3F806D137F9039F803FF0090B6FC -5D5D00F814F0013F13C0267007FEC7FC222A79A830>III<3B7FFF803FFFC0B56C4813E0A46C496C13C03B01F0 -0001F000A26D130300005DA2017C495AA36D495AA36D49C7FCA390380F803EA36D6C5AA2 -ECE0FC01035BA214F101015BA214FB01005BA214FF6E5AA3021FC8FC2B277EA630>I<3B -7FFF800FFFF06E5AB515F8A26C16F04A7ED807C0C7EA1F00A26D5C0003153EA56D147E00 -01157CEC0FC0EC1FE0EC3FF0A32600F87F5BEC7DF8147CA214FC01786D5AA290387CF87C -137D157D14F0013DEB3DE0013F133FA2ECE01FA2011F5C6D486C5A2D277FA630>I<263F -FFC0B5FC48168014E1A214C06C16003A007E001F806D49C7FCEB1F80157E6D6C5A6D6C5A -EB03F1903801F3F0ECFFE06D5B147F6E5A92C8FCA2814A7E4A7EEB01F3ECF1F0903803E0 -F849487E010F137C49487EEC003F496D7E017E6D7E4913073B7FFF803FFF806E4813C0B5 -FCA27E4A6C13802A277EA630>I<3B7FFF803FFFC06E4813E0B5FCA27E4A6C13C03B01F8 -0001F000120015036D5C137C4B5A7FA2013F495A7FA26E48C7FC130F14C00107133EA214 -E001035BA2EB01F05DA2EB00F85D1479147D5D143FA26E5AA36E5AA2141F92C8FCA25C14 -3EA2147E147C120F486C5AEA3FC113C3EB07F0495A13FF6C5B5C6C90C9FCEA07FCEA01F0 -2B3C7EA630>I<003FB612FC4815FEA416FC007EC7EA07F8ED0FF0ED1FE0ED3FC0ED7F80 -003CECFF00C7485AEC07FC4A5A4A5A4A5A4A5A4A5A4990C7FC495A495A495A495A495A49 -5A49C7121E4848143F485A485A485A485A485A48B7FCB8FCA46C15FE28277DA630>I<12 -38127C12FEB3B3B3AD127C123807476CBE30>124 D E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fb cmbx12 12 29 -/Fb 29 121 df46 D48 DIII< -161F5EA25E5E5DA25D5D5D5DA25D5D92B5FCEC01F715E7EC03C7EC0787140FEC1F07141E -143C147814F8EB01F014E0EB03C0EB0780130FEB1F00131E5B5B13F85B485A485A485A12 -0F90C7FC121E5A127C5AB91280A4C8000F90C7FCAC027FB61280A431417DC038>I<0003 -1503D807E0143F01FFEB07FF91B55A5E5E5E5E5E93C7FC5D15F815E04AC8FC01C0C9FCAA -EC3FF001C1B5FC01C714C09039DFC03FF09039FE000FF801F86D7E496D7E496D7E491580 -6C4815C0C8FC6F13E0A217F0A317F8A21206EA1FC0487E487E12FF7FA217F05BA24915E0 -6C485B5B003CC714C0003E4A1380001E16006C6C495A6C6C495AD803F0EB3FF8D801FEEB -FFF06CB65A013F1480010F01FCC7FC010113C02D427BC038>I67 D73 D80 -D82 -D<003FBA12E0A49026FE000FEB800301F0EE007FD87FC0EF1FF049170F90C71607007E18 -03007C1801A300781800A400F819F8481978A5C81700B3B3A40107B8FCA445437CC24E> -84 D<903801FFE0011F13FE017F6D7E9039FF007FE0D801F0EB1FF0D803FC6D7E486C6D -7E000F816D6D7EA283816C4881A26C5AEA00F090C7FCA4150F021FB5FC0103B6FC011F13 -8190387FF8013801FFC0481300485A485A485A485A127FA2485AA35DA36C6C1306150E6C -6C4913F06C6C9039387FFFC0390FFF81F000039038FFE01FC6EC8007D90FFEC9FC322F7D -AD36>97 D99 DII<4AB4FC021F13C0027F13F0903901FF83F8903903FE07 -FC90380FFC0F90391FF81FFEA2EB3FF0137F14E0ED0FFC01FFEB07F8ED03F0ED00C01600 -ABB612F8A4C601E0C7FCB3B2007FEBFFE0A427467DC522>II<1378EA01FE -487E481380A24813C0A46C1380A26C13006C5AEA007890C7FCABEB7FC0EA7FFFA412037E -B3B1B6FCA418467CC520>105 D -108 D<90277F8003FEEC07FCB590261FFFC090383FFF80037F01F090B512E0923CF81FF8 -01F03FF0913D81C00FFC03801FF80003903D830007FE06000FFC6C01865D028C6E488002 -986D49130702B803F08002B05D14F04A5DA34A5DB3A8B60081B60003B512FEA4572D7CAC -5E>I<90397F8007FEB590381FFF80037F13E0913981F03FF0913983C01FF80003903987 -000FFC6C138E028C800298130702B88014B014F05CA35CB3A8B60083B512FEA4372D7CAC -3E>II<90397FC01FF8B590 -B5FC02C314C09139CFE03FF09139DF000FF8000301FCEB07FE6C01F06D7E4A1580824A6D -13C018E0A2EF7FF0A218F8A2173FA218FCAA18F8A2177FA218F0A2EFFFE0A24C13C06E15 -804C13006E495A02FC495A02DE495A9139CFC07FF002C7B512C002C149C7FC9138C03FF0 -92C9FCAEB67EA436407DAC3E>I<90387F807FB53881FFC0028313F091388787F891388E -0FFC0003138C6C90389C1FFE149814B814B09138F00FFC14E0ED07F8ED01E092C7FCA25C -B3A7B612E0A4272D7DAC2E>114 D<90391FFC038090B51287000314FF3807F003380FC0 -0048C7123F48141F007E140FA2150712FEA27EA26D90C7FC13E013FE387FFFF014FF6C14 -C06C14F06C806C806C806C80D8003F1480010714C0EB003F1403020013E00070143F00F0 -141FA26C140FA36C15C0A27EED1F807E6DEB3F0001E0137E39FDFC03FC00F8B512F0D8F0 -3F5B26E007FEC7FC232F7CAD2C>III120 -D E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fc cmr10 10.95 40 -/Fc 40 122 df12 D<121E123FEA7F80EAFFC0A213E0A212 -7FEA3F60121E1200A513C0A3EA0180A2EA0300A21206A25A5A5A12200B1C79BE19>39 -D<121E123FEA7F80EAFFC0A213E0A2127FEA3F60121E1200A513C0A3EA0180A2EA0300A2 -1206A25A5A5A12200B1C798919>44 DI<121E123FEA7F80EAFF -C0A4EA7F80EA3F00121E0A0A798919>I<14C013031307131F137FEA07FFB5FC139FEAF8 -1F1200B3B3ACEB7FF0B612F8A31D3D78BC2D>49 DII68 DII73 -D78 D80 -D83 D<003FB91280A3903AE0007FE00090C76C48131F007EEF -0FC0007C17070078170300701701A300601700A5481860A5C81600B3B14B7E4B7E0107B6 -12FEA33B3D7DBC42>II97 DI< -49B4FC010F13E090383F00F8017C131C4913064848131F48485B0007EC7F80485A121F5B -003FEC3F00151E007F91C7FC90C9FCA35AA97EA27F123F16C0121F6DEB0180120F6C6CEB -0300A26C6C13066C6C5BD8007C133890383F01F090380FFFC0D901FEC7FC222A7DA828> -IIII<167C903903F801FF90391FFF0787903A7E0FCE0F809038F803F839 -01F001F03B03E000F8070000076EC7FCA24848137EA2001F147FA6000F147EA26C6C5BA2 -00035C6C6C485A6D485A39037E0FC0D91FFFC8FC380703F80006CAFCA2120EA2120F7E7F -7F6CB512F015FE6C6E7E6C15E00003813A07C0001FF848C7EA03FC001E140048157E007C -153E0078153F00F881A50078151E007C153E6C5D001E15786C5DD807C0EB03E0D803F0EB -0FC0D800FE017FC7FC90383FFFFC010313C0293D7EA82D>III107 -DI<2703F003FCEB01 -FE00FF903B0FFF8007FFC0913B3C0FC01E07E0913B7003E03801F00007903BC001F06000 -F82603F1806D487F2601F300EBF98001F6D900FBC7127C04FF147E01FC5CA3495CB3A648 -6C496C14FFB528F07FFFF83F13FCA346287CA74D>I<3903F003F800FFEB1FFF91383C0F -8091386007C00007496C7E2603F1807F3801F30001F613018213FCA35BB3A6486C497EB5 -00F0B512F0A32C287CA733>I<14FF010713E090381F81F890387E007E01F8131F4848EB -0F804848EB07C04848EB03E0000F15F04848EB01F8A2003F15FCA248C812FEA44815FFA9 -6C15FEA36C6CEB01FCA3001F15F86C6CEB03F0A26C6CEB07E06C6CEB0FC06C6CEB1F80D8 -007EEB7E0090383F81FC90380FFFF0010090C7FC282A7EA82D>I<3901F807F800FFEB3F -FF9138781FC09138C007E03A07F98001F02603FB007FD801FE6D7E49147E49147FEE3F80 -A2EE1FC0A217E0A2160F17F0A917E0161FA217C0A2EE3F80A26DEC7F00167E6D5C4B5A01 -FB495A9039F9C007E09039F8F01F80DA3FFEC7FCEC0FF091C9FCAD487EB512F0A32C3A7D -A733>I<3903F007E000FFEB1FF0EC7878ECE0FC3907F181FE12033801F3019038F600FC -A2153001FC1300A35BB3A5487EB512FCA31F287EA724>114 D<90387FC0603901FFF8E0 -3807C03D380E0007481303481301481300A212F01560A27EA27E007F140013C0EA3FFE38 -1FFFE06C13FC6C7F6C7FC61480010F13C09038007FE0EC0FF00040130300C0EB01F81400 -7E1578A37E15707E15E07E6CEB01C000F3EB038039E1E01F0038C0FFFCEB1FE01D2A7DA8 -24>I<1318A61338A41378A213F8A2120112031207001FB512C0B6FCA2D801F8C7FCB3A2 -1560A9000014C07F137CEC0180133E90381F8700EB07FEEB01F81B397EB723>IIII<3B7FFF -C00FFFE0A3000390390007FE00C648EB03F0017E6D5A6DEB03801480011F49C7FC90380F -C00E903807E00C6E5A903803F83801015B6D6C5AEC7EC0EC7F80143F141F6E7E81141FEC -3BF0EC71F8ECE1FC14C0903801807E01037FD907007F01066D7E49130F496D7E01386D7E -017880EA01F8D80FFCEB07FEB590381FFFF8A32D277FA630>II -E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fd cmbx12 24.88 14 -/Fd 14 117 df[33 70 111 270 65 39 D[73 142 121 269 87 73 D[137 -142 120 269 159 80 D<93387FFFF8033FB612E00203B712FE021FEEFFC0027F17F049 -B912FC4918FF49912680007F14C04901E0C7000F80496D020314F8496D0200806F6F7F49 -6D6F7F738090B68173807380A27380A288856D4984A26D5B747F6D5B6D5B6D5B010090CA -FC91CBFCAA0603B6FC050FB7FC0403B8FC167F0307B9FC153F4AB7C67E020F15C0023F02 -FCC7FC91B612C0010392C8FC010F14FC4914F04914C04991C9FC90B55A485C485C485C48 -5C5D5A485CA24891CAFCA3B6FC5CA397B5FCA461806C60F107EF6C6E150F6F16CF6CF03F -8F6F037F806C6EDBFF0F14C06C02FCDA03FE15FC6C6E91260FFC0791B5FC6C6E6CD93FF8 -17806C923AF003FFF003013F91B6487E010FEF8000010394C77E010004FC141F021F03E0 -1407020192C96C1400DA000701F093C9FC695F79DD71>97 D<94387FFFF8040FB612E093 -B712FE0307EEFFC0031F17F092B912FC4A84020784021F9126F0000714804A0280D9007F -13C04A49C8B512E049B500F85C494A4A14F0495C494A4A14F8495C93C8FC495B495B90B5 -FC5D5A484A6F14F0A2487214E05D487214C0741380487313004BEE07F897C8FC5AA4485C -A5B6FCB07EA281A37EA36C80A37E6F18FE6CF201FFA26C6E5F1CFE6C801B076C6E18FC6D -6D170FF31FF86D6EEE3FF06D6E167F6D6EEEFFE06D02F84B13C06D6E4B13806D02FF150F -6D03C0023F1300023F02F0ECFFFC6E02FF010F5B020792B65A6E18C0020060033F4CC7FC -030716F0030016C0040F02FCC8FCDC007F1380585F78DD67>99 D<94387FFFC0040FB6FC -93B712E0030716FC031F16FF037F17C04AB912F00207DAF80380021F912680003F13FE4A -49C7000F7F4A01F802038049B5486E804902C06E6C7F494A6F7F4991C9FC49727F494970 -7F4B84498490B548707F5A4B198048855D481CC086481CE05D5A871DF05AA25D5AA21DF8 -87A2B6FCA392BBFCA51DF00380CDFCA77EA4817EA37EA2817EA26CF307F06FF00FF87E81 -6C1B1F6F19F06C1B3F6D6DF07FE06D7FF4FFC06D6E4C13806D6E5E6D02F04C13006D6EEE -1FFE6D6E4C5A6D6C01FFEEFFF86E02E002035B6E02FC021F5B02079126FFC003B55A6E92 -B7C7FC020060033F17F8030F17E003011780DB003F03FCC8FC040315C0DC000F01F8C9FC -5D5F7ADD6A>101 D[80 -144 121 271 71 II109 DI<94381FFFF00407B612C0047F15FC0303B87E030F17E0037F17FC4ABAFC4A -9126FC007F80020F02C0010714E04A49C880027F01F8033F13FC91B5486F7F4902C00307 -7F494A6F804991C96C80494970804949717F49874949717FA290B548717F48884B83481D -80A2481DC04B83481DE0A2481DF0A3484A7114F8A4481DFCA5B61BFEAF6C1DFCA56C6E4D -14F8A36C1DF0A36C1DE06F5F6C1DC0A26C6E4D1480A26C1D006F5F6C646D6D4D5B6F94B5 -FC6D636D6D4C5C6D6E4B5C6D6E4B5C6D02F0031F5C6D6E4B91C7FC6D6C01FE92B512FC6E -D9FFC001075C6E02FC017F5C020791B812C0020196C8FC6E6C17FC031F17F003031780DB -007F03FCC9FC040715C0DC001F01F0CAFC675F7ADD74>I -114 D<92260FFFF814F80203B638C001FC021FEDF80791B7EAFE0F0107EEFFBF4917FF01 -3F9038F0000F4990C8FCD9FFF8153F4849150F4801C015034849814890CAFC197F484817 -3FA24848171FA2007F180FA312FF19077FA27F80806E705A02F893C8FC14FEECFFC06C14 -FCEDFFE0EEFF806C16FCEFFFC06C17F86C17FF19C06C18F06C846C18FE6C846D846D846D -840107840101846D6C83141F020383DA003F821503DB000F1680EE003F050115C0717E18 -1F1807007F050114E0486C8285856D83A2857F85A27F1BC07FA27F1B806D5FA26D19006E -5E6E5F6E4C5A6E167F02FC4C5A6E03035B6E6C4A5B03E0023F5B03FE0103B55A01F990B8 -C7FCD9F07F16FCD9E01F5ED9800716C0D900014BC8FC48D9003F14F0007C020149C9FC4B -5F78DD5C>I[72 -132 124 258 90 I E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fe cmbx12 20.74 8 -/Fe 8 117 df49 -D<96267FFFE01670063FB616F80503B700E01401053F04FC14034CB91407040706C0130F -043F06F0131F93B626FE000F01FC133F030303809026007FFE137F030F02FCC8390FFF80 -FF4B02E0030313C1037F91CA13E392B500FCEF3FF7020302F071B5FC4A4A17074A028083 -4A91CB7E4A01FC844A498591B54885494A854988494A85495C93CD7E4988495B49885D90 -B51C7F5D481E3F485CA21F1F485CA2481E0F5D5AA21F075D5AA2F703F09CC7FC5AA392D1 -FCA2B6FCB27EA281A37EA3F701F06CF603F881A37E816C1E0720F06C80A36C6E1B0F6C1F -E06F1B1F7F6F1CC06D1D3F6D6DF37F807F70F2FF006D6E626D6E19016D525A6D6E4F5A6E -6D190F6E01FE4F5A6E6D4F5A6E6E4E5A6E02E04D485A6E6E4D90C7FC020002FCEF0FFE6F -01FFEF3FFC031F02E0EEFFF06F02FC03075B0303DAFFC0023F1380030003FE0107B5C8FC -043F91B712FC040718F0040118C0DC003F94C9FC050316F8DD003F1580DE007F01F0CAFC -757A75F78C>67 D<92383FFFF8020FB612E0027F15FC0103B87E010F17E04983499026E0 -007F13FCD97FFCC7000F7F496C02037F486D6E806F6D6C7F86486E6E7F727F8684868486 -6C5CA26C91C86C806D5A6D5A6D5AEB03C090CAFCA80507B6FC041FB7FC0303B8FC157F02 -03B9FC021FECFE0391B612800103ECF800010F14C04991C7FC017F13FC90B512F04814C0 -485C4891C8FC485B485BA2485BA2485BA2B5FC5CA360A360806C5FA26C6D153E6E5D6C05 -FC806C01FFDA03F8806C6ED90FF014FC6C02E090263FE07FEBFFFC6C9128FC03FFC03F14 -FE6C91B61280013F4B487E010F4B1307010303F01301D9003F0280D9001F13FC020101F8 -CBFC57507ACE5E>97 D101 D<903801FFFCB6FCA7C67E -131F7FB3AE95380FFFE095B512FE05036E7E050F15E0053F15F84D819426FFF01F7F4CD9 -00077FDC07FC010180EE0FF0DC1FC06D804D82043EC87E5E04FC835EDBFDF0815E03FF84 -5EA25EA393C9FCA45DB3B3A7B8D8E003B81280A7617879F76C>104 -D<902601FFFCEC7FFEB60207B512F0053F14FE4CB712C0040716F0041F824C16FE4CD900 -7F7FC66C9026FDFFF0010F14C0011F90B500800103806D4AC76C804C6E6C7F04F06F7F4C -6F7F5E4C6F7F93C96C14805D7414C01DE0861DF0A2861DF8A2871DFCA57513FEAF5113FC -A41DF8A298B5FC1DF0A2621DE0A25014C01D80626F1900505B705D705F704B5B704B5B70 -92B55A04FE02035C706C010F91C7FC4B01E0013F5B93267FFC01B55A041FB712F07016C0 -040393C8FC040015F8051F14C0050301F0C9FC94CCFCB3A7B812E0A75F6F7ACD6C>112 -D<902601FFF8EB07FEB691383FFFC094B512F04C800407804C8093391FFC3FFF93263FE0 -7F1380C66C0380B512C0011F4A5A6DDAFC0114E0A2EDF9F816F015FB16E015FF4C6C14C0 -A24C6D1380721300725A93C76C5AF001E095C8FCA25DA55DB3B3A4B812F8A7434E7ACD4F ->114 D<157FA75DA45CA45CA25CA25CA25CA25C5C91B5FC5B5B5B5B133F90B6FC000792 -B6FCBAFCA6D8000791C9FCB3B3A4F00FE0AE181F6D6E14C0A2183F6D178070137F6D1700 -705B6E6D485A6E9038FE07FC6E90B55A6E5D6E5D02015D6E6C5C031F49C7FC030013F03B -6E7CEC4B>116 D E -%EndDVIPSBitmapFont -end -%%EndProlog -%%BeginSetup -%%Feature: *Resolution 600dpi -TeXDict begin -%%PaperSize: A4 - -%%EndSetup -%%Page: 1 1 -1 0 bop 382 1171 a Fe(Chapter)65 b(1)382 1586 y Fd(Programmer's)74 -b(In)-6 b(terface)382 2031 y Fc(Imp)s(orting)33 b(the)i(mo)s(dule)e('T) --8 b(ransducerIn)m(terface.hs')35 b(giv)m(es)i(y)m(ou)e(access)h(to)g -(the)f(fol-)382 2144 y(lo)m(wing)c(functions.)382 2385 -y Fb(1.0.1)112 b(Regular)37 b(expressions)382 2557 y -Fc(F)-8 b(unctions)31 b(for)f(constructing)h(a)g(simpli\014ed)d -(regular)j(expression.)382 2757 y Fa(s)477 b(::)47 b(a)h(->)f(Reg)g(a) -668 b(--)47 b(symbol)382 2870 y(eps)381 b(::)47 b(Reg)g(a)907 -b(--)47 b(epsilon)382 2983 y(empty)285 b(::)47 b(Reg)g(a)907 -b(--)47 b(empty)f(set)382 3096 y(allS)333 b(::)47 b(Reg)g(a)907 -b(--)47 b(all)g(symbol)382 3209 y(star)333 b(::)47 b(Reg)g(a)g(->)h -(Reg)f(a)477 b(--)47 b(kleene's)e(star)382 3322 y(plus)333 -b(::)47 b(Reg)g(a)g(->)h(Reg)f(a)477 b(--)47 b(kleene's)e(plus)382 -3435 y(complement)g(::)i(Reg)g(a)g(->)h(Reg)f(a)477 b(--)47 -b(complement)382 3548 y(\(<|>\))285 b(::)47 b(Reg)g(a)g(->)h(Reg)f(a)g -(->)g(Reg)g(a)h(--)f(union)382 3660 y(\(|>\))333 b(::)47 -b(Reg)g(a)g(->)h(Reg)f(a)g(->)g(Reg)g(a)h(--)f(product)382 -3773 y(\(<&>\))285 b(::)47 b(Reg)g(a)g(->)h(Reg)f(a)g(->)g(Reg)g(a)h -(--)f(intersection)382 3886 y(\(<->\))285 b(::)47 b(Reg)g(a)g(->)h(Reg) -f(a)g(->)g(Reg)g(a)h(--)f(set)g(minus)382 3999 y(symbols)189 -b(::)47 b(Reg)g(a)g(->)h(a)668 b(--)47 b(collect)f(all)g(symbols.)382 -4241 y Fb(1.0.2)112 b(Regular)37 b(relations)382 4412 -y Fc(F)-8 b(unctions)31 b(for)f(constructing)h(a)g(simpli\014ed)d -(regular)j(relation.)382 4613 y Fa(r)477 b(::)47 b(a)h(->)f(a)g(->)g -(Reg)g(a)573 b(--)47 b(relation)382 4726 y(empty)285 -b(::)47 b(RReg)g(a)1002 b(--)47 b(empty)f(set)382 4839 -y(idR)381 b(::)47 b(Reg)g(a)95 b(->)47 b(RReg)g(a)525 -b(--)47 b(identity)382 4951 y(star)333 b(::)47 b(RReg)g(a)g(->)g(RReg)g -(a)525 b(--)47 b(kleene's)e(star)382 5064 y(plus)333 -b(::)47 b(RReg)g(a)g(->)g(RReg)g(a)525 b(--)47 b(kleene's)e(plus)382 -5177 y(\(<|>\))285 b(::)47 b(RReg)g(a)g(->)g(RReg)g(a)g(->)h(RReg)e(a)i -(--)f(union)382 5290 y(\(|>\))333 b(::)47 b(RReg)g(a)g(->)g(RReg)g(a)g -(->)h(RReg)e(a)i(--)f(product)382 5403 y(\(<*>\))285 -b(::)47 b(Reg)g(a)95 b(->)47 b(Reg)g(a)95 b(->)48 b(RReg)e(a)i(--)f -(cross)f(product)1854 5652 y Fc(1)p eop -%%Page: 2 2 -2 1 bop 382 548 a Fa(\(<.>\))285 b(::)47 b(RReg)g(a)g(->)g(RReg)g(a)g -(->)h(RReg)e(a)i(--)f(composition)382 661 y(symbols)189 -b(::)47 b(RReg)g(a)g(->)g(a)764 b(--)47 b(collect)f(all)h(symbols.)382 -904 y Fb(1.0.3)112 b(P)m(arsing)37 b(regular)g(relations)382 -1076 y Fc(F)-8 b(unctions)31 b(for)f(parsing)g(regular)g(relations.)523 -1189 y('parseProgram')36 b(tak)m(es)i(a)f(string)g(con)m(taining)h(a)f -(fstStudio)f(program,)h(and)f(try)382 1302 y(to)c(parse)e(it)i(-)f(if)g -(unsuccessful,)f(it)h(returns)f(a)h(error)g(message.)42 -b('parseExp')31 b(parses)f(a)382 1415 y(string)g(con)m(taining)i(a)f -(regular)f(relation.)382 1740 y Fa(parseProgram)44 b(::)k(String)e(->)h -(Either)f(String)g(\(RReg)g(String\))382 1853 y(parseExp)236 -b(::)48 b(String)e(->)h(Either)f(String)g(\(RReg)g(String\))382 -2096 y Fb(1.0.4)112 b(Construction)37 b(and)h(running)382 -2268 y Fc(F)-8 b(unctions)31 b(for)f(constructing)h(and)f(running)e(a)j -(\014nite)f(state)i(transducer.)523 2381 y(The)40 b(function)h -('compile')g(construct)g(a)g(deterministic,)j(epsilonfree,)f(minimal) -382 2494 y(transducer,)22 b(and)d('compileN')i(construct)g(a)f -(epsilonfree,)j(p)s(ossibly)d(non-deterministic,)382 -2607 y(non-minimal)31 b(transducer.)48 b(The)33 b('Sigma')g(t)m(yp)s(e) -h(pro)m(vides)f(a)g(w)m(a)m(y)h(to)g(add)f(sym)m(b)s(ols)382 -2720 y(that)h(is)f(not)g(presen)m(t)g(in)g(the)g(regular)h(relation.)50 -b('applyDo)m(wn')34 b(and)e('applyUp')h(are)382 2833 -y(used)c(to)j(run)d(the)h(transducer.)382 3045 y Fa(type)47 -b(Sigma)f(a)h(=)h([a])382 3271 y(compile)428 b(::)47 -b(Ord)g(a)g(=>)g(RReg)g(a)g(->)h(Sigma)e(a)h(->)h(Transducer)d(a)382 -3384 y(compileN)380 b(::)47 b(Ord)g(a)g(=>)g(RReg)g(a)g(->)h(Sigma)e(a) -h(->)h(Transducer)d(a)382 3497 y(determinize)236 b(::)47 -b(Ord)g(a)g(=>)g(Transducer)e(a)j(->)f(Transducer)e(a)382 -3610 y(minimize)380 b(::)47 b(Ord)g(a)g(=>)g(Transducer)e(a)j(->)f -(Transducer)e(a)382 3723 y(unionT)476 b(::)47 b(Ord)g(a)g(=>)g -(Transducer)e(a)j(->)f(Transducer)e(a)i(->)h(Transducer)d(a)382 -3836 y(productT)380 b(::)47 b(Ord)g(a)g(=>)g(Transducer)e(a)j(->)f -(Transducer)e(a)i(->)h(Transducer)d(a)382 3948 y(starT)524 -b(::)47 b(Ord)g(a)g(=>)g(Transducer)e(a)j(->)f(Transducer)e(a)382 -4061 y(compositionT)188 b(::)47 b(Ord)g(a)g(=>)g(Transducer)e(a)j(->)f -(Transducer)e(a)i(->)h(Transducer)d(a)382 4174 y(emptyTransducer)f(::)j -(Transducer)e(a)382 4287 y(applyDown)332 b(::)47 b(Ord)g(a)g(=>)g -(Transducer)e(a)j(->)f([a])g(->)g(Maybe)f([[a]])382 4400 -y(applyUp)428 b(::)47 b(Ord)g(a)g(=>)g(Transducer)e(a)j(->)f([a])g(->)g -(Maybe)f([[a]])382 4513 y(load)572 b(::)47 b(FilePath)e(->)i(IO)h -(\(Either)d(String)i(\(Transducer)d(String\)\))382 4626 -y(save)572 b(::)47 b(FilePath)e(->)i(Transducer)e(String)i(->)g(IO)g -(\(Either)f(String)g(\(\)\))382 4869 y Fb(1.0.5)112 b(T)-9 -b(ransducer)38 b(Information)382 5041 y Fc(F)-8 b(unctions)31 -b(for)f(getting)i(information)e(ab)s(out)g(a)h(built)f(transducer.)382 -5253 y Fa(type)47 b(State)f(=)h(Int)1854 5652 y Fc(2)p -eop -%%Page: 3 3 -3 2 bop 382 548 a Fa(states)666 b(::)48 b(Transducer)d(a)i(->)g -([State])382 661 y(isFinal)618 b(::)48 b(Transducer)d(a)i(->)g(State)g -(->)g(Bool)382 774 y(initial)618 b(::)48 b(Transducer)d(a)i(->)g(State) -382 887 y(finals)666 b(::)48 b(Transducer)d(a)i(->)g([State])382 -1000 y(transitionsU)378 b(::)48 b(Transducer)d(a)i(->)g(\(State,a\))f -(->)h([\(a,State\)])382 1112 y(transitionsD)378 b(::)48 -b(Transducer)d(a)i(->)g(\(State,a\))f(->)h([\(a,State\)])382 -1225 y(showTransducer)282 b(::)48 b(Transducer)d(a)i(->)g(String)382 -1338 y(numberOfStates)282 b(::)48 b(Transducer)d(a)i(->)g(Int)382 -1451 y(numberOfTransitions)42 b(::)48 b(Transducer)d(a)i(->)g(Int)1854 -5652 y Fc(3)p eop -%%Trailer -end -userdict /end-hook known{end-hook}if -%%EOF diff --git a/doc/fstMan0.9.ps b/doc/fstMan0.9.ps deleted file mode 100644 --- a/doc/fstMan0.9.ps +++ /dev/null @@ -1,1299 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dvips(k) 5.86 Copyright 1999 Radical Eye Software -%%Pages: 8 -%%PageOrder: Ascend -%%BoundingBox: 0 0 596 842 -%%EndComments -%DVIPSWebPage: (www.radicaleye.com) -%DVIPSCommandLine: dvips -f -%DVIPSParameters: dpi=600, compressed -%DVIPSSource: TeX output 2001.08.28:0920 -%%BeginProcSet: texc.pro -%! -/TeXDict 300 dict def TeXDict begin/N{def}def/B{bind def}N/S{exch}N/X{S -N}B/A{dup}B/TR{translate}N/isls false N/vsize 11 72 mul N/hsize 8.5 72 -mul N/landplus90{false}def/@rigin{isls{[0 landplus90{1 -1}{-1 1}ifelse 0 -0 0]concat}if 72 Resolution div 72 VResolution div neg scale isls{ -landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div hsize -mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul TR[ -matrix currentmatrix{A A round sub abs 0.00001 lt{round}if}forall round -exch round exch]setmatrix}N/@landscape{/isls true N}B/@manualfeed{ -statusdict/manualfeed true put}B/@copies{/#copies X}B/FMat[1 0 0 -1 0 0] -N/FBB[0 0 0 0]N/nn 0 N/IEn 0 N/ctr 0 N/df-tail{/nn 8 dict N nn begin -/FontType 3 N/FontMatrix fntrx N/FontBBox FBB N string/base X array -/BitMaps X/BuildChar{CharBuilder}N/Encoding IEn N end A{/foo setfont}2 -array copy cvx N load 0 nn put/ctr 0 N[}B/sf 0 N/df{/sf 1 N/fntrx FMat N -df-tail}B/dfs{div/sf X/fntrx[sf 0 0 sf neg 0 0]N df-tail}B/E{pop nn A -definefont setfont}B/Cw{Cd A length 5 sub get}B/Ch{Cd A length 4 sub get -}B/Cx{128 Cd A length 3 sub get sub}B/Cy{Cd A length 2 sub get 127 sub} -B/Cdx{Cd A length 1 sub get}B/Ci{Cd A type/stringtype ne{ctr get/ctr ctr -1 add N}if}B/id 0 N/rw 0 N/rc 0 N/gp 0 N/cp 0 N/G 0 N/CharBuilder{save 3 -1 roll S A/base get 2 index get S/BitMaps get S get/Cd X pop/ctr 0 N Cdx -0 Cx Cy Ch sub Cx Cw add Cy setcachedevice Cw Ch true[1 0 0 -1 -.1 Cx -sub Cy .1 sub]/id Ci N/rw Cw 7 add 8 idiv string N/rc 0 N/gp 0 N/cp 0 N{ -rc 0 ne{rc 1 sub/rc X rw}{G}ifelse}imagemask restore}B/G{{id gp get/gp -gp 1 add N A 18 mod S 18 idiv pl S get exec}loop}B/adv{cp add/cp X}B -/chg{rw cp id gp 4 index getinterval putinterval A gp add/gp X adv}B/nd{ -/cp 0 N rw exit}B/lsh{rw cp 2 copy get A 0 eq{pop 1}{A 255 eq{pop 254}{ -A A add 255 and S 1 and or}ifelse}ifelse put 1 adv}B/rsh{rw cp 2 copy -get A 0 eq{pop 128}{A 255 eq{pop 127}{A 2 idiv S 128 and or}ifelse} -ifelse put 1 adv}B/clr{rw cp 2 index string putinterval adv}B/set{rw cp -fillstr 0 4 index getinterval putinterval adv}B/fillstr 18 string 0 1 17 -{2 copy 255 put pop}for N/pl[{adv 1 chg}{adv 1 chg nd}{1 add chg}{1 add -chg nd}{adv lsh}{adv lsh nd}{adv rsh}{adv rsh nd}{1 add adv}{/rc X nd}{ -1 add set}{1 add clr}{adv 2 chg}{adv 2 chg nd}{pop nd}]A{bind pop} -forall N/D{/cc X A type/stringtype ne{]}if nn/base get cc ctr put nn -/BitMaps get S ctr S sf 1 ne{A A length 1 sub A 2 index S get sf div put -}if put/ctr ctr 1 add N}B/I{cc 1 add D}B/bop{userdict/bop-hook known{ -bop-hook}if/SI save N @rigin 0 0 moveto/V matrix currentmatrix A 1 get A -mul exch 0 get A mul add .99 lt{/QV}{/RV}ifelse load def pop pop}N/eop{ -SI restore userdict/eop-hook known{eop-hook}if showpage}N/@start{ -userdict/start-hook known{start-hook}if pop/VResolution X/Resolution X -1000 div/DVImag X/IEn 256 array N 2 string 0 1 255{IEn S A 360 add 36 4 -index cvrs cvn put}for pop 65781.76 div/vsize X 65781.76 div/hsize X}N -/p{show}N/RMat[1 0 0 -1 0 0]N/BDot 260 string N/Rx 0 N/Ry 0 N/V{}B/RV/v{ -/Ry X/Rx X V}B statusdict begin/product where{pop false[(Display)(NeXT) -(LaserWriter 16/600)]{A length product length le{A length product exch 0 -exch getinterval eq{pop true exit}if}{pop}ifelse}forall}{false}ifelse -end{{gsave TR -.1 .1 TR 1 1 scale Rx Ry false RMat{BDot}imagemask -grestore}}{{gsave TR -.1 .1 TR Rx Ry scale 1 1 false RMat{BDot} -imagemask grestore}}ifelse B/QV{gsave newpath transform round exch round -exch itransform moveto Rx 0 rlineto 0 Ry neg rlineto Rx neg 0 rlineto -fill grestore}B/a{moveto}B/delta 0 N/tail{A/delta X 0 rmoveto}B/M{S p -delta add tail}B/b{S p tail}B/c{-4 M}B/d{-3 M}B/e{-2 M}B/f{-1 M}B/g{0 M} -B/h{1 M}B/i{2 M}B/j{3 M}B/k{4 M}B/w{0 rmoveto}B/l{p -4 w}B/m{p -3 w}B/n{ -p -2 w}B/o{p -1 w}B/q{p 1 w}B/r{p 2 w}B/s{p 3 w}B/t{p 4 w}B/x{0 S -rmoveto}B/y{3 2 roll p a}B/bos{/SS save N}B/eos{SS restore}B end - -%%EndProcSet -TeXDict begin 39158280 55380996 1000 600 600 () @start -%DVIPSBitmapFont: Fa cmtt10 10.95 71 -/Fa 71 125 df<121C127FA2EAFF80B2EA7F00B1123EC7FCA9121C127FA2EAFF80A3EA7F -00A2121C09396DB830>33 D<003C131E00FEEB3F80A26C137FA248133FB3007E1400007C -7F003C131E191B75B830>I<147814FCA5EB03FF011F13E090B512FC4880000780481580 -261FFCFC13C001F0EB3FE0D83FC0130FD87F80EB07F001001303007E15F812FE5A1507A3 -ED03F07E007E91C7FC127FEA3F8013E0EA1FF8EA0FFF7E6CEBFF80C614F0013F7F010F13 -FE01007F168002FC13C0153FED0FE0ED07F0A21503007E15F81501B4FCA35A1503A2007E -15F0007F1407ED0FE0D83FC0131FD81FE0EB7FC09039FCFDFF806CB612006C5C6C5CC614 -F0013F13C0D903FEC7FCEB00FCA6147825477BBE30>36 D39 D<141E147F14FF5BEB03FEEB07F8EB0FF0EB1FE0EB3F -C0EB7F80EBFF005B485A485A5B12075B120F5B121F5B123F90C7FCA25A127EA412FE5AAB -7E127EA4127F7EA27F121F7F120F7F12077F12037F6C7E6C7E7FEB7F80EB3FC0EB1FE0EB -0FF0EB07F8EB03FEEB01FF7F147F141E184771BE30>I<127812FE7E7F6C7EEA1FE06C7E -6C7E6C7E6C7E6C7E7FEB3F80EB1FC0130F14E0130714F0130314F8130114FC1300A214FE -147EA4147F143FAB147F147EA414FE14FCA2130114F8130314F0130714E0130F14C0131F -EB3F80EB7F005B485A485A485A485A485AEA7FC0485A90C7FC5A1278184778BE30>I<14 -E0497EA70030EC0180007CEC07C000FFEC1FE00181133F01E113FF267FF9F313C0261FFD -F713000007B512FC000114F06C5C013F1380D90FFEC7FC90383FFF8090B512E048800007 -14FC391FFDF7FF267FF9F313C026FFE1F013E00181133F0101131F007CEC07C00030EC01 -80000091C7FCA76D5A23277AAE30>I44 D<120EEA3F80EA7FC0EAFFE0A5EA7FC0EA3F80EA0E000B0B6E8A30>46 -D<16E0ED01F0ED03F8A2150716F0150F16E0151F16C0153F1680A2157F16005D5D14015D -14035D14075D140F5D141F5DA2143F5D147F92C7FC5C5C13015C13035C13075C130F5C13 -1F5CA2133F5C137F91C8FC5B5B12015B12035B12075B120F5BA2121F5B123F5B127F90C9 -FC5A5AA2127C123825477BBE30>IIIIII<000FB612804815C0A416 -800180C8FCAEEB81FF018F13E001BF13F890B57E8181D9FE0113809039F0007FC049131F -49EB0FE04913076CC713F0C81203A216F81501A4123C127EB4FC150316F015074815E000 -7E140F007FEC1FC06D137FD83FE0EBFF80261FF80713006CB55A6C5C6C5C6C14E0D8003F -1380D907F8C7FC25397BB730>II<1278B712FC16FEA416FC00FCC7EA03F8ED07F0ED -0FE00078EC1FC0C8EA3F80ED7F00157E15FE4A5A5D4A5A14075D140F5D4A5AA24AC7FCA2 -147EA214FE5C13015CA213035CA213075CA3130F5CA5131F5CA96DC8FCA2273A7CB830> -I<49B4FC011F13F0017F13FC90B57E0003ECFF804815C04848C613E0D81FF8EB3FF001E0 -130F4848EB07F849130348C7EA01FC007E1400A5007F14016C15F86D13036C6CEB07F06C -6CEB0FE0D807F8EB3FC03A03FF01FF806C90B512006C6C13FC011F13F0497F90B512FE48 -802607FE0013C0D80FF0EB1FE04848EB0FF0D83F80EB03F890C712014815FC007E140000 -FE15FE48157EA66C15FE007E15FC007F14016C6CEB03F86D13076C6CEB0FF001F8133FD8 -0FFEEBFFE06CB612C06C1580C6ECFE006D5B011F13F0010190C7FC273A7CB830>II<120EEA3F80EA7FC0 -EAFFE0A5EA7FC0EA3F80EA0E00C7FCB1120EEA3F80EA7FC0EAFFE0A5EA7FC0EA3F80EA0E -000B276EA630>II<16E0ED01F0ED07F8150F153FEDFFF04A13E0020713 -C04A1300EC3FFEEC7FF8903801FFE0495B010F90C7FC495AEB7FF8495A000313C0485BD8 -1FFEC8FC485AEA7FF0485A138013E06C7EEA3FFC6C7E3807FF806C7FC613F06D7EEB1FFE -6D7E010313C06D7F9038007FF8EC3FFEEC0FFF6E13C0020113E06E13F0ED3FF8150F1507 -ED01F0ED00E0252F7BB230>I<003FB612FE4881B81280A36C16006C5DCBFCA7003FB612 -FE4881B81280A36C16006C5D29157DA530>I<1238127CB4FC7F13E0EA7FF86C7E6CB4FC -00077F6C13E0C67FEB3FFC6D7E903807FF806D7F010013F06E7EEC1FFE6E7E020313C06E -13E09138007FF0ED3FF8150F153FED7FF0913801FFE04A13C0020F13004A5AEC7FF84A5A -010313C0495BD91FFEC7FC495AEBFFF000035B481380001F90C8FCEA3FFC485AEAFFE013 -8090C9FC127C1238252F7BB230>IIII<007FB512F0B612FE6F7E82826C813A03F0001FF815076F7E150115 -0082167EA516FE5E15015E15074B5AED7FE090B65A5E4BC7FC6F7E16E0829039F0000FF8 -ED03FCED00FE167E167F82A2EE1F80A6163F17005EA2ED01FE1503ED0FFC007FB65AB7FC -16E05E93C7FC6C14FC29387EB730>I<007FB512E015FCB67E6F7E6C81823A03F0007FF0 -ED1FF815076F7E6F7E1500167FA2EE3F80A2161F17C0A2160FA317E01607AB160F17C0A3 -161F1780163FA2EE7F00A216FE15014B5A1507ED1FF8ED7FF0007FB65A5EB75A93C7FC6C -14FC15E02B387FB730>68 D<007FB7128017C0B8FCA27EA2D801F8C7120FA8EE078093C7 -FCA5151E153FA490B6FCA69038F8003FA4151E92C8FCAE387FFFF080B5FCA27E5C2A387E -B730>70 D<3B7FFF803FFFC0B56C4813E0A46C496C13C03B03F00001F800B290B6FCA690 -38F00001B3A23B7FFF803FFFC0B56C4813E0A46C496C13C02B387EB730>72 -D<007FB512FEB7FCA46C14FE390007E000B3B3A8007FB512FEB7FCA46C14FE203878B730 ->I75 -D<387FFFF8B5FC80A25C7ED801F8C9FCB3B0160FEE1F80A9007FB7FCB8FCA46C16002938 -7DB730>III<90383FFFE048 -B512FC000714FF4815804815C04815E09038F0007F01C0131F4848EB0FF090C71207A200 -7E1403A300FE15F8481401B3A96C1403A2007E15F0A3007F1407A26D130F6C6CEB1FE001 -F813FF90B6FC6C15C06C15806C1500000114FCD8003F13E0253A7BB830>I<007FB512E0 -B612FC15FF16C016E06C15F03903F0003FED0FF8ED03FC1501ED00FEA2167E167F163FA6 -167F167E16FEA2ED01FC1503ED0FF8ED3FF090B6FC16E016C0160015FC15E001F0C8FCB0 -387FFF80B57EA46C5B28387DB730>I<90390FF801C090397FFF03E048B512C34814F748 -14FF5A381FF007383FE001903880007F48C7123F007E141F12FE48140FA21507A46CEC03 -C0007E91C7FC127F6C7E13E0EA1FF86CB47E6C13F86CEBFF806C14F0D8003F13FC01077F -9038007FFF020713809138007FC0153FED0FE0ED07F01503A216F80078140112FCA56C14 -0316F06C14077F6DEB0FE001F0EB3FC001FE13FF90B61280160000FD5CD8F87F13F8011F -13E0D870011380253A7BB830>83 D<007FB712C0B812E0A53AFC001F8007A80078ED03C0 -C791C7FCB3B1010FB5FC4980A46D91C7FC2B387EB730>I86 -DI<007FB5FCB61280A4150000FCC8FCB3B3B3A5B6FC1580A46C -140019476DBE30>91 D<007FB5FCB61280A47EC7121FB3B3B3A5007FB5FCB6FCA46C1400 -19477DBE30>93 D<1307EB1FC0497EEBFFF8000313FE000FEBFF80D81FFD13C0D87FF813 -F039FFE03FF8EB800FEB0007007CEB01F00070EB00701D0D77B730>I97 DI<49B47E010F13F0 -013F13FC497F48B6FC4815803907FE007F13F8485A485A49EB3F004848130C90C9FC5A12 -7EA212FE5AA87E127EA2127FED07806C6CEB0FC07F6C6C131F6C6C148001FC133F6CB4EB -FF006C90B5FC6C5C6C5C013F13F0010F13C0D901FEC7FC222A79A830>I<913803FFC082 -5CA280A2EC0007AAEB01FC90380FFF87013F13E790B512F74814FF5A3807FE03380FF800 -49137F4848133F4848131F49130F48C7FC1507127E12FEA25AA77E150F127EA2007F141F -7E6D133F6C6C137F6D13FF380FF8012607FE07EBFFC06CB7FC6C02F713E06C14E76D01C7 -13C0011F1303D903F8C8FC2B397DB730>II<157F913803FFE0020F13F0143F4A13F8A2ECFF07EB01FE9138FC03F0 -903903F800C04A1300A8007FB612C0B712E0A46C15C0260003F0C7FCB3A9003FB6FCA248 -1580A26C1500A225397DB830>II -II107 D<387FFFF0B57EA47EEA0001 -B3B3A8007FB612E0B712F0A46C15E024387AB730>I<903901F001F03A7F8FFC0FFC3AFF -DFFE1FFE90B5487E92B51280A23A7FFE1FFE1F3B07FC0FFC0FC001F813F89039F007F007 -01E013E0A401C013C0B3A23B7FFC1FFC1FFC3BFFFE3FFE3FFEA43B7FFC1FFC1FFC2F2880 -A730>IIII<903901FC01E090390FFF83F0013F13E390B512 -F34814FB4814FF481301380FF80049133F4848131F4848130F5B48C71207A2127E150312 -FE5AA77E1507127E127F150F6C7E151F6C6C133F6D137FD80FF813FF3807FE036CB6FC6C -14FB6C14F36D13C3011F1303EB03F890C7FCAD4AB512E04A14F0A46E14E02C3C7CA730> -II< -90381FFC0E90B5129F000714FF5A5A5A387FE007EB800100FEC77E5A81A37E007F141E01 -C090C7FCEA3FF8381FFFE06C13FF000314C0C614F0010F13FC9038007FFEEC03FFEC007F -0078EC3F8000FC141FED0FC0A27EA27E151F01C0EB3F806D137F9039F803FF0090B6FC5D -5D00F814F0013F13C0267007FEC7FC222A79A830>III<3B7FFF803FFFC0B56C4813E0A46C496C13C03B01F000 -01F000A26D130300005DA2017C495AA36D495AA36D49C7FCA390380F803EA36D6C5AA2EC -E0FC01035BA214F101015BA214FB01005BA214FF6E5AA3021FC8FC2B277EA630>I<3B7F -FF800FFFF06E5AB515F8A26C16F04A7ED807C0C7EA1F00A26D5C0003153EA56D147E0001 -157CEC0FC0EC1FE0EC3FF0A32600F87F5BEC7DF8147CA214FC01786D5AA290387CF87C13 -7D157D14F0013DEB3DE0013F133FA2ECE01FA2011F5C6D486C5A2D277FA630>I<263FFF -C0B5FC48168014E1A214C06C16003A007E001F806D49C7FCEB1F80157E6D6C5A6D6C5AEB -03F1903801F3F0ECFFE06D5B147F6E5A92C8FCA2814A7E4A7EEB01F3ECF1F0903803E0F8 -49487E010F137C49487EEC003F496D7E017E6D7E4913073B7FFF803FFF806E4813C0B5FC -A27E4A6C13802A277EA630>I<3B7FFF803FFFC06E4813E0B5FCA27E4A6C13C03B01F800 -01F000120015036D5C137C4B5A7FA2013F495A7FA26E48C7FC130F14C00107133EA214E0 -01035BA2EB01F05DA2EB00F85D1479147D5D143FA26E5AA36E5AA2141F92C8FCA25C143E -A2147E147C120F486C5AEA3FC113C3EB07F0495A13FF6C5B5C6C90C9FCEA07FCEA01F02B -3C7EA630>I<1238127C12FEB3B3B3AD127C123807476CBE30>124 -D E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fb cmmi10 10.95 3 -/Fb 3 98 df<17035F5FA25F5FA24D7EA217FF5EA2EE037FA21606160E160C04187FA216 -30EE703F166016C0A2ED0180150316001506845D031C131F15185DA25DA25D4A5A844AC7 -FC170F4AB6FC5CA20218C7120FA25C5C845CA24948140749C8FCA21306A25B131C131801 -788213FCD807FEED1FFE267FFFE00107B512F8B5FC6C5B3D417DC044>65 -D<91B712F84916FF19E090260001FEC7EA3FF04BEC07F8727E727E854A4880A21A80A24A -48157F19FFA34A481600606118034A485D4E5A180FF01FE04A484A5A4E5ADD01FEC7FCEF -07F84AC7EA7FE092B6C8FC18E092C7EA07F802FEEC01FE717E727E727E495A85181FA249 -5A85A349485E183FA2614948157F6118FF4D90C7FC49485D17034D5AEF1FF049484A5AEF -FFC0017F020790C8FC007FB712FCB812F06C93C9FC413E7DBD45>I<143F903801FFC090 -3903E0E0E090390F8031F090381F001B133E49EB0FE05B485A000314074848EB0FC0A248 -5AA2001FEC1F805B123FA248C7EA3F00A400FE147EA4EDFC01481503A3913801F806127C -1403007E150C003E1307140C6C013813186CEB70783A0781C038703A03FF801FE03A007E -000F8028297CA730>97 D E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fc cmsy10 10.95 4 -/Fc 4 107 df24 D<153FEC03FFEC0FE0EC3F00147E5C495A495AA2495AB3AA5C13 -0F5C131F49C7FC13FEEA03F8EA7FE048C8FCEA7FE0EA03F8EA00FE133F6D7E130F801307 -80B3AA6D7EA26D7E6D7E147E80EC0FE0EC03FFEC003F205B7AC32D>102 -D<127CEAFFC0EA07F0EA00FC137E7F6D7E6D7EA26D7EB3AA1303801301806D7E147FEC1F -C0EC07FEEC00FFEC07FEEC1FC0EC7F0014FC495A5C13035C1307B3AA495AA2495A49C7FC -137E5BEA07F0EAFFC0007CC8FC205B7AC32D>I<126012F0B3B3B3B3B11260045B76C319> -106 D E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fd cmbx10 10.95 52 -/Fd 52 121 df12 -D34 D<143CA449B47E011F13F0017F13FC90B6FC3A03FE3C7FC0D807F0EB0FE0D80F -E0EB03F0D81F801301ED00F8D83F001478163C007E15FCED03FE150712FE150FA27EA201 -80EB07FC01C0EB03F801E0EB01F001F090C7FCEA7FFEEBFFFC806CEBFFE015F86C806C14 -FF16806C15C06C15E0C6FC6D14F0131F010314F8EB003F16FCEC3C3F151FED0FFE001F14 -07D87FC013031501EAFFE01500A313C016FC1380EA7E000078EC01F8127C003C15F0003E -14036CEC07E0D80FC0EB0FC0D807E0131FD803FEEBFF006CB55A6C6C13F8011F13E00103 -90C7FCEB003CA427497AC334>36 D38 -D<1407140F141E143C147CEB01F8EB03F014E0EB07C0130FEB1F80EB3F00A2137E13FE5B -12015B12035B1207A2485AA3121F5BA2123FA3485AA612FFB0127FA66C7EA3121FA27F12 -0FA36C7EA212037F12017F12007F137E7FA2EB1F80EB0FC01307EB03E014F0EB01F8EB00 -7C143C141F140F1407185A76C329>40 D<126012F012787E123E6C7E6C7E12076C7E7F6C -7E6C7EA2137E137F7F1480131F14C0130F14E0A2EB07F0A314F81303A214FCA3EB01FEA6 -14FFB014FEA6EB03FCA314F8A2130714F0A3EB0FE0A214C0131F1480133F14005B137E5B -A2485A485A5B485A120F485A003EC7FC123C5A5A1260185A7AC329>I<14F8497EA2497E -6D5AA4007CEC01F000FEEC03F839FF00F80701C0131F01E0133F01F0137F9038FCF9FF26 -3FFEFB13E00007B61200000114FCD8003F13E0010790C7FCA2013F13E048B512FC000714 -FF263FFEFB13E026FFFCF913F89038F0F87F01E0133F01C0131F0100130739FE01FC0300 -7CEC01F0000091C7FCA4497E6D5AA26D5A252879C334>I<16F04B7EB3AD007FBA12E0BB -12F0A46C19E0C8D801F8C9FCB3AD6F5A44467AB951>I45 -DI48 D<141E143E14FE1303131FEA03FFB5FC -A213E7EAFC071200B3B3AA007FB612F0A4243C78BB34>I<903803FF80011F13F090B512 -FE00036E7E2607FC077F260FE00113F0261F80007F48C76C7E6D133FD87FE06D7E7F00FF -816D7F1780A46C5A6C5A6C5A0007C7FCC81400A25D5EA24B5A5E4B5A4B5A5E4A5B4A90C7 -FC5D4A5AEC0FF04A5A4A5A4AC8FC14FE4948EB0780495A5CD907C0EB0F00495A49C7FC13 -3E495C13F048B7FC485D5A5A5A5A5AA2B75AA3293C7BBB34>III58 D63 D<16FCA24B7EA24B7EA34B7FA24B7FA34B -7FA24B7FA34B7F157C03FC7FEDF87FA2020180EDF03F0203804B7E02078115C082020F81 -4B7E021F811500824A81023E7F027E81027C7FA202FC814A147F01018291B7FCA24982A2 -D907E0C7001F7F4A80010F835C83011F8391C87E4983133E83017E83017C8148B483B500 -FC91B612FCA4463F7CBE4F>65 DI69 DI<922607FFC0130E92B500F8 -131E020702FF133E021FEDC0FE027F9038003FF1902601FFF0EB07FB010701C0EB00FF49 -90C8127FD93FFC153F4948150F49481507485B4A1503481701485B18004890CAFC48187E -A25B003F183EA2127F5B96C7FCA212FFAB0407B612FC127FA27F93C7383FFE00123FA212 -1F7FA27E6C7FA26C7F6C7FA26C7F6D7ED93FFE157FD90FFF15FF6D01C05B010101F05B6D -6CB4EB1FF1021F90B512C00207ED003E020002FC130E030701C090C7FC46407ABE52>I< -B71280A426003FFEC7FCB3B3B2B71280A4213E7DBD28>73 D76 DI79 D82 D<903A01FF8001C0011FEBF803017FEBFE0748B612 -8F489038007FDFD807F8EB0FFF484813034848130049147F003F153F49141F127F160F16 -0712FFA36D1403A27F7F01FC91C7FC6CB4FC14F8ECFF806C14FCEDFF806C15E0826C15FC -6C816C816C16806C7E011F15C0010715E0EB007F020314F0EC003F1503030013F8167F16 -3F127000F0151FA2160FA36C16F0A36C16E06C151F6C16C07F6DEC3F8001F0147F01FCEC -FF003AFEFFE007FED8FC3FB512F8D8F80F14E0D8F003148027E0001FFCC7FC2D407ABE3A ->I89 D91 -D<1304130E131FEB7FC0497E487F487F487F380FF1FE393FC07F80397F803FC039FE000F -E04813070070EB01C00020EB00801B0F74BE34>94 D<903807FF80013F13F848B512FE3A -03FC01FF803A07E0007FC0486C6D7E6D6D7E486C6D7EA28215076C4880A26C5AEA01C0C8 -FCA3EC3FFF0103B5FC131F9038FFFC074813E000071380380FFE00485A485A485AA25B12 -FFA3150FA2007F141F6D131D6C6C903839FF806C6C01F813FE390FFE03F00003B5EAC03F -C6EC000FD90FFC90C7FC2F2B7DA933>97 DIIIII<903A03FF8007F0011F9038F03FF8017F9038FCFFFC3B01FF01FFF8FE48 -486C13C04848137F484890383FE0FC177C484890381FF000A2003F81A7001F5DA26C6C49 -5AA26C6C495A6C6C495A6D4890C7FCECFFFCD8079F13F00103138048CAFCA47F7F7F90B5 -12FE6CECFFE016FC6C15FF17806C16C04816E0120F271FE0000113F0D83F80EB001F48C8 -120FEE07F800FE1503A5007E16F0007F15076C6CEC0FE06D141F6C6CEC3FC0D80FF8ECFF -803B03FF800FFE00C690B512F8011F14C0010101FCC7FC2F3D7DA834>III< -EA01FE12FFA412071203B3B3B1B512F8A4153F7BBE1E>108 DIII<3A01FE01FF -8000FF010F13F0023F13FE91397F03FF80DAF8007F2607FFE06D7E6C496D7E4A6D7E91C7 -6C7E83A2707EA21880A28218C0AA18805EA21800A24C5AA26E495A5F6E495A6E495A02F8 -495ADA7E0790C7FC91383FFFFC020F13F0020190C8FC91CAFCADB512FCA4323B7CA83A> -II<3901FC03F800FFEB0FFF4A13C091 -383C1FE0EC783F00079038F07FF03803FDE014C0EBFF80ED3FE0A29138001FC0ED070092 -C7FCA25BB3A4B512FEA424297CA82B>I<90381FFC0E90B5123E000314FE380FE007381F -8000003EC7127E153E5A151E12FCA27E7E6D90C7FC13E06CB47E14FC6CEBFF8015E06C80 -6C14FC000380C680133F01031480EB000F020113C00070EB007F00F0143F151F6C140FA3 -6C1580A27E6CEC1F006D133E6D137E9038F803FC00FCB512F0D8F83F13C026E007FEC7FC -222B7DA929>II<01FFEC07F8B5EB07FFA40007EC003F6C151FB3A7163FA2167F -7E16EF6CD980017F923903CFFFE090397FE01F8F011FB5120F010713FC010001E0EBF000 -332A7CA83A>II120 -D E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fe cmr10 10.95 76 -/Fe 76 123 df11 -DI14 D<001E130F003FEB1F80 -397F803FC039FFC07FE0A201E013F0A2007F133F393F601FB0001EEB0F3000001300A549 -1360A3484813C0A23903000180A20006EB0300A2481306485B485B002013101C1C7DBE2D ->34 D<14E0A4EB07FC90383FFF804913E03901F8E3F03903E0E078D80780131CD80F007F -001E8081481580007C14011278ED06C000F8140F151F153FA36CEC1F80ED0F0092C7FC12 -7E127FA2EA3FC013E0EA1FFE13FF6C13FC6C13FF6C14C06C806C6C7F011F7F01037F0100 -7F14E7ECE1FFECE07FED3F80151FA2ED0FC01218123C007E1407B4FCA35A5A00C0158012 -60150F16006C5C151E6C5C121C6C14F8390780E1F03903F0EFE0C6B51280D93FFEC7FCEB -0FF8EB00E0A422497BC32D>36 D38 D<121E123FEA7F80EAFFC0A213E0A2127FEA3F60121E1200A513C0A3 -EA0180A2EA0300A21206A25A5A5A12200B1C79BE19>I<1430147014E0EB01C0EB0380EB -0700130EA25B5B1378137013F05B1201485AA2485AA348C7FCA35A121EA2123EA2123CA2 -127CA5127812F8B21278127CA5123CA2123EA2121EA2121F7EA36C7EA36C7EA26C7E1200 -7F1370137813387F7FA27FEB0380EB01C0EB00E014701430145A77C323>I<7E7E7E1270 -7E7E7EA27E6C7E7F12017F12007F1378A27FA37FA3131F7FA21480A21307A214C0A51303 -14E0B214C01307A51480A2130FA21400A25B131EA35BA35BA25B5B12015B12035B48C7FC -120EA25A5A5A5A5A5A135A7AC323>II<1506150FB3A9007FB912E0BA12F0A26C18E0C800 -0FC9FCB3A915063C3C7BB447>I<121E123FEA7F80EAFFC0A213E0A2127FEA3F60121E12 -00A513C0A3EA0180A2EA0300A21206A25A5A5A12200B1C798919>II<121E123FEA7F80EAFFC0A4EA7F80EA3F00121E0A0A798919>III<14C013031307131F137FEA07FFB5FC139FEAF81F1200B3B3 -ACEB7FF0B612F8A31D3D78BC2D>III<150EA2151E153EA2157E15FEA214011403157E1406140E140C1418 -14381430146014E014C0EB0180130314001306130E130C5B133813305B13E05B485A1203 -90C7FC1206120E120C5A123812305A12E0B8FCA3C8EAFE00AC4A7E49B6FCA3283E7EBD2D ->I<00021403D807C0130F01F813FE90B55A5D5D5D158092C7FC38063FF890C9FCADEB01 -FE90380FFF8090383E03E090387001F09038C00078D80780137C90C77E153F0002EC1F80 -C8FC16C0A2ED0FE0A316F0A4123E127F5A7FA290C713E0A248141F006015C0A200701580 -0030143F003815000018147E000E5C6C495A3903C003F03901F00FE06CB55A013F90C7FC -EB07F8243F7CBC2D>II< -12301238123E003FB612FCA316F84815F0A216E00070C812C00060EC0180A2ED03001506 -5A5D5DA2C85A5D15E05D4A5A140392C7FC1406A2140E5CA2143C14381478A214F85CA213 -01A21303A3495AA4130FA6131FA96D5A6D5A26407BBD2D>II<121E123FEA7F80EAFFC0A4EA7F80EA3F00121EC7FCB3121E123FEA7F80EA -FFC0A4EA7F80EA3F00121E0A2779A619>58 D63 D<1507A34B7EA34B7EA24B7EA3 -4B7E156FA2EDEFF815C7A291380187FC1583A291380303FE1501A291380600FFA34A6D7E -A34A6D7EA34A6D7EA20270800260130FA202E0804A1307A201018191B6FCA2498191C712 -01A201068182A2496F7EA3496F7EA3496F7EA21370717E13F0486C82D80FFEED3FFCB500 -E0010FB512F8A33D417DC044>65 DIIIII72 DI75 DIII< -ED7FE0913807FFFE91391FC03F8091397E0007E0D901F8EB01F8D907F0EB00FED90FC014 -3F49486E7E49C86C7E017E6F7E01FE8248486F7E49150100038348486F7EA24848167FA2 -001F1880A24848EE3FC0A3007F18E049161FA300FF18F0AC007F18E06D163FA4003F18C0 -6D167F001F1880A26D16FF000F1800A26C6C4B5A00035F6D150300015F6C6C4B5A017F4B -5A6D6C4A5A6D6C4A5A6D6C4AC7FC6D6C14FED901F8EB01F8D9007EEB07E091391FC03F80 -912607FFFEC8FC9138007FE03C427BBF47>II -82 DI<003FB91280A3903AE0007FE00090C76C48131F007E -EF0FC0007C17070078170300701701A300601700A5481860A5C81600B3B14B7E4B7E0107 -B612FEA33B3D7DBC42>III<007FB5D8C003B512E0A3C66C48C7387FFC00D93FF8EC1F -E06D48EC0F806D6C92C7FC170E6D6C140C6D6C5C17386D6C14306D6D5B17E06E6C5B023F -495AEDE003DA1FF090C8FC020F1306EDF80E6E6C5A1618913803FE386E6C5A16606E13E0 -6F5AA26F7E6F7EA26F7E4B7EA2ED33FEED71FF156103C07F0201137F03807F4A486C7E5C -02066D7E4A6D7E141C02186D7E4A6D7E147002606D7E4A6D7F13014A6E7E49C86C7E5B01 -066F7E010E6F7E133F496C812607FFC0EC3FFFB500F80103B512FEA33F3E7EBD44>88 -DI91 D<6D1340000114C039030001800006EB0300481306A248 -5BA2485BA2485BA3485BA500CFEB678039DF806FC039FFC07FE001E013F0A2007F133FA2 -393FC01FE0391F800FC0390F0007801C1C73BE2D>II<1318133C137E13FF3801E7803803C3C0380781E0380F00F0001E13 -7848133C48131E00E0130700401302180D76BD2D>I97 DI<49B4FC010F13E090383F00F8017C131C49 -13064848131F48485B0007EC7F80485A121F5B003FEC3F00151E007F91C7FC90C9FCA35A -A97EA27F123F16C0121F6DEB0180120F6C6CEB0300A26C6C13066C6C5BD8007C13389038 -3F01F090380FFFC0D901FEC7FC222A7DA828>II -II<167C903903F801FF -90391FFF0787903A7E0FCE0F809038F803F83901F001F03B03E000F8070000076EC7FCA2 -4848137EA2001F147FA6000F147EA26C6C5BA200035C6C6C485A6D485A39037E0FC0D91F -FFC8FC380703F80006CAFCA2120EA2120F7E7F7F6CB512F015FE6C6E7E6C15E00003813A -07C0001FF848C7EA03FC001E140048157E007C153E0078153F00F881A50078151E007C15 -3E6C5D001E15786C5DD807C0EB03E0D803F0EB0FC0D800FE017FC7FC90383FFFFC010313 -C0293D7EA82D>III107 DI<2703F003FCEB01FE00FF903B0FFF8007FFC0913B3C0FC01E07E0913B -7003E03801F00007903BC001F06000F82603F1806D487F2601F300EBF98001F6D900FBC7 -127C04FF147E01FC5CA3495CB3A6486C496C14FFB528F07FFFF83F13FCA346287CA74D> -I<3903F003F800FFEB1FFF91383C0F8091386007C00007496C7E2603F1807F3801F30001 -F613018213FCA35BB3A6486C497EB500F0B512F0A32C287CA733>I<14FF010713E09038 -1F81F890387E007E01F8131F4848EB0F804848EB07C04848EB03E0000F15F04848EB01F8 -A2003F15FCA248C812FEA44815FFA96C15FEA36C6CEB01FCA3001F15F86C6CEB03F0A26C -6CEB07E06C6CEB0FC06C6CEB1F80D8007EEB7E0090383F81FC90380FFFF0010090C7FC28 -2A7EA82D>I<3901F807F800FFEB3FFF9138781FC09138C007E03A07F98001F02603FB00 -7FD801FE6D7E49147E49147FEE3F80A2EE1FC0A217E0A2160F17F0A917E0161FA217C0A2 -EE3F80A26DEC7F00167E6D5C4B5A01FB495A9039F9C007E09039F8F01F80DA3FFEC7FCEC -0FF091C9FCAD487EB512F0A32C3A7DA733>I<02FF13180107EBC03890381F80E090397E -0030784913184848130C4848EB06F8485A000F1403485AA248481301A2127FA290C7FC5A -A97E7FA2123FA26C7E15036C7E000714076C7E6C6C130D00001419017E137190383F81E1 -90380FFF81903801FE0190C7FCAD4B7E92B512F0A32C3A7DA730>I<3903F007E000FFEB -1FF0EC7878ECE0FC3907F181FE12033801F3019038F600FCA2153001FC1300A35BB3A548 -7EB512FCA31F287EA724>I<90387FC0603901FFF8E03807C03D380E0007481303481301 -481300A212F01560A27EA27E007F140013C0EA3FFE381FFFE06C13FC6C7F6C7FC6148001 -0F13C09038007FE0EC0FF00040130300C0EB01F814007E1578A37E15707E15E07E6CEB01 -C000F3EB038039E1E01F0038C0FFFCEB1FE01D2A7DA824>I<1318A61338A41378A213F8 -A2120112031207001FB512C0B6FCA2D801F8C7FCB3A21560A9000014C07F137CEC018013 -3E90381F8700EB07FEEB01F81B397EB723>IIII<3B7FFFC00FFFE0A3000390390007FE00C6 -48EB03F0017E6D5A6DEB03801480011F49C7FC90380FC00E903807E00C6E5A903803F838 -01015B6D6C5AEC7EC0EC7F80143F141F6E7E81141FEC3BF0EC71F8ECE1FC14C090380180 -7E01037FD907007F01066D7E49130F496D7E01386D7E017880EA01F8D80FFCEB07FEB590 -381FFFF8A32D277FA630>II<001FB61280A29039E0003F0090C7127E001E14FE001C -495A5D0018495A003813075D0030495A141F4A5A92C7FC147EC712FE495A5C495A13075C -495A011FEB0180EB3F801400137E13FE485A491303485A000715005B48485B001F5C485A -90C7123F007E49B4FCB7FCA221277EA628>I E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Ff cmbx12 14.4 37 -/Ff 37 122 df46 D<157815FC14031407141F14FF130F0007B5FCB6FCA2147F13F0EAF8 -00C7FCB3B3B3A6007FB712FEA52F4E76CD43>49 D -I<91380FFF8091B512FC010314FF010F15C090263FF00313F09026FF800013FC4848C76C -7ED803F86E7E4980D807FC168001FF16C0487F82486D15E0A3805CA27E4A4913C07E6C90 -C7FCD800FC168090C85A18005F167F4C5A5F4B13E04B5B030F5BDB7FFEC7FC91B512F816 -C016FCEEFF80DA000713E0030013F8707E70B4FC7013807013C018E07013F0A218F88218 -FCA318FEEA01C0EA0FF8487E487E487EA2B57E18FCA44C13F86C90C7FC18F0495C6C4816 -E001F04A13C06C484A1380D80FF84A1300D807FE4A5A2703FFF0035BC690B612F0013F15 -C0010F92C7FC010114F8D9001F1380374F7ACD43>I<177C17FEA2160116031607160FA2 -161F163F167FA216FF5D5DA25D5DED1FBFED3F3F153E157C15FCEC01F815F0EC03E01407 -EC0FC01580EC1F005C147E147C5C1301495A495A5C495A131F49C7FC133E5B13FC485A5B -485A1207485A485A90C8FC123E127E5ABA12C0A5C96C48C7FCAF020FB712C0A53A4F7CCE -43>I<0003160ED807E0153E01FCEC03FED9FFE0137F91B65A5F5F5F5F5F94C7FC5E16F8 -5E16C04BC8FC15F801E090C9FC91CAFCABEC0FFF027F13F001E3B512FC01E714FF9026FF -F80713C0DAC0017F49C713F8496E7E01F0143F496E7E49816C5AC9148018C082A218E0A3 -18F0A3EA07C0EA1FF0487E487EA2487EA318E0A25B18C06C485C49168013C0003EC81400 -003F5D6C6C5D6C6C4A5A6D4A5AD807F8495B6C6C01075B2701FFC03F5B6C90B6C7FC013F -14FC010F14F0010314809026007FF8C8FC344F79CD43>II<121F -7F7FEBFF8091B81280A448180060A26060606060A2485F0180C86CC7FC007EC912FE5F00 -7C15014C5A4C5A4C5A4C5A485E163F4CC8FC16FEC8485A5E15034B5A150F5E4B5A153FA2 -4B5AA24BC9FCA25C5C5D1407A34A5AA2141FA3143FA34A5AA414FFA65BAB6D5B6E5A6E5A -6E5A395279D043>I<913807FFC0027F13FC49B67E010715E090261FFC007FD93FC0EB3F -FC4948EB0FFE49C76C7E48488048486E138082484816C0A2000FEE7FE0A3121F7FA27F7F -6E15C002E014FF8002FC15806C01FF5BDBC00313006F485A6C02F85B9238FE0FF86C9138 -FF3FF06CEDFFE017806C4BC7FC7F6D6E7E010F15E06D81010115FC4981010F81013F1680 -EB7FC32601FF8015C048496C14E04848131F4848010714F0497F001F020014F84848143F -160F48486E13FC1601824848157F173F171FA2170FA318F8A26C7E18F0171F6C6C16E0A2 -6C6CED3FC06DED7F806C6C15FF6C6C6C4913006C01E0EB0FFE6C01FCEB7FF86C6CB65A01 -1F15C0010792C7FC010014F8020F1380364F7ACD43>I<913807FF80027F13F00103B512 -FC010F14FF90261FFE0113C0903A7FF8007FE0D9FFE06D7E48496D7E48496D7E486F7E48 -90C77FA2486F1380A2484816C0A2007F17E0A28200FF17F0A418F8A618FCA2127F5EA312 -3F5E6C7EA26C5DA26C6D5B6C153D6C6D13396C6D13F990397FF801F1011FB512E16D02C1 -13F8010314019038007FFCEC00401500A218F05EA218E013F0EA03FC486C16C0486C5C18 -80487F18005E5F91C7485A4C5A6C48147F495DD807F049485A4B5B6C6C010F5B6CB4D93F -FEC7FC6C90B55A6D14F0011F14C0010749C8FC010013E0364F7ACD43>I66 D69 DI< -B812C0A5D8000701F8C7FCB3B3B3B2B812C0A52A527CD132>73 D76 D82 D<91260FFF80130791B500F85B010302FF5B010FEDC03F013FEDF07F90267F -F8006D5A2601FFC0EB07FD4890C70001B5FC48486E7E49814848150F48488183003F825B -007F82A284A200FF83A27F84A27F7F7F6D93C7FC6C13C014F014FF6C14F0EDFF806C15F8 -EEFF806C16F017FC6C16FF6C836C17E06C836D82011F826D821303010082020F16801400 -030715C0ED007F1603DC007F13E083170F7113F08383127800F882A3187FA27E19E0A37E -19C06C17FF6D17807F6D4B13006D5D6D5E01FE4B5AD9FFC0EC1FF802F84A5A903B1FFFC0 -03FFE0D8FE0790B65AD8FC0193C7FC486C6C14FC48010714E0489026003FFEC8FC3C5479 -D24B>I97 D<913801FFF8021FEBFF8091B612E0010315F8010F9038800FFE4948C77ED93F -F81303D9FFF0491380485B4A4913C0485B5A4890C7FCA2486F13805B003F6F1300EE00FC -94C7FC485AA412FFAB127FA27FA2123FA2001FEE03E07F7E6EEC07C07E6EEC0F806C6D14 -1F6CEE3F006C6D147ED97FFC5CD91FFEEB03F8903A0FFFC01FF0010390B55A0100158002 -1F01FCC7FC020113E033387CB63C>99 D<4DB47E0407B5FCA5EE001F1707B3A4EDFFC002 -1F13FC91B6FC010315C7010F9038C01FE7903A1FFE0003F7D93FF86DB5FCD9FFF06D7E48 -49804849805C48824890C8FCA2485AA2123FA2485AA412FFAB127FA46C7EA3121FA26C7E -6C5E6E5C6C7F6C5E6C6D49B5FCD97FF84914E06D6CD90FEFEBFF80903A0FFF807FCF0103 -90B5120F010014FE023F13F00203018049C7FC41547CD24B>I<913803FFC0023F13FC49 -B6FC010715C04901817F903A3FFC003FF0D97FF06D7E4948EB07FC48498048496D7E5A91 -C76C13805A486F13C05B003F17E0A2177F485A18F0A312FFA390B8FCA318E001FCCAFCA5 -127FA37F123FA2001F17E06DED01F07E17036C6D15E06C16076C6DEC0FC06C6DEC1F806D -6CEC3F006D6C14FED91FFEEB03FC903A0FFFC03FF8010390B55A010015C0021F49C7FC02 -0113F034387CB63D>IIII<137F497E487F487F487F487FA76C5B6C5B6C5B6C5B6DC7FC90C8FCADEB3FF0 -B5FCA512017EB3B3A6B612E0A51B547BD325>I108 DII<913801FF -E0021F13FE91B612C0010315F0010F9038807FFC903A1FFC000FFED97FF0903803FF8049 -486D7F48496D7F48496E7EA24890C86C7E488349151F001F83A2003F834981A2007F1880 -A400FF18C0AC007F1880A36C6C4B1300A3001F5FA26C6C4B5AA26C6D4A5A6C5F6C6D4A5A -6C6D495B6D6C495BD93FFC010F90C7FC903A0FFF807FFC6D90B55A010015C0023F91C8FC -020113E03A387CB643>II<90397FE001FCB590380FFF80033F13E04B13F09238FE1FF891 -39E1F03FFC0003EBE3E0C69138C07FFEECE780150014EF14EE02FEEB3FFC5CEE1FF8EE07 -E04A90C7FCA55CB3AAB612FCA52F367CB537>114 D<903901FFE007011FEBFC1F017FEB -FF7F48B7FC3907FE001FD80FF01307D81FC01301497F003F8148C87EA34881A27FA27F01 -F091C7FC13FC387FFFC014FEECFFF06C14FEEDFFC06C816C15F86C810001816C81013F15 -80010715C01300020714E0EC001F1503030013F00078157F00F8153F161F7E160FA27E17 -E07EA26DEC1FC07F6DEC3F806DEC7F0001FCEB01FE9039FF800FFC013FB55AD8FC1F14E0 -D8F803148027E0007FF8C7FC2C387CB635>I<143EA6147EA414FEA21301A313031307A2 -130F131F133F13FF5A000F90B6FCB8FCA426003FFEC8FCB3A9EE07C0AB011FEC0F80807F -EE1F006D1380EDC03E6D6D5A0100EBFFF86E5B021F5B020190C7FC2A4D7ECB34>III<00 -7FB500F090387FFFFEA5C66C48C7000F90C7FC6D6CEC03F86D6D495A6D6D495A6D4B5A6F -495A6D6D91C8FC6D6D137E6D6D5B91387FFE014C5A6E6C485A6EEB8FE06EEBCFC06EEBFF -806E91C9FCA26E5B6E5B6F7E6F7EA26F7F834B7F4B7F92B5FCDA01FD7F03F87F4A486C7E -4A486C7E020F7FDA1FC0804A486C7F4A486C7F02FE6D7F4A6D7F495A49486D7F01076F7E -49486E7E49486E7FEBFFF0B500FE49B612C0A542357EB447>120 -DI E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fg cmbx12 24.88 15 -/Fg 15 118 df[127 -141 120 268 146 70 D[203 142 120 269 -220 77 D[<932607FFF8163E4BB600E0153F030F03FC5D037FDBFF805C4AB800F05B020F -05FC5B4A05FF5B027FF0C00F91B526FC000FECF01F010302C0D9003F6D5A4949C800076D -5A4901F8030090B6FC4901E0163F4949160F49498290B5CA12014A834849844849181F87 -484984A2484984874886A248498588A24887A388A2B58680A36E85A3806E85A28080816C -6E725A03F096C7FC8115FE6F7E6C15F016FF17F86CEEFF8018FC6CEFFFC019FE6CF0FFE0 -6C19FEF2FFC06C1AF06C1AFC1BFF6D1AC06D866D1AF86D866D866D866D876D87023F866E -8602078614016E6C85031F851503DB007F8404031980EE003F050118C0EF001F060017E0 -190FF1007F080F15F01A031A007514F81B1F87877514FC87A2007F86486C86A288A288A4 -6D86A31EF87FA37F1EF0A26D621EE07F7F6D5013C0A26E1B806E616E1B0002F896B5FC6E -4E5B6E4E5B6E7E03E0050F5B6F4D5B03FE4D5B6F6C93B55A04F803035C496CD9FF80020F -91C7FCD9FC1F02FF91B55AD9F80792B75A496C19F049C66C6049011F18804901074DC8FC -90C817F048030F168048030003FCC9FC007C04011480>102 146 -115 271 129 83 D[162 144 120 269 179 -85 D<93387FFFF8033FB612E00203B712FE021FEEFFC0027F17F049B912FC4918FF4991 -2680007F14C04901E0C7000F80496D020314F8496D0200806F6F7F496D6F7F738090B681 -73807380A27380A288856D4984A26D5B747F6D5B6D5B6D5B010090CAFC91CBFCAA0603B6 -FC050FB7FC0403B8FC167F0307B9FC153F4AB7C67E020F15C0023F02FCC7FC91B612C001 -0392C8FC010F14FC4914F04914C04991C9FC90B55A485C485C485C485C5D5A485CA24891 -CAFCA3B6FC5CA397B5FCA461806C60F107EF6C6E150F6F16CF6CF03F8F6F037F806C6EDB -FF0F14C06C02FCDA03FE15FC6C6E91260FFC0791B5FC6C6E6CD93FF817806C923AF003FF -F003013F91B6487E010FEF8000010394C77E010004FC141F021F03E01407020192C96C14 -00DA000701F093C9FC695F79DD71>97 D[112 144 120 270 129 100 D<94387FFFC0040FB6FC93B712E003 -0716FC031F16FF037F17C04AB912F00207DAF80380021F912680003F13FE4A49C7000F7F -4A01F802038049B5486E804902C06E6C7F494A6F7F4991C9FC49727F4949707F4B844984 -90B548707F5A4B198048855D481CC086481CE05D5A871DF05AA25D5AA21DF887A2B6FCA3 -92BBFCA51DF00380CDFCA77EA4817EA37EA2817EA26CF307F06FF00FF87E816C1B1F6F19 -F06C1B3F6D6DF07FE06D7FF4FFC06D6E4C13806D6E5E6D02F04C13006D6EEE1FFE6D6E4C -5A6D6C01FFEEFFF86E02E002035B6E02FC021F5B02079126FFC003B55A6E92B7C7FC0200 -60033F17F8030F17E003011780DB003F03FCC8FC040315C0DC000F01F8C9FC5D5F7ADD6A ->I[48 144 119 271 64 105 D[49 143 119 270 64 -108 D110 D<94381FFFF00407B612C0047F15FC03 -03B87E030F17E0037F17FC4ABAFC4A9126FC007F80020F02C0010714E04A49C880027F01 -F8033F13FC91B5486F7F4902C003077F494A6F804991C96C80494970804949717F498749 -49717FA290B548717F48884B83481D80A2481DC04B83481DE0A2481DF0A3484A7114F8A4 -481DFCA5B61BFEAF6C1DFCA56C6E4D14F8A36C1DF0A36C1DE06F5F6C1DC0A26C6E4D1480 -A26C1D006F5F6C646D6D4D5B6F94B5FC6D636D6D4C5C6D6E4B5C6D6E4B5C6D02F0031F5C -6D6E4B91C7FC6D6C01FE92B512FC6ED9FFC001075C6E02FC017F5C020791B812C0020196 -C8FC6E6C17FC031F17F003031780DB007F03FCC9FC040715C0DC001F01F0CAFC675F7ADD -74>I114 D<92260FFFF814F80203B638C001FC021FEDF8 -0791B7EAFE0F0107EEFFBF4917FF013F9038F0000F4990C8FCD9FFF8153F4849150F4801 -C015034849814890CAFC197F4848173FA24848171FA2007F180FA312FF19077FA27F8080 -6E705A02F893C8FC14FEECFFC06C14FCEDFFE0EEFF806C16FCEFFFC06C17F86C17FF19C0 -6C18F06C846C18FE6C846D846D846D840107840101846D6C83141F020383DA003F821503 -DB000F1680EE003F050115C0717E181F1807007F050114E0486C8285856D83A2857F85A2 -7F1BC07FA27F1B806D5FA26D19006E5E6E5F6E4C5A6E167F02FC4C5A6E03035B6E6C4A5B -03E0023F5B03FE0103B55A01F990B8C7FCD9F07F16FCD9E01F5ED9800716C0D900014BC8 -FC48D9003F14F0007C020149C9FC4B5F78DD5C>I[72 132 124 258 90 II E -%EndDVIPSBitmapFont -%DVIPSBitmapFont: Fh cmbx12 20.74 8 -/Fh 8 117 df49 -D<96267FFFE01670063FB616F80503B700E01401053F04FC14034CB91407040706C0130F -043F06F0131F93B626FE000F01FC133F030303809026007FFE137F030F02FCC8390FFF80 -FF4B02E0030313C1037F91CA13E392B500FCEF3FF7020302F071B5FC4A4A17074A028083 -4A91CB7E4A01FC844A498591B54885494A854988494A85495C93CD7E4988495B49885D90 -B51C7F5D481E3F485CA21F1F485CA2481E0F5D5AA21F075D5AA2F703F09CC7FC5AA392D1 -FCA2B6FCB27EA281A37EA3F701F06CF603F881A37E816C1E0720F06C80A36C6E1B0F6C1F -E06F1B1F7F6F1CC06D1D3F6D6DF37F807F70F2FF006D6E626D6E19016D525A6D6E4F5A6E -6D190F6E01FE4F5A6E6D4F5A6E6E4E5A6E02E04D485A6E6E4D90C7FC020002FCEF0FFE6F -01FFEF3FFC031F02E0EEFFF06F02FC03075B0303DAFFC0023F1380030003FE0107B5C8FC -043F91B712FC040718F0040118C0DC003F94C9FC050316F8DD003F1580DE007F01F0CAFC -757A75F78C>67 D<92383FFFF8020FB612E0027F15FC0103B87E010F17E04983499026E0 -007F13FCD97FFCC7000F7F496C02037F486D6E806F6D6C7F86486E6E7F727F8684868486 -6C5CA26C91C86C806D5A6D5A6D5AEB03C090CAFCA80507B6FC041FB7FC0303B8FC157F02 -03B9FC021FECFE0391B612800103ECF800010F14C04991C7FC017F13FC90B512F04814C0 -485C4891C8FC485B485BA2485BA2485BA2B5FC5CA360A360806C5FA26C6D153E6E5D6C05 -FC806C01FFDA03F8806C6ED90FF014FC6C02E090263FE07FEBFFFC6C9128FC03FFC03F14 -FE6C91B61280013F4B487E010F4B1307010303F01301D9003F0280D9001F13FC020101F8 -CBFC57507ACE5E>97 D101 D<903801FFFCB6FCA7C67E -131F7FB3AE95380FFFE095B512FE05036E7E050F15E0053F15F84D819426FFF01F7F4CD9 -00077FDC07FC010180EE0FF0DC1FC06D804D82043EC87E5E04FC835EDBFDF0815E03FF84 -5EA25EA393C9FCA45DB3B3A7B8D8E003B81280A7617879F76C>104 -D<902601FFFCEC7FFEB60207B512F0053F14FE4CB712C0040716F0041F824C16FE4CD900 -7F7FC66C9026FDFFF0010F14C0011F90B500800103806D4AC76C804C6E6C7F04F06F7F4C -6F7F5E4C6F7F93C96C14805D7414C01DE0861DF0A2861DF8A2871DFCA57513FEAF5113FC -A41DF8A298B5FC1DF0A2621DE0A25014C01D80626F1900505B705D705F704B5B704B5B70 -92B55A04FE02035C706C010F91C7FC4B01E0013F5B93267FFC01B55A041FB712F07016C0 -040393C8FC040015F8051F14C0050301F0C9FC94CCFCB3A7B812E0A75F6F7ACD6C>112 -D<902601FFF8EB07FEB691383FFFC094B512F04C800407804C8093391FFC3FFF93263FE0 -7F1380C66C0380B512C0011F4A5A6DDAFC0114E0A2EDF9F816F015FB16E015FF4C6C14C0 -A24C6D1380721300725A93C76C5AF001E095C8FCA25DA55DB3B3A4B812F8A7434E7ACD4F ->114 D<157FA75DA45CA45CA25CA25CA25CA25C5C91B5FC5B5B5B5B133F90B6FC000792 -B6FCBAFCA6D8000791C9FCB3B3A4F00FE0AE181F6D6E14C0A2183F6D178070137F6D1700 -705B6E6D485A6E9038FE07FC6E90B55A6E5D6E5D02015D6E6C5C031F49C7FC030013F03B -6E7CEC4B>116 D E -%EndDVIPSBitmapFont -end -%%EndProlog -%%BeginSetup -%%Feature: *Resolution 600dpi -TeXDict begin -%%PaperSize: A4 - -%%EndSetup -%%Page: 1 1 -1 0 bop 382 1171 a Fh(Chapter)65 b(1)382 1586 y Fg(FstStudio)79 -b(User)e(Man)-6 b(ual)382 2067 y Ff(1.1)135 b(In)l(tro)t(duction)382 -2270 y Fe(FstStudio)39 b(\(Finite)g(State)h(T)-8 b(ransducer)37 -b(Studio\))i(is)f(a)h(program)f(for)g(construction)382 -2383 y(and)30 b(running)e(of)j(\014nite)f(state)i(transducers.)40 -b(If)30 b(y)m(ou're)h(not)g(familiar)f(with)g(the)h(con-)382 -2496 y(cept)g(of)f(transducers)g(and)g(regular)g(relations,)i(then)e -(Xero)m(x's)h(fst)g(homepage)382 2609 y(h)m(ttp://www.xrce.xero)m -(x.com/researc)m(h/mltt/fst/)382 2722 y(is)25 b(recommended)e(as)i(an)g -(in)m(tro)s(duction)g(\(primarily)f(b)s(ecause)h(the)h(syn)m(tax)f(of)g -(Xero)m(x's)382 2835 y(fst)30 b(program)f(has)h(functioned)g(as)h(an)f -(inspiration)h(for)f(the)g(syn)m(tax)h(of)g(fstStudio\).)382 -3121 y Ff(1.2)135 b(Installation)382 3324 y Fe(If)23 -b(y)m(ou)h(ha)m(v)m(e)h(access)h(to)e(the)g(binary)f(\014le,)j(then)d -(all)i(y)m(ou)f(ha)m(v)m(e)h(to)g(do)f(is)f(to)i(cop)m(y)g(the)f -(\014le)382 3437 y(to)j(an)g(appropriate)f(library)g(and)g(run)f(the)i -(program)e(according)j(to)f(the)g(instructions)382 3550 -y(b)s(elo)m(w.)42 b(If)30 b(y)m(ou)h(ha)m(v)m(e)h(access)f(to)h(the)f -(source)f(co)s(de,)i(compile)e(the)h(system)f(b)m(y)g(t)m(yping)382 -3663 y(\\mak)m(e".)45 b(This)30 b(will)i(construct)g(a)g(\014le)g -(named)e(\\fst")i(in)f(the)h(source)f(library)-8 b(.)44 -b(T)-8 b(o)32 b(b)s(e)382 3776 y(able)g(to)g(compile)f(the)h(system,)f -(y)m(ou)h(m)m(ust)e(ha)m(v)m(e)j(ghc)e(installed)i(at)f(y)m(our)f -(system.)43 b(If)382 3889 y(y)m(ou)35 b(don't)f(ha)m(v)m(e)i(it)f -(already)-8 b(,)37 b(a)e(free)g(distribution)f(of)h(ghc)f(can)h(b)s(e)f -(do)m(wnloaded)h(at)382 4002 y(h)m(ttp://www.hask)m(ell.org/ghc/.)59 -b(It)35 b(can)h(also)g(b)s(e)f(run)e(in)i(Hugs.)56 b(Load)35 -b('Main.hs')382 4114 y(and)30 b(t)m(yp)s(e)g('main'.)382 -4401 y Ff(1.3)135 b(Syn)l(tax)382 4604 y Fe(fstStudio)37 -b(tak)m(es)j(a)e(program)f(consisting)h(of)g(regular)h(relations)g -(that)f(denotes)g(the)382 4717 y(relation)23 b(b)s(et)m(w)m(een)g(t)m -(w)m(o)h(regular)f(languages)g(and)f(constructs)g(a)h(transducer.)37 -b(If)22 b(a)h(reg-)382 4830 y(ular)k(expression,)g(not)g(a)h(relation,) -h(is)e(giv)m(en,)i(then)d(it)i(is)f(in)m(terpreted)g(as)g(the)g(iden)m -(tit)m(y)382 4943 y(relation.)40 b(The)25 b(syn)m(tax)h(is)f(v)m(ery)h -(similar)f(to)h(Xero)m(x's)h(\014nite)e(state)i(transducer)d(syn)m(tax) -382 5055 y(with)33 b(t)m(w)m(o)j(fundamen)m(tal)c(di\013erences:)48 -b(a)34 b(distinction)h(is)f(made)f(b)s(et)m(w)m(een)h(functions)382 -5168 y(\(de\014nitions\))d(and)e(strings,)i(and)e(fststudio)i(allo)m -(ws)g(functional)g(de\014nitions.)382 5381 y Fd("a")1854 -5652 y Fe(1)p eop -%%Page: 2 2 -2 1 bop 609 548 a Fe(sym)m(b)s(ol.)609 661 y(Example:)40 -b(["b"])31 b(denotes)g(the)g(language)g Fc(f)p Fe("b")p -Fc(g)p Fe(.)382 846 y Fd(a)609 959 y Fe(v)-5 b(ariable.)42 -b(A)30 b(sym)m(b)s(ol)f(without)i(quotes)g(is)f(a)h(v)-5 -b(ariable.)382 1256 y Fd("a":"b")609 1369 y Fe(Describ)s(es)43 -b(a)f(relation)i(b)s(et)m(w)m(een)f(the)g(sym)m(b)s(ol)e(a)i(and)e(b.) -76 b(This)42 b(relation)i(is)609 1482 y(ordered)29 b(and)g(a)h(is)g -(said)g(to)g(b)s(e)f(a)h(part)g(of)f(the)h(upp)s(er)e(language)j(and)e -(b)g(is)h(said)609 1595 y(to)h(b)s(e)f(part)g(of)h(the)f(lo)m(w)m(er)i -(language.)609 1708 y(Example:)40 b([)31 b("a":"b")h(])e(denotes)h(the) -g(relation)g Fc(f)p Fe(\("a","b"\))p Fc(g)p Fe(.)382 -1893 y Fd(0)609 2006 y Fe(epsilon)j(sym)m(b)s(ol.)51 -b(The)33 b(epsilon)h(sym)m(b)s(ol)f(denotes)h(the)g(string)g(with)g(no) -g(sym-)609 2118 y(b)s(ols.)609 2231 y(Example:)40 b([0])31 -b(denotes)g(the)g(language)g Fc(f)p Fe("")p Fc(g)p Fe(.)382 -2416 y Fd(?)609 2529 y Fe(all)40 b(sym)m(b)s(ol.)64 b(The)39 -b(all)g(sym)m(b)s(ol)f(denotes)h(the)g(union)f(of)h(all)h(sym)m(b)s -(ols)d(in)h(the)609 2642 y(alphab)s(et.)609 2755 y(Example:)d([?])i -(and)20 b(an)g(alphab)s(et)g Fc(f)p Fe(a,)k(b,)e(c)p -Fc(g)f Fe(denotes)g(the)f(language)i Fc(f)p Fe(\\a","b","c")p -Fc(g)p Fe(.)382 2940 y Fd("")609 3052 y Fe(quotes)31 -b(cancels)h(ev)m(ery)f(sp)s(ecial)g(meaning)e(of)i(the)f(sym)m(b)s -(ols.)609 3165 y(Example:)40 b(["?)71 b(0"])32 b(denotes)f(the)f -(language)i Fc(f)p Fe("?)72 b(0")p Fc(g)p Fe(.)382 3350 -y Fd([A)45 b Fe(])609 3463 y(brac)m(k)m(ets)32 b(are)f(used)e(to)i(c)m -(hange)h(the)f(precedence)f(of)h(a)g(regular)f(relation.)382 -3648 y Fd(\(A\))609 3761 y Fe(paren)m(thesis)h(expresses)f(optionalit)m -(y)-8 b(,)33 b(and)d(has)g(the)h(same)e(meaning)h(as)h([)p -Fb(A)p Fc(j)p Fe(0].)382 3946 y Fd(A)70 b(B)609 4058 -y Fe(Concatenation)32 b(of)f(the)f(expressions)g(or)h(relations)g(A)g -(and)e(B.)609 4171 y(Example:)39 b([[a)55 b(b])27 b([c)55 -b(d]])28 b(denotes)g(the)f(language)i Fc(f)p Fe("ac",)h("ad",)f("b)s -(c",)g("b)s(d")p Fc(g)382 4356 y Fd(A)35 b(^)g(n)609 -4469 y Fe(Concatenation)d(of)f(A)f(n)g(times.)40 b(A^0)32 -b(is)e(de\014ned)f(as)i(the)f(empt)m(y)g(string.)609 -4582 y(Example:)40 b([a]^3)32 b(describ)s(es)e(the)g(language)i -Fc(f)p Fe("aaa")p Fc(g)p Fe(.)382 4767 y Fd(A)70 b(B)609 -4880 y Fe(Union)30 b(of)h(the)f(languages)i(or)e(relations)i(A)e(and)g -(B.)609 4992 y(Example:)40 b([a)61 b(b])30 b(describ)s(es)g(the)h -(language)g Fc(f)p Fe(\\a",)i(\\b")p Fc(g)p Fe(.)382 -5177 y Fd(A)i(&)g(B)609 5290 y Fe(In)m(tersection)d(of)e(the)h -(languages)h(A)e(and)g(B.)609 5403 y(Example:)40 b([a)61 -b(b])30 b(&)g([a])i(describ)s(es)d(the)i(language)h Fc(f)p -Fe(\\a")p Fc(g)p Fe(.)1854 5652 y(2)p eop -%%Page: 3 3 -3 2 bop 382 548 a Fd(A)35 b(-)f(B)609 661 y Fe(Min)m(us)e(of)h(the)f -(languages)h(A)g(and)e(B,)i(and)f(has)g(the)g(same)g(meaning)f(as)h([A) -h(&)609 774 y Fc(\030)10 b Fb(B)5 b Fe(])609 887 y(Example:)40 -b([a)61 b(b])30 b(-)h([a])g(describ)s(es)f(the)g(language)i -Fc(f)p Fe(\\b")p Fc(g)p Fe(.)382 1073 y Fc(\030)p Fd(A)609 -1186 y Fe(Describ)s(es)25 b(the)f(complemen)m(t)g(of)g(an)h -(expression,)g(and)f(has)g(the)h(same)e(meaning)609 1299 -y(as)k([?*)g(-)g(A].)g(Note)g(that)h(complemen)m(t)d(is)i(alw)m(a)m(ys) -h(de\014ned)d(o)m(v)m(er)j(an)e(alphab)s(et)g(-)609 1412 -y(the)h(expression)g Fc(\030)10 b Fe([)p Fb(A)p Fe(])27 -b(is)g(only)g(unam)m(biguous)e(with)i(resp)s(ect)g(to)h(an)e(alphab)s -(et.)609 1525 y(Example:)50 b Fc(\030)18 b Fe([)p Fb(a)p -Fe(])35 b(denotes)h(the)f(language)i(that)f(do)s(esn't)f(con)m(tain)h -(the)g(string)609 1638 y(\\a".)k(If)24 b(the)h(alphab)s(et)g(is)f -Fc(f)p Fe(a,b)p Fc(g)p Fe(,)k(then)c Fc(\030)10 b Fe([)p -Fb(a)p Fe(])25 b(denotes)g(the)g(language)h Fc(f)p Fe("",)h("b",)609 -1751 y("aa",)33 b("ba",)e(...)p Fc(g)382 1937 y Fd(A+)609 -2050 y Fe(Rep)s(etition)44 b(\(Kleenes)f(plus\).)77 b(A)42 -b(concatenated)j(with)d(itself)h(an)g(arbitrary)609 2163 -y(n)m(um)m(b)s(er)28 b(of)j(times,)f(including)g(zero)h(times.)609 -2276 y(Example:)40 b([a]+)31 b(denotes)g(the)f(in\014nite)g(language)i -Fc(f)p Fe(\\a","aa","aaa")q(,...)q Fc(g)382 2463 y Fd(A*)609 -2575 y Fe(Kleene's)f(star:)41 b([A+)61 b(0].)609 2688 -y(Example:)40 b([a]*)32 b(denotes)f(the)f(in\014nite)g(language)i -Fc(f)p Fe("","a","aa",...)p Fc(g)382 2875 y Fd($A)609 -2988 y Fe(Con)m(tainmen)m(t.)63 b(The)38 b(set)g(of)g(strings)g(where)f -(A)h(app)s(ear)f(at)i(least)g(once)f(as)g(a)609 3101 -y(substring.)i(Con)m(tainmen)m(t)30 b(is)h(the)f(same)g(thing)g(as)h -([?*)g(A)f(?*])382 3287 y Fd(A)35 b(.x.)47 b(B)609 3400 -y Fe(Cross)30 b(pro)s(duct)f(of)i(the)f(languages)i(A)e(and)g(B.)609 -3513 y(Example:)39 b([[a)56 b(b])27 b(.x.)40 b(c])29 -b(describ)s(es)e(the)h(relations)g Fc(f)p Fe(\("a",)j("c"\),)f(\(\\b",) -f("c"\))p Fc(g)p Fe(.)382 3700 y Fd(A)35 b(.o.)47 b(B)609 -3813 y Fe(Comp)s(osition)30 b(of)g(the)h(relations)g(A)g(and)e(B.)609 -3925 y(Example:)40 b([a:b)61 b(c:)41 b(d])30 b(.o.)42 -b([d:e])31 b(describ)s(es)e(the)i(relation)g Fc(f)p Fe(\("c","e"\))p -Fc(g)p Fe(.)523 4135 y(The)41 b(precedence)i(of)f(the)g(op)s(erators)g -(is)g(as)g(follo)m(ws,)47 b(where)41 b(4)h(is)g(the)g(highest)382 -4248 y(precedence:)382 4433 y Fd(4)k Fc(\030)30 b Fe(^)g(*)h(+)f($)382 -4619 y Fd(3)46 b Fe(Concatenation)382 4806 y Fd(2)76 -b Fe(&)30 b(-)382 4992 y Fd(1)46 b Fe(.x.)41 b(.o.)523 -5177 y(A)31 b(\014le)g(con)m(taining)h(a)f(program)f(m)m(ust)f(end)h -(with)h(*.fst,)g(and)g(an)f(input)g(\014le)h(m)m(ust)382 -5290 y(end)44 b(with)h(*.dat.)86 b(A)45 b(program)f(is)h(a)h -(collection)h(of)f(functions)e(de\014ning)g(regular)382 -5403 y(relations.)39 b(A)22 b(function)h(with)f(zero)h(argumen)m(ts)e -(is)i(called)g(a)g Fd(de\014nition)e Fe(or)h(a)h Fd(macro)p -Fe(.)1854 5652 y(3)p eop -%%Page: 4 4 -4 3 bop 523 548 a Fe(A)31 b(de\014nition,)f(or)g(a)h(macro,)f(can)h -(for)f(example)g(lo)s(ok)h(lik)m(e)h(this:)382 848 y -Fa()45 b(::=)i("1")g(|)h("2")f(|)g("3")g(|)g("4")g(|)h("5")f(|) -1002 961 y("6")g(|)h("7")f(|)g("8")g(|)g("9")g(|)h("0";)382 -1149 y Fe(and)30 b(a)g(function)g(can)h(lo)s(ok)g(lik)m(e)h(this:)382 -1450 y Fa()45 b(::=)i(b)g(a)h(;)523 1637 y -Fe(Note)29 b(that)g(strings)e(are)i(mark)m(ed)e(with)g(quotes,)i(and)f -(v)-5 b(ariables)28 b(ha)m(v)m(e)h(no)f(quotes.)523 1750 -y(Ev)m(ery)42 b(program)e(m)m(ust)g(con)m(tain)j(a)e(main)g -(de\014nition)g(\(a)h(program)e(without)h(a)382 1863 -y(main)29 b(de\014nition)h(will)h(result)f(in)g(a)h(parse)f(error\).) -382 2164 y Fa(
)46 b(::=)h(...)g(;)523 2351 y Fe(The)26 -b(alphab)s(et)h(of)g(a)h(program)d(is)i(the)g(sym)m(b)s(ols)f(in)g(the) -i(regular)f(relation)h(de\014ned)382 2464 y(in)i(the)h(program.)382 -2751 y Ff(1.4)135 b(Example)46 b(program)382 2953 y Fe(The)20 -b(example)g(w)m(as)g(found)f(at)i(h)m(ttp://www.xrce.xero)m -(x.com/researc)m(h/mltt/fst/fsexamples.h)m(tml.)382 3066 -y(The)38 b(program)f(sim)m(ulates)i(a)f(so)s(da)h(mac)m(hine)f(and)g -(tak)m(es)h(a)g(collection)i(of)e(sym)m(b)s(ols)382 3179 -y(that)32 b(sym)m(b)s(olises)e(di\013eren)m(t)i(coins.)43 -b(If)31 b(the)h(amoun)m(t)e(of)i(money)e(applied)h(to)h(the)f(ma-)382 -3292 y(c)m(hine)26 b(corresp)s(onds)e(to)j(65)f(cen)m(t,)i(then)d(the)h -(mac)m(hine)f(pro)s(duces)g(a)h(PLONK)f(\(enough)382 -3405 y(money)k(has)h(b)s(een)g(put)g(in)m(to)h(the)g(mac)m(hine)f(to)h -(get)g(a)g(so)s(da\).)382 3618 y Fa()93 b(::=)47 -b(["n")g(.x.)g("c"^5];)382 3731 y()189 b(::=)47 -b(["d")g(.x.)g("c"^10];)382 3843 y()e(::=)i(["q")g(.x.)g -("c"^25];)382 3956 y()189 b(::=)47 b(["c")g(.x.)g("c"];)382 -4069 y()141 b(::=)47 b([)h()d(|)j()e(|)h -()e(|)j(]*;)382 4182 y()141 b(::=)47 -b(["c"^65)f(.x.)h("PLONK"];)382 4295 y(
)189 b(::=)47 -b([)h()d(.o.)i()f(];)382 4582 y Ff(1.5)135 -b(Running)45 b(FstStudio)382 4784 y Fe(fstStudio)30 b(can)g(b)s(e)g -(run)f(in)h(t)m(w)m(o)i(mo)s(des,)d(batc)m(h)i(mo)s(de)e(and)h(in)m -(teractiv)m(e)j(mo)s(de.)382 5071 y Ff(1.6)135 b(Batc)l(h)45 -b(mo)t(de)382 5274 y Fd(fst)609 5387 y Fe(Starts)31 b(fstStudio)e(in)i -(in)m(teractiv)m(e)i(mo)s(de.)39 b(See)31 b(b)s(elo)m(w.)1854 -5652 y(4)p eop -%%Page: 5 5 -5 4 bop 417 548 a Fd(fst)34 b(FILE)g([Options)45 b Fe(])609 -661 y(Run)24 b(fstStudio)g(in)g(batc)m(h)h(mo)s(de.)38 -b(FILE)24 b(m)m(ust)f(end)h(with)h(*.fst,)h(whic)m(h)f(de\014nes)609 -774 y(a)38 b(FstStudio)f(program,)i(or)e(*.net,)j(whic)m(h)d(de\014nes) -g(a)h(sa)m(v)m(ed)g(transducer.)61 b(If)609 887 y(no)27 -b(options)g(is)g(giv)m(en,)h(then)f(input)f(is)h(tak)m(en)g(from)f -(standard)g(input,)h(the)f(tran-)609 1000 y(ducer)f(is)h(applied)f(do)m -(wn,)i(and)e(the)h(output,)g(if)g(an)m(y)-8 b(,)27 b(is)f(pro)s(duced)e -(on)h(standard)609 1112 y(output.)p 523 1233 1549 4 v -523 1250 V 521 1363 4 113 v 538 1363 V 589 1329 a Fd(Options)p -996 1363 V 99 w(Meaning)p 2053 1363 V 2070 1363 V 523 -1366 1549 4 v 521 1479 4 113 v 538 1479 V 589 1445 a -Fe(-u)p 996 1479 V 377 w(apply)30 b(the)h(transducer)e(up)p -2053 1479 V 2070 1479 V 521 1592 V 538 1592 V 589 1558 -a(-d)p 996 1592 V 377 w(apply)h(the)h(transducer)e(up)p -2053 1592 V 2070 1592 V 521 1705 V 538 1705 V 589 1671 -a(-i)i(FILE)p 996 1705 V 161 w(tak)m(e)h(input)d(from)g(FILE)p -2053 1705 V 2070 1705 V 521 1818 V 538 1818 V 589 1784 -a(-o)j(FILE)p 996 1818 V 140 w(write)f(output)f(to)h(FILE)p -2053 1818 V 2070 1818 V 523 1821 1549 4 v 523 1838 V -382 2065 a Ff(1.7)135 b(In)l(teractiv)l(e)47 b(mo)t(de)382 -2268 y Fe(In)m(teractiv)m(e)33 b(mo)s(de)c(is)h(en)m(tered)h(b)m(y)f(t) -m(yping)h(the)g(follo)m(wing)h(command:)382 2585 y Fa($)47 -b(fstStudio)f()382 2811 y(************************)o(****)o -(***)o(****)o(****)o(***)o(****)o(****)o(***)382 2924 -y(*)h(Welcome)f(to)h(Finite)f(State)h(Transducer)e(Studio!)380 -b(*)382 3036 y(*)47 b(Written)f(purely)g(in)h(Haskell.)1144 -b(*)382 3149 y(*)47 b(Version)f(:)i(0.9)1765 b(*)382 -3262 y(*)47 b(Date)190 b(:)48 b(11)f(August)f(2001)1240 -b(*)382 3375 y(*)47 b(Author)94 b(:)48 b(Markus)e(Forsberg)1191 -b(*)382 3488 y(*)47 b(Please)f(send)h(bug)g(reports/suggestions)c(to:) -524 b(*)382 3601 y(*)47 b(d97forma@dtek.chalmers.se)1187 -b(*)382 3714 y(************************)o(****)o(***)o(****)o(****)o -(***)o(****)o(****)o(***)382 3940 y(Type)47 b('h')f(for)h(help.)382 -4166 y(>)382 4564 y Ff(1.8)135 b(List)46 b(of)f(commands)382 -4767 y Fd(r)35 b(REG)609 4879 y Fe(Read)g(a)h(regular)f(relation)h -(from)d(standard)h(input.)54 b(If)34 b(a)i(regular)f(expression)609 -4992 y(is)c(t)m(yp)s(ed,)f(then)g(it)h(is)f(in)m(terpreted)h(as)g(the)f -(iden)m(tit)m(y)i(relation.)382 5177 y Fd(b)609 5290 -y Fe(Build)20 b(a)h(epsilonfree,)i(deterministic,)f(minimal)d -(transducer)g(from)g(a)i(loaded/t)m(yp)s(ed)609 5403 -y(regular)31 b(relation.)1854 5652 y(5)p eop -%%Page: 6 6 -6 5 bop 382 548 a Fd(bn)609 661 y Fe(Build)47 b(a)g(epsilonfree,)k(p)s -(ossibly)46 b(non-deterministic,)k(non-minimal)45 b(trans-)609 -774 y(ducer)30 b(from)f(a)i(load/t)m(yp)s(ed)g(regular)f(relation.)382 -961 y Fd(m)609 1074 y Fe(Minimize)h(a)f(built)h(transducer.)382 -1262 y Fd(det)609 1375 y Fe(Determinize)g(a)g(built)f(transducer)382 -1562 y Fd(s)35 b(FILE)609 1675 y Fe(Sa)m(v)m(e)k(to)e(FILE.)h(If)e -(FILE)h(ends)f(with)h(*.net,)j(then)d(the)g(built)g(transducer)g(is)609 -1788 y(sa)m(v)m(ed.)55 b(An)m(y)34 b(other)h(su\016x,)g(sa)m(v)m(es)h -(the)f(pro)s(duced)e(output)h(in)g(the)h(system)f(to)609 -1901 y(FILE,)d(if)f(an)m(y)-8 b(.)382 2089 y Fd(l)34 -b(FILE)609 2202 y Fe(Load)i(from)e(FILE.)h(FILE)h(m)m(ust)e(end)h(with) -g(*.fst,)j(*.net)e(or)g(*.dat.)57 b(If)35 b(FILE)609 -2315 y(ends)28 b(with)g(*.fst,)h(then)f(a)h(FstStudio)f(program)f(is)h -(loaded)h(in)m(to)g(FstStudio.)40 b(If)609 2428 y(FILE)33 -b(ends)g(with)g(*.net,)j(then)d(a)h(transducer)f(is)g(loaded)h(in)m(to) -h(FstStudio.)50 b(If)609 2540 y(FILE)30 b(ends)g(with)g(*.dat,)i(then)e -(input)f(is)h(loaded)h(in)m(to)h(FstStudio.)382 2728 -y Fd(l)i(ab)609 2841 y Fe(Load)c(and)e(union)g(t)m(w)m(o)j -(transducers.)39 b(a)30 b(and)e(b)h(m)m(ust)f(either)i(b)s(e)e(a)i -(\014le)f(ending)609 2954 y(with)22 b(*.net)h(or)g(the)f(sym)m(b)s(ol)f -(*,)k(whic)m(h)d(refers)f(to)i(the)g(in)m(terior)g(transducer.)37 -b(The)609 3067 y(pro)s(duced)29 b(transducer)g(is)i(p)s(ossibly)e -(non-deterministic)h(and)g(non-minimal.)382 3254 y Fd(l)k(a)g(b)609 -3367 y Fe(Load)44 b(and)g(concatenate)i(t)m(w)m(o)g(transducers.)80 -b(a)45 b(and)e(b)h(m)m(ust)e(either)j(b)s(e)e(a)609 3480 -y(\014le)f(ending)g(with)g(*.net)h(or)f(the)g(sym)m(b)s(ol)f(*,)k(whic) -m(h)d(refers)g(to)h(the)f(in)m(terior)609 3593 y(transducer.)81 -b(The)43 b(pro)s(duced)f(transducer)h(is)h(p)s(ossibly)f -(non-deterministic)609 3706 y(and)30 b(non-minimal.)382 -3894 y Fd(l)k(a)g(*)609 4007 y Fe(Load)41 b(and)g(apply)f(Kleene's)i -(star)f(on)g(a)g(transducer.)72 b(a)42 b(m)m(ust)d(either)j(b)s(e)e(a) -609 4120 y(\014le)i(ending)g(with)g(*.net)h(or)f(the)g(sym)m(b)s(ol)f -(*,)k(whic)m(h)d(refers)g(to)h(the)f(in)m(terior)609 -4232 y(transducer.)81 b(The)43 b(pro)s(duced)f(transducer)h(is)h(p)s -(ossibly)f(non-deterministic)609 4345 y(and)30 b(non-minimal.)382 -4533 y Fd(l)k(a)g(.o.)47 b(b)609 4646 y Fe(Load)42 b(and)g(comp)s(ose)f -(t)m(w)m(o)j(transducers.)75 b(a)42 b(and)g(b)f(m)m(ust)g(either)i(b)s -(e)e(a)i(\014le)609 4759 y(ending)32 b(with)g(*.net)i(or)e(the)h(sym)m -(b)s(ol)e(*,)j(whic)m(h)e(refers)g(to)i(the)e(in)m(terior)i(trans-)609 -4872 y(ducer.)85 b(The)45 b(pro)s(duced)e(transducer)i(is)g(p)s -(ossibly)f(non-deterministic)h(and)609 4985 y(non-minimal.)382 -5172 y Fd(vt)609 5285 y Fe(View)31 b(loaded/built)g(transducer.)1854 -5652 y(6)p eop -%%Page: 7 7 -7 6 bop 382 548 a Fd(vr)609 661 y Fe(View)31 b(loaded/t)m(yp)s(ed)g -(regular)g(relation.)382 847 y Fd(vi)609 960 y Fe(View)g(loaded)g -(input.)382 1146 y Fd(v)m(o)609 1259 y Fe(View)g(pro)s(duced)e(output.) -382 1445 y Fd(d)609 1558 y Fe(Apply)h(transducer)f(do)m(wn)h(with)g -(loaded)h(input.)382 1744 y Fd(u)609 1857 y Fe(Apply)f(transducer)f(up) -h(with)g(loaded)h(input.)382 2043 y Fd(d)k(SYMBOLS)609 -2156 y Fe(Apply)30 b(tranducer)g(do)m(wn)f(with)i(SYMBOLS.)382 -2342 y Fd(u)k(SYMBOLS)609 2455 y Fe(Apply)30 b(transducer)f(up)h(with)g -(SYMBOLS.)382 2641 y Fd(c)609 2754 y Fe(Clear)h(memory)-8 -b(.)382 2940 y Fd(h)609 3053 y Fe(List)31 b(commands.)382 -3239 y Fd(q)609 3352 y Fe(End)e(session.)382 3637 y Ff(1.9)135 -b(Example)46 b(on)f(FstStudio)g(in)g(in)l(teractiv)l(e)i(mo)t(de)382 -3840 y Fe(First,)39 b(sa)m(v)m(e)g(example)e(program)e(ab)s(o)m(v)m(e)k -(to)e(the)h(\014le)f('drink.fst'.)60 b(Then)36 b(start)i(Fst-)382 -3953 y(Studio)30 b(in)g(in)m(teractiv)m(e)j(mo)s(de.)382 -4161 y Fa(>l)47 b(drink.fst)382 4387 y(Loaded)f(a)h(regular)f(relation) -g(from)g(drink.fst.)382 4613 y(>b)382 4839 y(Built)g(a)i -(deterministic,)c(minimal)h(transducer)g(with)i(26)g(states)f(and)h(46) -g(transitions.)382 5064 y(>u)g(PLONK)382 5290 y(Input)f(accepted.)g -(Type)g('vo')h(to)g(view)g(outputs.)1854 5652 y Fe(7)p -eop -%%Page: 8 8 -8 7 bop 382 548 a Fa(>vo)382 774 y(...)382 887 y(q)47 -b(n)h(n)f(d)h(d)f(d)382 1000 y(q)g(n)h(n)f(d)h(d)f(n)h(n)382 -1112 y(q)f(n)h(n)f(d)h(n)f(n)h(d)382 1225 y(q)f(n)h(n)f(d)h(n)f(n)h(n)f -(n)382 1338 y(q)g(n)h(n)f(d)h(n)f(d)h(n)382 1451 y(q)f(d)h(n)f(q)382 -1564 y(q)g(d)h(n)f(n)h(d)f(d)382 1677 y(q)g(d)h(n)f(n)h(d)f(n)h(n)382 -1790 y(q)f(d)h(n)f(n)h(n)f(n)h(d)382 1903 y(q)f(d)h(n)f(n)h(n)f(n)h(n)f -(n)382 2016 y(q)g(d)h(n)f(n)h(n)f(d)h(n)382 2129 y(q)f(d)h(n)f(d)h(n)f -(d)382 2242 y(q)g(d)h(n)f(d)h(n)f(n)h(n)382 2355 y(q)f(d)h(n)f(d)h(d)f -(n)382 2467 y(q)g(d)h(q)f(n)382 2580 y(q)g(d)h(d)f(d)h(d)382 -2693 y(q)f(d)h(d)f(d)h(n)f(n)382 2806 y(q)g(d)h(d)f(n)h(n)f(d)382 -2919 y(q)g(d)h(d)f(n)h(n)f(n)h(n)382 3032 y(...)382 3258 -y(>s)f(drink.out)382 3484 y(Saved)f(outputs)g(to)h(file)g(drink.out.) -382 3709 y(>q)382 3935 y(Do)g(you)g(really)f(want)h(to)g(quit?)f -(\(y\):y)382 4161 y(Session)g(ended.)523 4374 y Fe(In)36 -b('drink.out')g(w)m(e)h(no)m(w)f(ha)m(v)m(e)i(all)f(p)s(ossible)f(w)m -(a)m(ys)i(to)f(feed)f(the)h(so)s(da)f(mac)m(hine)382 -4487 y(with)d(coins,)i(with)f(regard)f(to)i(order,)f(in)f(suc)m(h)g(a)h -(w)m(a)m(y)h(that)f(w)m(e)g(get)h(a)f(so)s(da.)50 b(There)382 -4599 y(are)31 b(634)g(di\013eren)m(t)g(w)m(a)m(ys.)1854 -5652 y(8)p eop -%%Trailer -end -userdict /end-hook known{end-hook}if -%%EOF diff --git a/fst.cabal b/fst.cabal --- a/fst.cabal +++ b/fst.cabal @@ -1,33 +1,95 @@ -name: fst -version: 0.9.0.1 -synopsis: Finite state transducers -description: Fst is an application for construction and running of - finite state transducers. The application was written - purely in Haskell, and is intended to be a tool for the - Haskell programmer, especially for ones that develop language applications. -category: Compilers/Interpreters -license: BSD3 -license-file: LICENSE -author: Markus Forsberg -homepage: http://www.cse.chalmers.se/alumni/markus/fstStudio/ -build-type: Simple -Cabal-Version: >= 1.2 -tested-with: GHC==6.8.2 +name: fst +version: 0.10.0.0 +synopsis: Finite state transducers +description: + Fst is an application for construction and running of finite state + transducers, as based on the concepts of transducers and regular + relations developed by Xerox. The syntax of Xerox's fst program has + functioned as an inspiration for the syntax of fstStudio. + . + The application was written purely in Haskell, and is intended to be + a tool for the Haskell programmer, especially for ones that develop + language applications. + . + This package provides an interactive shell for parsing transducers + specified in a specialized FST language. See "FST.FSTStudio". + . + This package also provides a programmer's interface for building and + applying transducers. See "FST.TransducerInterface". +category: Compilers/Interpreters +license: BSD3 +license-file: LICENSE +author: Markus Forsberg +maintainer: Baldur Blöndal, John J. Camilleri +homepage: http://www.cse.chalmers.se/alumni/markus/fstStudio/ +bug-reports: https://github.com/johnjcamilleri/fst/issues +build-type: Simple +cabal-version: >= 1.8 -data-files: doc/fstMan0.9.ps, doc/Interface0.9.ps +extra-source-files: + tests/drink.fst + tests/drink.hs + tests/email.fst + tests/email.hs -Library - Build-Depends: base>=3 && <5, array - exposed-modules: FST.Alex, FST.Arguments, FST.Automaton, FST.AutomatonInterface, FST.AutomatonTypes, - FST.Complete, FST.Deterministic, FST.DeterministicT, FST.EpsilonFreeT, FST.FileImport, - FST.GetOpt, FST.Info, FST.LBFA, FST.LBFT, FST.Lexer, FST.MinimalBrzozowski, FST.MinimalTBrzozowski, - FST.NReg, FST.Parse, FST.RegTypes, FST.Reversal, FST.ReversalT, FST.RRegTypes, FST.RunTransducer, - FST.StateMonad, FST.Transducer, FST.TransducerInterface, FST.TransducerTypes, FST.Utils - ghc-options: -O2 - ghc-prof-options: -prof -auto-all +source-repository head + type: git + location: git://github.com/johnjcamilleri/fst.git -Executable fst - main-is: FST/Main.hs - ghc-options: -O2 - ghc-prof-options: -prof -auto-all +source-repository this + type: git + location: git://github.com/johnjcamilleri/fst.git + tag: v0.10.0.0 +library + build-depends: + base>=4 && <5, + array, + mtl + exposed-modules: + FST.Automaton + FST.AutomatonInterface + FST.AutomatonTypes + FST.Complete + FST.Deterministic + FST.DeterministicT + FST.EpsilonFreeT + FST.LBFA + FST.LBFT + FST.NReg + FST.RegTypes + FST.Reversal + FST.ReversalT + FST.RRegTypes + FST.RunTransducer + FST.Transducer + FST.TransducerInterface + FST.TransducerTypes + FST.FSTStudio + other-modules: + FST.Alex + FST.Arguments + FST.Info + FST.Lexer + FST.Parse + FST.Utils + ghc-prof-options: -prof -auto-all + +executable fststudio + main-is: Main.hs + ghc-prof-options: -prof -auto-all + build-depends: + base, + array, + mtl, + transformers, + haskeline + +test-suite test-fst + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: properties.hs + build-depends: + base, + fst, + QuickCheck diff --git a/tests/drink.fst b/tests/drink.fst new file mode 100644 --- /dev/null +++ b/tests/drink.fst @@ -0,0 +1,7 @@ + ::= ["n" .x. "c"^5]; + ::= ["d" .x. "c"^10]; + ::= ["q" .x. "c"^25]; + ::= ["c" .x. "c"]; + ::= [ | | | ]*; + ::= ["c"^65 .x. "PLONK"]; +
::= [ .o. ]; diff --git a/tests/drink.hs b/tests/drink.hs new file mode 100644 --- /dev/null +++ b/tests/drink.hs @@ -0,0 +1,47 @@ +-- | Haskell version of drinks example + +import FST.TransducerInterface +import Data.Maybe (fromJust) + +{- + ::= ["n" .x. "c"^5]; + ::= ["d" .x. "c"^10]; + ::= ["q" .x. "c"^25]; + ::= ["c" .x. "c"]; + ::= [ | | | ]*; + ::= ["c"^65 .x. "PLONK"]; +
::= [ .o. ]; +-} + +-- | Emulation of ^ operator +times :: Int -> String -> Reg String +times n str = foldl (\a b -> a |> s b) (s (head ss)) (tail ss) + where ss = replicate n str + +nickel = s "n" <*> (times 5 "c") +dime = s "d" <*> (times 10 "c") +quarter = s "q" <*> (times 25 "c") +cent = s "c" <*> s "c" +money = star (nickel <|> dime <|> quarter <|> cent) +drink = (times 65 "c") <*> s "PLONK" +main' = money <.> drink + +main :: IO () +main = do + let trans = compile main' [] + putStrLn $ unwords $ concat $ fromJust $ applyUp trans ["PLONK"] + +-- | Parsed version of drinks transducer +parsed :: RReg String +parsed = case either of + Right r -> r + where + either = parseProgram $ unlines [ + " ::= [\"n\" .x. \"c\"^5];", + " ::= [\"d\" .x. \"c\"^10];", + " ::= [\"q\" .x. \"c\"^25];", + " ::= [\"c\" .x. \"c\"];", + " ::= [ | | | ]*;", + " ::= [\"c\"^65 .x. \"PLONK\"];", + "
::= [ .o. ];" + ] diff --git a/tests/email.fst b/tests/email.fst new file mode 100644 --- /dev/null +++ b/tests/email.fst @@ -0,0 +1,51 @@ +# Recogniser for email addresses with some support for known domains + + ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" ; + ::= "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" ; + ::= "a" | "b" | "c" | "d" | "e" | "f" | "g" | "h" | "i" | "j" | "k" | "l" | "m" | "n" | "o" | "p" | "q" | "r" | "s" | "t" | "u" | "v" | "w" | "x" | "y" | "z" ; + ::= "!" | "#" | "$" | "%" | "&" | "'" | "*" | "+" | "-" | "/" | "=" | "?" | "^" | "_" | "{" | "|" | "}" | "~" ; + ::= "-" ; + +# Local part + ::= | | ; +# Should be limited to 64 chars, but this is impossible to compile: +# ::= [+] - [^65 *] ; + ::= + ; + +# IP address + ::= + + | [ ] + | ["1" ^2] + | ["2" ["0" | "1" | "2" | "3" | "4"] ] + | ["2" "5" [ - ["6" | "7" | "8" | "9"]]] + ; + ::= [ "."]^3 ; + +# DNS names + ::= [ | | ]+ ; + ::= ; + ::= + [ "."]* + | [(["Student":"student" | "Academic Staff":"staff"] "at":".") "Chalmers University":"chalmers"] + | ["Apple Inc.":"apple"] + | [("Google Mail":"mail" "at":".") "Google":"google"] + ; + +# Some known TLDs + ::= "Sweden":"se" ; + ::= "Malta":"com.mt" ; + ::= "UK":"co.uk" ; + ::= "com" ; + ::= "net" ; + ::= "org" ; + ::= | | | | | ; + +# Either DNS or IP + ::= + [ "@" ["|":"."] ] + | [ "@" ] + ; + +
::= ; + diff --git a/tests/email.hs b/tests/email.hs new file mode 100644 --- /dev/null +++ b/tests/email.hs @@ -0,0 +1,108 @@ +-- | Email address recogniser using transducer interface API + +import FST.TransducerInterface +import Data.Maybe (fromJust) + +charsToUnion :: [Char] -> Reg String +charsToUnion cs = foldl (\a b -> a <|> s [b]) (s [head cs]) (tail cs) + +digit :: Reg String +digit = charsToUnion ['0'..'9'] + +digit1 :: Reg String +digit1 = charsToUnion ['1'..'9'] + +letter :: Reg String +letter = charsToUnion ['a'..'z'] + +punct :: Reg String +punct = charsToUnion "!#$%&'*+-/=?^_{|}~" + +hyphen :: Reg String +hyphen = s "-" ; + +-- Local part +local :: RReg String +local = idR $ plus local_sym + where local_sym = digit <|> letter <|> punct + +-- Should be limited to 64 chars, but this is impossible to compile: +-- local = idR $ (plus local_sym) <-> over65 +-- where local_sym = digit <|> letter <|> punct +-- over65 = foldl (\a b -> a <|> b) local_sym (replicate 65 local_sym) + +-- IP address +ip_segment :: Reg String +ip_segment = + digit + <|> (digit1 |> digit) + <|> (s "1" |> digit |> digit) + <|> (s "2" |> d0to5 |> digit) + <|> (s "2" |> s "5" |> (digit <-> d6to9)) + where + d0to5 = s "0" <|> s "1" <|> s "2" <|> s "3" <|> s "4" + d6to9 = s "6" <|> s "7" <|> s "8" <|> s "9" + +ip :: RReg String +ip = idR $ ip_segment |> dot |> ip_segment |> dot |> ip_segment |> dot |> ip_segment + where dot = s "." + +-- DNS names +hostname :: Reg String +hostname = plus (digit <|> letter <|> hyphen) + +subdomain :: RReg String +subdomain = idR hostname + +-- | Emulation of optionality (?) +option :: RReg String -> RReg String +option rr = rr <|> idR eps + +domain :: RReg String +domain = + ((star (subdomain |> dot)) |> idR hostname) + <|> option ((student <|> staff) |> dot) |> "Chalmers University" `r` "chalmers" + <|> "Apple Inc." `r` "apple" + <|> option gmail |> ("Google" `r` "google") + where + student = "Student" `r` "student" + staff = "Academic Staff" `r` "staff" + gmail = "Google Mail" `r` "mail" |> dot + dot = "at" `r` "." + +-- Some known TLDs +tld_se = "Sweden" `r` "se" +tld_mt = "Malta" `r` "com.mt" +tld_uk = "UK" `r` "co.uk" +tld_com = idR (s "com") +tld_net = idR (s "net") +tld_org = idR (s "org") +tld = tld_se <|> tld_mt <|> tld_uk <|> tld_com <|> tld_net <|> tld_org + +-- | An email address using either DNS names or IP address +email :: RReg String +email = + local |> at |> domain |> dot |> tld + <|> local |> at |> ip + where + at = idR (s "@") + dot = "|" `r` "." + +-- | Main test function +main :: IO () +main = do + let trans = compile email [] :: Transducer String + tests = map words [test1, test2, test3, test4, test5, test6] + sequence_ $ map (handle . applyUp trans) tests + where + handle :: Maybe [[String]] -> IO () + handle (Just outs) = putStrLn $ unwords $ concat outs + handle Nothing = putStrLn "Input rejected." + +-- Test cases +test1 = "j o h n @ 1 9 2 . 1 6 8 . 0 . 1" +test2 = "j o h n { 8 6 } @ chalmers . se" +test3 = "j - ! @ student . chalmers . se" +test4 = "a b c d @ staff . chalmers . se" +test5 = "# $ % ^ @ mail . google . com.mt" +test6 = "b a l d u r @ apple . co.uk" diff --git a/tests/properties.hs b/tests/properties.hs new file mode 100644 --- /dev/null +++ b/tests/properties.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE ViewPatterns #-} + +import Data.List +import Control.Applicative +import Control.Monad +import Data.Maybe + +import Test.QuickCheck + +import FST.LBFA +import FST.Automaton + +import FST.RegTypes +import FST.RRegTypes (idR) +import FST.TransducerTypes +import FST.TransducerInterface (compile) +import FST.RunTransducer + +instance Arbitrary a => Arbitrary (Reg a) where + arbitrary = oneof [return Empty, + return Epsilon, + return All, + liftM2 (:|:) arbitrary arbitrary, + liftM2 (:.:) arbitrary arbitrary, + liftM2 (:&:) arbitrary arbitrary, + liftM Symbol arbitrary, + liftM Complement arbitrary, + liftM Star arbitrary] + +-- | A datatype that only accepts the empty string. +newtype EmptyString a = EmptyString { unEmpty :: Reg a } deriving Show + +instance Arbitrary a => Arbitrary (EmptyString a) where + arbitrary = + fmap EmptyString $ + oneof [return Epsilon, + liftM Star arbitrary, + liftM2 (:|:) arbitrary (fmap unEmpty arbitrary), + liftM2 (:|:) (fmap unEmpty arbitrary) arbitrary, + liftM2 (:&:) (fmap unEmpty arbitrary) (fmap unEmpty arbitrary), + liftM2 (:.:) (fmap unEmpty arbitrary) (fmap unEmpty arbitrary), + fmap (Complement . Complement) (fmap unEmpty arbitrary)] + +prop_empty :: Eq a => EmptyString a -> Bool +prop_empty (EmptyString xs) = acceptEps xs + +instance Arbitrary a => Arbitrary (Symbol a) where + arbitrary = frequency [(4, S `fmap` arbitrary) + ,(1, return Eps )] + + +newtype Language = Language { unLanguage :: (Reg Char, [String]) } deriving Show + +instance Arbitrary Language where + arbitrary = sized gLanguage + +gLanguage :: Int -> Gen Language +gLanguage 0 = Language `fmap` oneof + -- Return empty language ε + [return (Epsilon, [""]), + + -- Return one of two symbols: a or b + elements "ab" >>= \ch -> return (Symbol ch, [[ch]])] +gLanguage n = Language `fmap` oneof + -- Generate A* ≅ {ε, A, A} out of arbitrary A + [do (reg, lang) <- fmap unLanguage subGen + let matches = concat [[""], lang, (++) <$> lang <*> lang] + return (Star reg, nub matches), + + -- Sequence A B out of arbitrary A and B + do (reg1, lang1) <- fmap unLanguage subGen + (reg2, lang2) <- fmap unLanguage subGen + let matches = (++) <$> lang1 <*> lang2 + return (reg1 :.: reg2, nub matches)] + where subGen :: Gen Language + subGen = gLanguage (n `div` 4) + +-- If a regular expression generates a (sub)language, then compiling it and +-- running it on all strings of that languages should always match. +prop_language (Language (reg, inputs)) = + and [ maybe False (elem input) appliedUp && maybe False (elem input) appliedDown + | input <- inputs + , let appliedUp = applyUp (compile (idR reg) "ab") input + , let appliedDown = applyDown (compile (idR reg) "ab") input ] + +-- | Run the test suite +main :: IO () +main = do + putStrLn "Running tests" + quickCheck (prop_empty :: EmptyString String -> Bool) + quickCheck prop_language +