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

14 files changed, 62 insertions, 61 deletions

diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
index a660fa55a..5e655c360 100644
--- a/src/GF/Command/Commands.hs
+++ b/src/GF/Command/Commands.hs
@@ -615,18 +615,18 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        case arg of
          [EFun id] -> case Map.lookup id (funs (abstract pgf)) of
                         Just (ty,_,eqs) -> return $ fromString $
-                                              render (text "fun" <+> text (prCId id) <+> colon <+> ppType 0 [] ty $$
+                                              render (text "fun" <+> ppCId id <+> colon <+> ppType 0 [] ty $$
                                                       if null eqs
                                                         then empty
                                                         else text "def" <+> vcat [let (scope,ds) = mapAccumL (ppPatt 9) [] patts
-                                                                                  in text (prCId id) <+> hsep ds <+> char '=' <+> ppExpr 0 scope res | Equ patts res <- eqs])
+                                                                                  in ppCId id <+> hsep ds <+> char '=' <+> ppExpr 0 scope res | Equ patts res <- eqs])
                         Nothing         -> case Map.lookup id (cats (abstract pgf)) of
                                              Just hyps -> do return $ fromString $
-                                                                render (text "cat" <+> text (prCId id) <+> hsep (snd (mapAccumL ppHypo [] hyps)) $$
+                                                                render (text "cat" <+> ppCId id <+> hsep (snd (mapAccumL ppHypo [] hyps)) $$
                                                                         if null (functionsToCat pgf id)
                                                                           then empty
                                                                           else space $$
-                                                                               text "fun" <+> vcat [text (prCId fid) <+> colon <+> ppType 0 [] ty 
+                                                                               text "fun" <+> vcat [ppCId fid <+> colon <+> ppType 0 [] ty 
                                                                                                        | (fid,ty) <- functionsToCat pgf id])
                                              Nothing   -> do putStrLn "unknown identifier"
                                                              return void
@@ -647,8 +647,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
 
    optLin opts t = unlines $ 
      case opts of 
-       _ | isOpt "treebank" opts -> (prCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
-                                    [prCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
+       _ | isOpt "treebank" opts -> (showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
+                                    [showCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
        _                         -> [linear opts lang t | lang <- optLangs opts] 
     
    linear :: [Option] -> CId -> Expr -> String
@@ -689,7 +689,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
      lang -> map mkCId (chunks ',' lang)
    optLang opts = head $ optLangs opts ++ [wildCId]
    optType opts = 
-     let str = valStrOpts "cat" (prCId $ lookStartCat pgf) opts
+     let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts
      in case readType str of
           Just ty -> case checkType pgf ty of
                        Left tcErr -> error $ render (ppTcError tcErr)
@@ -714,7 +714,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
    prGrammar opts
      | isOpt "cats"     opts = return $ fromString $ unwords $ map (showType []) $ categories pgf
      | isOpt "fullform" opts = return $ fromString $ concatMap (prFullFormLexicon . morpho) $ optLangs opts
-     | isOpt "missing"  opts = return $ fromString $ unlines $ [unwords (prCId la:":": map prCId cs) | 
+     | isOpt "missing"  opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) | 
                                                                   la <- optLangs opts, let cs = missingLins pgf la]
      | otherwise             = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)
                                   return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf
diff --git a/src/GF/Command/TreeOperations.hs b/src/GF/Command/TreeOperations.hs
index b4fdff5ae..0489dd23f 100644
--- a/src/GF/Command/TreeOperations.hs
+++ b/src/GF/Command/TreeOperations.hs
@@ -5,6 +5,7 @@ module GF.Command.TreeOperations (
 
 import GF.Compile.TypeCheck
 import PGF
+import PGF.Data
 
 import Data.List
 
diff --git a/src/GF/Compile/Export.hs b/src/GF/Compile/Export.hs
index 051889b59..d03eb947e 100644
--- a/src/GF/Compile/Export.hs
+++ b/src/GF/Compile/Export.hs
@@ -48,13 +48,13 @@ exportPGF opts fmt pgf =
       FmtRegExp       -> single "rexp" regexpPrinter
       FmtFA           -> single "dot"  slfGraphvizPrinter
  where
-   name = fromMaybe (prCId (absname pgf)) (flag optName opts)
+   name = fromMaybe (showCId (absname pgf)) (flag optName opts)
 
    multi :: String -> (PGF -> String) -> [(FilePath,String)]
    multi ext pr = [(name <.> ext, pr pgf)]
 
    single :: String -> (PGF -> CId -> String) -> [(FilePath,String)]
-   single ext pr = [(prCId cnc <.> ext, pr pgf cnc) | cnc <- cncnames pgf]
+   single ext pr = [(showCId cnc <.> ext, pr pgf cnc) | cnc <- cncnames pgf]
 
 -- | Get the name of the concrete syntax to generate output from.
 -- FIXME: there should be an option to change this.
diff --git a/src/GF/Compile/GFCCtoHaskell.hs b/src/GF/Compile/GFCCtoHaskell.hs
index 675cecad5..eb428f221 100644
--- a/src/GF/Compile/GFCCtoHaskell.hs
+++ b/src/GF/Compile/GFCCtoHaskell.hs
@@ -193,8 +193,8 @@ fInstance gId lexical m (cat,rules) =
 --type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
 hSkeleton :: PGF -> (String,HSkeleton)
 hSkeleton gr = 
-  (prCId (absname gr), 
-   [(prCId c, [(prCId f, map prCId cs) | (f, (cs,_)) <- fs]) | 
+  (showCId (absname gr), 
+   [(showCId c, [(showCId f, map showCId cs) | (f, (cs,_)) <- fs]) | 
                                         fs@((_, (_,c)):_) <- fns]
   )
  where
diff --git a/src/GF/Compile/GFCCtoJS.hs b/src/GF/Compile/GFCCtoJS.hs
index 6a82d02d9..dce3949c6 100644
--- a/src/GF/Compile/GFCCtoJS.hs
+++ b/src/GF/Compile/GFCCtoJS.hs
@@ -23,10 +23,10 @@ pgf2js :: PGF -> String
 pgf2js pgf =
   encodeUTF8 $ JS.printTree $ JS.Program [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident n) grammar]]
  where
-   n  = prCId $ absname pgf
+   n  = showCId $ absname pgf
    as = abstract pgf
    cs = Map.assocs (concretes pgf)
-   start = prCId $ M.lookStartCat pgf
+   start = showCId $ M.lookStartCat pgf
    grammar = new "GFGrammar" [js_abstract, js_concrete]
    js_abstract = abstract2js start as
    js_concrete = JS.EObj $ map (concrete2js start n) cs
@@ -37,15 +37,15 @@ abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js
 absdef2js :: (CId,(Type,Int,[Equation])) -> JS.Property
 absdef2js (f,(typ,_,_)) =
   let (args,cat) = M.catSkeleton typ in 
-    JS.Prop (JS.IdentPropName (JS.Ident (prCId f))) (new "Type" [JS.EArray [JS.EStr (prCId x) | x <- args], JS.EStr (prCId cat)])
+    JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (new "Type" [JS.EArray [JS.EStr (showCId x) | x <- args], JS.EStr (showCId cat)])
 
 concrete2js :: String -> String -> (CId,Concr) -> JS.Property
 concrete2js start n (c, cnc) =
-    JS.Prop l (new "GFConcrete" ([flags,(JS.EObj $ ((map (cncdef2js n (prCId c)) ds) ++ litslins))] ++
+    JS.Prop l (new "GFConcrete" ([flags,(JS.EObj $ ((map (cncdef2js n (showCId c)) ds) ++ litslins))] ++
                                  maybe [] (parser2js start) (parser cnc)))
   where 
    flags = mapToJSObj JS.EStr $ cflags cnc
-   l  = JS.IdentPropName (JS.Ident (prCId c))
+   l  = JS.IdentPropName (JS.Ident (showCId c))
    ds = concatMap Map.assocs [lins cnc, opers cnc, lindefs cnc]
    litslins = [JS.Prop (JS.StringPropName    "Int") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]), 
                JS.Prop (JS.StringPropName  "Float") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),
@@ -53,7 +53,7 @@ concrete2js start n (c, cnc) =
 
 
 cncdef2js :: String -> String -> (CId,Term) -> JS.Property
-cncdef2js n l (f, t) = JS.Prop (JS.IdentPropName (JS.Ident (prCId f))) (JS.EFun [children] [JS.SReturn (term2js n l t)])
+cncdef2js n l (f, t) = JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (JS.EFun [children] [JS.SReturn (term2js n l t)])
 
 term2js :: String -> String -> Term -> JS.Expr
 term2js n l t = f t
@@ -66,7 +66,7 @@ term2js n l t = f t
       K t            -> tokn2js t
       V i            -> JS.EIndex (JS.EVar children) (JS.EInt i)
       C i            -> new "Int" [JS.EInt i]
-      F f            -> JS.ECall (JS.EMember (JS.EIndex (JS.EMember (JS.EVar $ JS.Ident n) (JS.Ident "concretes")) (JS.EStr l)) (JS.Ident "rule")) [JS.EStr (prCId f), JS.EVar children]
+      F f            -> JS.ECall (JS.EMember (JS.EIndex (JS.EMember (JS.EVar $ JS.Ident n) (JS.Ident "concretes")) (JS.EStr l)) (JS.Ident "rule")) [JS.EStr (showCId f), JS.EVar children]
       FV xs          -> new "Variants" (map f xs)
       W str x        -> new "Suffix" [JS.EStr str, f x]
       TM _           -> new "Meta" []
@@ -94,7 +94,7 @@ parser2js start p  = [new "Parser" [JS.EStr start,
                                     JS.EArray $ [frule2js p cat prod | (cat,set) <- IntMap.toList (productions p), prod <- Set.toList set],
                                     JS.EObj $ map cats (Map.assocs (startCats p))]]
   where 
-    cats (c,is) = JS.Prop (JS.IdentPropName (JS.Ident (prCId c))) (JS.EArray (map JS.EInt is))
+    cats (c,is) = JS.Prop (JS.IdentPropName (JS.Ident (showCId c))) (JS.EArray (map JS.EInt is))
 
 frule2js :: ParserInfo -> FCat -> Production -> JS.Expr
 frule2js p res (FApply funid args) = new "Rule" [JS.EInt res, name2js (f,ps), JS.EArray (map JS.EInt args), lins2js p lins]
@@ -114,7 +114,7 @@ frule2js p res (FCoerce arg) = new "Rule" [JS.EInt res, daughter 0, JS.EArray [J
 
 
 name2js :: (CId,[Profile]) -> JS.Expr
-name2js (f,ps) = new "FunApp" $ [JS.EStr $ prCId f, JS.EArray (map fromProfile ps)]
+name2js (f,ps) = new "FunApp" $ [JS.EStr $ showCId f, JS.EArray (map fromProfile ps)]
   where
     fromProfile :: Profile -> JS.Expr
     fromProfile []   = new "MetaVar" []
@@ -135,4 +135,4 @@ new :: String -> [JS.Expr] -> JS.Expr
 new f xs = JS.ENew (JS.Ident f) xs
 
 mapToJSObj :: (a -> JS.Expr) -> Map CId a -> JS.Expr
-mapToJSObj f m = JS.EObj [ JS.Prop (JS.IdentPropName (JS.Ident (prCId k))) (f v) | (k,v) <- Map.toList m ]
+mapToJSObj f m = JS.EObj [ JS.Prop (JS.IdentPropName (JS.Ident (showCId k))) (f v) | (k,v) <- Map.toList m ]
diff --git a/src/GF/Compile/GFCCtoProlog.hs b/src/GF/Compile/GFCCtoProlog.hs
index 3e30dccc3..a31fe4b84 100644
--- a/src/GF/Compile/GFCCtoProlog.hs
+++ b/src/GF/Compile/GFCCtoProlog.hs
@@ -163,7 +163,7 @@ instance PLPrint CId where
     plp cid | isLogicalVariable str || 
               cid == wildCId = plVar str
             | otherwise      = plAtom str
-        where str = prCId cid
+        where str = showCId cid
 
 instance PLPrint Literal where
     plp (LStr s) = plp s
diff --git a/src/GF/Compile/GenerateFCFG.hs b/src/GF/Compile/GenerateFCFG.hs
index 096572659..52e95f686 100644
--- a/src/GF/Compile/GenerateFCFG.hs
+++ b/src/GF/Compile/GenerateFCFG.hs
@@ -72,7 +72,7 @@ expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns,
       -- lincat for the _Var category
       varLincat = Map.singleton varCat (R [S []])
 
-      lincatOf c = fromMaybe (error $ "No lincat for " ++ prCId c) $ Map.lookup c lincats
+      lincatOf c = fromMaybe (error $ "No lincat for " ++ showCId c) $ Map.lookup c lincats
 
       modifyRec :: ([Term] -> [Term]) -> Term -> Term
       modifyRec f (R xs) = R (f xs)
@@ -82,13 +82,13 @@ expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns,
 
       catName :: (Int,CId) -> CId
       catName (0,c) = c
-      catName (n,c) = mkCId ("_" ++ show n ++ prCId c)
+      catName (n,c) = mkCId ("_" ++ show n ++ showCId c)
 
       funName :: (Int,CId) -> CId
-      funName (n,c) = mkCId ("__" ++ show n ++ prCId c)
+      funName (n,c) = mkCId ("__" ++ show n ++ showCId c)
 
       varFunName :: CId -> CId
-      varFunName c = mkCId ("_Var_" ++ prCId c)
+      varFunName c = mkCId ("_Var_" ++ showCId c)
 
 -- replaces __NCat with _B and _Var_Cat with _.
 -- the temporary names are just there to avoid name collisions.
@@ -404,7 +404,7 @@ genFCatArg cnc_defs ctype env@(GrammarEnv last_id catSet seqSet funSet prodSet)
         addConstraint path0 index0 cs  = (path0,index0) : cs
     gen_tcs (F id)        path acc = case Map.lookup id cnc_defs of
                                         Just term -> gen_tcs term path acc
-                                        Nothing   -> error ("unknown identifier: "++prCId id)
+                                        Nothing   -> error ("unknown identifier: "++showCId id)
 
 
 
@@ -463,7 +463,7 @@ mkSingletonSelectors cnc_defs term = sels0
     loop path (sels,tcss) (S _)      = (mkSelector [path] tcss0 : sels,                        tcss)
     loop path (sels,tcss) (F id)     = case Map.lookup id cnc_defs of
                                          Just term -> loop path (sels,tcss) term
-                                         Nothing   -> error ("unknown identifier: "++prCId id)
+                                         Nothing   -> error ("unknown identifier: "++showCId id)
 
 mkSelector :: [FPath] -> [[(FPath,FIndex)]] -> TermSelector
 mkSelector rcs tcss =
diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs
index 22bb47b60..2f1fe1580 100644
--- a/src/GF/Compile/GeneratePMCFG.hs
+++ b/src/GF/Compile/GeneratePMCFG.hs
@@ -281,13 +281,13 @@ convertTerm cnc_defs sel ctype (K (KS t)) = return (Str [FSymKS [t]])
 convertTerm cnc_defs sel ctype (K (KP s v))=return (Str [FSymKP s v])
 convertTerm cnc_defs sel ctype (F id)     = case Map.lookup id cnc_defs of
                                               Just term -> convertTerm cnc_defs sel ctype term
-                                              Nothing   -> error ("unknown id " ++ prCId id)
+                                              Nothing   -> error ("unknown id " ++ showCId id)
 convertTerm cnc_defs sel ctype (W s t)    = do
   ss <- case t of
     R ss -> return ss
     F f -> case Map.lookup f cnc_defs of
              Just (R ss) -> return ss
-             _           -> error ("unknown id " ++ prCId f)
+             _           -> error ("unknown id " ++ showCId f)
   convertRec cnc_defs sel ctype [K (KS (s ++ s1)) | K (KS s1) <- ss]
 convertTerm cnc_defs sel ctype x          = error ("convertTerm ("++show x++")")
 
@@ -331,7 +331,7 @@ evalTerm cnc_defs path (P term sel) = do index <- evalTerm cnc_defs [] sel
 evalTerm cnc_defs path (FV terms)   = variants terms >>= evalTerm cnc_defs path
 evalTerm cnc_defs path (F id)       = case Map.lookup id cnc_defs of
                                         Just term -> evalTerm cnc_defs path term
-                                        Nothing   -> error ("unknown id " ++ prCId id)
+                                        Nothing   -> error ("unknown id " ++ showCId id)
 evalTerm cnc_defs path x = error ("evalTerm ("++show x++")")
 
 
@@ -361,7 +361,7 @@ emptyGrammarEnv cnc_defs lincats =
     getMultipliers m ms (C max_index) = (m*(max_index+1),m : ms)
     getMultipliers m ms (F id)        = case Map.lookup id cnc_defs of
                                           Just term -> getMultipliers m ms term
-                                          Nothing   -> error ("unknown identifier: "++prCId id)
+                                          Nothing   -> error ("unknown identifier: "++showCId id)
 
 expandHOAS abs_defs cnc_defs lincats env = 
   foldl add_varFun (foldl (\env ncat -> add_hoFun (add_hoCat env ncat) ncat) env hoTypes) hoCats
@@ -400,7 +400,7 @@ expandHOAS abs_defs cnc_defs lincats env =
       in env3
       where
         (arg,res) = case Map.lookup cat lincats of
-	              Nothing    -> error $ "No lincat for " ++ prCId cat
+	              Nothing    -> error $ "No lincat for " ++ showCId cat
                       Just ctype -> (protoFCat cnc_defs (0,cat) ctype, protoFCat cnc_defs (n,cat) ctype)
 
     -- add one PMCFG function for each high-order category: _V : Var -> Cat
@@ -414,7 +414,7 @@ expandHOAS abs_defs cnc_defs lincats env =
       in env3
       where
         res = case Map.lookup cat lincats of
-	        Nothing    -> error $ "No lincat for " ++ prCId cat
+	        Nothing    -> error $ "No lincat for " ++ showCId cat
                 Just ctype -> protoFCat cnc_defs (0,cat) ctype
 
     _B = mkCId "_B"
diff --git a/src/GF/Compile/PGFPretty.hs b/src/GF/Compile/PGFPretty.hs
index 309ce5c31..679714db5 100644
--- a/src/GF/Compile/PGFPretty.hs
+++ b/src/GF/Compile/PGFPretty.hs
@@ -21,7 +21,7 @@ prPMCFGPretty :: PGF -> CId -> String
 prPMCFGPretty pgf lang = render $
   case lookParser pgf lang of
     Nothing    -> empty
-    Just pinfo -> text "language" <+> text (prCId lang) $$ ppPMCFG pinfo
+    Just pinfo -> text "language" <+> ppCId lang $$ ppPMCFG pinfo
                                                    
 
 prAbs :: Abstr -> Doc
@@ -29,13 +29,13 @@ prAbs a = prAll prCat (cats a) $$ prAll prFun (funs a)
 
 prCat :: CId -> [Hypo] -> Doc
 prCat c h | isLiteralCat c = empty
-          | otherwise = text "cat" <+> text (prCId c)
+          | otherwise = text "cat" <+> ppCId c
 
 prFun :: CId -> (Type,Int,[Equation]) -> Doc
-prFun f (t,_,_) = text "fun" <+> text (prCId f) <+> text ":" <+> prType t
+prFun f (t,_,_) = text "fun" <+> ppCId f <+> text ":" <+> prType t
 
 prType :: Type -> Doc
-prType t = parens (hsep (punctuate (text ",") (map (text . prCId) cs))) <+> text "->" <+> text (prCId c)
+prType t = parens (hsep (punctuate (text ",") (map ppCId cs))) <+> text "->" <+> ppCId c
   where (cs,c) = catSkeleton t
 
 
@@ -46,14 +46,14 @@ prCnc abstr name c = prAll prLinCat (lincats c) $$ prAll prLin (lins (expand c))
   where
     prLinCat :: CId -> Term -> Doc
     prLinCat c t | isLiteralCat c = empty
-                 | otherwise = text "lincat" <+> text (prCId c) <+> text "=" <+> pr 0 t
+                 | otherwise = text "lincat" <+> ppCId c <+> text "=" <+> pr 0 t
         where
           pr p (R ts) = prec p 1 (hsep (punctuate (text " *") (map (pr 1) ts)))
           pr _ (S []) = text "Str"
           pr _ (C n) = text "Int_" <> text (show (n+1))
 
     prLin :: CId -> Term -> Doc
-    prLin f t = text "lin" <+> text (prCId f) <+> text "=" <+> pr 0 t
+    prLin f t = text "lin" <+> ppCId f <+> text "=" <+> pr 0 t
         where
           pr :: Int -> Term -> Doc
           pr p (R ts) = text "<" <+> hsep (punctuate (text ",") (map (pr 0) ts)) <+> text ">"
@@ -66,7 +66,7 @@ prCnc abstr name c = prAll prLinCat (lincats c) $$ prAll prLin (lins (expand c))
           pr _ t = error $ "PGFPretty.prLin " ++ show t
 
 linCat :: Concr -> CId -> Term
-linCat cnc c = Map.findWithDefault (error $ "lincat: " ++ prCId c) c (lincats cnc)
+linCat cnc c = Map.findWithDefault (error $ "lincat: " ++ showCId c) c (lincats cnc)
 
 prec :: Int -> Int -> Doc -> Doc
 prec p m | p >= m = parens
@@ -84,7 +84,7 @@ expand cnc = cnc { lins = Map.map (f "") (lins cnc) }
     f w (FV ts) = FV (map (f w) ts)
     f w (W s t) = f (w++s) t
     f w (K (KS t)) = K (KS (w++t))
-    f w (F o) = f w (Map.findWithDefault (error $ "Bad oper: " ++ prCId o) o (opers cnc))
+    f w (F o) = f w (Map.findWithDefault (error $ "Bad oper: " ++ showCId o) o (opers cnc))
     f w t = t
 
 -- Utilities
diff --git a/src/GF/Speech/CFG.hs b/src/GF/Speech/CFG.hs
index 6a34dfba3..9ec8416c5 100644
--- a/src/GF/Speech/CFG.hs
+++ b/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 ++ ")"
 
diff --git a/src/GF/Speech/PGFToCFG.hs b/src/GF/Speech/PGFToCFG.hs
index 4165e0aa1..d22a4ea8d 100644
--- a/src/GF/Speech/PGFToCFG.hs
+++ b/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]]
diff --git a/src/GF/Speech/SISR.hs b/src/GF/Speech/SISR.hs
index 7933a2597..f966d96b9 100644
--- a/src/GF/Speech/SISR.hs
+++ b/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")
diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs
index 5d1bbdfed..2270ec7a1 100644
--- a/src/GF/Speech/SRG.hs
+++ b/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.
diff --git a/src/GF/Speech/VoiceXML.hs b/src/GF/Speech/VoiceXML.hs
index a30342cd0..cf6f7120f 100644
--- a/src/GF/Speech/VoiceXML.hs
+++ b/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"
 
 
 --