cleanup

src/compiler/GF/Speech/CFGToFA.hs

@@ -14,7 +14,6 @@ import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 
-import PGF.Internal
 import GF.Data.Utilities
 import GF.Grammar.CFG
 --import GF.Speech.PGFToCFG

src/compiler/GF/Speech/GSL.hs

@@ -8,13 +8,11 @@
 
 module GF.Speech.GSL (gslPrinter) where
 
---import GF.Data.Utilities
 import GF.Grammar.CFG
 import GF.Speech.SRG
 import GF.Speech.RegExp
 import GF.Infra.Option
---import GF.Infra.Ident
-import PGF
+import PGF2
 
 import Data.Char (toUpper,toLower)
 import Data.List (partition)
@@ -23,7 +21,7 @@ import GF.Text.Pretty
 width :: Int
 width = 75
 
-gslPrinter :: Options -> PGF -> CId -> String
+gslPrinter :: Options -> PGF -> Concr -> String
 gslPrinter opts pgf cnc = renderStyle st $ prGSL $ makeNonLeftRecursiveSRG opts pgf cnc
   where st = style { lineLength = width } 
 

src/compiler/GF/Speech/JSGF.hs

@@ -18,7 +18,7 @@ import GF.Grammar.CFG
 import GF.Speech.RegExp
 import GF.Speech.SISR
 import GF.Speech.SRG
-import PGF
+import PGF2
 
 import Data.Char
 import Data.List
@@ -30,8 +30,8 @@ width :: Int
 width = 75
 
 jsgfPrinter :: Options
-	    -> PGF 
-            -> CId -> String
+	        -> PGF 
+            -> Concr -> String
 jsgfPrinter opts pgf cnc = renderStyle st $ prJSGF sisr $ makeNonLeftRecursiveSRG opts pgf cnc
   where st = style { lineLength = width }
         sisr = flag optSISR opts

src/compiler/GF/Speech/PrRegExp.hs

@@ -11,12 +11,12 @@ import GF.Grammar.CFG
 import GF.Speech.CFGToFA
 import GF.Speech.PGFToCFG
 import GF.Speech.RegExp
-import PGF
+import PGF2
 
-regexpPrinter :: PGF -> CId -> String
+regexpPrinter :: PGF -> Concr -> String
 regexpPrinter pgf cnc = (++"\n") $ prRE id $ dfa2re $ cfgToFA $ pgfToCFG pgf cnc
 
-multiRegexpPrinter :: PGF -> CId -> String
+multiRegexpPrinter :: PGF -> Concr -> String
 multiRegexpPrinter pgf cnc = prREs $ mfa2res $ cfgToMFA $ pgfToCFG pgf cnc
 
 prREs :: [(String,RE CFSymbol)] -> String

src/compiler/GF/Speech/SISR.hs

@@ -10,13 +10,9 @@ module GF.Speech.SISR (SISRFormat(..), SISRTag, prSISR,
 
 import Data.List
 
---import GF.Data.Utilities
---import GF.Infra.Ident
 import GF.Infra.Option (SISRFormat(..))
 import GF.Grammar.CFG
 import GF.Speech.SRG (SRGNT)
-import PGF(showCId)
-
 import qualified GF.JavaScript.AbsJS   as JS
 import qualified GF.JavaScript.PrintJS as JS
 
@@ -50,12 +46,12 @@ catSISR t (c,i) fmt
 profileFinalSISR :: CFTerm -> SISRFormat -> SISRTag
 profileFinalSISR term fmt = [JS.DExpr $ fmtOut fmt `ass` f term]
   where 
-        f (CFObj n ts) = tree (showCId n) (map f ts)
+        f (CFObj n ts) = tree n (map f ts)
         f (CFAbs v x) = JS.EFun [var v] [JS.SReturn (f x)]
         f (CFApp x y) = JS.ECall (f x) [f y]
         f (CFRes i) = JS.EIndex (JS.EVar args) (JS.EInt (fromIntegral i))
         f (CFVar v) = JS.EVar (var v)
-        f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr (showCId typ))]
+        f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr typ)]
 
 fmtOut SISR_WD20030401 = JS.EVar (JS.Ident "$")
 fmtOut SISR_1_0 = JS.EVar (JS.Ident "out")

src/compiler/GF/Speech/SLF.hs

@@ -16,17 +16,14 @@ module GF.Speech.SLF (slfPrinter,slfGraphvizPrinter,
 import GF.Data.Utilities
 import GF.Grammar.CFG
 import GF.Speech.FiniteState
---import GF.Speech.CFG
 import GF.Speech.CFGToFA
 import GF.Speech.PGFToCFG
 import qualified GF.Data.Graphviz as Dot
-import PGF
---import PGF.CId
+import PGF2
 
 import Control.Monad
 import qualified Control.Monad.State as STM
 import Data.Char (toUpper)
---import Data.List
 import Data.Maybe
 
 data SLFs = SLFs [(String,SLF)] SLF
@@ -43,7 +40,7 @@ data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }
 
 type SLF_FA = FA State (Maybe CFSymbol) ()
 
