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

Contract lambda first in a lambda application

Browse source 
Try to prevent timing issues that occur when the application is contracted first, and arguments can be removed too early.
This commit is contained in:
Justin Ethier 2016-05-23 22:29:48 -04:00
parent 3dc541c99b
commit 58bc782022
1 changed files with 34 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -317,40 +317,43 @@
,(opt:contract (if->else exp)))) ,(opt:contract (if->else exp))))
; Application: ; Application:
((app? exp) ((app? exp)
(cond (let* ((fnc (opt:contract (car exp))))
((and (ast:lambda? (car exp)) (cond
(list? (ast:lambda-args (car exp))) ;; Avoid optional/extra args ((and (ast:lambda? fnc)
(= (length (ast:lambda-args (car exp))) (list? (ast:lambda-args fnc)) ;; Avoid optional/extra args
(length (app->args exp)))) (= (length (ast:lambda-args fnc))
(let ((new-params '()) (length (app->args exp))))
(new-args '()) (let ((new-params '())
(args (cdr exp))) (new-args '())
(for-each (args (cdr exp)))
(lambda (param) (for-each
(let ((var (adb:get/default param #f))) (lambda (param)
(cond (let ((var (adb:get/default param #f)))
((and var (adbv:const? var)) (cond
#f) ((and var (adbv:const? var))
(else #f)
;; Collect the params/args not optimized-out (else
(set! new-args (cons (car args) new-args)) ;; Collect the params/args not optimized-out
(set! new-params (cons param new-params)))) (set! new-args (cons (car args) new-args))
(set! args (cdr args)))) (set! new-params (cons param new-params))))
(ast:lambda-args (car exp))) (set! args (cdr args))))
;(trace:error `(DEBUG contract args ,(app->args exp) (ast:lambda-args fnc))
; new-args ,new-args ;(trace:e rror `(DEBUG contract args ,(app->args exp)
; params ,(ast:lambda-args (car exp)) ; new-args ,new-args
; new-params ,new-params)) ; params ,(ast:lambda-args fnc)
(map ; new-params ,new-params))
opt:contract
(cons (cons
(ast:%make-lambda (ast:%make-lambda
(ast:lambda-id (car exp)) (ast:lambda-id fnc)
(reverse new-params) (reverse new-params)
(ast:lambda-body (car exp))) (ast:lambda-body fnc))
(reverse new-args))))) (map
(else opt:contract
(map (lambda (e) (opt:contract e)) exp)))) (reverse new-args)))))
(else
(cons
fnc
(map (lambda (e) (opt:contract e)) (cdr exp)))))))
(else (else
(error "CPS optimize [1] - Unknown expression" exp)))) (error "CPS optimize [1] - Unknown expression" exp))))