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

Issue #449 - Selectively disable optimizations

Browse source 
Memoize optimizations are not compatible with top-level define-c forms, so for now we disable these optimizations in this situation.
This commit is contained in:
Justin Ethier 2021-03-02 22:30:49 -05:00
parent 209050b2d4
commit d874c05266
1 changed files with 47 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

82
scheme/cyclone/cps-opt-memoize-pure-fncs.scm
View file

@ -168,42 +168,54 @@
(map scan exp)) (map scan exp))
(else exp) (else exp)
)) ))
(let ((new-exp (scan sexp)))
(cond
((not (null? memo-tbl))
(when (procedure? add-globals!)
(add-globals! (map cdr memo-tbl)))
(append
(map
(lambda (var/new-var)
`(define ,(car var/new-var) #f))
memo-tbl)
(map
(lambda (exp)
(cond
((define? exp) exp) ;; not top-level
(else
;; Memoize all of the functions at top-level
(foldl
(lambda (var/new-var acc)
(let* ((rsym (gensym 'r))
(var (car var/new-var))
(new-var (cdr var/new-var))
(body
`((Cyc-seq
(set-global-unsafe! ,(list 'quote var) ,var ,rsym)
,acc)))
)
`(Cyc-memoize
,(ast:make-lambda (list rsym) body)
,new-var)))
exp
memo-tbl)
)))
new-exp)))
(else new-exp)))
)
;; Does given sexp contain any top-level define-c expressions?
(define (has-define-c? sexp)
(call/cc
(lambda (k)
(for-each
(lambda (exp)
(if (define-c? exp)
(k #t)))
sexp)
(k #f))))
(if (has-define-c? sexp)
sexp ;; Can't optimize with define-c (yet), so bail
(let ((new-exp (scan sexp)))
(cond
((not (null? memo-tbl))
(when (procedure? add-globals!)
(add-globals! (map cdr memo-tbl)))
(append
(map
(lambda (var/new-var)
`(define ,(car var/new-var) #f))
memo-tbl)
(map
(lambda (exp)
(cond
((define? exp) exp) ;; not top-level
(else
;; Memoize all of the functions at top-level
(foldl
(lambda (var/new-var acc)
(let* ((rsym (gensym 'r))
(var (car var/new-var))
(new-var (cdr var/new-var))
(body
`((Cyc-seq
(set-global-unsafe! ,(list 'quote var) ,var ,rsym)
,acc)))
)
`(Cyc-memoize
,(ast:make-lambda (list rsym) body)
,new-var)))
exp
memo-tbl)
)))
new-exp)))
(else new-exp)))))
(cond-expand (cond-expand
(program (program