diff options
| author | bringert <bringert@cs.chalmers.se> | 2006-01-05 17:46:30 +0000 |
|---|---|---|
| committer | bringert <bringert@cs.chalmers.se> | 2006-01-05 17:46:30 +0000 |
| commit | ca84f92302438de357793f2548bf56dc9a5d43b2 (patch) | |
| tree | dde069726a6653623f63f9d7353d1e91a8e0c97d /src/GF/Speech/PrSLF.hs | |
| parent | bffc7df07e2345b19ade6ce2e9718aa3b1bf6a23 (diff) | |
Remove unused sub-networks when generating multiple FAs.
Diffstat (limited to 'src/GF/Speech/PrSLF.hs')
| -rw-r--r-- | src/GF/Speech/PrSLF.hs | 33 |
1 files changed, 24 insertions, 9 deletions
diff --git a/src/GF/Speech/PrSLF.hs b/src/GF/Speech/PrSLF.hs index bb8f5ddaf..e837a0f3a 100644 --- a/src/GF/Speech/PrSLF.hs +++ b/src/GF/Speech/PrSLF.hs @@ -53,10 +53,13 @@ data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int } type SLF_FA = FA State (Maybe (MFALabel String)) () --- | Make a network with subnetworks in SLF -slfPrinter :: Ident -- ^ Grammar name - -> Options -> CGrammar -> String -slfPrinter name opts cfg = prSLFs (mfaToSLFs $ cfgToMFA opts cfg) "" +slfStyleFA :: DFA (MFALabel String) -> SLF_FA +slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing () + . moveLabelsToNodes . dfa2nfa + +-- +-- * SLF graphviz printing +-- slfGraphvizPrinter :: Ident -- ^ Grammar name -> Options -> CGrammar -> String @@ -82,11 +85,23 @@ gvSLFFA n fa = STM.put names' return fa' -mapMFA :: (DFA (MFALabel a) -> b) -> MFA a -> (b,[(String,b)]) -mapMFA f (MFA main subs) = (f main, [(c, f fa) | (c,fa) <- subs]) +-- +-- * SLF printing +-- -slfStyleFA :: DFA (MFALabel String) -> SLF_FA -slfStyleFA = removeTrivialEmptyNodes . oneFinalState Nothing () . moveLabelsToNodes . dfa2nfa +-- | Make a network with subnetworks in SLF +slfPrinter :: Ident -- ^ Grammar name + -> Options -> CGrammar -> String +slfPrinter name opts cfg = prSLFs (mfaToSLFs $ renameSubs $ cfgToMFA opts cfg) "" + +renameSubs :: MFA String -> MFA String +renameSubs (MFA main subs) = MFA (renameLabels main) subs' + where newNames = zip (map fst subs) ["sub"++show n | n <- [0..]] + newName s = lookup' s newNames + subs' = [(newName s,renameLabels n) | (s,n) <- subs] + renameLabels = mapTransitions renameLabel + renameLabel (MFASub x) = MFASub (newName x) + renameLabel l = l mfaToSLFs :: MFA String -> SLFs mfaToSLFs (MFA main subs) @@ -121,7 +136,7 @@ mkSLFEdge :: Int -> (Int,Int) -> SLFEdge mkSLFEdge i (f,t) = SLFEdge { eId = i, eStart = f, eEnd = t } prSLFs :: SLFs -> ShowS -prSLFs (SLFs subs main) = unlinesS (map prSub subs) . prOneSLF main +prSLFs (SLFs subs main) = unlinesS (map prSub subs ++ [prOneSLF main]) where prSub (n,s) = showString "SUBLAT=" . shows n . nl . prOneSLF s . showString "." . nl |