From 50b2692ff0b76d3a0c27d49c9bb24713f7752879 Mon Sep 17 00:00:00 2001 From: Atze Dijkstra Date: Tue, 11 Sep 2012 22:42:03 +0200 Subject: [PATCH] fix of missing upper/lowercase conversion primitives for Data.Char --- EHC/ehclib/uhcbase/Data/Char.hs | 4 +-- EHC/src/ehc/Core/CommonBindExtract.cag | 34 +++++++++----------------- EHC/src/javascript/rts/prim.cjs | 6 +++++ 3 files changed, 19 insertions(+), 25 deletions(-) diff --git a/EHC/ehclib/uhcbase/Data/Char.hs b/EHC/ehclib/uhcbase/Data/Char.hs index eede014fd..0617a8a47 100644 --- 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 index 39f39d61e..16857cf1f 100644 --- 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 index 5b06f65d3..234a3cbf2 100644 --- 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