Relocated old CPS optimization code

This commit is contained in:
Justin Ethier 2016-05-20 00:44:30 -04:00
parent 308bba3c9b
commit 89d3444ca9
2 changed files with 55 additions and 56 deletions

View file

@ -290,4 +290,59 @@
;ast ;; DEBUGGING!!!
(opt:contract ast)
)
;; Older code, delete this soon
;;;; TODO: don't think we can assume lambda body is single expr, if we want
;;;; to do optimizations such as inlining
;;(define (cps-optimize-01 exp)
;; exp) ;; Temporarily disabling while this is reworked.
;;; (define (opt-lambda exp)
;;; (let ((body (car (lambda->exp exp)))) ;; Single expr after CPS
;;; ;(trace:error `(DEBUG
;;; ; ,exp
;;; ; ,body
;;; ; ,(if (and (pair? body) (app? body) (lambda? (car body)))
;;; ; (list (app->args body)
;;; ; (lambda->formals exp))
;;; ; #f)))
;;; (cond
;;; ;; Does the function just call its continuation?
;;; ((and (pair? body)
;;; (app? body)
;;; (lambda? (car body))
;;; ;; TODO: need to check body length if we allow >1 expr in a body
;;; ;; TODO: not sure this is good enough for all cases
;;; (equal? (app->args body)
;;; ;(lambda->formals (car body))
;;; (lambda->formals exp)
;;; )
;;; (> (length (lambda->formals exp)) 0)
;;; ;; TODO: don't do it if args are used in the body
;;; ;; this won't work if we have any num other than 1 arg
;;; (not (member
;;; (car (lambda->formals exp))
;;; (free-vars (car body))))
;;; )
;;; (cps-optimize-01 (car body)))
;;; (else
;;; `(lambda ,(lambda->formals exp)
;;; ,(cps-optimize-01 (car (lambda->exp exp)))) ;; Assume single expr in lambda body, since after CPS phase
;;; ))))
;;; (cond
;;; ; Core forms:
;;; ((const? exp) exp)
;;; ((ref? exp) exp)
;;; ((prim? exp) exp)
;;; ((quote? exp) exp)
;;; ((lambda? exp) (opt-lambda exp))
;;; ((set!? exp) `(set!
;;; ,(set!->var exp)
;;; ,(cps-optimize-01 (set!->exp exp))))
;;; ((if? exp) `(if ,(cps-optimize-01 (if->condition exp))
;;; ,(cps-optimize-01 (if->then exp))
;;; ,(cps-optimize-01 (if->else exp))))
;;; ; Application:
;;; ((app? exp) (map (lambda (e) (cps-optimize-01 e)) exp))
;;; (else (error "CPS optimize unknown expression type: " exp))))
))

View file

@ -127,7 +127,6 @@
wrap-mutables
alpha-convert
cps-convert
cps-optimize-01
pos-in-list
closure-convert
)
@ -1549,61 +1548,6 @@
(cps ast '%halt)))))
ast-cps))
;; CPS optimizations
;; TODO: don't think we can assume lambda body is single expr, if we want
;; to do optimizations such as inlining
(define (cps-optimize-01 exp)
exp) ;; Temporarily disabling while this is reworked.
; (define (opt-lambda exp)
; (let ((body (car (lambda->exp exp)))) ;; Single expr after CPS
; ;(trace:error `(DEBUG
; ; ,exp
; ; ,body
; ; ,(if (and (pair? body) (app? body) (lambda? (car body)))
; ; (list (app->args body)
; ; (lambda->formals exp))
; ; #f)))
; (cond
; ;; Does the function just call its continuation?
; ((and (pair? body)
; (app? body)
; (lambda? (car body))
; ;; TODO: need to check body length if we allow >1 expr in a body
; ;; TODO: not sure this is good enough for all cases
; (equal? (app->args body)
; ;(lambda->formals (car body))
; (lambda->formals exp)
; )
; (> (length (lambda->formals exp)) 0)
; ;; TODO: don't do it if args are used in the body
; ;; this won't work if we have any num other than 1 arg
; (not (member
; (car (lambda->formals exp))
; (free-vars (car body))))
; )
; (cps-optimize-01 (car body)))
; (else
; `(lambda ,(lambda->formals exp)
; ,(cps-optimize-01 (car (lambda->exp exp)))) ;; Assume single expr in lambda body, since after CPS phase
; ))))
; (cond
; ; Core forms:
; ((const? exp) exp)
; ((ref? exp) exp)
; ((prim? exp) exp)
; ((quote? exp) exp)
; ((lambda? exp) (opt-lambda exp))
; ((set!? exp) `(set!
; ,(set!->var exp)
; ,(cps-optimize-01 (set!->exp exp))))
; ((if? exp) `(if ,(cps-optimize-01 (if->condition exp))
; ,(cps-optimize-01 (if->then exp))
; ,(cps-optimize-01 (if->else exp))))
; ; Application:
; ((app? exp) (map (lambda (e) (cps-optimize-01 e)) exp))
; (else (error "CPS optimize unknown expression type: " exp))))
;; Closure-conversion.
;;
;; Closure conversion eliminates all of the free variables from every