Permalink
Browse files

lambdas are called through data nodes

  • Loading branch information...
1 parent 47d0a10 commit c78764af284a252a0951494a6d94b593362fccb6 @mikea committed Jun 30, 2008
Showing with 127 additions and 11 deletions.
  1. +30 −6 compile.scm
  2. +75 −4 runtime.c
  3. +17 −0 runtime.ll.h
  4. +1 −0 runtime_shared.h
  5. +4 −1 tests/020_lambda.scm
View
@@ -101,6 +101,12 @@
result-var res-ptr-var-load)
result-var))))
+(define (ptr-to-type d)
+ (format "getelementptr (DATA* ~a, i32 0, i32 1)" d))
+
+(define (ptr-to-data d)
+ (format "getelementptr (DATA* ~a, i32 0, i32 0)" d))
+
(define (compile-lambda e i env)
(let* ((formals (cadr e))
(body (caddr e))
@@ -111,8 +117,26 @@
proc-name (string-join formals-definition ",") e)
(let ((ret (compile body global-list (append add-env env))))
(gen-global "ret DATA* ~a" ret)
- (gen-global "}"))
- proc-name))
+ (gen-global "}")
+ (let* ((var-data (next-literal-var))
+ (var-lambda (next-literal-var))
+ (args-type (map (lambda (x) (format "DATA*" x)) formals))
+ (function-type (format "DATA* (~a)*" (string-join args-type ", ")))
+ (lambda-ptr (next-local-var)))
+ (gen-global "~a = internal constant DATA zeroinitializer; ~a" var-data e)
+ (gen-global "~a = internal constant LAMBDA zeroinitializer; ~a" var-lambda e)
+ (gen-global-init "; init ~a" e)
+ (gen-global-init "store i8 T_LAMBDA, i8* ~a"
+ (ptr-to-type var-data))
+ (gen-global-init "store i8* bitcast (LAMBDA* ~a to i8*), i8** ~a"
+ var-lambda (ptr-to-data var-data))
+ (gen-global-init "store i32 ~a, i32* getelementptr (LAMBDA* ~a, i32 0, i32 0)"
+ (length formals) var-lambda)
+ (gen-global-init "~a = bitcast ~a ~a to i8*"
+ lambda-ptr function-type proc-name)
+ (gen-global-init "store i8* ~a, i8** getelementptr (LAMBDA* ~a, i32 0, i32 1)"
+ lambda-ptr var-lambda)
+ var-data))))
(define (compile-call e i env)
(let* ((args (map (lambda (e1) (compile e1 i env)) (cdr e)))
@@ -133,8 +157,8 @@
(if (eq? 'lambda (caar e))
;; compile lambda
(let ((lambda-var (compile-lambda (car e) i env)))
- (gen-to-list i "~a = call DATA* ~a(~a)"
- var lambda-var arglist)
+ (gen-to-list i "~a = call DATA* @call~a(DATA* ~a, ~a)"
+ var (length args) lambda-var arglist)
var)
(error i "Can't compile call: ~a" e)))))
@@ -256,10 +280,10 @@
(define (output-footer)
(display "ret void\n")
(display "}\n")
+ (display globals)
(display "define void @scheme_init() {\n")
(display global-init)
- (display "ret void\n}\n")
- (display globals))
+ (display "ret void\n}\n"))
(define (read-list)
(let loop ()
View
@@ -15,14 +15,33 @@ typedef struct {
Data* cdr;
} Cons;
-#define CHECK(b) assert(b)
-#define CHECK_IS_CONS(d) CHECK(d && d->type == T_CONS)
-#define CHECK_IS_INT(d) CHECK(d && d->type == T_INT)
-#define CHECK_IS_SYMBOL(d) CHECK(d && d->type == T_SYMBOL)
+typedef struct {
+ int arity;
+ void* proc;
+} Lambda;
+
+typedef Data* (*proc0)();
+typedef Data* (*proc1)(Data*);
+typedef Data* (*proc2)(Data*, Data*);
+typedef Data* (*proc3)(Data*, Data*, Data*);
+typedef Data* (*proc4)(Data*, Data*, Data*, Data*);
+typedef Data* (*proc5)(Data*, Data*, Data*, Data*, Data*);
+typedef Data* (*proc6)(Data*, Data*, Data*, Data*, Data*, Data*);
+typedef Data* (*proc7)(Data*, Data*, Data*, Data*, Data*, Data*, Data*);
+typedef Data* (*proc8)(Data*, Data*, Data*, Data*, Data*, Data*, Data*, Data*);
+typedef Data* (*proc9)(Data*, Data*, Data*, Data*, Data*, Data*, Data*, Data*, Data*);
#define CONS(d) ((Cons*)(d->data))
#define CHARP(d) ((char*)(d->data))
#define INT(d) ((int)(d->data))
+#define LAMBDA(d) ((Lambda*)(d->data))
+#define PROC(d) ((void*)(LAMBDA(d)->proc))
+
+#define CHECK(b) assert(b)
+#define CHECK_IS_CONS(d) CHECK(d && d->type == T_CONS)
+#define CHECK_IS_INT(d) CHECK(d && d->type == T_INT)
+#define CHECK_IS_SYMBOL(d) CHECK(d && d->type == T_SYMBOL)
+#define CHECK_IS_LAMBDA(d, a) CHECK(d && d->type == T_LAMBDA && LAMBDA(d)->arity == a)
Data* car(Data* d) {
if (!d) {
@@ -107,6 +126,58 @@ Data* display(Data* d) {
return 0;
}
+Data* call0(Data* d) {
+ CHECK_IS_LAMBDA(d, 0);
+ return ((proc0)(PROC(d)))();
+}
+
+Data* call1(Data* d, Data* p1) {
+ CHECK_IS_LAMBDA(d, 1);
+ return ((proc1)(PROC(d)))(p1);
+}
+
+Data* call2(Data* d, Data* p1, Data* p2) {
+ CHECK_IS_LAMBDA(d, 2);
+ return ((proc2)(PROC(d)))(p1, p2);
+}
+
+Data* call3(Data* d, Data* p1, Data* p2, Data* p3) {
+ CHECK_IS_LAMBDA(d, 3);
+ return ((proc3)(PROC(d)))(p1, p2, p3);
+}
+
+Data* call4(Data* d, Data* p1, Data* p2, Data* p3, Data* p4) {
+ CHECK_IS_LAMBDA(d, 4);
+ return ((proc4)(PROC(d)))(p1, p2, p3, p4);
+}
+
+Data* call5(Data* d, Data* p1, Data* p2, Data* p3, Data* p4, Data* p5) {
+ CHECK_IS_LAMBDA(d, 5);
+ return ((proc5)(PROC(d)))(p1, p2, p3, p4, p5);
+}
+
+Data* call6(Data* d, Data* p1, Data* p2, Data* p3, Data* p4, Data* p5, Data* p6) {
+ CHECK_IS_LAMBDA(d, 6);
+ return ((proc6)(PROC(d)))(p1, p2, p3, p4, p5, p6);
+}
+
+Data* call7(Data* d, Data* p1, Data* p2, Data* p3, Data* p4, Data* p5, Data* p6, Data* p7) {
+ CHECK_IS_LAMBDA(d, 7);
+ return ((proc7)(PROC(d)))(p1, p2, p3, p4, p5, p6, p7);
+}
+
+Data* call8(Data* d, Data* p1, Data* p2, Data* p3, Data* p4, Data* p5, Data* p6, Data* p7,
+ Data* p8) {
+ CHECK_IS_LAMBDA(d, 8);
+ return ((proc8)(PROC(d)))(p1, p2, p3, p4, p5, p6, p7, p8);
+}
+
+Data* call9(Data* d, Data* p1, Data* p2, Data* p3, Data* p4, Data* p5, Data* p6, Data* p7,
+ Data* p8, Data* p9) {
+ CHECK_IS_LAMBDA(d, 9);
+ return ((proc9)(PROC(d)))(p1, p2, p3, p4, p5, p6, p7, p8, p9);
+}
+
Data* symbols;
int symbols_size;
int symbols_count;
View
@@ -6,9 +6,11 @@
#define DATA %struct.Data
#define CONS %struct.Cons
+#define LAMBDA %struct.Lambda
DATA = type { i8*, i8 }
CONS = type { DATA*, DATA* }
+LAMBDA = type { i32, i8* }
declare DATA* @car(DATA* %d)
declare DATA* @cdr(DATA* %d)
@@ -21,5 +23,20 @@ declare DATA* @string_to_symbol(i8* %str)
declare DATA* @get_env(DATA* %symbol)
declare void @llvm.memcpy.i32(i8* %dst, i8* %src, i32 %size, i32 %align)
+declare DATA* @call0(DATA* %d)
+declare DATA* @call1(DATA* %d, DATA* %p1)
+declare DATA* @call2(DATA* %d, DATA* %p1, DATA* %p2)
+declare DATA* @call3(DATA* %d, DATA* %p1, DATA* %p2, DATA* %p3)
+declare DATA* @call4(DATA* %d, DATA* %p1, DATA* %p2, DATA* %p3, DATA* %p4)
+declare DATA* @call5(DATA* %d, DATA* %p1, DATA* %p2, DATA* %p3, DATA* %p4, DATA* %p5)
+declare DATA* @call6(DATA* %d, DATA* %p1, DATA* %p2, DATA* %p3, DATA* %p4, DATA* %p5,
+ DATA* %p6)
+declare DATA* @call7(DATA* %d, DATA* %p1, DATA* %p2, DATA* %p3, DATA* %p4, DATA* %p5,
+ DATA* %p6, DATA* %p7)
+declare DATA* @call8(DATA* %d, DATA* %p1, DATA* %p2, DATA* %p3, DATA* %p4, DATA* %p5,
+ DATA* %p6, DATA* %p7, DATA* %p8)
+declare DATA* @call9(DATA* %d, DATA* %p1, DATA* %p2, DATA* %p3, DATA* %p4, DATA* %p5,
+ DATA* %p6, DATA* %p7, DATA* %p8, DATA* %p9)
+
#endif
View
@@ -7,5 +7,6 @@
#define T_INT 4
#define T_CHAR 5
#define T_BUILTIN 6
+#define T_LAMBDA 7
#endif
View
@@ -2,4 +2,7 @@
;; (1 2)
((lambda (x) (car x)) '(1 2))
-;; 1
+;; 1
+
+((lambda (x y) (+ x y)) 5 6)
+;; 11

0 comments on commit c78764a

Please sign in to comment.