Permalink
Browse files

Finished adding character functions

  • Loading branch information...
1 parent d3634e5 commit efaa2b1edc7fed97b5c9023ac81407a4f679af4f @justinethier committed Sep 26, 2012
Showing with 12 additions and 6 deletions.
  1. +5 −6 hs-src/Language/Scheme/Core.hs
  2. +7 −0 hs-src/Language/Scheme/Primitives.hs
@@ -1025,12 +1025,11 @@ primitives = [("+", numAdd),
("char>?", charBoolBinop (>)),
("char<=?", charBoolBinop (<=)),
("char>=?", charBoolBinop (>=)),
--- TODO:
--- library procedure: (char-ci=? char1 char2)
--- library procedure: (char-ci<? char1 char2)
--- library procedure: (char-ci>? char1 char2)
--- library procedure: (char-ci<=? char1 char2)
--- library procedure: (char-ci>=? char1 char2)
+ ("char-ci=?", charCIBoolBinop (==)),
+ ("char-ci<?", charCIBoolBinop (<)),
+ ("char-ci>?", charCIBoolBinop (>)),
+ ("char-ci<=?", charCIBoolBinop (<=)),
+ ("char-ci>=?", charCIBoolBinop (>=)),
("char-alphabetic?", charPredicate Data.Char.isAlpha),
("char-numeric?", charPredicate Data.Char.isNumber),
("char-whitespace?", charPredicate Data.Char.isSpace),
@@ -54,7 +54,9 @@ module Language.Scheme.Primitives (
, symbol2String
, string2Symbol
--data Unpacker = forall a . Eq a => AnyUnpacker (LispVal -> ThrowsError a)
+
-- ** Character
+ , charCIBoolBinop
, charPredicate
, charUpper
, charLower
@@ -434,6 +436,11 @@ stringCIBoolBinop op [(String s1), (String s2)] = boolBinop unpackStr op [(Strin
stringCIBoolBinop _ [badType] = throwError $ TypeMismatch "string string" badType
stringCIBoolBinop _ badArgList = throwError $ NumArgs 2 badArgList
+charCIBoolBinop :: (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
+charCIBoolBinop op [(Char s1), (Char s2)] = boolBinop unpackChar op [(Char $ toLower s1), (Char $ toLower s2)]
+charCIBoolBinop _ [badType] = throwError $ TypeMismatch "character character" badType
+charCIBoolBinop _ badArgList = throwError $ NumArgs 2 badArgList
+
stringAppend :: [LispVal] -> ThrowsError LispVal
stringAppend [(String s)] = return $ String s -- Needed for "last" string value
stringAppend (String st : sts) = do

0 comments on commit efaa2b1

Please sign in to comment.