summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp.c217
-rw-r--r--lisp.h19
-rw-r--r--lisp.l14
-rw-r--r--lisp.y5
-rw-r--r--main.c9
5 files changed, 224 insertions, 40 deletions
diff --git a/lisp.c b/lisp.c
index 357e94c..e111c47 100644
--- a/lisp.c
+++ b/lisp.c
@@ -2,6 +2,7 @@
#include <stdio.h>
#include <readline/readline.h>
#include <readline/history.h>
+#include <math.h>
#include "lisp.h"
#include "lex.yy.h"
#include "lisp.tab.h"
@@ -41,20 +42,21 @@ value *make_nil() {
}
value *make_lambda(env *e, value *params, value *body) {
- printf("making lambda:\n");
value *l = malloc(sizeof(value));
l->type = VT_LAMBDA;
l->as.lambda.params = params;
- printf("params: ");
- print_value(params);
l->as.lambda.body = body;
- printf("\nbody: ");
- print_value(body);
- printf("\n");
l->as.lambda.env = e;
return l;
}
+value *make_builtin(value *(*fn) (env *, value *)){
+ value *val = malloc(sizeof(value));
+ val->type = VT_BUILTIN;
+ val->as.builtin.fn = fn;
+ return val;
+}
+
value *cons(value *car, value *cdr) {
value *val = malloc(sizeof(value));
val->type = VT_PAIR;
@@ -98,10 +100,26 @@ void *print_value(value *val){
break;
case VT_PAIR:
+ // DOTTED:
+ //printf("(");
+ //print_value(val->as.pair.car);
+ //printf(" . ");
+ //print_value(val->as.pair.cdr);
+ //printf(")");
+
+ // LISTS:
printf("(");
- print_value(val->as.pair.car);
- printf(" . ");
- print_value(val->as.pair.cdr);
+ print_value(car(val));
+ value *p_cdr = cdr(val);
+ while (p_cdr->type == VT_PAIR) {
+ printf(" ");
+ print_value(car(p_cdr));
+ p_cdr = cdr(p_cdr);
+ }
+ if(p_cdr->type != VT_NIL) {
+ printf(" . ");
+ print_value(p_cdr);
+ }
printf(")");
break;
@@ -111,7 +129,13 @@ void *print_value(value *val){
printf(" ");
print_value(val->as.lambda.body);
printf(")");
+ break;
+
+ case VT_BUILTIN:
+ printf("<builtin>\n");
+ break;
default:
+ printf("<unknown>\n");
}
return val;
@@ -153,24 +177,25 @@ value *env_lookup(env *e, const char *sym) {
}
value *eval(env *e, value *v) {
- value *found;
+ printf("evaluating: ");
+ print_value(v);
+ printf("\n");
if (v->type == VT_NIL) {
return v;
}
- if (v->type == VT_SYMBOL &&
- (found = env_lookup(e, v->as.sym))) {
- return found;
+ if (v->type == VT_PAIR) {
+ return eval_pair(e, v);
}
if (v->type == VT_SYMBOL) {
- printf("symbol %s not found\n", v->as.sym);
- return v;
- }
-
- if (v->type == VT_PAIR) {
- return eval_pair(e, v);
+ value *found = env_lookup(e, v->as.sym);
+ if (!found) {
+ printf("symbol %s not found\n", v->as.sym);
+ return make_nil();
+ }
+ return found;
}
return v;
@@ -180,13 +205,11 @@ value *eval_pair(env *e, value *v) {
value *head = car(v);
value *tail = cdr(v);
- value *head_eval = eval(e, head);
-
- if (head_eval->type == VT_LAMBDA) {
- apply(head_eval, tail);
+ if (head->type == VT_SYMBOL && !strcmp(head->as.sym, "quote")) {
+ return car(tail);
}
- if (!strcmp(head->as.str, "define")) {
+ if (head->type == VT_SYMBOL && !strcmp(head->as.sym, "define")) {
value *defargs = tail;
value *defname = car(defargs);
value *defval = eval(e, car(cdr(defargs)));
@@ -198,16 +221,37 @@ value *eval_pair(env *e, value *v) {
return v;
}
env_define(e, defname->as.sym, defval);
+ return defval;
}
- if (!strcmp(head->as.str, "lambda") ||
- !strcmp(head->as.str, "\\") ||
- !strcmp(head->as.str, "λ")) {
+ if (head->type == VT_SYMBOL && (!strcmp(head->as.sym, "lambda") ||
+ !strcmp(head->as.sym, "\\") ||
+ !strcmp(head->as.sym, "λ"))) {
value *params = car(tail);
value *body = car(cdr(tail));
return make_lambda(e, params, body);
}
+
+ if (head->type == VT_SYMBOL && !strcmp(head->as.sym, "if")) {
+ value *test = eval(e, car(tail));
+ if(test->type != VT_NIL) {
+ return eval(e, car(cdr(tail)));
+ } else {
+ return eval(e, car(cdr(cdr(tail))));
+ }
+ return make_nil();
+ }
+
+ value *head_eval = eval(e, head);
+ if (head_eval->type == VT_BUILTIN) {
+ return head_eval->as.builtin.fn(e, tail);
+ }
+
+ if (head_eval->type == VT_LAMBDA) {
+ return apply(head_eval, tail);
+ }
+
return v;
}
@@ -225,3 +269,122 @@ value *apply(value *lval, value *args) {
}
return eval(sub_env, lval->as.lambda.body);
}
+
+value *builtin_cons(env *e, value *args) {
+ value *v = eval(e, car(args));
+ return cons(v, car(cdr(args)));
+}
+
+value *builtin_car(env *e, value *args) {
+ return car(eval(e, car(args)));
+}
+
+value *builtin_cdr(env *e, value *args) {
+ return cdr(eval(e, car(args)));
+}
+
+value *builtin_isnull(env *e, value *args) {
+ value *v = eval(e, car(args));
+ if(v->type == VT_NIL) {
+ return make_int(1);
+ }
+ return make_nil();
+}
+
+value *apply_to_nums(env *e, value *args, double (*fn)(double, double)) {
+ double result;
+ value *v = eval(e, car(args));
+ if (v->type == VT_INT) {
+ result = v->as.i;
+ } else if (v->type == VT_DOUBLE) {
+ result = v->as.d;
+ } else {
+ printf("not a number: ");
+ print_value(v);
+ printf("\n");
+ return make_nil();
+ }
+
+ args = cdr(args);
+ while (args->type == VT_PAIR) {
+ v = eval(e, car(args));
+ if (v->type == VT_INT) {
+ result = fn(result, v->as.i);
+ } else if (v->type == VT_DOUBLE) {
+ result = fn(result, v->as.d);
+ } else {
+ printf("not a number: ");
+ print_value(v);
+ printf("\n");
+ return make_nil();
+ }
+ args = cdr(args);
+ }
+
+ if(is_integer(result)){
+ return make_int((int) result);
+ }
+ return make_double(result);
+}
+
+double add_fn(double x, double y) { return x+y; }
+value *builtin_add(env *e, value *args) {
+ return apply_to_nums(e, args, add_fn);
+}
+
+double sub_fn(double x, double y) { return x-y; }
+value *builtin_sub(env *e, value *args) {
+ return apply_to_nums(e, args, sub_fn);
+}
+
+double mul_fn(double x, double y) { return x*y; }
+value *builtin_mul(env *e, value *args) {
+ return apply_to_nums(e, args, mul_fn);
+}
+
+double div_fn(double x, double y) { return x/y; }
+value *builtin_div(env *e, value *args) {
+ return apply_to_nums(e, args, div_fn);
+}
+
+value *builtin_le(env *e, value *args) {
+ double prev_num;
+ value *v = eval(e, car(args));
+
+ if (v->type == VT_INT) {
+ prev_num = v->as.i;
+ } else if (v->type == VT_DOUBLE) {
+ prev_num = v->as.d;
+ } else {
+ printf("not a number: ");
+ print_value(v);
+ printf("\n");
+ return make_nil();
+ }
+
+ args = cdr(args);
+ while (args->type == VT_PAIR) {
+ v = eval(e, car(args));
+ double cur_num;
+ if (v->type == VT_INT) {
+ cur_num = v->as.i;
+ } else if (v->type == VT_DOUBLE) {
+ cur_num = v->as.d;
+ } else {
+ printf("not a number: ");
+ print_value(v);
+ printf("\n");
+ return make_nil();
+ }
+ if(prev_num > cur_num) {
+ return make_nil();
+ }
+ prev_num = cur_num;
+ args = cdr(args);
+ }
+ return make_int(1);
+}
+
+int is_integer(double x) {
+ return floor(x) == x && isfinite(x);
+}
diff --git a/lisp.h b/lisp.h
index a43f750..b7e5a94 100644
--- a/lisp.h
+++ b/lisp.h
@@ -11,7 +11,8 @@ typedef enum {
VT_STRING,
VT_NIL,
VT_PAIR,
- VT_LAMBDA
+ VT_LAMBDA,
+ VT_BUILTIN
} val_type;
struct value {
@@ -30,6 +31,9 @@ struct value {
value *body;
env *env;
} lambda;
+ struct {
+ value *(*fn) (env *, value *);
+ } builtin;
} as;
};
@@ -39,6 +43,7 @@ value *make_symbol(const char *sym);
value *make_string(const char *str);
value *make_nil();
value *make_lambda(env *e, value *params, value *body);
+value *make_builtin(value *(*fn) (env *, value *));
value *cons(value *car, value *cdr);
value *car(value *cons);
value *cdr(value *cons);
@@ -64,4 +69,16 @@ value *eval_pair(env *e, value *val);
value *apply(value *lambda, value *args);
+value *builtin_cons(env *e, value *args);
+value *builtin_car(env *e, value *args);
+value *builtin_cdr(env *e, value *args);
+value *builtin_isnull(env *e, value *args);
+value *builtin_add(env *e, value *args);
+value *builtin_sub(env *e, value *args);
+value *builtin_mul(env *e, value *args);
+value *builtin_div(env *e, value *args);
+value *builtin_le(env *e, value *args);
+
+int is_integer(double x);
+
#endif
diff --git a/lisp.l b/lisp.l
index 7a9eece..5ad5c57 100644
--- a/lisp.l
+++ b/lisp.l
@@ -7,14 +7,14 @@ int tcnt = 0;
%}
%%
-[[:space:]]+ { printf("%d: WHITESPACE\n", tcnt); /*ignore whitespace*/}
-"(" { printf("%d: LPAREN\n", ++tcnt); return LPAREN; }
-")" { printf("%d: RPAREN\n", ++tcnt); return RPAREN; }
-"\." { printf("%d: DOT\n", ++tcnt); return DOT; }
+[[:space:]]+ { /*ignore whitespace*/}
+"(" { return LPAREN; }
+")" { return RPAREN; }
+"\." { return DOT; }
[+-]?([0-9]+|([0-9]*\.[0-9]+))([eE][-+]?[0-9]+)? {
yylval.dval = atof(yytext);
- printf("%d: NUMBER: %f\n", ++tcnt, yylval.dval);
+
return NUMBER;
}
@@ -27,13 +27,13 @@ int tcnt = 0;
str[len] = '\0';
yylval.strval = str;
- printf("%d: STRING: \"%s\"\n", ++tcnt, yylval.strval);
+
return STRING;
}
[^[:space:]\"().]+ {
yylval.strval = strdup(yytext);
- printf("%d: SYMBOL: %s\n", ++tcnt, yylval.strval);
+
return SYMBOL;
}
. ; // do nothing
diff --git a/lisp.y b/lisp.y
index 8ed479d..e8dd961 100644
--- a/lisp.y
+++ b/lisp.y
@@ -1,15 +1,10 @@
%{
#include <stdio.h>
#include <stdlib.h>
-#include <math.h>
#include "lisp.h"
int yylex(void);
int yyerror(const char *s);
-
-static int is_integer(double x) {
- return floor(x) == x && isfinite(x);
-}
%}
%union {
diff --git a/main.c b/main.c
index c9f9acd..f297402 100644
--- a/main.c
+++ b/main.c
@@ -12,6 +12,15 @@ env *global_env = NULL;
int main(void) {
// init global env
global_env = env_create(NULL);
+ env_define(global_env, "cons", make_builtin(builtin_cons));
+ env_define(global_env, "car", make_builtin(builtin_car));
+ env_define(global_env, "cdr", make_builtin(builtin_cdr));
+ env_define(global_env, "null?", make_builtin(builtin_isnull));
+ env_define(global_env, "+", make_builtin(builtin_add));
+ env_define(global_env, "-", make_builtin(builtin_sub));
+ env_define(global_env, "*", make_builtin(builtin_mul));
+ env_define(global_env, "/", make_builtin(builtin_div));
+ env_define(global_env, "<=", make_builtin(builtin_le));
// START REPL
char* line;
while ((line = readline("λ > ")) != NULL) {
generated by cgit v1.2.3 (git 2.39.1) at 2026-09-18 01:48:23 +0000