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

Temporarily disable well-known fnc changes

Browse source
This commit is contained in:
Justin Ethier 2018-09-25 12:38:30 -04:00
parent 2fe6b80b3e
commit bad93ae229
1 changed files with 8 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
scheme/cyclone/cgen.sld
View file

@ -924,7 +924,8 @@
(else ;; CPS, IE normal behavior (else ;; CPS, IE normal behavior
(set-c-call-arity! num-cargs) (set-c-call-arity! num-cargs)
(with-fnc (ast:lambda-id (closure->lam fun)) (lambda (fnc) (with-fnc (ast:lambda-id (closure->lam fun)) (lambda (fnc)
(if (and (adbf:well-known fnc) (if (and #f
(adbf:well-known fnc)
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
(let* ((lid (adbf:cgen-id fnc)) (let* ((lid (adbf:cgen-id fnc))
(c-lambda-fnc-str (string-append "__lambda_" (number->string lid))) (c-lambda-fnc-str (string-append "__lambda_" (number->string lid)))
@ -1225,7 +1226,8 @@
(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 (adbf:well-known fnc) ((and #f
(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))
(mangle (car (adbf:all-params fnc)))) (mangle (car (adbf:all-params fnc))))
@ -1266,7 +1268,8 @@
(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 (adbf:well-known fnc) ;; Only optimize well-known functions (and #f
(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
)))) ))))
@ -1625,7 +1628,8 @@
(let ((ast (caddr l))) (let ((ast (caddr l)))
(when (ast:lambda? ast) (when (ast:lambda? ast)
(with-fnc (ast:lambda-id ast) (lambda (fnc) (with-fnc (ast:lambda-id ast) (lambda (fnc)
(when (and (adbf:well-known fnc) (when (and #f
(adbf:well-known fnc)
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
;(trace:error `(JAE ,l ,fnc)) ;(trace:error `(JAE ,l ,fnc))
(let* ((params-str (cdadr l)) (let* ((params-str (cdadr l))