-mkFAs :: PGF -> CId -> (SLF_FA, [(String,SLF_FA)])
+mkFAs :: PGF -> Concr -> (SLF_FA, [(String,SLF_FA)])
 mkFAs pgf cnc = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
   where MFA start subs = {- renameSubs $ -} cfgToMFA $ pgfToCFG pgf cnc
         main = let (fa,s,f) = newFA_ in newTransition s f (NonTerminal start) fa
@@ -64,7 +61,7 @@ renameSubs (MFA start subs) = MFA (newName start) subs'
 -- * SLF graphviz printing (without sub-networks)
 --
 
-slfGraphvizPrinter :: PGF -> CId -> String
+slfGraphvizPrinter :: PGF -> Concr -> String
 slfGraphvizPrinter pgf cnc
     = prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc
   where 
@@ -74,7 +71,7 @@ slfGraphvizPrinter pgf cnc
 -- * SLF graphviz printing (with sub-networks)
 --
 
-slfSubGraphvizPrinter :: PGF -> CId -> String
+slfSubGraphvizPrinter :: PGF -> Concr -> String
 slfSubGraphvizPrinter pgf cnc = Dot.prGraphviz g
   where (main, subs) = mkFAs pgf cnc
         g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..] 
@@ -100,7 +97,7 @@ gvSLFFA n fa =
 -- * SLF printing (without sub-networks)
 --
 
-slfPrinter :: PGF -> CId -> String
+slfPrinter :: PGF -> Concr -> String
 slfPrinter pgf cnc
     = prSLF $ automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc
 
@@ -109,7 +106,7 @@ slfPrinter pgf cnc
 --
 
 -- | Make a network with subnetworks in SLF
-slfSubPrinter :: PGF -> CId -> String
+slfSubPrinter :: PGF -> Concr -> String
 slfSubPrinter pgf cnc = prSLFs slfs
   where 
   (main,subs) = mkFAs pgf cnc

src/compiler/GF/Speech/SRG.hs

@@ -17,21 +17,15 @@ module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol
                      , lookupFM_
                      ) where
 
---import GF.Data.Operations
+import PGF2
 import GF.Data.Utilities
---import GF.Infra.Ident
 import GF.Infra.Option
 import GF.Grammar.CFG
 import GF.Speech.PGFToCFG
---import GF.Data.Relation
---import GF.Speech.FiniteState
 import GF.Speech.RegExp
 import GF.Speech.CFGToFA
---import GF.Infra.Option
-import PGF
 
 import Data.List
---import Data.Maybe (fromMaybe, maybeToList)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
@@ -62,16 +56,16 @@ type SRGSymbol = Symbol SRGNT Token
 -- | An SRG non-terminal. Category name and its number in the profile.
 type SRGNT = (Cat, Int)
 
-ebnfPrinter :: Options -> PGF -> CId -> String
+ebnfPrinter :: Options -> PGF -> Concr -> String
 ebnfPrinter opts pgf cnc = prSRG opts $ makeSRG opts pgf cnc
 
 -- | Create a compact filtered non-left-recursive SRG. 
-makeNonLeftRecursiveSRG :: Options -> PGF -> CId -> SRG
+makeNonLeftRecursiveSRG :: Options -> PGF -> Concr -> SRG
 makeNonLeftRecursiveSRG opts = makeSRG opts'
     where
       opts' = setDefaultCFGTransform opts CFGNoLR True
 
-makeSRG :: Options -> PGF -> CId -> SRG
+makeSRG :: Options -> PGF -> Concr -> SRG
 makeSRG opts = mkSRG cfgToSRG preprocess
     where
       cfgToSRG cfg = [cfRulesToSRGRule rs | (_,rs) <- allRulesGrouped cfg]
@@ -97,7 +91,7 @@ stats g = "Categories: " ++ show (countCats g)
 -}
 makeNonRecursiveSRG :: Options 
                     -> PGF
-                    -> CId -- ^ Concrete syntax name.
+                    -> Concr
                     -> SRG
 makeNonRecursiveSRG opts = mkSRG cfgToSRG id
     where
@@ -105,17 +99,17 @@ makeNonRecursiveSRG opts = mkSRG cfgToSRG id
           where
             MFA _ dfas = cfgToMFA cfg
             dfaToSRGItem = mapRE dummySRGNT . minimizeRE . dfa2re
