use ByteString internally in Ident, CId and Label

1 files changed, 60 insertions, 68 deletions

diff --git a/src-3.0/GF/Grammar/AppPredefined.hs b/src-3.0/GF/Grammar/AppPredefined.hs
index fa0048c80..452050ac8 100644
--- a/src-3.0/GF/Grammar/AppPredefined.hs
+++ b/src-3.0/GF/Grammar/AppPredefined.hs
@@ -15,12 +15,13 @@
 module GF.Grammar.AppPredefined (isInPredefined, typPredefined, appPredefined
 		     ) where
 
+import GF.Infra.Ident
 import GF.Data.Operations
+import GF.Grammar.Predef
 import GF.Grammar.Grammar
-import GF.Infra.Ident
 import GF.Grammar.Macros
 import GF.Grammar.PrGrammar (prt,prt_,prtBad)
----- import PGrammar (pTrm)
+import qualified Data.ByteString.Char8 as BS
 
 -- predefined function type signatures and definitions. AR 12/3/2003.
 
@@ -28,75 +29,77 @@ isInPredefined :: Ident -> Bool
 isInPredefined = err (const True) (const False) . typPredefined
 
 typPredefined :: Ident -> Err Type
-typPredefined c@(IC f) = case f of
-  "Int"    -> return typePType
-  "Float"  -> return typePType
-  "Error"  -> return typeType
-  "Ints"   -> return $ mkFunType [cnPredef "Int"] typePType
-  "PBool"  -> return typePType
-  "error"  -> return $ mkFunType [typeStr] (cnPredef "Error")  -- non-can. of empty set
-  "PFalse" -> return $ cnPredef "PBool"
-  "PTrue"  -> return $ cnPredef "PBool"
-  "dp"     -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
-  "drop"   -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
-  "eqInt"  -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
-  "lessInt"-> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
-  "eqStr"  -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
-  "length" -> return $ mkFunType [typeTok] (cnPredef "Int")
-  "occur"  -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
-  "occurs" -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
-  "plus"   -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "Int")
+typPredefined f
+  | f == cInt       = return typePType
+  | f == cFloat     = return typePType
+  | f == cErrorType = return typeType
+  | f == cInts      = return $ mkFunType [typeInt] typePType
+  | f == cPBool     = return typePType
+  | f == cError     = return $ mkFunType [typeStr] typeError  -- non-can. of empty set
+  | f == cPFalse    = return $ typePBool
+  | f == cPTrue     = return $ typePBool
+  | f == cDp        = return $ mkFunType [typeInt,typeTok] typeTok
+  | f == cDrop      = return $ mkFunType [typeInt,typeTok] typeTok
+  | f == cEqInt     = return $ mkFunType [typeInt,typeInt] typePBool
+  | f == cLessInt   = return $ mkFunType [typeInt,typeInt] typePBool
+  | f == cEqStr     = return $ mkFunType [typeTok,typeTok] typePBool
+  | f == cLength    = return $ mkFunType [typeTok] typeInt
+  | f == cOccur     = return $ mkFunType [typeTok,typeTok] typePBool
+  | f == cOccurs    = return $ mkFunType [typeTok,typeTok] typePBool
+  | f == cPlus      = return $ mkFunType [typeInt,typeInt] (typeInt)
 ----  "read"   -> (P : Type) -> Tok -> P
-  "show"   -> return $ mkProd -- (P : PType) -> P -> Tok
-    ([(zIdent "P",typePType),(wildIdent,Vr (zIdent "P"))],typeStr,[]) 
-  "toStr"  -> return $ mkProd -- (L : Type)  -> L -> Str
-    ([(zIdent "L",typeType),(wildIdent,Vr (zIdent "L"))],typeStr,[]) 
-  "mapStr" -> 
-    let ty = zIdent "L" in
-    return $ mkProd -- (L : Type)  -> (Str -> Str) -> L -> L
-    ([(ty,typeType),(wildIdent,mkFunType [typeStr] typeStr),(wildIdent,Vr ty)],Vr ty,[]) 
-  "take"   -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
-  "tk"     -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
-  _        -> prtBad "unknown in Predef:" c
-typPredefined c = prtBad "unknown in Predef:" c
+  | f == cShow      = return $ mkProd -- (P : PType) -> P -> Tok
+    ([(varP,typePType),(identW,Vr varP)],typeStr,[]) 
+  | f == cToStr     = return $ mkProd -- (L : Type)  -> L -> Str
+    ([(varL,typeType),(identW,Vr varL)],typeStr,[]) 
+  | f == cMapStr    = return $ mkProd -- (L : Type)  -> (Str -> Str) -> L -> L
+    ([(varL,typeType),(identW,mkFunType [typeStr] typeStr),(identW,Vr varL)],Vr varL,[])
+  | f == cTake      = return $ mkFunType [typeInt,typeTok] typeTok
+  | f == cTk        = return $ mkFunType [typeInt,typeTok] typeTok
+  | otherwise       = prtBad "unknown in Predef:" f
+
+varL :: Ident
+varL = identC (BS.pack "L")
+
+varP :: Ident
+varP = identC (BS.pack "P")
 
 appPredefined :: Term -> Err (Term,Bool)
 appPredefined t = case t of
