klisp

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

commit 58b97810b01f918ab81670f47ad5f8a62c7eb62c
parent 3294f249fa0c31bf357c4240010cb6a44b355e08
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat, 12 Mar 2011 18:16:24 -0300

Added car and cdr to the ground environment.

Diffstat:
Msrc/kground.c | 58++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 58 insertions(+), 0 deletions(-)

diff --git a/src/kground.c b/src/kground.c @@ -1236,7 +1236,54 @@ void Slambda(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) kapply_cc(K, new_app); } +/* +** 5.4 Pairs and lists +*/ + +/* 5.4.1 car, cdr */ +/* 5.4.2 caar, cadr, ... cddddr */ +/* the name stands for the regular expression c[ad]{1,4}r */ +void c_ad_r( klisp_State *K, TValue *xparams, TValue ptree, TValue denv) +{ + + /* + ** xparams[0]: name as symbol + ** xparams[1]: an int with the less significant 2 nibbles + ** standing for the count and the branch selection. + ** The high nibble is the count: that is the number of + ** 'a's and 'd's in the name, for example: + ** 0x1? for car and cdr. + ** 0x2? for caar, cadr, cdar and cddr. + ** The low nibble is the branch selection, a 0 bit means + ** car, a 1 bit means cdr, the first bit to be applied + ** is bit 0 so: caar=0x20, cadr=0x21, cdar:0x22, cddr 0x23 + */ + + char *name = ksymbol_buf(xparams[0]); + int p = ivalue(xparams[1]); + int count = (p >> 4) & 0xf; + int branches = p & 0xf; + + bind_1p(K, name, ptree, obj); + /* TEST */ + printf("In c[ad]{1,4}r: %s, count: %d, branches: %x\n", name, count, + branches); + printf("c"); + + while(count) { + if (!ttispair(obj)) { + klispE_throw_extra(K, name, ": non pair found while traversing"); + return; + } + obj = ((branches & 1) == 0)? kcar(obj) : kcdr(obj); + printf("%c", ((branches & 1) == 0)? 'a' : 'd'); + branches >>= 1; + --count; + } + printf("r\n"); + kapply_cc(K, obj); +} /* ** This is called once to bind all symbols in the ground environment @@ -1411,5 +1458,16 @@ TValue kmake_ground_env(klisp_State *K) /* 5.3.2 $lambda */ add_operative(K, ground_env, "$lambda", Slambda, 0); + /* + ** 5.4 Pairs and lists + */ + + /* 5.4.1 car, cdr */ + add_applicative(K, ground_env, "car", c_ad_r, 2, symbol, i2tv(0x10)); + add_applicative(K, ground_env, "cdr", c_ad_r, 2, symbol, i2tv(0x11)); + + /* 5.4.2 caar, cadr, ... cddddr */ + /* TODO */ + return ground_env; }