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

Refactoring

Browse source
This commit is contained in:
Justin Ethier 2018-10-25 17:42:02 -04:00
parent 67698ec9a7
commit 8bd87a8ef6
2 changed files with 22 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
scheme/cyclone/cgen.sld
View file

@ -31,6 +31,8 @@
emits emits
emits* emits*
emit-newline emit-newline
;; Helpers
self-closure-call?
) )
(inline (inline
global-not-lambda? global-not-lambda?
@ -418,7 +420,7 @@
(create-cons (create-cons
(lambda (cvar a b) (lambda (cvar a b)
(c-code/vars (c-code/vars
(string-append "alloca_pair(" cvar "," (c:body a) "," (c:body b) ");") (string-append "make_pair(" cvar "," (c:body a) "," (c:body b) ");")
(append (c:allocs a) (c:allocs b)))) (append (c:allocs a) (c:allocs b))))
) )
(_c-compile-scalars (_c-compile-scalars
@ -436,7 +438,8 @@
(_c-compile-scalars (cdr args))))) (_c-compile-scalars (cdr args)))))
(set! num-args (+ 1 num-args)) (set! num-args (+ 1 num-args))
(c-code/vars (c-code/vars
cvar-name ;; Not needed with alloca - (string-append "&" cvar-name) ;;cvar-name ;; Not needed with alloca - (string-append "&" cvar-name)
(string-append "&" cvar-name)
(append (append
(c:allocs cell) (c:allocs cell)
(list (c:body cell)))))))))) (list (c:body cell))))))))))
@ -762,6 +765,22 @@
;; END primitives ;; END primitives
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Detect closure call of the form:
;; (%closure-ref
;; (cell-get (%closure-ref self$249 1))
;; 0)
;;TODO: need adbf, only a closure call if inner-cref's index matches adbf:self-closure-index
(define (self-closure-call? ast self)
(and-let* (((tagged-list? '%closure-ref ast))
((tagged-list? 'cell-get (cadr ast)))
(inner-cref (cadadr ast))
((tagged-list? '%closure-ref inner-cref))
(equal? self (cadr inner-cref))
((equal? 0 (caddr ast)))
((equal? 1 (caddr inner-cref)))
)
#t))
; c-compile-ref : ref-exp -> string ; c-compile-ref : ref-exp -> string
(define (c-compile-ref exp) (define (c-compile-ref exp)
(c-code (c-code
@ -967,7 +986,7 @@
(cond (cond
;; Handle recursive calls via iteration, if possible ;; Handle recursive calls via iteration, if possible
((and ast-fnc ((and ast-fnc
;#f ;; TODO: temporarily disabled #f ;; TODO: temporarily disabled
(adbf:calls-self? ast-fnc) (adbf:calls-self? ast-fnc)
(self-closure-call? fun (car (adbf:all-params ast-fnc))) (self-closure-call? fun (car (adbf:all-params ast-fnc)))
) )

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

@ -92,8 +92,6 @@
adbf:calls-self? adbf:set-calls-self! adbf:calls-self? adbf:set-calls-self!
with-fnc with-fnc
with-fnc! with-fnc!
;; Helpers
self-closure-call?
) )
(begin (begin
;; The following two defines allow non-CPS functions to still be considered ;; The following two defines allow non-CPS functions to still be considered
@ -1790,22 +1788,6 @@
(list (convert exp #f '())) (list (convert exp #f '()))
#f)) #f))
;; Detect closure call of the form:
;; (%closure-ref
;; (cell-get (%closure-ref self$249 1))
;; 0)
TODO: need adbf, only a closure call if inner-cref's index matches adbf:self-closure-index
(define (self-closure-call? ast self)
(and-let* (((tagged-list? '%closure-ref ast))
((tagged-list? 'cell-get (cadr ast)))
(inner-cref (cadadr ast))
((tagged-list? '%closure-ref inner-cref))
(equal? self (cadr inner-cref))
((equal? 0 (caddr ast)))
((equal? 1 (caddr inner-cref)))
)
#t))
(define (analyze:find-named-lets exp) (define (analyze:find-named-lets exp)
(define (scan exp lp) (define (scan exp lp)
(cond (cond