use ByteString internally in Ident, CId and Label

src-3.0/GF/Source/SourceToGrammar.hs

@@ -27,6 +27,7 @@ import qualified GF.Grammar.Macros as M
 import qualified GF.Compile.Update as U
 import qualified GF.Infra.Option as GO
 import qualified GF.Compile.ModDeps as GD
+import GF.Grammar.Predef
 import GF.Infra.Ident
 import GF.Source.AbsGF
 import GF.Source.PrintGF
@@ -37,6 +38,7 @@ import GF.Infra.Option
 import Control.Monad
 import Data.Char
 import Data.List (genericReplicate)
+import qualified Data.ByteString.Char8 as BS
 
 -- based on the skeleton Haskell module generated by the BNF converter
 
@@ -45,9 +47,6 @@ type Result = Err String
 failure :: Show a => a -> Err b
 failure x = Bad $ "Undefined case: " ++ show x
 
-prPIdent :: PIdent -> String
-prPIdent (PIdent (_,c)) = c
-
 getIdentPos :: PIdent -> Err (Ident,Int)
 getIdentPos x = case x of
   PIdent ((line,_),c) -> return (IC c,line)
@@ -225,7 +224,7 @@ transAbsDef x = case x of
   DefFunData fundefs -> do
     fundefs' <- mapM transFunDef fundefs
     returnl $
