Permalink
Browse files

Issue #83 - Added case-sensitive character comparison functions.

  • Loading branch information...
1 parent a76012a commit d3634e51d85f764e6b6b69737f6e74648d84a28f @justinethier committed Sep 25, 2012
Showing with 13 additions and 5 deletions.
  1. +2 −0 ChangeLog.markdown
  2. +5 −5 hs-src/Language/Scheme/Core.hs
  3. +6 −0 hs-src/Language/Scheme/Primitives.hs
View
@@ -3,6 +3,8 @@ v3.5.7
The major change in this release is support for explicit renaming macros. This low-level macro system provides the ability to break macro hygiene, if necessary, and offers a macro system that is similar to `defmacro`.
+In addition, all of the character functions from R<sup>5</sup>RS have been implemented.
+
v3.5.6
--------
@@ -1020,12 +1020,12 @@ primitives = [("+", numAdd),
("string-ci<=?", stringCIBoolBinop (<=)),
("string-ci>=?", stringCIBoolBinop (>=)),
+ ("char=?", charBoolBinop (==)),
+ ("char<?", charBoolBinop (<)),
+ ("char>?", charBoolBinop (>)),
+ ("char<=?", charBoolBinop (<=)),
+ ("char>=?", charBoolBinop (>=)),
-- TODO:
--- procedure: (char=? char1 char2)
--- procedure: (char<? char1 char2)
--- procedure: (char>? char1 char2)
--- procedure: (char<=? char1 char2)
--- procedure: (char>=? char1 char2)
-- library procedure: (char-ci=? char1 char2)
-- library procedure: (char-ci<? char1 char2)
-- library procedure: (char-ci>? char1 char2)
@@ -78,6 +78,7 @@ module Language.Scheme.Primitives (
, boolBinop
, unaryOp
, strBoolBinop
+ , charBoolBinop
, boolBoolBinop
, unpackStr
, unpackBool
@@ -584,9 +585,14 @@ unaryOp _ args@(_ : _) = throwError $ NumArgs 1 args
numBoolBinop = boolBinop unpackNum -}
strBoolBinop :: (String -> String -> Bool) -> [LispVal] -> ThrowsError LispVal
strBoolBinop = boolBinop unpackStr
+charBoolBinop = boolBinop unpackChar
boolBoolBinop :: (Bool -> Bool -> Bool) -> [LispVal] -> ThrowsError LispVal
boolBoolBinop = boolBinop unpackBool
+unpackChar :: LispVal -> ThrowsError Char
+unpackChar (Char c) = return c
+unpackChar notChar = throwError $ TypeMismatch "character" notChar
+
unpackStr :: LispVal -> ThrowsError String
unpackStr (String s) = return s
unpackStr (Number s) = return $ show s

0 comments on commit d3634e5

Please sign in to comment.