fix of missing upper/lowercase conversion primitives for Data.Char

UU-ComputerScience · Sep 11, 2012 · 50b2692 · 50b2692
1 parent 83c2f06
commit 50b2692
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 25 deletions.
diff --git a/EHC/ehclib/uhcbase/Data/Char.hs b/EHC/ehclib/uhcbase/Data/Char.hs
@@ -229,8 +229,8 @@ isLatin1 c = c <= '\xff'
 isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
 isPrint c = c >= ' '
 
-foreign import ccall "primCharToUpper" toUpper :: Char -> Char
-foreign import ccall "primCharToLower" toLower :: Char -> Char
+foreign import prim "primCharToUpper" toUpper :: Char -> Char
+foreign import prim "primCharToLower" toLower :: Char -> Char
 
 #endif
 

diff --git a/EHC/src/ehc/Core/CommonBindExtract.cag b/EHC/src/ehc/Core/CommonBindExtract.cag
@@ -40,31 +40,19 @@ ATTR
     ]
 
 SEM CBound
-  | Val         lhs         .   (selvalYesL,selvalNoL)
-                                                =   if selVal @lhs.boundsel @aspectKeyS @mlev @lbl
-                                                    then ([@boundval],[])
-                                                    else ([],[@boundval])
-  | Bind        lhs         .   (selvalYesL,selvalNoL)
-                                                =   if selBind @lhs.boundsel
-                                                    then ([@boundval],[])
-                                                    else ([],[@boundval])
-  | Meta        lhs         .   (selvalYesL,selvalNoL)
-                                                =   if selMeta @lhs.boundsel @aspectKeyS
-                                                    then ([@boundval],[])
-                                                    else ([],[@boundval])
-  | RelevTy     lhs         .   (selvalYesL,selvalNoL)
-                                                =   if selRelevTy @lhs.boundsel @aspectKeyS @relevTy
-                                                    then ([@boundval],[])
-                                                    else ([],[@boundval])
-  | Ty          lhs         .   (selvalYesL,selvalNoL)
-                                                =   if selTy @lhs.boundsel @aspectKeyS
-                                                    then ([@boundval],[])
-                                                    else ([],[@boundval])
+  | Val         loc         .   isSelected      =   selVal     @lhs.boundsel @aspectKeyS @mlev @lbl
+  | Bind        loc         .   isSelected      =   selBind    @lhs.boundsel
+  | Meta        loc         .   isSelected      =   selMeta    @lhs.boundsel @aspectKeyS
+  | RelevTy     loc         .   isSelected      =   selRelevTy @lhs.boundsel @aspectKeyS @relevTy
+  | Ty          loc         .   isSelected      =   selTy      @lhs.boundsel @aspectKeyS
 %%[[90
-  | FFE         lhs         .   (selvalYesL,selvalNoL)
-                                                =   if selFFE @lhs.boundsel
+  | FFE         loc         .   isSelected      =   selFFE     @lhs.boundsel
+%%]]
+
+SEM CBound
+  | *           lhs         .   (selvalYesL,selvalNoL)
+                                                =   if @isSelected
                                                     then ([@boundval],[])
                                                     else ([],[@boundval])
-%%]]
 %%]
 
diff --git a/EHC/src/javascript/rts/prim.cjs b/EHC/src/javascript/rts/prim.cjs
@@ -283,6 +283,12 @@ primCharIsUpper = function(x) {
 primCharIsLower = function(x) { 
   return PrimMkBool(x > 96 && x < 123) ; 
 }
+primCharToLower = function(charCode) {
+  return String.fromCharCode(charCode).toLowerCase().charCodeAt(0);
+};
+primCharToUpper = function(charCode) {
+  return String.fromCharCode(charCode).toUpperCase().charCodeAt(0);
+};
 %%]
 
 Represent packed strings as Javascript strings