-
   App f x0 -> do
    (x,_) <- appPredefined x0
    case f of
     -- one-place functions
-    Q (IC "Predef") (IC f) -> case (f, x) of
-      ("length", K s) -> retb $ EInt $ toInteger $ length s
-      _ -> retb t ---- prtBad "cannot compute predefined" t
+    Q mod f | mod == cPredef ->
+      case x of
+        (K s) | f == cLength -> retb $ EInt $ toInteger $ length s
+        _                    -> retb t
 
     -- two-place functions
-    App (Q (IC "Predef") (IC f)) z0 -> do
+    App (Q mod f) z0 | mod == cPredef -> do
      (z,_) <- appPredefined z0
-     case (f, norm z, norm x) of
-      ("drop", EInt i, K s) -> retb $ K (drop (fi i) s)
-      ("take", EInt i, K s) -> retb $ K (take (fi i) s)
-      ("tk",   EInt i, K s) -> retb $ K (take (max 0 (length s - fi i)) s)
-      ("dp",   EInt i, K s) -> retb $ K (drop (max 0 (length s - fi i)) s)
-      ("eqStr",K s,    K t) -> retb $ if s == t then predefTrue else predefFalse
-      ("occur",K s,    K t) -> retb $ if substring s t then predefTrue else predefFalse
-      ("occurs",K s,   K t) -> retb $ if any (flip elem t) s then predefTrue else predefFalse
-      ("eqInt",EInt i, EInt j) -> retb $ if i==j then predefTrue else predefFalse
-      ("lessInt",EInt i, EInt j) -> retb $ if i<j then predefTrue else predefFalse
-      ("plus", EInt i, EInt j) -> retb $ EInt $ i+j
-      ("show", _, t) -> retb $ foldr C Empty $ map K $ words $ prt t
-      ("read", _, K s) -> retb $ str2tag s --- because of K, only works for atomic tags
-      ("toStr", _, t) -> trm2str t >>= retb
-
+     case (norm z, norm x) of
+      (EInt i, K s)    | f == cDrop    -> retb $ K (drop (fi i) s)
+      (EInt i, K s)    | f == cTake    -> retb $ K (take (fi i) s)
+      (EInt i, K s)    | f == cTk      -> retb $ K (take (max 0 (length s - fi i)) s)
+      (EInt i, K s)    | f == cDp      -> retb $ K (drop (max 0 (length s - fi i)) s)
+      (K s,    K t)    | f == cEqStr   -> retb $ if s == t then predefTrue else predefFalse
+      (K s,    K t)    | f == cOccur   -> retb $ if substring s t then predefTrue else predefFalse
+      (K s,    K t)    | f == cOccurs  -> retb $ if any (flip elem t) s then predefTrue else predefFalse
+      (EInt i, EInt j) | f == cEqInt   -> retb $ if i==j then predefTrue else predefFalse
+      (EInt i, EInt j) | f == cLessInt -> retb $ if i<j  then predefTrue else predefFalse
+      (EInt i, EInt j) | f == cPlus    -> retb $ EInt $ i+j
+      (_,      t)      | f == cShow    -> retb $ foldr C Empty $ map K $ words $ prt t
+      (_,      K s)    | f == cRead    -> retb $ Cn (identC (BS.pack s)) --- because of K, only works for atomic tags
+      (_,      t)      | f == cToStr   -> trm2str t >>= retb
       _ -> retb t ---- prtBad "cannot compute predefined" t
 
     -- three-place functions
-    App (App (Q (IC "Predef") (IC f)) z0) y0 -> do
+    App (App (Q mod f) z0) y0 | mod == cPredef -> do
      (y,_) <- appPredefined y0
      (z,_) <- appPredefined z0
-     case (f, z, y, x) of
-      ("mapStr",ty,op,t) -> retf $ mapStr ty op t
+     case (z, y, x) of
+      (ty,op,t) | f == cMapStr -> retf $ mapStr ty op t
       _ -> retb t ---- prtBad "cannot compute predefined" t
 
     _ -> retb t ---- prtBad "cannot compute predefined" t
@@ -112,19 +115,8 @@ appPredefined t = case t of
 
 -- read makes variables into constants
 
-str2tag :: String -> Term
-str2tag s = case s of
-----  '\'' : cs -> mkCn $ pTrm $ init cs
-  _ -> Cn $ IC s ---
- where
-   mkCn t = case t of
-     Vr i -> Cn i
-     App c a -> App (mkCn c) (mkCn a)
-     _ -> t
-
-
-predefTrue = Q (IC "Predef") (IC "PTrue")
-predefFalse = Q (IC "Predef") (IC "PFalse")
+predefTrue = Q cPredef cPTrue
+predefFalse = Q cPredef cPFalse
 
 substring :: String -> String -> Bool
 substring s t = case (s,t) of