Skip to content

Commit

Permalink
almost working
Browse files Browse the repository at this point in the history
  • Loading branch information
@jaz303
jaz303 committed Jan 4, 2012
1 parent a9420c7 commit f0b944e
Show file tree
Hide file tree
Showing 8 changed files with 179 additions and 113 deletions.
7 changes: 7 additions & 0 deletions TODO
View file
@@ -0,0 +1,7 @@
1: setjmp/longjmp for abort on error
2: finish garbage collector, make incremental
2.1: bindings should not be garbage collected objects
3: atom/ident distinction
4: unicode strings
5: '( quote syntax
6: reimplement as VM
12 changes: 11 additions & 1 deletion include/lispy/eval.h
View file
Expand Up @@ -2,8 +2,18 @@
#define EVAL_H

#include "lispy/lispy.h"
#include "lispy/binding.h"

#define EVAL(val) (IS_LIST(val) ? (eval_list(env, binding, AS_LIST(val))) : (val))
#define EVAL3(_e, _b, _v) \
(IS_LIST(_v) \
? (eval_list(_e, _b, AS_LIST(_v))) \
: (VALUE_IS_IDENT(_v) \
? (binding_lookup(_b, IDENT(_v))) \
: (_v) \
) \
)

#define EVAL(val) EVAL3(env, binding, val)

VALUE eval(env_t *env, binding_t *binding, VALUE val);
VALUE eval_list(env_t *env, binding_t *binding, list_t *list);
Expand Down
1 change: 1 addition & 0 deletions include/lispy/gc.h
View file
Expand Up @@ -11,5 +11,6 @@ string_t* gc_alloc_string(gc_mgr_t *mgr, const char *str);
float_t* gc_alloc_float(gc_mgr_t *mgr, float val);
binding_t* gc_alloc_binding(gc_mgr_t *mgr, binding_t *parent);
native_fn_t* gc_alloc_native_fn(gc_mgr_t *mgr, size_t arity, native_fn *fn);
lambda_t* gc_alloc_lambda(gc_mgr_t *mgr, binding_t *binding, list_t *args, list_t *defn);

#endif
11 changes: 11 additions & 0 deletions include/lispy/lispy.h
View file
Expand Up @@ -45,6 +45,7 @@ typedef struct env env_t;
#define TYPE_FLOAT 3
#define TYPE_BINDING 4
#define TYPE_NATIVE_FN 5
#define TYPE_LAMBDA 6

#define IS_OBJECT(v) (VALUE_IS_PTR(v))
#define IS_A(v, t) (((obj_t*)v)->type == t)
Expand All @@ -54,12 +55,14 @@ typedef struct env env_t;
#define IS_FLOAT(v) (IS_OBJECT(v) && IS_A(v, TYPE_FLOAT))
#define IS_BINDING(v) (IS_OBJECT(v) && IS_A(v, TYPE_BINDING))
#define IS_NATIVE_FN(v) (IS_OBJECT(v) && IS_A(v, TYPE_NATIVE_FN))
#define IS_LAMBDA(v) (IS_OBJECT(v) && IS_A(v, TYPE_LAMBDA))

#define AS_LIST(v) ((list_t*)v)
#define AS_STRING(v) ((string_t*)v)
#define AS_FLOAT(v) ((float_t*)v)
#define AS_BINDING(v) ((binding_t*)v)
#define AS_NATIVE_FN(v) ((native_fn_t*)v)
#define AS_LAMBDA(v) ((lambda_t*)v)

