diff --git a/doc/gf-history.html b/doc/gf-history.html
index fef775d3b..8b96959cb 100644
--- a/doc/gf-history.html
+++ b/doc/gf-history.html
@@ -14,6 +14,9 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2
+5/1 (BB) New grammar printers slf_sub and slf_sub_graphviz
+for creating SLF networks with sub-automata.
+
22/12 Release of GF 2.4.
diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs
index 2b5d4ac26..ab5321297 100644
--- a/src/GF/Shell/HelpFile.hs
+++ b/src/GF/Shell/HelpFile.hs
@@ -599,7 +599,9 @@ txtHelpFile =
"\n -printer=srgs_xml SRGS XML format" ++
"\n -printer=srgs_xml_prob SRGS XML format, with weights" ++
"\n -printer=slf a finite automaton in the HTK SLF format" ++
- "\n -printer=slf_graphviz the same automaton as in SLF, but in Graphviz format" ++
+ "\n -printer=slf_graphviz the same automaton as slf, but in Graphviz format" ++
+ "\n -printer=slf_sub a finite automaton with sub-automata in the HTK SLF format" ++
+ "\n -printer=slf_sub_graphviz the same automaton as slf_sub, but in Graphviz format" ++
"\n -printer=fa_graphviz a finite automaton with labelled edges" ++
"\n -printer=regular a regular grammar in a simple BNF" ++
"\n -printer=unpar a gfc grammar with parameters eliminated" ++
diff --git a/src/GF/Speech/PrSLF.hs b/src/GF/Speech/PrSLF.hs
index 159d5b806..897113a03 100644
--- a/src/GF/Speech/PrSLF.hs
+++ b/src/GF/Speech/PrSLF.hs
@@ -18,7 +18,8 @@
-- categories in the grammar
-----------------------------------------------------------------------------
-module GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter) where
+module GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter,
+ slfSubPrinter,slfSubGraphvizPrinter) where
import GF.Data.Utilities
import GF.Conversion.Types
@@ -37,7 +38,7 @@ import Control.Monad
import qualified Control.Monad.State as STM
import Data.Char (toUpper)
import Data.List
-import Data.Maybe (maybe)
+import Data.Maybe
data SLFs = SLFs [(String,SLF)] SLF
@@ -57,7 +58,7 @@ mkFAs :: Options -> CGrammar -> (SLF_FA, [(String,SLF_FA)])
mkFAs opts cfg = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
where MFA main subs = {- renameSubs $ -} cfgToMFA opts cfg
-slfStyleFA :: DFA (MFALabel String) -> SLF_FA
+slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) ()
slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing ()
. moveLabelsToNodes . dfa2nfa
@@ -72,12 +73,22 @@ renameSubs (MFA main subs) = MFA (renameLabels main) subs'
renameLabel l = l
--
--- * SLF graphviz printing
+-- * SLF graphviz printing (without sub-networks)
--
-slfGraphvizPrinter :: Ident -- ^ Grammar name
+slfGraphvizPrinter :: Ident -> Options -> CGrammar -> String
+slfGraphvizPrinter name opts cfg
+ = prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA opts cfg
+ where
+ gvFA = mapStates (fromMaybe "") . mapTransitions (const "")
+
+--
+-- * SLF graphviz printing (with sub-networks)
+--
+
+slfSubGraphvizPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
-slfGraphvizPrinter name opts cfg = Dot.prGraphviz g
+slfSubGraphvizPrinter name opts cfg = Dot.prGraphviz g
where (main, subs) = mkFAs opts cfg
g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..]
ss = mapM (\ (c,f) -> gvSLFFA (Just c) f) subs
@@ -100,20 +111,29 @@ gvSLFFA n fa =
return fa'
--
--- * SLF printing
+-- * SLF printing (without sub-networks)
+--
+
+slfPrinter :: Ident -> Options -> CGrammar -> String
+slfPrinter name opts cfg
+ = prSLF (automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA opts cfg) ""
+
+--
+-- * SLF printing (with sub-networks)
--
-- | Make a network with subnetworks in SLF
-slfPrinter :: Ident -- ^ Grammar name
+slfSubPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
-slfPrinter name opts cfg = prSLFs slfs ""
+slfSubPrinter name opts cfg = prSLFs slfs ""
where
(main,subs) = mkFAs opts cfg
- slfs = SLFs [(c, automatonToSLF fa) | (c,fa) <- subs] (automatonToSLF main)
+ slfs = SLFs [(c, faToSLF fa) | (c,fa) <- subs] (faToSLF main)
+ faToSLF = automatonToSLF mfaNodeToSLFNode
-automatonToSLF :: SLF_FA -> SLF
-automatonToSLF fa = SLF { slfNodes = ns, slfEdges = es }
- where ns = map (uncurry mfaNodeToSLFNode) (states fa)
+automatonToSLF :: (Int -> a -> SLFNode) -> FA State a () -> SLF
+automatonToSLF mkNode fa = SLF { slfNodes = ns, slfEdges = es }
+ where ns = map (uncurry mkNode) (states fa)
es = zipWith (\i (f,t,()) -> mkSLFEdge i (f,t)) [0..] (transitions fa)
mfaNodeToSLFNode :: Int -> Maybe (MFALabel String) -> SLFNode
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index f888c22ab..b65c6d815 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -58,7 +58,7 @@ import GF.CF.CFtoSRG
import GF.Speech.PrGSL (gslPrinter)
import GF.Speech.PrJSGF (jsgfPrinter)
import GF.Speech.PrSRGS (srgsXmlPrinter)
-import GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter)
+import GF.Speech.PrSLF
import GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter)
import GF.Data.Zipper
@@ -259,6 +259,12 @@ customGrammarPrinter =
,(strCI "slf_graphviz", \s -> let opts = stateOptions s
name = cncId s
in slfGraphvizPrinter name opts $ stateCFG s)
+ ,(strCI "slf_sub", \s -> let opts = stateOptions s
+ name = cncId s
+ in slfSubPrinter name opts $ stateCFG s)
+ ,(strCI "slf_sub_graphviz", \s -> let opts = stateOptions s
+ name = cncId s
+ in slfSubGraphvizPrinter name opts $ stateCFG s)
,(strCI "fa_graphviz", \s -> let opts = stateOptions s
name = cncId s
in faGraphvizPrinter name opts $ stateCFG s)
diff --git a/src/HelpFile b/src/HelpFile
index 531f2d9ab..88b5eba7e 100644
--- a/src/HelpFile
+++ b/src/HelpFile
@@ -570,7 +570,9 @@ q, quit: q
-printer=srgs_xml SRGS XML format
-printer=srgs_xml_prob SRGS XML format, with weights
-printer=slf a finite automaton in the HTK SLF format
- -printer=slf_graphviz the same automaton as in SLF, but in Graphviz format
+ -printer=slf_graphviz the same automaton as slf, but in Graphviz format
+ -printer=slf_sub a finite automaton with sub-automata in the HTK SLF format
+ -printer=slf_sub_graphviz the same automaton as slf_sub, but in Graphviz format
-printer=fa_graphviz a finite automaton with labelled edges
-printer=regular a regular grammar in a simple BNF
-printer=unpar a gfc grammar with parameters eliminated