conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* eliminated a few instances of set-rem and set->list.

This commit is contained in:
Abdulaziz Ghuloum 2007-03-11 20:39:21 -04:00
parent 2b6bcc324b
commit 068bc38e42
2 changed files with 21 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

48
src/libaltcogen.ss
View File

@ -1750,14 +1750,6 @@
;;; ;;;
(define (rewrite x varvec) (define (rewrite x varvec)
(define who 'rewrite) (define who 'rewrite)
(define (frame-conflict? i vs fs)
(define (frm-conf x) (fx= i x))
(define (var-conf xi)
(let ([loc (var-loc (vector-ref varvec xi))])
(and (fvar? loc)
(fx= i (frm-loc loc)))))
(or (ormap frm-conf (set->list fs))
(ormap var-conf (set->list vs))))
(define (assign x) (define (assign x)
(let () (let ()
(define (assign-any) (define (assign-any)
@ -1771,8 +1763,6 @@
(set-var-loc! x fv) (set-var-loc! x fv)
(for-each-var vars varvec (for-each-var vars varvec
(lambda (var) (lambda (var)
;(set-var-var-conf! var
; (rem-var x (var-var-conf var)))
(set-var-frm-conf! var (set-var-frm-conf! var
(add-frm fv (var-frm-conf var))))) (add-frm fv (var-frm-conf var)))))
fv)])))) fv)]))))
@ -1788,19 +1778,18 @@
(set-var-loc! x fv) (set-var-loc! x fv)
(for-each-var (var-var-conf x) varvec (for-each-var (var-var-conf x) varvec
(lambda (var) (lambda (var)
(set-var-var-conf! var
(rem-var x (var-var-conf var)))
(set-var-frm-conf! var (set-var-frm-conf! var
(add-frm fv (var-frm-conf var))))) (add-frm fv (var-frm-conf var)))))
(for-each-var (var-var-move x) varvec (for-each-var (var-var-move x) varvec
(lambda (var) (lambda (var)
(set-var-var-move! var ;(set-var-var-move! var
(rem-var x (var-var-move var))) ; (rem-var x (var-var-move var)))
(set-var-frm-move! var (set-var-frm-move! var
(add-frm fv (var-frm-move var))) (add-frm fv (var-frm-move var)))
(let ([loc (var-loc var)]) ;(let ([loc (var-loc var)])
(when (and loc (not (fvar? loc))) ; (when (and loc (not (fvar? loc)))
(assign-move var))))) ; (assign-move var)))
))
fv)]))) fv)])))
(or (assign-move x) (or (assign-move x)
(assign-any)))) (assign-any))))
@ -1884,13 +1873,18 @@
(unless (fvar? loc) (error 'max-nfv "not assigned")) (unless (fvar? loc) (error 'max-nfv "not assigned"))
(max-nfv (cdr ls) (max i (frm-loc loc))))])) (max-nfv (cdr ls) (max i (frm-loc loc))))]))
(define (actual-frame-size vars i) (define (actual-frame-size vars i)
(define (var-conflict? i vs)
(ormap (lambda (xi)
(let ([loc (var-loc (vector-ref varvec xi))])
(and (fvar? loc)
(fx= i (frm-loc loc)))))
(set->list vs)))
(define (frame-size-ok? i vars) (define (frame-size-ok? i vars)
(or (null? vars) (or (null? vars)
(and (let ([x (car vars)]) (let ([x (car vars)])
(not (frame-conflict? i (and (not (set-member? i (nfv-frm-conf x)))
(nfv-var-conf x) (not (var-conflict? i (nfv-var-conf x)))
(nfv-frm-conf x)))) (frame-size-ok? (fxadd1 i) (cdr vars))))))
(frame-size-ok? (fxadd1 i) (cdr vars)))))
(cond (cond
[(frame-size-ok? i vars) i] [(frame-size-ok? i vars) i]
[else (actual-frame-size vars (fxadd1 i))])) [else (actual-frame-size vars (fxadd1 i))]))
@ -1898,11 +1892,11 @@
(unless (null? vars) (unless (null? vars)
(let ([v (car vars)] [fv (mkfvar i)]) (let ([v (car vars)] [fv (mkfvar i)])
(set-nfv-loc! v fv) (set-nfv-loc! v fv)
(for-each ;(for-each
(lambda (j) ; (lambda (j)
(when (fx= j i) ; (when (fx= j i)
(error who "invalid assignment"))) ; (error who "invalid assignment")))
(set->list (nfv-frm-conf v))) ; (set->list (nfv-frm-conf v)))
(for-each (for-each
(lambda (x) (lambda (x)
(let ([loc (nfv-loc x)]) (let ([loc (nfv-loc x)])