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

WIP - Cyc-seq

Browse source
This commit is contained in:
Justin Ethier 2018-10-30 12:06:47 -04:00
parent 2d4a5f0f44
commit 6f65432c2a
1 changed files with 7 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
scheme/cyclone/cps-optimizations.sld
View file

@ -353,7 +353,8 @@
(lambda-body (lambda->exp define-body)) (lambda-body (lambda->exp define-body))
(fv (filter (fv (filter
(lambda (v) (lambda (v)
(not (prim? v))) (and (not (equal? 'Cyc-seq v))
(not (prim? v))))
(free-vars expr))) (free-vars expr)))
) )
;(trace:error `(JAE DEBUG ,(define->var expr) ,fv)) ;(trace:error `(JAE DEBUG ,(define->var expr) ,fv))
@ -1679,7 +1680,7 @@
(body (ast:lambda-body exp)) (body (ast:lambda-body exp))
(new-free-vars (new-free-vars
(difference (difference
(difference (free-vars body) (ast:lambda-formals->list exp)) (difference (free-vars body) (cons 'Cyc-seq (ast:lambda-formals->list exp)))
globals)) globals))
(formals (list->lambda-formals (formals (list->lambda-formals
(cons new-self-var (ast:lambda-formals->list exp)) (cons new-self-var (ast:lambda-formals->list exp))
@ -1725,6 +1726,9 @@
(let ((fn (car exp)) (let ((fn (car exp))
(args (map cc (cdr exp)))) (args (map cc (cdr exp))))
(cond (cond
((tagged-list? 'Cyc-seq exp)
(cons 'Cyc-seq
(map cc (cdr exp))))
((ast:lambda? fn) ((ast:lambda? fn)
(cond (cond
;; If the lambda argument is not used, flag so the C code is ;; If the lambda argument is not used, flag so the C code is
@ -1752,7 +1756,7 @@
(let* ((body (ast:lambda-body fn)) (let* ((body (ast:lambda-body fn))
(new-free-vars (new-free-vars
(difference (difference
(difference (free-vars body) (ast:lambda-formals->list fn)) (difference (free-vars body) (cons 'Cyc-seq (ast:lambda-formals->list fn)))
globals)) globals))
(new-free-vars? (> (length new-free-vars) 0))) (new-free-vars? (> (length new-free-vars) 0)))
(if new-free-vars? (if new-free-vars?