sjs/lake
1
0
Fork 0
mirror of https://github.com/samsonjs/lake.git synced 2026-03-25 08:55:49 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

add car, cdr, cons

Browse source
This commit is contained in:
Sami Samhuri 2011-04-20 20:48:06 -07:00
parent 65015374fa
commit 575502f69b
3 changed files with 41 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/list.c
View file

@ -43,6 +43,14 @@ LakeList *list_make(void)
return list;
}
LakeList *list_cons(LakeVal *car, LakeVal *cdr)
{
LakeList *list = list_make_with_capacity(2);
list->vals[0] = car;
list->vals[1] = cdr;
return list;
}
LakeList *list_make_with_capacity(size_t cap)
{
LakeList *list = list_alloc();

1
src/list.h
View file

@ -15,6 +15,7 @@
#include "string.h"
LakeList *list_make(void);
LakeList *list_cons(LakeVal *car, LakeVal *cdr);
void list_free(LakeList *list);
LakeList *list_make_with_capacity(size_t cap);
LakeList *list_from_array(size_t n, LakeVal *vals[]);

32
src/primitive.c
View file

@ -164,6 +164,35 @@ static LakeVal *prim_int_eq(LakeList *args)
return VAL(bool_from_int(result));
}
static LakeVal *prim_car(LakeList *args)
{
LakeList *list = LIST(LIST_VAL(args, 0));
if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
return LIST_VAL(list, 0);
}
ERR("not a pair: %s", list_repr(list));
return NULL;
}
static LakeVal *prim_cdr(LakeList *args)
{
LakeList *list = LIST(LIST_VAL(args, 0));
if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
LakeList *cdr = list_copy(list);
list_shift(cdr);
return VAL(cdr);
}
ERR("not a pair: %s", list_repr(list));
return NULL;
}
static LakeVal *prim_cons(LakeList *args)
{
LakeVal *car = LIST_VAL(args, 0);
LakeVal *cdr = LIST_VAL(args, 1);
return VAL(list_cons(car, cdr));
}
Env *primitive_bindings(void)
{
#define DEFINE(name, fn, arity) env_define(env, sym_intern(name), VAL(prim_make(name, arity, fn)))
@ -177,5 +206,8 @@ Env *primitive_bindings(void)
DEFINE("*", prim_mul, ARITY_VARARGS);
DEFINE("/", prim_div, ARITY_VARARGS);
DEFINE("=", prim_int_eq, ARITY_VARARGS);
DEFINE("car", prim_car, 1);
DEFINE("cdr", prim_cdr, 1);
DEFINE("cons", prim_cons, 2);
return env;
}