Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-11 23:07:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding define-c

Browse source
This commit is contained in:
Justin Ethier 2016-01-07 22:45:03 -05:00
parent 16f420e057
commit 69e8450c1b
1 changed files with 17 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
scheme/cyclone/transforms.sld
View file

@ -86,7 +86,7 @@
define->lambda define->lambda
define->var define->var
define->exp define->exp
define-c define-c?
set!? set!?
set!->var set!->var
set!->exp set!->exp
@ -888,6 +888,12 @@
(loop (cdr top-lvl) (loop (cdr top-lvl)
(cons (car top-lvl) globals) (cons (car top-lvl) globals)
exprs)))) exprs))))
((define-c? (car top-lvl))
;; Add as a new global, for now keep things simple
;; since this is compiler-specific
(loop (cdr top-lvl)
(cons (car top-lvl) globals)
exprs))
(else (else
(loop (cdr top-lvl) (loop (cdr top-lvl)
globals globals
@ -916,7 +922,8 @@
(let ((globals '())) (let ((globals '()))
(for-each (for-each
(lambda (e) (lambda (e)
(if (define? e) (if (or (define? e)
(define-c? e))
(set! globals (cons (define->var e) globals)))) (set! globals (cons (define->var e) globals))))
exp) exp)
globals)) globals))
@ -978,6 +985,7 @@
(search (if->else exp))))) (search (if->else exp)))))
((define? exp) (union (list (define->var exp)) ((define? exp) (union (list (define->var exp))
(search (define->exp exp)))) (search (define->exp exp))))
((define-c? exp) (list (define->var exp)))
((set!? exp) (union (list (set!->var exp)) ((set!? exp) (union (list (set!->var exp))
(search (set!->exp exp)))) (search (set!->exp exp))))
; Application: ; Application:
@ -1399,13 +1407,17 @@
(let* ((global-def? (define? ast)) ;; No internal defines by this phase (let* ((global-def? (define? ast)) ;; No internal defines by this phase
(ast-cps (ast-cps
(if global-def? (cond
(global-def?
(remove-unused (remove-unused
`(define ,(define->var ast) `(define ,(define->var ast)
,@(let ((k (gensym 'k)) ,@(let ((k (gensym 'k))
(r (gensym 'r))) (r (gensym 'r)))
(cps (car (define->exp ast)) 'unused)))) (cps (car (define->exp ast)) 'unused)))))
(cps ast '%halt)))) ((define-c? ast)
ast)
(else
(cps ast '%halt)))))
ast-cps)) ast-cps))