use ByteString internally in Ident, CId and Label

12 files changed, 144 insertions, 159 deletions

diff --git a/src-3.0/GF/GFCC/API.hs b/src-3.0/GF/GFCC/API.hs
index c266a5553..7c5c6da77 100644
--- a/src-3.0/GF/GFCC/API.hs
+++ b/src-3.0/GF/GFCC/API.hs
@@ -84,12 +84,12 @@ file2gfcc f = do
   g <- parseGrammar s
   return $ toGFCC g
 
-linearize mgr lang = GF.GFCC.Linearize.linearize (gfcc mgr) (CId lang)
+linearize mgr lang = GF.GFCC.Linearize.linearize (gfcc mgr) (mkCId lang)
 
 parse mgr lang cat s = 
-  case lookParser (gfcc mgr) (CId lang) of
+  case lookParser (gfcc mgr) (mkCId lang) of
     Nothing    -> error "no parser"
-    Just pinfo -> case parseFCF "bottomup" pinfo (CId cat) (words s) of
+    Just pinfo -> case parseFCF "bottomup" pinfo (mkCId cat) (words s) of
                     Ok x -> x
                     Bad s -> error s
 
@@ -104,23 +104,20 @@ parseAllLang mgr cat s =
 
 generateRandom mgr cat = do
   gen <- newStdGen
-  return $ genRandom gen (gfcc mgr) (CId cat)
+  return $ genRandom gen (gfcc mgr) (mkCId cat)
 
-generateAll mgr cat = generate (gfcc mgr) (CId cat) Nothing
-generateAllDepth mgr cat = generate (gfcc mgr) (CId cat)
+generateAll mgr cat = generate (gfcc mgr) (mkCId cat) Nothing
+generateAllDepth mgr cat = generate (gfcc mgr) (mkCId cat)
 
 readTree _ = pTree
 
 showTree = prExp
 
-prIdent :: CId -> String
-prIdent (CId s) = s
+abstractName mgr = prCId (absname (gfcc mgr))
 
-abstractName mgr = prIdent (absname (gfcc mgr))
+languages mgr = [prCId l | l <- cncnames (gfcc mgr)]
 
-languages mgr = [l | CId l <- cncnames (gfcc mgr)]
-
-categories mgr = [c | CId c <- Map.keys (cats (abstract (gfcc mgr)))]
+categories mgr = [prCId c | c <- Map.keys (cats (abstract (gfcc mgr)))]
 
 startCat mgr = lookStartCat (gfcc mgr)
 
diff --git a/src-3.0/GF/GFCC/CId.hs b/src-3.0/GF/GFCC/CId.hs
index e4efa98ba..928dc18e2 100644
--- a/src-3.0/GF/GFCC/CId.hs
+++ b/src-3.0/GF/GFCC/CId.hs
@@ -1,14 +1,15 @@
-module GF.GFCC.CId (
-  module GF.GFCC.Raw.AbsGFCCRaw,
-  prCId,
-  cId
-  ) where
+module GF.GFCC.CId (CId(..), wildCId, mkCId, prCId) where
 
-import GF.GFCC.Raw.AbsGFCCRaw (CId(CId))
+import GF.Infra.PrintClass
+import Data.ByteString.Char8 as BS
 
-prCId :: CId -> String
-prCId (CId s) = s
+newtype CId = CId BS.ByteString deriving (Eq,Ord,Show)
+
+wildCId :: CId
+wildCId = CId (BS.singleton '_')
 
-cId :: String -> CId
-cId = CId
+mkCId :: String -> CId
+mkCId s = CId (BS.pack s)
 
+prCId :: CId -> String
+prCId (CId x) = BS.unpack x
diff --git a/src-3.0/GF/GFCC/CheckGFCC.hs b/src-3.0/GF/GFCC/CheckGFCC.hs
index d59dba1a9..33143c9ad 100644
--- a/src-3.0/GF/GFCC/CheckGFCC.hs
+++ b/src-3.0/GF/GFCC/CheckGFCC.hs
@@ -45,7 +45,7 @@ labelBoolErr ms iob = do
 
 checkConcrete :: GFCC -> (CId,Concr) -> Err ((CId,Concr),Bool)
 checkConcrete gfcc (lang,cnc) = 
-  labelBoolErr ("happened in language " ++ printCId lang) $ do
+  labelBoolErr ("happened in language " ++ prCId lang) $ do
     (rs,bs) <- mapM checkl (Map.assocs (lins cnc)) >>= return . unzip
     return ((lang,cnc{lins = Map.fromAscList rs}),and bs)
  where
