Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 1819b5d006
Fetching contributors…

Cannot retrieve contributors at this time

77 lines (65 sloc) 2.325 kb
#include "scheme.h"
scm_val env_create(scm_val parent) {
ASSERT(LIST_P(parent)) ;
return cons(NIL, parent) ;
}
scm_val env_get_pair(scm_val env, scm_val key, int force, int up) {
scm_val pair ;
ASSERT(LIST_P(env)) ;
pair = assq(CAR(env), key) ;
if (EQ_P(pair, FALSE)) {
if (up && PAIR_P(CDR(env)))
return env_get_pair(CDR(env), key, force, up) ;
if (force) {
pair = cons(key, NIL) ;
CAR(env) = cons(pair, CAR(env)) ;
}
}
return pair ;
}
scm_val env_get(scm_val env, scm_val key) {
scm_val pair = env_get_pair(env, key, 0, 1) ;
if (EQ_P(pair, FALSE)) {
scm_print(key, stderr) ;
die(": unbound variable\n") ;
}
return CDR(pair) ;
}
scm_val env_bind_formals(scm_val parent, scm_val formals, scm_val values) {
scm_val env, alist = NIL ;
if (type_of(formals) == SYMBOL) {
alist = cons(cons(formals, values), alist) ;
values = NIL ;
} else if (LIST_P(formals))
while (!NULL_P(formals)) {
ASSERT(type_of(CAR(formals)) == SYMBOL) ;
alist = cons(cons(CAR(formals), CAR(values)), alist) ;
if (LIST_P(CDR(formals))) {
formals = CDR(formals) ;
values = CDR(values) ;
} else {
ASSERT(type_of(CDR(formals)) == SYMBOL) ;
alist = cons(cons(CDR(formals), CDR(values)), alist) ;
values = NIL ;
break ;
}
}
ASSERT(NULL_P(values)) ;
env = env_create(parent) ;
CAR(env) = alist ;
return env ;
}
void env_tests(void) {
scm_val e1 = env_create(NIL), e2 = env_create(e1), e3 = env_create(e2) ;
printf("\n;; --- ENV TESTS --- ;;\n") ;
SCM_DEBUG(e3, "init") ;
env_define(e1, intern("one"), TRUE) ;
env_define(e2, intern("two"), MKTAG(2, FIXNUM)) ;
env_define(e3, intern("three"), MKTAG(333, FIXNUM)) ;
env_define(e2, intern("two2"), MKTAG(22, FIXNUM)) ;
SCM_DEBUG(e3, "e1: one->#t; e2: two->2, two2->22; e3: three->333\n") ;
env_set(e3, intern("one"), MKTAG(1111, FIXNUM)) ;
env_set(e3, intern("three"), MKTAG(4444, FIXNUM)) ;
SCM_DEBUG(e3, "e1: one->1111, three->4444\n") ;
SCM_DEBUG(env_get(e3, intern("one")), "get one") ;
}
Jump to Line
Something went wrong with that request. Please try again.