diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index b1cee0fd..7f83d48a 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -298,8 +298,8 @@ ; Global definition ((define? exp) (c-compile-global exp append-preamble cont trace)) -; ((define-c? exp) -; (c-compile-raw-global-lambda exp append-preamble cont trace)) + ((define-c? exp) + (c-compile-raw-global-lambda exp append-preamble cont trace)) ; Special case - global function w/out a closure. Create an empty closure ((tagged-list? 'lambda exp) (c-compile-exp @@ -995,12 +995,19 @@ ;; TODO: not tested, does not work yet: (define (c-compile-raw-global-lambda exp append-preamble cont trace) - (let* ((lid (allocate-lambda (c-compile-lambda lam trace))) - (fnc-name (string-append "static void __lambda_" (number->string lid)))) + (let* ( + ;(fnc-name (string-append "static void __lambda_" (number->string lid))) + (lambda-data + `(precompiled-lambda + ,(caddr exp) ;; Args + ,(cadddr exp) ;; Body + )) + (lid (allocate-lambda lambda-data)) + ) (add-global (define->var exp) #t ;(lambda? body) - (c-code (caddr exp)) + (c-code (cadddr exp)) ;(c-compile-exp ; body append-preamble cont ; (st:add-function! trace var)) @@ -1307,11 +1314,19 @@ ; Print the prototypes: (for-each (lambda (l) - (emit* - "static void __lambda_" - (number->string (car l)) "(void *data, int argc, " - (cdadr l) - ") ;")) + (cond + ((equal? 'precompiled-lambda (cadr l)) + (emit* + "static void __lambda_" + (number->string (car l)) + (caddr l) + " ;")) + (else + (emit* + "static void __lambda_" + (number->string (car l)) "(void *data, int argc, " + (cdadr l) + ") ;")))) lambdas) (emit "") @@ -1319,7 +1334,17 @@ ; Print the definitions: (for-each (lambda (l) - (emit ((caadr l) (string-append "__lambda_" (number->string (car l)))))) + (cond + ((equal? 'precompiled-lambda (cadr l)) + (emit* + "static void __lambda_" + (number->string (car l)) + (caddr l) + " {" + (cadddr l) + " }")) + (else + (emit ((caadr l) (string-append "__lambda_" (number->string (car l)))))))) lambdas) ; Emit entry point diff --git a/scheme/load.sld b/scheme/load.sld index fe9f9a92..c7563a35 100644 --- a/scheme/load.sld +++ b/scheme/load.sld @@ -1,6 +1,6 @@ (define-library (scheme load) (export -; prim-test ;; TODO: This is just temporary, of course + prim-test ;; TODO: This is just temporary, of course load) (import (scheme base) (scheme eval) @@ -15,11 +15,9 @@ ;; lambda portion is computed, so we can't include that. ;; compiler would need to insert the "static void (lambda)" part ;; TODO: maybe break up into two args, one being the args list and the other being the function body?? -; (define-c prim-test " -; (void *data, int argc, closure _, object k, object arg1, object arg2) { -; return_closcall1(data, k, arg1); -; } -; ") + (define-c prim-test + "(void *data, int argc, closure _, object k, object arg1, object arg2)" + " return_closcall1(data, k, arg1); ") ;; End FFI (define (load filename . env) (let ((exprs (call-with-input-file filename