@@ -53,7 +53,7 @@ checkConcrete gfcc (lang,cnc) =
 
 checkLin :: GFCC -> CId -> (CId,Term) -> Err ((CId,Term),Bool)
 checkLin gfcc lang (f,t) = 
-  labelBoolErr ("happened in function " ++ printCId f) $ do
+  labelBoolErr ("happened in function " ++ prCId f) $ do
     (t',b) <- checkTerm (lintype gfcc lang f) t --- $ inline gfcc lang t
     return ((f,t'),b)
 
diff --git a/src-3.0/GF/GFCC/DataGFCC.hs b/src-3.0/GF/GFCC/DataGFCC.hs
index 077d62b19..6d6fd0b86 100644
--- a/src-3.0/GF/GFCC/DataGFCC.hs
+++ b/src-3.0/GF/GFCC/DataGFCC.hs
@@ -1,6 +1,7 @@
 module GF.GFCC.DataGFCC where
 
 import GF.GFCC.CId
+import GF.Infra.PrintClass(prt)
 import GF.Infra.CompactPrint
 import GF.Text.UTF8
 import GF.Formalism.FCFG
@@ -90,21 +91,17 @@ data Equation =
 
 statGFCC :: GFCC -> String
 statGFCC gfcc = unlines [
-  "Abstract\t" ++ pr (absname gfcc), 
-  "Concretes\t" ++ unwords (lmap pr (cncnames gfcc)), 
-  "Categories\t" ++ unwords (lmap pr (keys (cats (abstract gfcc)))) 
+  "Abstract\t" ++ prt (absname gfcc), 
+  "Concretes\t" ++ unwords (lmap prt (cncnames gfcc)), 
+  "Categories\t" ++ unwords (lmap prt (keys (cats (abstract gfcc)))) 
   ]
- where pr (CId s) = s
-
-printCId :: CId -> String
-printCId (CId s) = s
 
 -- merge two GFCCs; fails is differens absnames; priority to second arg
 
 unionGFCC :: GFCC -> GFCC -> GFCC
 unionGFCC one two = case absname one of
-  CId "" -> two                  -- extending empty grammar
-  n | n == absname two -> one {  -- extending grammar with same abstract
+  n | n == wildCId     -> two    -- extending empty grammar
+    | n == absname two -> one {  -- extending grammar with same abstract
       concretes = Data.Map.union (concretes two) (concretes one),
       cncnames  = Data.List.union (cncnames two) (cncnames one)
     }
@@ -112,7 +109,7 @@ unionGFCC one two = case absname one of
 
 emptyGFCC :: GFCC
 emptyGFCC = GFCC {
-  absname   = CId "",
+  absname   = wildCId,
   cncnames  = [] ,
   gflags    = empty,
   abstract  = error "empty grammar, no abstract",
diff --git a/src-3.0/GF/GFCC/Generate.hs b/src-3.0/GF/GFCC/Generate.hs
index 63bdb3b9a..0c02f2034 100644
--- a/src-3.0/GF/GFCC/Generate.hs
+++ b/src-3.0/GF/GFCC/Generate.hs
@@ -36,8 +36,8 @@ genRandom gen gfcc cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
                 (genTrees ds2 cat)          -- else (drop k ds)
 
   genTree rs = gett rs where
-    gett ds (CId "String") = (tree (AS "foo") [], 1)
-    gett ds (CId "Int")    = (tree (AI 12345) [], 1)
+    gett ds cid | cid == mkCId "String" = (tree (AS "foo") [], 1)
+    gett ds cid | cid == mkCId "Int"    = (tree (AI 12345) [], 1)
     gett [] _ = (tree (AS "TIMEOUT") [], 1) ----
     gett ds cat = case fns cat of
       [] -> (tree (AM 0) [],1)
diff --git a/src-3.0/GF/GFCC/Linearize.hs b/src-3.0/GF/GFCC/Linearize.hs
index c66ff93c1..255b141b0 100644
--- a/src-3.0/GF/GFCC/Linearize.hs
+++ b/src-3.0/GF/GFCC/Linearize.hs
@@ -3,6 +3,7 @@ module GF.GFCC.Linearize where
 import GF.GFCC.Macros
 import GF.GFCC.DataGFCC
 import GF.GFCC.CId
+import GF.Infra.PrintClass
 import Data.Map
 import Data.List
 
@@ -35,7 +36,7 @@ linExp mcfg lang tree@(DTr xs at trees) =
                 --- [C lst, kks (show i), C size] where 
                 --- lst = mod (fromInteger i) 10 ; size = if i < 10 then 0 else 1
     AF d   -> R [kks (show d)]
-    AV x   -> TM (prCId x)
+    AV x   -> TM (prt x)
     AM i   -> TM (show i)
  where
    lin  = linExp mcfg lang
@@ -44,8 +45,8 @@ linExp mcfg lang tree@(DTr xs at trees) =
    addB t 
      | Data.List.null xs = t
      | otherwise = case t of
-         R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs)
-         TM s -> R $ t : (Data.List.map (kks . prCId) xs)
+         R ts -> R $ ts ++ (Data.List.map (kks . prt) xs)
+         TM s -> R $ t : (Data.List.map (kks . prt) xs)
 
 compute :: GFCC -> CId -> [Term] -> Term -> Term
 compute mcfg lang args = comp where
diff --git a/src-3.0/GF/GFCC/Macros.hs b/src-3.0/GF/GFCC/Macros.hs
index 4897aa667..5eaa4bdb3 100644
--- a/src-3.0/GF/GFCC/Macros.hs
+++ b/src-3.0/GF/GFCC/Macros.hs
@@ -4,7 +4,7 @@ import GF.GFCC.CId
 import GF.GFCC.DataGFCC
 import GF.Formalism.FCFG (FGrammar)
 import GF.Parsing.FCFG.PInfo (FCFPInfo, fcfPInfoToFGrammar)
-----import GF.GFCC.PrintGFCC
+import GF.Infra.PrintClass
 import Control.Monad
 import Data.Map
 import Data.Maybe
@@ -39,7 +39,7 @@ lookFCFG :: GFCC -> CId -> Maybe FGrammar
 lookFCFG gfcc lang = fmap fcfPInfoToFGrammar $ lookParser gfcc lang
 
 lookStartCat :: GFCC -> String
-lookStartCat gfcc = fromMaybe "S" $ msum $ Data.List.map (Data.Map.lookup (CId "startcat"))
+lookStartCat gfcc = fromMaybe "S" $ msum $ Data.List.map (Data.Map.lookup (mkCId "startcat"))
                                               [gflags gfcc, aflags (abstract gfcc)]
 
 lookGlobalFlag :: GFCC -> CId -> String
@@ -87,12 +87,6 @@ contextLength :: Type -> Int
 contextLength ty = case ty of
   DTyp hyps _ _ -> length hyps
 
-cid :: String -> CId
-cid = CId
-
-wildCId :: CId
-wildCId = cid "_"
-
 exp0 :: Exp
 exp0 = tree (AM 0) []
 
@@ -100,7 +94,7 @@ primNotion :: Exp
 primNotion = EEq []
 
 term0 :: CId -> Term
-term0 = TM . prCId
+term0 = TM . prt
 
 tm0 :: Term
 tm0 = TM "?"
diff --git a/src-3.0/GF/GFCC/OptimizeGFCC.hs b/src-3.0/GF/GFCC/OptimizeGFCC.hs
index 394458041..59fb93ffd 100644
--- a/src-3.0/GF/GFCC/OptimizeGFCC.hs
+++ b/src-3.0/GF/GFCC/OptimizeGFCC.hs
@@ -75,7 +75,7 @@ addSubexpConsts tree cnc = cnc {
        W s t  -> W s (recomp f t)
        P t p  -> P (recomp f t) (recomp f p)
        _ -> t
-   fid n = CId $ "_" ++ show n
+   fid n = mkCId $ "_" ++ show n
    rec field = Map.fromAscList [(f,recomp f trm) | (f,trm) <- Map.assocs (field cnc)]
 
 
diff --git a/src-3.0/GF/GFCC/Raw/AbsGFCCRaw.hs b/src-3.0/GF/GFCC/Raw/AbsGFCCRaw.hs
index ab5f184a8..2be8537eb 100644
--- a/src-3.0/GF/GFCC/Raw/AbsGFCCRaw.hs
+++ b/src-3.0/GF/GFCC/Raw/AbsGFCCRaw.hs
@@ -1,14 +1,11 @@
 module GF.GFCC.Raw.AbsGFCCRaw where
 
--- Haskell module generated by the BNF converter
-
-newtype CId = CId String deriving (Eq,Ord,Show)
 data Grammar =
    Grm [RExp]
   deriving (Eq,Ord,Show)
 
 data RExp =
-   App CId [RExp]
+   App String [RExp]
  | AInt Integer
  | AStr String
  | AFlt Double
diff --git a/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs b/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
index 0b010d604..d72d74b77 100644
--- a/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
+++ b/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
@@ -1,8 +1,10 @@
 module GF.GFCC.Raw.ConvertGFCC (toGFCC,fromGFCC) where
 
+import GF.GFCC.CId
 import GF.GFCC.DataGFCC
 import GF.GFCC.Raw.AbsGFCCRaw
 
+import GF.Infra.PrintClass
 import GF.Data.Assoc
 import GF.Formalism.FCFG
 import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
@@ -18,29 +20,29 @@ pgfMajorVersion, pgfMinorVersion :: Integer
 
 toGFCC :: Grammar -> GFCC
 toGFCC (Grm [
-  App (CId "pgf") (AInt v1 : AInt v2 : App a []:cs),
-  App (CId "flags")     gfs, 
+  App "pgf" (AInt v1 : AInt v2 : App a []:cs),
+  App "flags"     gfs, 
   ab@(
-    App (CId "abstract") [
-      App (CId "fun")   fs,
-      App (CId "cat")   cts
+    App "abstract" [
+      App "fun"   fs,
+      App "cat"   cts
       ]), 
-  App (CId "concrete") ccs
+  App "concrete" ccs
   ]) = GFCC {
-    absname = a,
-    cncnames = [c | App c [] <- cs],
-    gflags = fromAscList [(f,v) | App f [AStr v] <- gfs],
+    absname = mkCId a,
+    cncnames = [mkCId c | App c [] <- cs],
+    gflags = fromAscList [(mkCId f,v) | App f [AStr v] <- gfs],
     abstract = 
      let
-      aflags  = fromAscList [(f,v) | App f [AStr v] <- gfs]
-      lfuns   = [(f,(toType typ,toExp def)) | App f [typ, def] <- fs]
+      aflags  = fromAscList [(mkCId f,v) | App f [AStr v] <- gfs]
+      lfuns   = [(mkCId f,(toType typ,toExp def)) | App f [typ, def] <- fs]
       funs    = fromAscList lfuns
-      lcats   = [(c, Prelude.map toHypo hyps) | App c hyps <- cts]
+      lcats   = [(mkCId c, Prelude.map toHypo hyps) | App c hyps <- cts]
       cats    = fromAscList lcats
       catfuns = fromAscList 
         [(cat,[f | (f, (DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
      in Abstr aflags funs cats catfuns,
-    concretes = fromAscList [(lang, toConcr ts) | App lang ts <- ccs]
+    concretes = fromAscList [(mkCId lang, toConcr ts) | App lang ts <- ccs]
     }
  where
 
@@ -57,71 +59,71 @@ toConcr = foldl add (Concr {
              })
   where
     add :: Concr -> RExp -> Concr
-    add cnc (App (CId "flags") ts)     = cnc { cflags = fromAscList [(f,v) | App f [AStr v] <- ts] }
-    add cnc (App (CId "lin") ts)       = cnc { lins = mkTermMap ts }
-    add cnc (App (CId "oper") ts)      = cnc { opers = mkTermMap ts }
-    add cnc (App (CId "lincat") ts)    = cnc { lincats = mkTermMap ts }
-    add cnc (App (CId "lindef") ts)    = cnc { lindefs = mkTermMap ts }
-    add cnc (App (CId "printname") ts) = cnc { printnames = mkTermMap ts }
-    add cnc (App (CId "param") ts)     = cnc { paramlincats = mkTermMap ts }
-    add cnc (App (CId "parser") ts)    = cnc { parser = Just (toPInfo ts) }
+    add cnc (App "flags" ts)     = cnc { cflags = fromAscList [(mkCId f,v) | App f [AStr v] <- ts] }
+    add cnc (App "lin" ts)       = cnc { lins = mkTermMap ts }
+    add cnc (App "oper" ts)      = cnc { opers = mkTermMap ts }
+    add cnc (App "lincat" ts)    = cnc { lincats = mkTermMap ts }
+    add cnc (App "lindef" ts)    = cnc { lindefs = mkTermMap ts }
+    add cnc (App "printname" ts) = cnc { printnames = mkTermMap ts }
+    add cnc (App "param" ts)     = cnc { paramlincats = mkTermMap ts }
+    add cnc (App "parser" ts)    = cnc { parser = Just (toPInfo ts) }
 
 toPInfo :: [RExp] -> FCFPInfo
-toPInfo [App (CId "rules") rs, App (CId "startupcats") cs] = buildFCFPInfo (rules, cats)
+toPInfo [App "rules" rs, App "startupcats" cs] = buildFCFPInfo (rules, cats)
   where 
     rules = lmap toFRule rs
-    cats = fromList [(c, lmap expToInt fs) | App c fs <- cs]
+    cats = fromList [(mkCId c, lmap expToInt fs) | App c fs <- cs]
 
     toFRule :: RExp -> FRule
-    toFRule (App (CId "rule") 
+    toFRule (App "rule"
               [n,                      
-               App (CId "cats") (rt:at),
-               App (CId "R") ls]) = FRule name args res lins
+               App "cats" (rt:at),
+               App "R" ls]) = FRule name args res lins
       where 
         name = toFName n
         args = lmap expToInt at
         res  = expToInt rt
-        lins = mkArray [mkArray [toSymbol s | s <- l] | App (CId "S") l <- ls]
+        lins = mkArray [mkArray [toSymbol s | s <- l] | App "S" l <- ls]
 
 toFName :: RExp -> FName
-toFName (App (CId "_A") [x]) = Name (CId "_") [Unify [expToInt x]]
-toFName (App f ts) = Name f (lmap toProfile ts)
+toFName (App "_A" [x]) = Name wildCId [Unify [expToInt x]]
+toFName (App f ts) = Name (mkCId f) (lmap toProfile ts)
     where
       toProfile :: RExp -> Profile (SyntaxForest CId)
       toProfile AMet = Unify []
-      toProfile (App (CId "_A") [t]) = Unify [expToInt t]
-      toProfile (App (CId "_U") ts) = Unify [expToInt t | App (CId "_A") [t] <- ts]
+      toProfile (App "_A" [t]) = Unify [expToInt t]
+      toProfile (App "_U" ts) = Unify [expToInt t | App "_A" [t] <- ts]
       toProfile t = Constant (toSyntaxForest t)
 
       toSyntaxForest :: RExp -> SyntaxForest CId
       toSyntaxForest AMet = FMeta
-      toSyntaxForest (App n ts) = FNode n [lmap toSyntaxForest ts]
+      toSyntaxForest (App n ts) = FNode (mkCId n) [lmap toSyntaxForest ts]
       toSyntaxForest (AStr s) = FString s
       toSyntaxForest (AInt i) = FInt i
       toSyntaxForest (AFlt f) = FFloat f
 
 toSymbol :: RExp -> FSymbol
-toSymbol (App (CId "P") [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n)
+toSymbol (App "P" [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n)
 toSymbol (AStr t) = FSymTok t
 
 toType :: RExp -> Type
 toType e = case e of
-  App cat [App (CId "H") hypos, App (CId "X") exps] -> 
-    DTyp (lmap toHypo hypos) cat (lmap toExp exps) 
+  App cat [App "H" hypos, App "X" exps] -> 
+    DTyp (lmap toHypo hypos) (mkCId cat) (lmap toExp exps) 
   _ -> error $ "type " ++ show e
 
 toHypo :: RExp -> Hypo
 toHypo e = case e of
-  App x [typ] -> Hyp x (toType typ)
+  App x [typ] -> Hyp (mkCId x) (toType typ)
   _ -> error $ "hypo " ++ show e
 
 toExp :: RExp -> Exp
 toExp e = case e of
-  App (CId "App") [App fun [], App (CId "B") xs, App (CId "X") exps] ->
-    DTr [x | App x [] <- xs] (AC fun) (lmap toExp exps)
-  App (CId "Eq") eqs -> 
-    EEq [Equ (lmap toExp ps) (toExp v) | App (CId "E") (v:ps) <- eqs]
-  App (CId "Var") [App i []] -> DTr [] (AV i) []
+  App "App" [App fun [], App "B" xs, App "X" exps] ->
+    DTr [mkCId x | App x [] <- xs] (AC (mkCId fun)) (lmap toExp exps)
+  App "Eq" eqs -> 
+    EEq [Equ (lmap toExp ps) (toExp v) | App "E" (v:ps) <- eqs]
+  App "Var" [App i []] -> DTr [] (AV (mkCId i)) []
   AMet -> DTr [] (AM 0) []
   AInt i -> DTr [] (AI i) []
   AFlt i -> DTr [] (AF i) []
@@ -130,14 +132,14 @@ toExp e = case e of
 
 toTerm :: RExp -> Term
 toTerm e = case e of
-  App (CId "R") es    -> R  (lmap toTerm es)
-  App (CId "S") es    -> S  (lmap toTerm es)
-  App (CId "FV") es   -> FV (lmap toTerm es)
-  App (CId "P") [e,v] -> P  (toTerm e) (toTerm v)
-  App (CId "RP") [e,v] -> RP  (toTerm e) (toTerm v) ----
-  App (CId "W") [AStr s,v] -> W s (toTerm v)
-  App (CId "A") [AInt i] -> V (fromInteger i)
-  App f []  -> F f
+  App "R" es    -> R  (lmap toTerm es)
+  App "S" es    -> S  (lmap toTerm es)
+  App "FV" es   -> FV (lmap toTerm es)
+  App "P" [e,v] -> P  (toTerm e) (toTerm v)
+  App "RP" [e,v] -> RP  (toTerm e) (toTerm v) ----
+  App "W" [AStr s,v] -> W s (toTerm v)
+  App "A" [AInt i] -> V (fromInteger i)
+  App f []  -> F (mkCId f)
   AInt i -> C (fromInteger i)
   AMet   -> TM "?"
   AStr s -> K (KS s) ----
@@ -149,129 +151,124 @@ toTerm e = case e of
 
 fromGFCC :: GFCC -> Grammar
 fromGFCC gfcc0 = Grm [
-  app "pgf" (AInt pgfMajorVersion:AInt pgfMinorVersion
-             : App (absname gfcc) [] : lmap (flip App []) (cncnames gfcc)), 
-  app "flags" [App f [AStr v] | (f,v) <- toList (gflags gfcc `union` aflags agfcc)],
-  app "abstract" [
-    app "fun"   [App f [fromType t,fromExp d] | (f,(t,d)) <- toList (funs agfcc)],
-    app "cat"   [App f (lmap fromHypo hs) | (f,hs) <- toList (cats agfcc)]
+  App "pgf" (AInt pgfMajorVersion:AInt pgfMinorVersion
+             : App (prCId (absname gfcc)) [] : lmap (flip App [] . prCId) (cncnames gfcc)), 
+  App "flags" [App (prCId f) [AStr v] | (f,v) <- toList (gflags gfcc `union` aflags agfcc)],
+  App "abstract" [
+    App "fun"   [App (prCId f) [fromType t,fromExp d] | (f,(t,d)) <- toList (funs agfcc)],
+    App "cat"   [App (prCId f) (lmap fromHypo hs) | (f,hs) <- toList (cats agfcc)]
     ],
-  app "concrete" [App lang (fromConcrete c) | (lang,c) <- toList (concretes gfcc)]
+  App "concrete" [App (prCId lang) (fromConcrete c) | (lang,c) <- toList (concretes gfcc)]
   ]
  where
   gfcc = utf8GFCC gfcc0
-  app s = App (CId s)
   agfcc = abstract gfcc
   fromConcrete cnc = [
-      app "flags"     [App f [AStr v]     | (f,v) <- toList (cflags cnc)],
-      app "lin"       [App f [fromTerm v] | (f,v) <- toList (lins cnc)],
-      app "oper"      [App f [fromTerm v] | (f,v) <- toList (opers cnc)],
-      app "lincat"    [App f [fromTerm v] | (f,v) <- toList (lincats cnc)],
-      app "lindef"    [App f [fromTerm v] | (f,v) <- toList (lindefs cnc)],
-      app "printname" [App f [fromTerm v] | (f,v) <- toList (printnames cnc)],
-      app "param"     [App f [fromTerm v] | (f,v) <- toList (paramlincats cnc)]
+      App "flags"     [App (prCId f) [AStr v]     | (f,v) <- toList (cflags cnc)],
+      App "lin"       [App (prCId f) [fromTerm v] | (f,v) <- toList (lins cnc)],
+      App "oper"      [App (prCId f) [fromTerm v] | (f,v) <- toList (opers cnc)],
+      App "lincat"    [App (prCId f) [fromTerm v] | (f,v) <- toList (lincats cnc)],
+      App "lindef"    [App (prCId f) [fromTerm v] | (f,v) <- toList (lindefs cnc)],
+      App "printname" [App (prCId f) [fromTerm v] | (f,v) <- toList (printnames cnc)],
+      App "param"     [App (prCId f) [fromTerm v] | (f,v) <- toList (paramlincats cnc)]
      ] ++ maybe [] (\p -> [fromPInfo p]) (parser cnc)
 
 fromType :: Type -> RExp
 fromType e = case e of
   DTyp hypos cat exps -> 
-    App cat [
-      App (CId "H") (lmap fromHypo hypos), 
-      App (CId "X") (lmap fromExp exps)] 
+    App (prCId cat) [
+      App "H" (lmap fromHypo hypos), 
+      App "X" (lmap fromExp exps)] 
 
 fromHypo :: Hypo -> RExp
 fromHypo e = case e of
-  Hyp x typ -> App x [fromType typ]
+  Hyp x typ -> App (prCId x) [fromType typ]
 
 fromExp :: Exp -> RExp
 fromExp e = case e of
   DTr xs (AC fun) exps ->
-    App (CId "App") [App fun [], App (CId "B") (lmap (flip App []) xs), App (CId "X") (lmap fromExp exps)]
-  DTr [] (AV x) [] -> App (CId "Var") [App x []]
+    App "App" [App (prCId fun) [], App "B" (lmap (flip App [] . prCId) xs), App "X" (lmap fromExp exps)]
+  DTr [] (AV x) [] -> App "Var" [App (prCId x) []]
   DTr [] (AS s) [] -> AStr s
   DTr [] (AF d) [] -> AFlt d
   DTr [] (AI i) [] -> AInt (toInteger i)
   DTr [] (AM _) [] -> AMet ----
   EEq eqs -> 
-    App (CId "Eq") [App (CId "E") (lmap fromExp (v:ps)) | Equ ps v <- eqs]
+    App "Eq" [App "E" (lmap fromExp (v:ps)) | Equ ps v <- eqs]
   _ -> error $ "exp " ++ show e
 
 fromTerm :: Term -> RExp
 fromTerm e = case e of
-  R es    -> app "R" (lmap fromTerm es)
-  S es    -> app "S" (lmap fromTerm es)
-  FV es   -> app "FV" (lmap fromTerm es)
-  P e v   -> app "P"  [fromTerm e, fromTerm v]
-  RP e v  -> app "RP" [fromTerm e, fromTerm v] ----
-  W s v   -> app "W" [AStr s, fromTerm v]
+  R es    -> App "R" (lmap fromTerm es)
+  S es    -> App "S" (lmap fromTerm es)
+  FV es   -> App "FV" (lmap fromTerm es)
+  P e v   -> App "P"  [fromTerm e, fromTerm v]
+  RP e v  -> App "RP" [fromTerm e, fromTerm v] ----
+  W s v   -> App "W" [AStr s, fromTerm v]
   C i     -> AInt (toInteger i)
   TM _    -> AMet
-  F f     -> App f []
-  V i     -> App (CId "A") [AInt (toInteger i)]
+  F f     -> App (prCId f) []
+  V i     -> App "A" [AInt (toInteger i)]
   K (KS s) -> AStr s ----
-  K (KP d vs) -> app "FV" (str d : [str v | Var v _ <- vs]) ----
+  K (KP d vs) -> App "FV" (str d : [str v | Var v _ <- vs]) ----
  where
-   app = App . CId
-   str v = app "S" (lmap AStr v)
+   str v = App "S" (lmap AStr v)
 
 -- ** Parsing info
 
 fromPInfo :: FCFPInfo -> RExp
-fromPInfo p = app "parser" [
-          app "rules"         [fromFRule rule | rule <- Array.elems (allRules p)],
-          app "startupcats"   [App f (lmap intToExp cs) | (f,cs) <- toList (startupCats p)]
+fromPInfo p = App "parser" [
+          App "rules"         [fromFRule rule | rule <- Array.elems (allRules p)],
+          App "startupcats"   [App (prCId f) (lmap intToExp cs) | (f,cs) <- toList (startupCats p)]
         ]
 
 fromFRule :: FRule -> RExp
 fromFRule (FRule n args res lins) = 
-    app "rule" [fromFName n,
-                app "cats" (intToExp res:lmap intToExp args),
-                app "R" [app "S" [fromSymbol s | s <- Array.elems l] | l <- Array.elems lins]
+    App "rule" [fromFName n,
+                App "cats" (intToExp res:lmap intToExp args),
+                App "R" [App "S" [fromSymbol s | s <- Array.elems l] | l <- Array.elems lins]
                ]
 
 fromFName :: FName -> RExp
 fromFName n = case n of
-                Name (CId "_") [p] -> fromProfile p
-                Name f ps          -> App f (lmap fromProfile ps)
+                Name f ps | f == wildCId -> fromProfile (head ps)
+                          | otherwise    -> App (prCId f) (lmap fromProfile ps)
   where
     fromProfile :: Profile (SyntaxForest CId) -> RExp
     fromProfile (Unify []) = AMet
     fromProfile (Unify [x]) = daughter x
-    fromProfile (Unify args) = app "_U" (lmap daughter args)
+    fromProfile (Unify args) = App "_U" (lmap daughter args)
     fromProfile (Constant forest) = fromSyntaxForest forest
 
-    daughter n = app "_A" [intToExp n]
+    daughter n = App "_A" [intToExp n]
 
     fromSyntaxForest :: SyntaxForest CId -> RExp
     fromSyntaxForest FMeta = AMet
     -- FIXME: is there always just one element here?
-    fromSyntaxForest (FNode n [args]) = App n (lmap fromSyntaxForest args)
+    fromSyntaxForest (FNode n [args]) = App (prCId n) (lmap fromSyntaxForest args)
     fromSyntaxForest (FString s) = AStr s
     fromSyntaxForest (FInt i) = AInt i
     fromSyntaxForest (FFloat f) = AFlt f
 
 fromSymbol :: FSymbol -> RExp
-fromSymbol (FSymCat c l n) = app "P" [intToExp c, intToExp n, intToExp l]
+fromSymbol (FSymCat c l n) = App "P" [intToExp c, intToExp n, intToExp l]
 fromSymbol (FSymTok t) = AStr t
 
 -- ** Utilities
 
 mkTermMap :: [RExp] -> Map CId Term
-mkTermMap ts = fromAscList [(f,toTerm v) | App f [v] <- ts]
-
-app :: String -> [RExp] -> RExp
-app = App . CId
+mkTermMap ts = fromAscList [(mkCId f,toTerm v) | App f [v] <- ts]
 
 mkArray :: [a] -> Array.Array Int a
 mkArray xs = Array.listArray (0, length xs - 1) xs
 
 expToInt :: Integral a => RExp -> a
-expToInt (App (CId "neg") [AInt i]) = fromIntegral (negate i)
+expToInt (App "neg" [AInt i]) = fromIntegral (negate i)
 expToInt (AInt i) = fromIntegral i
 
 expToStr :: RExp -> String
 expToStr (AStr s) = s
 
 intToExp :: Integral a => a -> RExp
-intToExp x | x < 0 = App (CId "neg") [AInt (fromIntegral (negate x))]
+intToExp x | x < 0 = App "neg" [AInt (fromIntegral (negate x))]
            | otherwise =  AInt (fromIntegral x)
diff --git a/src-3.0/GF/GFCC/Raw/ParGFCCRaw.hs b/src-3.0/GF/GFCC/Raw/ParGFCCRaw.hs
index b71904948..159eea5fb 100644
--- a/src-3.0/GF/GFCC/Raw/ParGFCCRaw.hs
+++ b/src-3.0/GF/GFCC/Raw/ParGFCCRaw.hs
@@ -1,9 +1,11 @@
 module GF.GFCC.Raw.ParGFCCRaw (parseGrammar) where
 
+import GF.GFCC.CId
 import GF.GFCC.Raw.AbsGFCCRaw
 
 import Control.Monad
 import Data.Char
+import qualified Data.ByteString.Char8 as BS
 
 parseGrammar :: String -> IO Grammar
 parseGrammar s = case runP pGrammar s of
@@ -27,7 +29,7 @@ pTerm n = skipSpaces >> (pParen <++ pApp <++ pNum <++ pStr <++ pMeta)
                    <++
                    return (AInt (read x)))
         pMeta = char '?' >> return AMet
-        pIdent = liftM CId $ liftM2 (:) (satisfy isIdentFirst) (munch isIdentRest)
+        pIdent = liftM2 (:) (satisfy isIdentFirst) (munch isIdentRest)
         isIdentFirst c = c == '_' || isAlpha c
         isIdentRest c = c == '_' || c == '\'' || isAlphaNum c
 
diff --git a/src-3.0/GF/GFCC/Raw/PrintGFCCRaw.hs b/src-3.0/GF/GFCC/Raw/PrintGFCCRaw.hs
index d46d8096f..23bb8a542 100644
--- a/src-3.0/GF/GFCC/Raw/PrintGFCCRaw.hs
+++ b/src-3.0/GF/GFCC/Raw/PrintGFCCRaw.hs
@@ -1,9 +1,11 @@
 module GF.GFCC.Raw.PrintGFCCRaw (printTree) where
 
+import GF.GFCC.CId
 import GF.GFCC.Raw.AbsGFCCRaw
 
 import Data.List (intersperse)
 import Numeric (showFFloat)
+import qualified Data.ByteString.Char8 as BS
 
 printTree :: Grammar -> String
 printTree g = prGrammar g ""
@@ -12,8 +14,8 @@ prGrammar :: Grammar -> ShowS
 prGrammar (Grm xs) = prRExpList xs
 
 prRExp :: Int -> RExp -> ShowS
-prRExp _ (App x []) = prCId x
-prRExp n (App x xs) = p (prCId x . showChar ' ' . prRExpList xs)
+prRExp _ (App x []) = showString x
+prRExp n (App x xs) = p (showString x . showChar ' ' . prRExpList xs)
     where p s = if n == 0 then s else showChar '(' . s . showChar ')'
 prRExp _ (AInt x) = shows x
 prRExp _ (AStr x) = showChar '"' . concatS (map mkEsc x) . showChar '"'
@@ -29,8 +31,5 @@ mkEsc s = case s of
 prRExpList :: [RExp] -> ShowS
 prRExpList = concatS . intersperse (showChar ' ') . map (prRExp 1)
 
-prCId :: CId -> ShowS
-prCId (CId x) = showString x
-
 concatS :: [ShowS] -> ShowS
 concatS = foldr (.) id