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

Cleanup

Browse source
This commit is contained in:
Justin Ethier 2016-06-09 03:13:56 -04:00
parent 7fa4cd4ebd
commit 63d6d8fbab
1 changed files with 17 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -7,17 +7,7 @@
;;;; This module performs CPS analysis and optimizations. ;;;; This module performs CPS analysis and optimizations.
;;;; ;;;;
;; TODO: ;(define-library (cps-optimizations) ;; For debugging via local unit tests
;- add 'analyze' function, can base it on expand or another transform to start
;- modify cps to use ast for lambda's
; will need analyze to use the ast, and will need
; closure conversion to recognize it, too.
; at least for now, closure conversion can output
; regular lambda's, though.
; can write initial analyze, but can't get too far without being able
; to uniquely ID each lambda
;(define-library (cps-optimizations)
(define-library (scheme cyclone cps-optimizations) (define-library (scheme cyclone cps-optimizations)
(import (scheme base) (import (scheme base)
(scheme cyclone util) (scheme cyclone util)
@ -29,7 +19,7 @@
optimize-cps optimize-cps
analyze-cps analyze-cps
opt:contract opt:contract
contract-prims opt:inline-prims
adb:clear! adb:clear!
adb:get adb:get
adb:get/default adb:get/default
@ -426,34 +416,34 @@
;; Uses analysis DB, so must be executed after analysis phase ;; Uses analysis DB, so must be executed after analysis phase
;; ;;
;; TBD: better to enhance CPS conversion to do this?? ;; TBD: better to enhance CPS conversion to do this??
(define (contract-prims exp . refs*) (define (opt:inline-prims exp . refs*)
(let ((refs (if (null? refs*) (let ((refs (if (null? refs*)
(make-hash-table) (make-hash-table)
(car refs*)))) (car refs*))))
;(trace:error `(contract-prims ,exp)) ;(trace:error `(opt:inline-prims ,exp))
(cond (cond
((ref? exp) ((ref? exp)
;; Replace lambda variables, if necessary ;; Replace lambda variables, if necessary
(let ((key (hash-table-ref/default refs exp #f))) (let ((key (hash-table-ref/default refs exp #f)))
(if key (if key
(contract-prims key refs) (opt:inline-prims key refs)
exp))) exp)))
((ast:lambda? exp) ((ast:lambda? exp)
(ast:%make-lambda (ast:%make-lambda
(ast:lambda-id exp) (ast:lambda-id exp)
(ast:lambda-args exp) (ast:lambda-args exp)
(map (lambda (b) (contract-prims b refs)) (ast:lambda-body exp)))) (map (lambda (b) (opt:inline-prims b refs)) (ast:lambda-body exp))))
((const? exp) exp) ((const? exp) exp)
((quote? exp) exp) ((quote? exp) exp)
((define? exp) ((define? exp)
`(define ,(define->var exp) `(define ,(define->var exp)
,@(contract-prims (define->exp exp) refs))) ;; TODO: map???? ,@(opt:inline-prims (define->exp exp) refs))) ;; TODO: map????
((set!? exp) ((set!? exp)
`(set! ,(set!->var exp) `(set! ,(set!->var exp)
,(contract-prims (set!->exp exp) refs))) ,(opt:inline-prims (set!->exp exp) refs)))
((if? exp) `(if ,(contract-prims (if->condition exp) refs) ((if? exp) `(if ,(opt:inline-prims (if->condition exp) refs)
,(contract-prims (if->then exp) refs) ,(opt:inline-prims (if->then exp) refs)
,(contract-prims (if->else exp) refs))) ,(opt:inline-prims (if->else exp) refs)))
; Application: ; Application:
((app? exp) ((app? exp)
;(trace:error `(app? ,exp ,(ast:lambda? (car exp)) ;(trace:error `(app? ,exp ,(ast:lambda? (car exp))
@ -494,14 +484,13 @@
(hash-table-set! refs param (car args)) (hash-table-set! refs param (car args))
(set! args (cdr args))) (set! args (cdr args)))
(ast:lambda-formals->list (car exp)))) (ast:lambda-formals->list (car exp))))
(contract-prims (car (ast:lambda-body (car exp))) refs)) (opt:inline-prims (car (ast:lambda-body (car exp))) refs))
(else (else
(map (lambda (e) (contract-prims e refs)) exp)))) (map (lambda (e) (opt:inline-prims e refs)) exp))))
(else (else
(error `(Unexpected expression passed to contract-prims ,exp)))))) (error `(Unexpected expression passed to opt:inline-prims ,exp))))))
;; Do all the expressions contain prim calls? ;; Do all the expressions contain prim calls?
;; TODO: check for prim calls accepting no continuation
(define (all-prim-calls? exps) (define (all-prim-calls? exps)
(cond (cond
((null? exps) #t) ((null? exps) #t)
@ -645,10 +634,9 @@
(define (optimize-cps ast) (define (optimize-cps ast)
(adb:clear!) (adb:clear!)
(analyze-cps ast) (analyze-cps ast)
;(trace:info "---------------- cps analysis db:") (trace:info "---------------- cps analysis db:")
;(trace:info (adb:get-db)) (trace:info (adb:get-db))
;ast ;; DEBUGGING!!! (opt:inline-prims
(contract-prims
(opt:contract ast)) (opt:contract ast))
) )