klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

commit 66534051fd2ca953cb3e5fe3f63302b25f450276
parent 2740797a4b72a9ddcca5e9696366a81bcc2b96df
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 18 Mar 2011 16:04:09 -0300

Bugfix + Added char-alphabetic?, char-numeric?, char-whitespace?, char-upper-case? & char-lower-case? to the ground environment.
Bugfix: added p2tv wrapper around kis_input_port & kis_ouput_port in use of ftypep. The error wasn't detected in the compiler because of the use of VAR_ARGS.

Diffstat:
Msrc/Makefile | 8+++++---
Asrc/kgchars.c | 57+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Asrc/kgchars.h | 58++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Msrc/kground.c | 18++++++++++++++----
Msrc/kobject.h | 2+-
5 files changed, 135 insertions(+), 8 deletions(-)

diff --git a/src/Makefile b/src/Makefile @@ -14,7 +14,7 @@ CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \ kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \ kgsymbols.o kgcontrol.o kgpairs_lists.o kgpair_mut.o kgenvironments.o \ kgenv_mut.o kgcombiners.o kgcontinuations.o kgencapsulations.o \ - kgpromises.o kgkd_vars.o kgks_vars.o kgports.o + kgpromises.o kgkd_vars.o kgks_vars.o kgports.o kgchars.o KRN_T= klisp KRN_O= klisp.o @@ -54,7 +54,7 @@ kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h \ klisp.h kport.h kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h \ kground.h kenvironment.h kpair.h keval.h koperative.h kground.h \ - krepl.h kcontinuation.h kapplicative.h kport.h ksymbol.h kport.h + krepl.h kcontinuation.h kapplicative.h kport.h ksymbol.h kport.h kmem.o: kmem.c kmem.h klisp.h kerror.h klisp.h kstate.h kerror.o: kerror.c kerror.h klisp.h kstate.h klisp.h kmem.h kstring.h kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h klisp.h @@ -80,7 +80,7 @@ kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \ kgbooleans.h kgeqp.h kgequalp.h kgsymbols.h kgpairs_lists.h \ kgpair_mut.h kgenvironments.h kgenv_mut.h kgcombiners.h \ kgcontinuations.h kgencapsulations.h kgpromises.h kgkd_vars.h \ - kgks_vars.h kgports.h + kgks_vars.h kgports.h kgchars.h kghelpers.o: kghelpers.c kghelpers.h kstate.h kstate.h klisp.h kpair.h \ kapplicative.h koperative.h kerror.h kobject.h ksymbol.h kgbooleans.o: kgbooleans.c kgbooleans.c kghelpers.h kstate.h klisp.h \ @@ -125,3 +125,5 @@ kgports.o: kgports.c kgports.h kghelpers.h kstate.h klisp.h \ kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h \ kport.h ksymbol.h kread.h kwrite.h ktoken.h kgcontinuations.h \ kpair.h kenvironment.h +kgchars.o: kgchars.c kgchars.h kghelpers.h kstate.h klisp.h \ + kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h diff --git a/src/kgchars.c b/src/kgchars.c @@ -0,0 +1,57 @@ +/* +** kgchars.c +** Characters features for the ground environment +** See Copyright Notice in klisp.h +*/ + +#include <assert.h> +#include <stdio.h> +#include <stdlib.h> +#include <stdbool.h> +#include <stdint.h> +#include <ctype.h> + +#include "kstate.h" +#include "kobject.h" +#include "kapplicative.h" +#include "koperative.h" +#include "kcontinuation.h" +#include "kerror.h" + +#include "kghelpers.h" +#include "kgchars.h" + +/* 14.1.1? char? */ +/* uses typep */ + +/* 14.1.2? char-alphabetic?, char-numeric?, char-whitespace? */ +/* use ftyped_predp */ + +/* 14.1.3? char-upper-case?, char-lower-case? */ +/* use ftyped_predp */ + +/* Helpers for typed predicates */ +bool kcharp(TValue tv) { return ttischar(tv); } +bool kchar_alphabeticp(TValue ch) { return isalpha(chvalue(ch)) != 0; } +bool kchar_numericp(TValue ch) { return isdigit(chvalue(ch)) != 0; } +bool kchar_whitespacep(TValue ch) { return isspace(chvalue(ch)) != 0; } +bool kchar_upper_casep(TValue ch) { return isupper(chvalue(ch)) != 0; } +bool kchar_lower_casep(TValue ch) { return islower(chvalue(ch)) != 0; } + +/* 14.1.4? char->integer, integer->char */ +/* TODO */ + +/* 14.1.4? char-upcase, char-downcase */ +/* TODO */ + +/* 14.2.1? char=? */ +/* TODO */ + +/* 14.2.2? char<?, char<=?, char>?, char>=? */ +/* TODO */ + +/* 14.2.3? char-ci=? */ +/* TODO */ + +/* 14.2.4? char-ci<?, char-ci<=?, char-ci>?, char-ci>=? */ +/* TODO */ diff --git a/src/kgchars.h b/src/kgchars.h @@ -0,0 +1,58 @@ +/* +** kgchars.c +** Characters features for the ground environment +** See Copyright Notice in klisp.h +*/ + +#ifndef kgchars_h +#define kgchars_h + +#include <assert.h> +#include <stdio.h> +#include <stdlib.h> +#include <stdbool.h> +#include <stdint.h> + +#include "kobject.h" +#include "klisp.h" +#include "kstate.h" +#include "kghelpers.h" + +/* 14.1.1? char? */ +/* uses typep */ + +/* 14.1.2? char-alphabetic?, char-numeric?, char-whitespace? */ +/* use ftyped_predp */ + +/* 14.1.3? char-upper-case?, char-lower-case? */ +/* use ftyped_predp */ + +/* Helpers for typed predicates */ +/* XXX: this should probably be in a file kchar.h but there is no real need for + that file yet */ +bool kcharp(TValue tv); +bool kchar_alphabeticp(TValue ch); +bool kchar_numericp(TValue ch); +bool kchar_whitespacep(TValue ch); +bool kchar_upper_casep(TValue ch); +bool kchar_lower_casep(TValue ch); + +/* 14.1.4? char->integer, integer->char */ +/* TODO */ + +/* 14.1.4? char-upcase, char-downcase */ +/* TODO */ + +/* 14.2.1? char=? */ +/* TODO */ + +/* 14.2.2? char<?, char<=?, char>?, char>=? */ +/* TODO */ + +/* 14.2.3? char-ci=? */ +/* TODO */ + +/* 14.2.4? char-ci<?, char-ci<=?, char-ci>?, char-ci>=? */ +/* TODO */ + +#endif diff --git a/src/kground.c b/src/kground.c @@ -36,6 +36,7 @@ #include "kgkd_vars.h" #include "kgks_vars.h" #include "kgports.h" +#include "kgchars.h" /* ** BEWARE: this is highly unhygienic, it assumes variables "symbol" and @@ -493,12 +494,21 @@ void kinit_ground_env(klisp_State *K) /* 14.1.2? char-alphabetic?, char-numeric?, char-whitespace? */ /* unlike in r5rs these take an arbitrary number of chars (even cyclical list) */ - /* TODO */ + add_applicative(K, ground_env, "char-alphabetic?", ftyped_predp, 3, + symbol, p2tv(kcharp), p2tv(kchar_alphabeticp)); + add_applicative(K, ground_env, "char-numeric?", ftyped_predp, 3, + symbol, p2tv(kcharp), p2tv(kchar_numericp)); + add_applicative(K, ground_env, "char-whitespace?", ftyped_predp, 3, + symbol, p2tv(kcharp), p2tv(kchar_whitespacep)); /* 14.1.3? char-upper-case?, char-lower-case? */ /* unlike in r5rs these take an arbitrary number of chars (even cyclical list) */ - /* TODO */ + add_applicative(K, ground_env, "char-upper-case?", ftyped_predp, 3, + symbol, p2tv(kcharp), p2tv(kchar_upper_casep)); + add_applicative(K, ground_env, "char-lower-case?", ftyped_predp, 3, + symbol, p2tv(kcharp), p2tv(kchar_lower_casep)); + /* 14.1.4? char->integer, integer->char */ /* TODO */ @@ -538,10 +548,10 @@ void kinit_ground_env(klisp_State *K) /* 15.1.2 input-port?, output-port? */ add_applicative(K, ground_env, "input-port?", ftypep, 2, symbol, - kis_input_port); + p2tv(kis_input_port)); add_applicative(K, ground_env, "output-port?", ftypep, 2, symbol, - kis_output_port); + p2tv(kis_output_port)); /* 15.1.3 with-input-from-file, with-ouput-to-file */ /* TODO */ diff --git a/src/kobject.h b/src/kobject.h @@ -405,7 +405,7 @@ const TValue keminf; #define ch2tv(ch_) ((TValue) ch2tv_(ch_)) #define i2tv(i_) ((TValue) i2tv_(i_)) #define b2tv(b_) ((TValue) b2tv_(b_)) -#define p2tv(p_) ((TValue) b2tv_(p_)) +#define p2tv(p_) ((TValue) p2tv_(p_)) /* Macros to convert a GCObject * into a tagged value */ /* TODO: add assertions */