-            dummyCFTerm = CFMeta (mkCId "dummy")
+            dummyCFTerm = CFMeta "dummy"
             dummySRGNT = mapSymbol (\c -> (c,0)) id
 
-mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> CId -> SRG
+mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> Concr -> SRG
 mkSRG mkRules preprocess pgf cnc =
-    SRG { srgName = showCId cnc,
-	  srgStartCat = cfgStartCat cfg,
+    SRG { srgName = concreteName cnc,
+	      srgStartCat = cfgStartCat cfg,
           srgExternalCats = cfgExternalCats cfg,
-          srgLanguage = languageCode pgf cnc,
+          srgLanguage = languageCode cnc,
 	  srgRules = mkRules cfg }
-    where cfg = renameCats (showCId cnc) $ preprocess $ pgfToCFG pgf cnc
+    where cfg = renameCats (concreteName cnc) $ preprocess $ pgfToCFG pgf cnc
 
 -- | Renames all external cats C to C_cat, and all internal cats C_X (where X is any string), 
 --   to C_N where N is an integer.

src/compiler/GF/Speech/SRGS_ABNF.hs

@@ -25,23 +25,21 @@ import GF.Grammar.CFG
 import GF.Speech.SISR as SISR
 import GF.Speech.SRG
 import GF.Speech.RegExp
-import PGF (PGF, CId)
+import PGF2 (PGF,Concr)
 
---import Data.Char
 import Data.List
 import Data.Maybe
 import GF.Text.Pretty
---import Debug.Trace
 
 width :: Int
 width = 75
 
 srgsAbnfPrinter :: Options
-	        -> PGF -> CId -> String
+	        -> PGF -> Concr -> String
 srgsAbnfPrinter opts pgf cnc = showDoc $ prABNF sisr $ makeNonLeftRecursiveSRG opts pgf cnc
     where sisr = flag optSISR opts
 
-srgsAbnfNonRecursivePrinter :: Options -> PGF -> CId -> String
+srgsAbnfNonRecursivePrinter :: Options -> PGF -> Concr -> String
 srgsAbnfNonRecursivePrinter opts pgf cnc = showDoc $ prABNF Nothing $ makeNonRecursiveSRG opts pgf cnc
 
 showDoc = renderStyle (style { lineLength = width })

src/compiler/GF/Speech/SRGS_XML.hs

@@ -13,7 +13,7 @@ import GF.Grammar.CFG
 import GF.Speech.RegExp
 import GF.Speech.SISR as SISR
 import GF.Speech.SRG
-import PGF (PGF, CId, Token)
+import PGF2 (PGF, Concr)
 
 --import Control.Monad
 --import Data.Char (toUpper,toLower)
@@ -22,11 +22,11 @@ import Data.Maybe
 --import qualified Data.Map as Map
 
 srgsXmlPrinter :: Options
-               -> PGF -> CId -> String
+               -> PGF -> Concr -> String
 srgsXmlPrinter opts pgf cnc = prSrgsXml sisr $ makeNonLeftRecursiveSRG opts pgf cnc
     where sisr = flag optSISR opts
 
-srgsXmlNonRecursivePrinter :: Options -> PGF -> CId -> String
+srgsXmlNonRecursivePrinter :: Options -> PGF -> Concr -> String
 srgsXmlNonRecursivePrinter opts pgf cnc = prSrgsXml Nothing $ makeNonRecursiveSRG opts pgf cnc
 
 

src/compiler/GF/Speech/VoiceXML.hs

@@ -6,14 +6,8 @@
 -----------------------------------------------------------------------------
 module GF.Speech.VoiceXML (grammar2vxml) where
 
---import GF.Data.Operations
---import GF.Data.Str (sstrV)
---import GF.Data.Utilities
 import GF.Data.XML
---import GF.Infra.Ident
-import PGF
-
---import Control.Monad (liftM)
+import PGF2
 import Data.List (intersperse) -- isPrefixOf, find
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
@@ -21,19 +15,19 @@ import Data.Maybe (fromMaybe)
 --import Debug.Trace
 
 -- | the main function
-grammar2vxml :: PGF -> CId -> String
-grammar2vxml pgf cnc = showsXMLDoc (skel2vxml name language start skel qs) ""
+grammar2vxml :: PGF -> Concr -> String
+grammar2vxml pgf cnc = showsXMLDoc (skel2vxml name mb_language start skel qs) ""
     where skel = pgfSkeleton pgf
-          name = showCId cnc
-          qs = catQuestions pgf cnc (map fst skel)
-          language = languageCode pgf cnc
+          name = concreteName cnc
+          qs = catQuestions cnc (map fst skel)
+          mb_language = languageCode cnc
           (_,start,_) = unType (startCat pgf)
 
 --
 -- * VSkeleton: a simple description of the abstract syntax.
 --
 
-type Skeleton = [(CId, [(CId, [CId])])]
+type Skeleton = [(Cat, [(Fun, [Cat])])]
 
 pgfSkeleton :: PGF -> Skeleton
 pgfSkeleton pgf = [(c,[(f,[cat | (_,_,ty) <- hypos, let (_,cat,_) = unType ty]) | f <- functionsByCat pgf c, Just (hypos,_,_) <- [fmap unType (functionType pgf f)]])
@@ -43,37 +37,23 @@ pgfSkeleton pgf = [(c,[(f,[cat | (_,_,ty) <- hypos, let (_,cat,_) = unType ty])
 -- * Questions to ask 
 --
 
-type CatQuestions = [(CId,String)]
+type CatQuestions = [(Cat,String)]
 
-catQuestions :: PGF -> CId -> [CId] -> CatQuestions
-catQuestions pgf cnc cats = [(c,catQuestion pgf cnc c) | c <- cats]
+catQuestions :: Concr -> [Cat] -> CatQuestions
+catQuestions cnc cats = [(c,catQuestion cnc c) | c <- cats]
 
-catQuestion :: PGF -> CId -> CId -> String
-catQuestion pgf cnc cat = showPrintName pgf cnc cat
+catQuestion :: Concr -> Cat -> String
+catQuestion cnc cat = fromMaybe cat (printName cnc cat)
 
-
-{-
-lin :: StateGrammar -> String -> Err String
-lin gr fun = do
-             tree <- string2treeErr gr fun
-             let ls = map unt $ linTree2strings noMark g c tree
-             case ls of
-                 [] -> fail $ "No linearization of " ++ fun
-                 l:_ -> return l
-  where c = cncId gr
-        g = stateGrammarST gr
-        unt = formatAsText 
--}
-
-getCatQuestion :: CId -> CatQuestions -> String
+getCatQuestion :: Cat -> CatQuestions -> String
 getCatQuestion c qs = 
-    fromMaybe (error "No question for category " ++ showCId c) (lookup c qs)
+    fromMaybe (error "No question for category " ++ c) (lookup c qs)
 
 --
 -- * Generate VoiceXML
 --
 
-skel2vxml :: String -> Maybe String -> CId -> Skeleton -> CatQuestions -> XML
+skel2vxml :: String -> Maybe String -> Cat -> Skeleton -> CatQuestions -> XML
 skel2vxml name language start skel qs = 
     vxml language ([startForm] ++ concatMap (uncurry (catForms gr qs)) skel)
   where 
@@ -85,12 +65,12 @@ grammarURI :: String -> String
 grammarURI name = name ++ ".grxml"
 
 
-catForms :: String -> CatQuestions -> CId -> [(CId, [CId])] -> [XML]
+catForms :: String -> CatQuestions -> Cat -> [(Fun, [Cat])] -> [XML]
 catForms gr qs cat fs = 
-    comments [showCId cat ++ " category."]
+    comments [cat ++ " category."]
     ++ [cat2form gr qs cat fs] 
 
-cat2form :: String -> CatQuestions -> CId -> [(CId, [CId])] -> XML
+cat2form :: String -> CatQuestions -> Cat -> [(Fun, [Cat])] -> XML
 cat2form gr qs cat fs = 
   form (catFormId cat) $ 
       [var "old" Nothing, 
@@ -103,22 +83,22 @@ cat2form gr qs cat fs =
      ++ concatMap (uncurry (fun2sub gr cat)) fs
      ++ [block [return_ ["term"]{-]-}]]
 
-fun2sub :: String -> CId -> CId -> [CId] -> [XML]
+fun2sub :: String -> Cat -> Fun -> [Cat] -> [XML]
 fun2sub gr cat fun args = 
-    comments [showCId fun ++ " : (" 
-              ++ concat (intersperse ", " (map showCId args))
-              ++ ") " ++ showCId cat] ++ ss
+    comments [fun ++ " : (" 
+              ++ concat (intersperse ", " args)
+              ++ ") " ++ cat] ++ ss
   where 
   ss = zipWith mkSub [0..] args
   mkSub n t = subdialog s [("src","#"++catFormId t),
-                           ("cond","term.name == "++string (showCId fun))] 
+                           ("cond","term.name == "++string  fun)] 
               [param "old" v,
                filled [] [assign v (s++".term")]]
-    where s = showCId fun ++ "_" ++ show n
+    where s = fun ++ "_" ++ show n
           v = "term.args["++show n++"]"
 
-catFormId :: CId -> String
-catFormId c = showCId c ++ "_cat"
+catFormId :: Cat -> String
+catFormId c = c ++ "_cat"
 
 
 --