This commit is contained in:
Justin Ethier 2016-01-08 23:22:44 -05:00
parent 52cd5c48e1
commit 1b1320ebf0
2 changed files with 40 additions and 17 deletions

View file

@ -298,8 +298,8 @@
; Global definition ; Global definition
((define? exp) ((define? exp)
(c-compile-global exp append-preamble cont trace)) (c-compile-global exp append-preamble cont trace))
; ((define-c? exp) ((define-c? exp)
; (c-compile-raw-global-lambda exp append-preamble cont trace)) (c-compile-raw-global-lambda exp append-preamble cont trace))
; Special case - global function w/out a closure. Create an empty closure ; Special case - global function w/out a closure. Create an empty closure
((tagged-list? 'lambda exp) ((tagged-list? 'lambda exp)
(c-compile-exp (c-compile-exp
@ -995,12 +995,19 @@
;; TODO: not tested, does not work yet: ;; TODO: not tested, does not work yet:
(define (c-compile-raw-global-lambda exp append-preamble cont trace) (define (c-compile-raw-global-lambda exp append-preamble cont trace)
(let* ((lid (allocate-lambda (c-compile-lambda lam trace))) (let* (
(fnc-name (string-append "static void __lambda_" (number->string lid)))) ;(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 (add-global
(define->var exp) (define->var exp)
#t ;(lambda? body) #t ;(lambda? body)
(c-code (caddr exp)) (c-code (cadddr exp))
;(c-compile-exp ;(c-compile-exp
; body append-preamble cont ; body append-preamble cont
; (st:add-function! trace var)) ; (st:add-function! trace var))
@ -1307,11 +1314,19 @@
; Print the prototypes: ; Print the prototypes:
(for-each (for-each
(lambda (l) (lambda (l)
(cond
((equal? 'precompiled-lambda (cadr l))
(emit*
"static void __lambda_"
(number->string (car l))
(caddr l)
" ;"))
(else
(emit* (emit*
"static void __lambda_" "static void __lambda_"
(number->string (car l)) "(void *data, int argc, " (number->string (car l)) "(void *data, int argc, "
(cdadr l) (cdadr l)
") ;")) ") ;"))))
lambdas) lambdas)
(emit "") (emit "")
@ -1319,7 +1334,17 @@
; Print the definitions: ; Print the definitions:
(for-each (for-each
(lambda (l) (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) lambdas)
; Emit entry point ; Emit entry point

View file

@ -1,6 +1,6 @@
(define-library (scheme load) (define-library (scheme load)
(export (export
; prim-test ;; TODO: This is just temporary, of course prim-test ;; TODO: This is just temporary, of course
load) load)
(import (scheme base) (import (scheme base)
(scheme eval) (scheme eval)
@ -15,11 +15,9 @@
;; lambda portion is computed, so we can't include that. ;; lambda portion is computed, so we can't include that.
;; compiler would need to insert the "static void (lambda)" part ;; 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?? ;; TODO: maybe break up into two args, one being the args list and the other being the function body??
; (define-c prim-test " (define-c prim-test
; (void *data, int argc, closure _, object k, object arg1, object arg2) { "(void *data, int argc, closure _, object k, object arg1, object arg2)"
; return_closcall1(data, k, arg1); " return_closcall1(data, k, arg1); ")
; }
; ")
;; End FFI ;; End FFI
(define (load filename . env) (define (load filename . env)
(let ((exprs (call-with-input-file filename (let ((exprs (call-with-input-file filename