-      [(cat, G.AbsCat nope (yes [M.cn fun])) | (funs,typ) <- fundefs', 
+      [(cat, G.AbsCat nope (yes [G.Cn fun])) | (funs,typ) <- fundefs', 
                                        fun <- funs, 
                                        Ok (_,cat) <- [M.valCat typ]
       ] ++
@@ -257,6 +256,9 @@ returnl = return . Left
 transFlagDef :: FlagDef -> Err GO.Option
 transFlagDef x = case x of
   FlagDef f x  -> return $ GO.Opt (prPIdent f,[prPIdent x])
+  where
+    prPIdent (PIdent (_,c)) = BS.unpack c
+
 
 -- | Cat definitions can also return some fun defs
 --   if it is a list category definition
@@ -280,7 +282,7 @@ transCatDef x = case x of
            consId = mkConsId id'
 	 catd0@(c,G.AbsCat (Yes cont0) _) <- cat li ddecls
 	 let
-  	   catd = (c,G.AbsCat (Yes cont0) (Yes [M.cn baseId,M.cn consId]))
+  	   catd = (c,G.AbsCat (Yes cont0) (Yes [G.Cn baseId,G.Cn consId]))
            cont = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont0]
            xs = map (G.Vr . fst) cont 
            cd = M.mkDecl (M.mkApp (G.Vr id') xs)
@@ -290,7 +292,7 @@ transCatDef x = case x of
 	   constyp = M.mkProdSimple (cont ++ [cd, M.mkDecl lc]) lc
 	   consfund = (consId, G.AbsFun (yes constyp) (yes G.EData))
 	 return [catd,nilfund,consfund]
-   mkId x i = if isWildIdent x then (mkIdent "x" i) else x
+   mkId x i = if isWildIdent x then (varX i) else x
 
 transFunDef :: FunDef -> Err ([Ident], G.Type)
 transFunDef x = case x of
@@ -434,10 +436,10 @@ transExp x = case x of
   EQConstr m c  -> liftM2 G.QC (transIdent m) (transIdent c)
   EQCons m c    -> liftM2 G.Q  (transIdent m) (transIdent c)
   EString str   -> return $ G.K str 
-  ESort sort    -> liftM G.Sort $ transSort sort
+  ESort sort    -> return $ G.Sort $ transSort sort
   EInt n        -> return $ G.EInt n
   EFloat n      -> return $ G.EFloat n
-  EMeta         -> return $ M.meta $ M.int2meta 0
+  EMeta         -> return $ G.Meta $ M.int2meta 0
   EEmpty        -> return G.Empty
   -- [ C x_1 ... x_n ] becomes (ListC x_1 ... x_n)
   EList i es    -> do
@@ -499,7 +501,7 @@ transExp x = case x of
   EPattType typ -> liftM G.EPattType (transExp typ)
   EPatt patt -> liftM G.EPatt (transPatt patt)
 
-  ELString (LString str) -> return $ G.K str 
+  ELString (LString str) -> return $ G.K (BS.unpack str)  -- use the grammar encoding here
   ELin id -> liftM G.LiT $ transIdent id
 
   EEqs eqs -> liftM G.Eqs $ mapM transEquation eqs
@@ -527,10 +529,10 @@ erecord2term ds = do
     (lab,(Just ty,Nothing)) -> mapM tryRT fs >>= return . Left
     _ -> mapM tryR fs >>= return . Right
   tryRT f = case f of
-    (lab,(Just ty,Nothing)) -> return (M.ident2label lab,ty)
+    (lab,(Just ty,Nothing)) -> return (G.ident2label lab,ty)
     _ -> Bad $ "illegal record type field" +++ GP.prt (fst f) --- manifest fields ?!
   tryR f = case f of
-    (lab,(mty, Just t)) -> return (M.ident2label lab,(mty,t))
+    (lab,(mty, Just t)) -> return (G.ident2label lab,(mty,t))
     _ -> Bad $ "illegal record field" +++ GP.prt (fst f)
 
   
@@ -552,16 +554,16 @@ locdef2fields d = case d of
 
 trLabel :: Label -> Err G.Label
 trLabel x = case x of
-
-  -- this case is for bward compatibility and should be removed
-  LIdent (PIdent (_,'v':ds@(_:_))) | all isDigit ds -> return $ G.LVar $ readIntArg ds 
-  
   LIdent (PIdent (_, s)) -> return $ G.LIdent s
-  LVar x   -> return $ G.LVar $ fromInteger x
+  LVar x                 -> return $ G.LVar $ fromInteger x
+
+transSort :: Sort -> Ident
+transSort Sort_Type  = cType
+transSort Sort_PType = cPType
+transSort Sort_Tok   = cTok
+transSort Sort_Str   = cStr
+transSort Sort_Strs  = cStrs
 
-transSort :: Sort -> Err String
-transSort x = case x of
-  _ -> return $ printTree x
 
 {-
 --- no more used 7/1/2006 AR
@@ -703,7 +705,7 @@ transOldGrammar opts name0 x = case x of
    resName = identPI $ maybe ("Res" ++ lang) id $ getOptVal opts useResName
    cncName = identPI $ maybe lang id $ getOptVal opts useCncName
 
-   identPI s = PIdent ((0,0),s)
+   identPI s = PIdent ((0,0),BS.pack s)
 
    (beg,rest) = span (/='.') name
    (topic,lang) = case rest of -- to avoid overwriting old files
@@ -725,8 +727,8 @@ transInclude x = case x of
      FDot filename  -> '.' : trans filename
      FMinus filename  -> '-' : trans filename
      FAddId (PIdent (_, s)) filename  -> modif s ++ trans filename
-   modif s = let s' = init s ++ [toLower (last s)] in 
-             if elem s' newReservedWords then s' else s 
+   modif s = let s' = BS.snoc (BS.init s) (toLower (BS.last s)) in 
+             BS.unpack (if elem (BS.unpack s') newReservedWords then s' else s)
                       --- unsafe hack ; cf. GetGrammar.oldLexer
 
 
@@ -740,16 +742,16 @@ termInPattern t = M.mkAbs xx $ G.R [(s, (Nothing, toP body))] where
   toP t = case t of
     G.Vr x -> G.P t s
     _ -> M.composSafeOp toP t
-  s = G.LIdent "s"
+  s = G.LIdent (BS.pack "s")
   (xx,body) = abss [] t
   abss xs t = case t of
     G.Abs x b -> abss (x:xs) b
     _ -> (reverse xs,t)
 
 mkListId,mkConsId,mkBaseId  :: Ident -> Ident
-mkListId = prefixId "List"
-mkConsId = prefixId "Cons"
-mkBaseId = prefixId "Base"
+mkListId = prefixId (BS.pack "List")
+mkConsId = prefixId (BS.pack "Cons")
+mkBaseId = prefixId (BS.pack "Base")
 
-prefixId :: String -> Ident -> Ident
-prefixId pref id = IC (pref ++ prIdent id)
+prefixId :: BS.ByteString -> Ident -> Ident
+prefixId pref id = identC (BS.append pref (ident2bs id))