Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 04:55:04 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Expose UDF inlines and original symbols

Browse source
This commit is contained in:
Justin Ethier 2017-04-24 23:03:09 +00:00
parent 1c82f0e74a
commit 6e1073387a
1 changed files with 12 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
scheme/cyclone/cgen.sld
View file

@ -840,17 +840,17 @@
;; Global inlinable functions ;; Global inlinable functions
(define *global-inlines* '()) (define *global-inlines* '())
(define (add-global-inline var-sym) (define (add-global-inline orig-sym inline-sym)
(set! *global-inlines* (cons var-sym *global-inlines*))) (set! *global-inlines* (cons (cons orig-sym inline-sym) *global-inlines*)))
;; Add a global inlinable function that is written in Scheme. ;; Add a global inlinable function that is written in Scheme.
;; This is more challenging than define-c forms since the ;; This is more challenging than define-c forms since the
;; code must be compiled again to work without CPS. ;; code must be compiled again to work without CPS.
(define *global-inline-scms* '()) ;(define *global-inline-scms* '())
(define (add-global-inline-scm-lambda var-sym code) ;(define (add-global-inline-scm-lambda var-sym code)
(add-global-inline var-sym) ; (add-global-inline var-sym )
(set! *global-inline-scms* ; (set! *global-inline-scms*
(cons (list var-sym code) *global-inline-scms*))) ; (cons (list var-sym code) *global-inline-scms*)))
;; Global compilation ;; Global compilation
(define *globals* '()) (define *globals* '())
@ -881,6 +881,7 @@
(when (and (lambda? body) (when (and (lambda? body)
(prim:udf? (define-c->inline-var exp))) (prim:udf? (define-c->inline-var exp)))
(add-global-inline (add-global-inline
var
(define-c->inline-var exp)) (define-c->inline-var exp))
(add-global (add-global
(define-c->inline-var exp) (define-c->inline-var exp)
@ -924,7 +925,7 @@
(let ((fnc-sym (let ((fnc-sym
(define-c->inline-var exp))) (define-c->inline-var exp)))
;(trace:error `(JAE define-c inline detected ,fnc-sym)) ;(trace:error `(JAE define-c inline detected ,fnc-sym))
(add-global-inline fnc-sym) (add-global-inline (define->var exp) fnc-sym)
(c-compile-raw-global-lambda (c-compile-raw-global-lambda
`(define-c ,fnc-sym ,@(cddddr exp)) `(define-c ,fnc-sym ,@(cddddr exp))
append-preamble append-preamble
@ -1418,14 +1419,10 @@
(head-pair #f)) (head-pair #f))
(for-each (for-each
(lambda (g) (lambda (g)
(let ((cvar-sym (mangle (gensym 'cvar))) (let ((pair-sym (mangle (gensym 'pair))))
(pair-sym (mangle (gensym 'pair))))
(emits*
" make_cvar(" cvar-sym
", (object *)&" (cgen:mangle-global g) ");")
(emits* (emits*
"make_pair(" pair-sym ", find_or_add_symbol(\"" (symbol->string g) "make_pair(" pair-sym ", find_or_add_symbol(\"" (symbol->string (car g))
"\"), &" cvar-sym ");\n") "\"), find_or_add_symbol(\"" (symbol->string (cdr g)) "\"));\n")
(set! pairs (cons pair-sym pairs)))) (set! pairs (cons pair-sym pairs))))
*global-inlines*) *global-inlines*)
;; Link the pairs ;; Link the pairs