klisp

commit a4b85984484ede70a1d23f5b8bb40503f6f8e652
parent 3ca515c7e8aee79d3847ba3ee495af1d11529b80
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 18 Mar 2011 16:44:43 -0300

Added char-downcase & char-upcase to the ground environment.

Diffstat:
M
src/kgchars.c
 | 
21
+++++++++++++++++++++
M
src/kgchars.h
 | 
5
++++-
M
src/kground.c
 | 
3
++-

3 files changed, 27 insertions(+), 2 deletions(-)
diff --git a/src/kgchars.c b/src/kgchars.c
@@ -69,6 +69,27 @@ void kinteger_to_char(klisp_State *K, TValue *xparams, TValue ptree,
 }
 
 /* 14.1.4? char-upcase, char-downcase */
+void kchar_upcase(klisp_State *K, TValue *xparams, TValue ptree, 
+		  TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    bind_1tp(K, "char-upcase", ptree, "character", ttischar, chtv);
+    char ch = chvalue(chtv);
+    ch = toupper(ch);
+    kapply_cc(K, ch2tv(ch));
+}
+
+void kchar_downcase(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    bind_1tp(K, "char-downcase", ptree, "character", ttischar, chtv);
+    char ch = chvalue(chtv);
+    ch = tolower(ch);
+    kapply_cc(K, ch2tv(ch));
+}
 /* TODO */
 
 /* 14.2.1? char=? */
diff --git a/src/kgchars.h b/src/kgchars.h
@@ -44,7 +44,10 @@ void kinteger_to_char(klisp_State *K, TValue *xparams, TValue ptree,
 		      TValue denv);
 
 /* 14.1.4? char-upcase, char-downcase */
-/* TODO */
+void kchar_upcase(klisp_State *K, TValue *xparams, TValue ptree, 
+		  TValue denv);
+void kchar_downcase(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv);
 
 /* 14.2.1? char=? */
 /* TODO */
diff --git a/src/kground.c b/src/kground.c
@@ -515,7 +515,8 @@ void kinit_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "integer->char", kinteger_to_char, 0);
 
     /* 14.1.4? char-upcase, char-downcase */
-    /* TODO */
+    add_applicative(K, ground_env, "char-upcase", kchar_upcase, 0);
+    add_applicative(K, ground_env, "char-downcase", kchar_downcase, 0);
 
     /* 
     ** 14.2 Library features