polish the PGF API and make Expr and Type abstract types. Tree is a type synonym of Expr

src/GF/Speech/CFG.hs

@@ -298,12 +298,12 @@ prProductions prods =
 prCFTerm :: CFTerm -> String
 prCFTerm = pr 0
   where
-    pr p (CFObj f args) = paren p (prCId f ++ " (" ++ concat (intersperse "," (map (pr 0) args)) ++ ")")
+    pr p (CFObj f args) = paren p (showCId f ++ " (" ++ concat (intersperse "," (map (pr 0) args)) ++ ")")
     pr p (CFAbs i t) = paren p ("\\x" ++ show i ++ ". " ++ pr 0 t)
     pr p (CFApp t1 t2) = paren p (pr 1 t1 ++ "(" ++ pr 0 t2 ++ ")")
     pr _ (CFRes i) = "$" ++ show i
     pr _ (CFVar i) = "x" ++ show i
-    pr _ (CFMeta c) = "?" ++ prCId c
+    pr _ (CFMeta c) = "?" ++ showCId c
     paren 0 x = x
     paren 1 x = "(" ++ x ++ ")"
 

src/GF/Speech/PGFToCFG.hs

@@ -31,7 +31,7 @@ toBNF f pgf cnc = prCFG $ f $ pgfToCFG pgf cnc
 pgfToCFG :: PGF 
           -> CId   -- ^ Concrete syntax name
           -> CFG
-pgfToCFG pgf lang = mkCFG (prCId (lookStartCat pgf)) extCats (startRules ++ concatMap fruleToCFRule rules)
+pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ concatMap fruleToCFRule rules)
   where
     pinfo = fromMaybe (error "pgfToCFG: No parser.") (lookParser pgf lang)
 
@@ -40,7 +40,7 @@ pgfToCFG pgf lang = mkCFG (prCId (lookStartCat pgf)) extCats (startRules ++ conc
                          , prod <- Set.toList set]
 
     fcatCats :: Map FCat Cat
-    fcatCats = Map.fromList [(fc, prCId c ++ "_" ++ show i) 
+    fcatCats = Map.fromList [(fc, showCId c ++ "_" ++ show i) 
                                  | (c,fcs) <- Map.toList (startCats pinfo), 
                                    (fc,i) <- zip fcs [1..]]
 
@@ -67,7 +67,7 @@ pgfToCFG pgf lang = mkCFG (prCId (lookStartCat pgf)) extCats (startRules ++ conc
     extCats = Set.fromList $ map lhsCat startRules
 
     startRules :: [CFRule]
-    startRules = [CFRule (prCId c) [NonTerminal (fcatToCat fc r)] (CFRes 0) 
+    startRules = [CFRule (showCId c) [NonTerminal (fcatToCat fc r)] (CFRes 0) 
                       | (c,fcs) <- Map.toList (startCats pinfo), 
                         fc <- fcs, not (isLiteralFCat fc),
                         r <- [0..catLinArity fc-1]]

src/GF/Speech/SISR.hs

@@ -50,12 +50,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 (prCId n) (map f ts)
+        f (CFObj n ts) = tree (showCId 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 (prCId typ))]
+        f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr (showCId typ))]
 
 fmtOut SISR_WD20030401 = JS.EVar (JS.Ident "$")
 fmtOut SISR_1_0 = JS.EVar (JS.Ident "out")

src/GF/Speech/SRG.hs

@@ -113,12 +113,12 @@ makeNonRecursiveSRG opts = mkSRG cfgToSRG id
 
 mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> CId -> SRG
 mkSRG mkRules preprocess pgf cnc =
-    SRG { srgName = prCId cnc,
+    SRG { srgName = showCId cnc,
 	  srgStartCat = cfgStartCat cfg,
           srgExternalCats = cfgExternalCats cfg,
           srgLanguage = getSpeechLanguage pgf cnc,
 	  srgRules = mkRules cfg }
-    where cfg = renameCats (prCId cnc) $ preprocess $ pgfToCFG pgf cnc
+    where cfg = renameCats (showCId 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/GF/Speech/VoiceXML.hs

@@ -29,7 +29,7 @@ import Debug.Trace
 grammar2vxml :: PGF -> CId -> String
 grammar2vxml pgf cnc = showsXMLDoc (skel2vxml name language start skel qs) ""
     where skel = pgfSkeleton pgf
-          name = prCId cnc
+          name = showCId cnc
           qs = catQuestions pgf cnc (map fst skel)
           language = getSpeechLanguage pgf cnc
           start = lookStartCat pgf
@@ -73,7 +73,7 @@ lin gr fun = do
 
 getCatQuestion :: CId -> CatQuestions -> String
 getCatQuestion c qs = 
-    fromMaybe (error "No question for category " ++ prCId c) (lookup c qs)
+    fromMaybe (error "No question for category " ++ showCId c) (lookup c qs)
 
 --
 -- * Generate VoiceXML
@@ -93,7 +93,7 @@ grammarURI name = name ++ ".grxml"
 
 catForms :: String -> CatQuestions -> CId -> [(CId, [CId])] -> [XML]
 catForms gr qs cat fs = 
-    comments [prCId cat ++ " category."]
+    comments [showCId cat ++ " category."]
     ++ [cat2form gr qs cat fs] 
 
 cat2form :: String -> CatQuestions -> CId -> [(CId, [CId])] -> XML
@@ -111,20 +111,20 @@ cat2form gr qs cat fs =
 
 fun2sub :: String -> CId -> CId -> [CId] -> [XML]
 fun2sub gr cat fun args = 
-    comments [prCId fun ++ " : (" 
-              ++ concat (intersperse ", " (map prCId args))
-              ++ ") " ++ prCId cat] ++ ss
+    comments [showCId fun ++ " : (" 
+              ++ concat (intersperse ", " (map showCId args))
+              ++ ") " ++ showCId cat] ++ ss
   where 
   ss = zipWith mkSub [0..] args
   mkSub n t = subdialog s [("src","#"++catFormId t),
-                           ("cond","term.name == "++string (prCId fun))] 
+                           ("cond","term.name == "++string (showCId fun))] 
               [param "old" v,
                filled [] [assign v (s++".term")]]
-    where s = prCId fun ++ "_" ++ show n
+    where s = showCId fun ++ "_" ++ show n
           v = "term.args["++show n++"]"
 
 catFormId :: CId -> String
-catFormId c = prCId c ++ "_cat"
+catFormId c = showCId c ++ "_cat"
 
 
 --