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

WIP - beta expansion

Browse source
This commit is contained in:
Justin Ethier 2017-05-12 17:30:10 +00:00
parent 9618e35364
commit 341679a479
1 changed files with 32 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1167,7 +1167,11 @@
(let* ((args (cdr exp)) (let* ((args (cdr exp))
(var (adb:get (car exp))) (var (adb:get (car exp)))
;; Function definition, or #f if none ;; Function definition, or #f if none
(fnc (adbv:assigned-value var)) (fnc* (adbv:assigned-value var))
(fnc (if (and (pair? fnc*)
(ast:lambda? (car fnc*)))
(car fnc*)
fnc*))
(formals (if (ast:lambda? fnc) (ast:lambda-args fnc) '())) (formals (if (ast:lambda? fnc) (ast:lambda-args fnc) '()))
;; First formal, or #f if none ;; First formal, or #f if none
(maybe-cont (if (and (list? formals) (pair? formals)) (maybe-cont (if (and (list? formals) (pair? formals))
@ -1181,18 +1185,37 @@
) )
(trace:error `(JAE beta expand ,exp ,var ,fnc ,formals ,cont)) (trace:error `(JAE beta expand ,exp ,var ,fnc ,formals ,cont))
(cond (cond
;; TODO: first arg to the lambda could be a cont, in which ;; TODO: what if fnc has no cont? do we need to handle differently?
;; case it needs to be removed from formals list and body
((and (ast:lambda? fnc) ((and (ast:lambda? fnc)
(or ;(= (length args) (length formals)) (= (length args) (length formals)))
(and (= (length args) (- (length formals) 1)) ;(trace:error `(JAE DEBUG beta expand ,exp))
cont))) (beta-expansion exp fnc) ; exp
;;todo: set up a map, and replace each formal with its corresponding arg
(trace:error `(JAE DEBUG beta expand ,exp))
exp
) )
(else exp)))) ;; beta expansion failed (else exp)))) ;; beta expansion failed
;; Replace function call with body of fnc
(define (beta-expansion exp fnc)
;; Mapping from a formal => actual arg
(define formals/actuals
(map cons (ast:lambda-args fnc) (cdr exp)))
(define (replace ref)
(let ((r (assoc ref formals/actuals)))
(if r (cdr r) ref)))
(define (scan exp)
(cond
((ast:lambda? exp)
(ast:%make-lambda
(ast:lambda-id exp)
(ast:lambda-args exp)
(scan (ast:lambda-body exp))
(ast:lambda-has-cont exp)))
((ref? exp)
(replace exp))
((app? exp)
(map scan exp))
(else exp)))
(scan (car (ast:lambda-body fnc))))
(define (analyze-cps exp) (define (analyze-cps exp)
(analyze-find-lambdas exp -1) (analyze-find-lambdas exp -1)
(analyze-lambda-side-effects exp -1) (analyze-lambda-side-effects exp -1)