typedef struct obj {
int type;
Expand Down Expand Up @@ -103,6 +106,14 @@ typedef struct {
native_fn *fn;
} native_fn_t;

typedef struct {
obj_t obj;
binding_t *binding;
size_t arity;
list_t *args;
list_t *defn;
} lambda_t;

#define list_len(list) (AS_LIST(list)->length)
#define list_get(list, ix) (AS_LIST(list)->values[ix])
#define list_set(list, ix, val) (AS_LIST(list)->values[ix]=(VALUE)val)
Expand Down
2 changes: 1 addition & 1 deletion src/binding.c
View file
Expand Up @@ -51,7 +51,7 @@ void binding_set(binding_t *binding, INTERN key, VALUE value) {
VALUE binding_lookup(binding_t *binding, INTERN key) {
binding_t *source = binding_find(binding, key);
if (source) {
return binding_get(binding, key);
return binding_get(source, key);
} else {
return kNil;
}
Expand Down
15 changes: 6 additions & 9 deletions src/env.c
View file
Expand Up @@ -19,15 +19,12 @@ int env_init(env_t *env) {

/* add builtin names to symbol table first so we know what their interned values will be */

intern_table_put(&env->intern, "def"); // 1
intern_table_put(&env->intern, "do"); // 2
intern_table_put(&env->intern, "if"); // 3
intern_table_put(&env->intern, "println"); // 4
intern_table_put(&env->intern, "quote"); // 5
intern_table_put(&env->intern, "set"); // 6
intern_table_put(&env->intern, "get"); // 7
intern_table_put(&env->intern, "first"); // 8
intern_table_put(&env->intern, "rest"); // 9
intern_table_put(&env->intern, "quote"); // 1
intern_table_put(&env->intern, "if"); // 2
intern_table_put(&env->intern, "set!"); // 3
intern_table_put(&env->intern, "define"); // 4
intern_table_put(&env->intern, "lambda"); // 5
intern_table_put(&env->intern, "begin"); // 6

env->gc.root = NULL;
env->gc.head = NULL;
Expand Down
232 changes: 130 additions & 102 deletions src/eval.c
View file
@@ -1,28 +1,109 @@
#include "lispy/eval.h"
#include "lispy/binding.h"
#include "lispy/gc.h"
#include "lispy/intern.h"

#include <stdio.h>

// http://norvig.com/lispy.html
// http://norvig.com/lispy2.html

#define ENSURE_ARITY(lst, arity) if (list_len(lst) != arity) return kError
#define ENSURE_MIN_ARITY(lst, min_arity) if (list_len(lst) < min_arity) return kError
#define ENSURE_MAX_ARITY(lst, max_arity) if (list_len(lst) > max_arity) return kError

#define BUILTIN(name) static inline VALUE name(env_t *env, binding_t *binding, list_t *list)

BUILTIN(eval_def) {
BUILTIN(eval_quote) {
ENSURE_ARITY(list, 2);
return list_get(list, 1);
}

BUILTIN(eval_if) {
if (list_len(list) == 3) {
return VALUE_IS_TRUTHY(EVAL(list_get(list, 1)))
? EVAL(list_get(list, 2))
: kNil;
} else if (list_len(list) == 4) {
return VALUE_IS_TRUTHY(EVAL(list_get(list, 1)))
? EVAL(list_get(list, 2))
: EVAL(list_get(list, 3));
} else {
return kError;
}
}

BUILTIN(eval_set) {
ENSURE_ARITY(list, 3);

VALUE ident = list_get(list, 1);
if (!VALUE_IS_IDENT(ident)) {
return kError;
}

binding_t *source = binding_find(binding, IDENT(ident));
if (source) {
VALUE v = EVAL(list_get(list, 2));
binding_set(source, IDENT(ident), v);
return v;
} else {
return kError;
}
}

BUILTIN(eval_define) {
ENSURE_ARITY(list, 3);

VALUE ident = list_get(list, 1),
value = list_get(list, 2);

if (!VALUE_IS_IDENT(ident)) {
return kError;
} else {
binding_set(binding, IDENT(ident), value);
}

value = EVAL(value);
binding_set(binding, IDENT(ident), value);

return value;
}

BUILTIN(eval_do) {
BUILTIN(eval_lambda) {

list_t *args = NULL;
list_t *defn = NULL;

if (list_len(list) == 3) {

args = list_get(list, 1);
defn = list_get(list, 2);

if (!IS_LIST(args)) return kError;
if (!IS_LIST(defn)) return kError;

int i;
for (i = 0; i < list_len(args); i++) {
if (!VALUE_IS_IDENT(list_get(args, i))) {
return kError;
}
}

} else if (list_len(list) == 2) {

args = NULL;
defn = list_get(list, 1);

if (!IS_LIST(defn)) return kError;

} else {

return kError;

}

return (VALUE) gc_alloc_lambda(&env->gc, binding, args, defn);
}

BUILTIN(eval_begin) {
int i;
VALUE out;
for (i = 1; i < list_len(list); i++) {
Expand All @@ -31,110 +112,57 @@ BUILTIN(eval_do) {
return out;
}

BUILTIN(eval_if) {
if (list_len(list) == 3) {
return VALUE_IS_TRUTHY(EVAL(list_get(list, 1)))
? EVAL(list_get(list, 2))
: kNil;
} else if (list_len(list) == 4) {
return VALUE_IS_TRUTHY(EVAL(list_get(list, 1)))
? EVAL(list_get(list, 2))
: EVAL(list_get(list, 3));
} else {
VALUE eval_list(env_t *env, binding_t *binding, list_t *list) {

if (list_len(list) == 0) {
return kError;
}
}

VALUE eval_list(env_t *env, binding_t *binding, list_t *list) {
if (list->length > 0) {
VALUE head = list_get(list, 0);
if (VALUE_IS_IDENT(head)) {
switch (IDENT(head)) {
case 1: return eval_def(env, binding, list);
case 2: return eval_do(env, binding, list);
case 3: return eval_if(env, binding, list);
case 4: /* println */
{
printf("println\n");
break;
}
case 5: /* quote */
{
ENSURE_ARITY(list, 2);
return list_get(list, 1);
}
case 6: /* set */
{
ENSURE_ARITY(list, 3);

VALUE ident = list_get(list, 1);
if (!VALUE_IS_IDENT(ident)) {
return kError;
}

binding_t *source = binding_find(binding, IDENT(ident));
if (source) {
VALUE v = list_get(list, 2);
binding_set(source, IDENT(ident), v);
return v;
} else {
return kError;
}
}
case 7: /* get */
{
ENSURE_ARITY(list, 2);

VALUE ident = list_get(list, 1);
if (!VALUE_IS_IDENT(ident)) {
return kError;
}

return binding_lookup(binding, IDENT(ident));
}
case 8: /* first */
{
ENSURE_ARITY(list, 2);

VALUE arg = EVAL(list_get(list, 1));
if (!IS_LIST(arg)) return kError;
if (list_len(arg) < 1) return kError;

return list_get(arg, 0);
}
case 9: /* rest */
{
ENSURE_ARITY(list, 2);

VALUE arg = EVAL(list_get(list, 1));
if (!IS_LIST(arg)) return kError;
if (list_len(arg) < 1) return kError;

list_t *rest = gc_alloc_list(&env->gc, list_len(arg) - 1);
int i;
for (i = 1; i < list_len(arg); i++) {
list_set(rest, i - 1, list_get(arg, i));
}

return (VALUE)rest;
}
default: /* something else */
{
VALUE def = binding_lookup(binding, IDENT(head));
if (IS_OBJECT(def)) {
if (IS_A(def, TYPE_NATIVE_FN)) {
if (list_len(list) - 1 == AS_NATIVE_FN(def)->arity) {
return AS_NATIVE_FN(def)->fn(env, binding, list);
}
}
}

return kError;
}

/* special forms */

VALUE head = list_get(list, 0);
if (VALUE_IS_IDENT(head)) {
switch (IDENT(head)) {
case 1: return eval_quote(env, binding, list);
case 2: return eval_if(env, binding, list);
case 3: return eval_set(env, binding, list);
case 4: return eval_define(env, binding, list);
case 5: return eval_lambda(env, binding, list);
case 6: return eval_begin(env, binding, list);
}
}

/* and the rest */

head = EVAL(head);

if (IS_OBJECT(head)) {
if (IS_A(head, TYPE_NATIVE_FN)) {
if (list_len(list) - 1 == AS_NATIVE_FN(head)->arity) {
return AS_NATIVE_FN(head)->fn(env, binding, list);
}
} else if (IS_A(head, TYPE_LAMBDA)) {
lambda_t *lambda = AS_LAMBDA(head);

if (lambda->arity != list_len(list) - 1) {
return kError;
}

binding_t *new_binding = gc_alloc_binding(&env->gc, lambda->binding);

int i;
for (i = 0; i < lambda->arity; i++) {
binding_set(new_binding,
IDENT(list_get(lambda->args, i)),
EVAL(list_get(list, i + 1)));
}

return eval_list(env, new_binding, lambda->defn);
}
}

return kError;

}

VALUE eval(env_t *env, binding_t *binding, VALUE val) {
Expand Down
12 changes: 12 additions & 0 deletions src/gc.c
View file
Expand Up @@ -104,4 +104,16 @@ native_fn_t* gc_alloc_native_fn(gc_mgr_t *mgr, size_t arity, native_fn *native)
fn->fn = native;
}
return fn;
}

lambda_t* gc_alloc_lambda(gc_mgr_t *mgr, binding_t *binding, list_t *args, list_t *defn) {
lambda_t *lambda = gc_alloc(mgr, sizeof(lambda_t));
if (lambda) {
lambda->obj.type = TYPE_LAMBDA;
lambda->binding = binding;
lambda->arity = args ? list_len(args) : 0;
lambda->args = args;
lambda->defn = defn;
}
return lambda;
}

0 comments on commit f0b944e

Please sign in to comment.