From a3924abece87303a26ab8066cbf0509976864a48 Mon Sep 17 00:00:00 2001
From: aarne <aarne@chalmers.se>
Date: Thu, 2 Jun 2011 16:10:46 +0000
Subject: [PATCH] Predef functions toUpper, toLower, isUpper

---
 src/compiler/GF/Compile/Compute/AppPredefined.hs | 12 +++++++++++-
 src/compiler/GF/Grammar/Predef.hs                | 10 ++++++++++
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs
index bbc28a05e..8cde4e39e 100644
--- a/src/compiler/GF/Compile/Compute/AppPredefined.hs
+++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs
@@ -26,6 +26,7 @@ import GF.Grammar.Predef
 import qualified Data.Map as Map
 import qualified Data.ByteString.Char8 as BS
 import Text.PrettyPrint
+import Data.Char (isUpper,toUpper,toLower)
 
 -- predefined function type signatures and definitions. AR 12/3/2003.
 
@@ -67,6 +68,11 @@ primitives = Map.fromList
   , (cEqStr    , ResOper (Just (noLoc (mkFunType [typeTok,typeTok] typePBool))) Nothing)
   , (cOccur    , ResOper (Just (noLoc (mkFunType [typeTok,typeTok] typePBool))) Nothing)
   , (cOccurs   , ResOper (Just (noLoc (mkFunType [typeTok,typeTok] typePBool))) Nothing)
+
+  , (cToUpper  , ResOper (Just (noLoc (mkFunType [typeTok] typeTok))) Nothing)
+  , (cToLower  , ResOper (Just (noLoc (mkFunType [typeTok] typeTok))) Nothing)
+  , (cIsUpper  , ResOper (Just (noLoc (mkFunType [typeTok] typePBool))) Nothing)
+
 ----  "read"   -> 
   , (cRead     , ResOper (Just (noLoc (mkProd -- (P : Type) -> Tok -> P
                                          [(Explicit,varP,typePType),(Explicit,identW,typeStr)] (Vr varP) []))) Nothing)
@@ -94,7 +100,11 @@ appPredefined t = case t of
     -- one-place functions
     Q (mod,f) | mod == cPredef ->
       case x of
-        (K s) | f == cLength -> retb $ EInt $ length s
+        (K s) | f == cLength  -> retb $ EInt $ length s
+        (K s) | f == cIsUpper -> retb $ if (all isUpper s) then predefTrue else predefFalse
+        (K s) | f == cToUpper -> retb $ K $ map toUpper s
+        (K s) | f == cToLower -> retb $ K $ map toLower s
+
         _                    -> retb t
 
     -- two-place functions
diff --git a/src/compiler/GF/Grammar/Predef.hs b/src/compiler/GF/Grammar/Predef.hs
index f9c2c5d18..b77aea40e 100644
--- a/src/compiler/GF/Grammar/Predef.hs
+++ b/src/compiler/GF/Grammar/Predef.hs
@@ -32,6 +32,7 @@ module GF.Grammar.Predef
           , cLength, cDrop, cTake, cTk, cDp, cEqStr, cOccur
           , cOccurs, cEqInt, cLessInt, cPlus, cShow, cRead
           , cToStr, cMapStr, cError
+          , cToUpper, cToLower, cIsUpper
 
           -- hacks
           , cMeta, cAs, cChar, cChars, cSeq, cAlt, cRep
@@ -116,6 +117,15 @@ cTk = identC (BS.pack "tk")
 cDp :: Ident
 cDp = identC (BS.pack "dp")
 
+cToUpper :: Ident
+cToUpper = identC (BS.pack "toUpper")
+
+cToLower :: Ident
+cToLower = identC (BS.pack "toLower")
+
+cIsUpper :: Ident
+cIsUpper = identC (BS.pack "isUpper")
+
 cEqStr :: Ident
 cEqStr = identC (BS.pack "eqStr")