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

Make it easier to enable/disable WKL

Browse source
This commit is contained in:
Justin Ethier 2018-09-27 17:49:04 -04:00
parent 3b1f124b6a
commit 03b4f21b66
1 changed files with 9 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
scheme/cyclone/cgen.sld
View file

@ -41,6 +41,8 @@
) )
(begin (begin
(define *optimize-well-known-lambdas* #f)
(define (emit line) (define (emit line)
(display line) (display line)
(newline)) (newline))
@ -126,7 +128,8 @@
(emit (c-macro-closcall arity)) (emit (c-macro-closcall arity))
(emit (c-macro-return-closcall arity)) (emit (c-macro-return-closcall arity))
(emit (c-macro-return-direct arity)) (emit (c-macro-return-direct arity))
(emit (c-macro-return-direct-with-closure arity)) (when *optimize-well-known-lambdas*
(emit (c-macro-return-direct-with-closure arity)))
) )
) )
(emit-c-arity-macros (+ arity 1)))) (emit-c-arity-macros (+ arity 1))))
@ -901,6 +904,7 @@
) )
(cond (cond
((and wkf fnc ((and wkf fnc
*optimize-well-known-lambdas*
(adbf:well-known fnc) ;; not really needed (adbf:well-known fnc) ;; not really needed
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
(let* ((lid (ast:lambda-id wkf)) (let* ((lid (ast:lambda-id wkf))
@ -957,7 +961,7 @@
;need to use (well-known-lambda) to check the ref to see if it is a WKL. ;need to use (well-known-lambda) to check the ref to see if it is a WKL.
;if so, lookup ast and use cgen-id to map back to emit the lambda_gc_ret there ;if so, lookup ast and use cgen-id to map back to emit the lambda_gc_ret there
(with-fnc (ast:lambda-id (closure->lam fun)) (lambda (fnc) (with-fnc (ast:lambda-id (closure->lam fun)) (lambda (fnc)
(if (and ;#f (if (and *optimize-well-known-lambdas*
(adbf:well-known fnc) (adbf:well-known fnc)
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
(let* ((lid (ast:lambda-id (closure->lam fun))) (let* ((lid (ast:lambda-id (closure->lam fun)))
@ -1263,7 +1267,7 @@
(with-fnc ast-id (lambda (fnc) (with-fnc ast-id (lambda (fnc)
(trace:info `(c-compile-closure-element-ref ,ast-id ,var ,idx ,fnc)) (trace:info `(c-compile-closure-element-ref ,ast-id ,var ,idx ,fnc))
(cond (cond
((and ;#f ((and *optimize-well-known-lambdas*
(adbf:well-known fnc) (adbf:well-known fnc)
;(pair? (adbf:all-params fnc)) ;(pair? (adbf:all-params fnc))
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
@ -1305,7 +1309,7 @@
(lid (allocate-lambda lam (c-compile-lambda lam trace cps?) cps?)) (lid (allocate-lambda lam (c-compile-lambda lam trace cps?) cps?))
(use-obj-instead-of-closure? (use-obj-instead-of-closure?
(with-fnc (ast:lambda-id lam) (lambda (fnc) (with-fnc (ast:lambda-id lam) (lambda (fnc)
(and ;#f (and *optimize-well-known-lambdas*
(adbf:well-known fnc) ;; Only optimize well-known functions (adbf:well-known fnc) ;; Only optimize well-known functions
;(equal? (length free-vars) 1) ;; Sanity check ;(equal? (length free-vars) 1) ;; Sanity check
(equal? (adbf:closure-size fnc) 1) ;; From closure conv (equal? (adbf:closure-size fnc) 1) ;; From closure conv
@ -1671,7 +1675,7 @@
;; (equal? (adbf:closure-size fnc) 1)) ;; (equal? (adbf:closure-size fnc) 1))
;; (trace:error `(JAE ,(car l) ,l ,fnc))) ;; (trace:error `(JAE ,(car l) ,l ,fnc)))
(when (and ;#f (when (and *optimize-well-known-lambdas*
(adbf:well-known fnc) (adbf:well-known fnc)
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
;(trace:error `(JAE ,(car l) ,l ,fnc)) ;(trace:error `(JAE ,(car l) ,l ,fnc))