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

* Just realized that you don't need all var<->var conflicts to be 

recorded.  All is needed is for a var $x$ to know some of its var
  conflicts as long as the other conflicts know about $x$.  I'll be
  working on this now.  I'm hoping for a 50% speedup in the
  assign-frame-sizes pass.
This commit is contained in:
Abdulaziz Ghuloum 2007-03-11 18:54:15 -04:00
parent aa1c7e1bb7
commit 2b5b555bac
2 changed files with 75 additions and 75 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.

150
src/libaltcogen.ss
View File

@ -964,8 +964,9 @@
(module IntegerSet (module IntegerSet
(make-empty-set set-member? set-add set-rem set-difference (make-empty-set set-member? set-add set-rem set-difference
set-union empty-set? set->list list->set set-map set-for-each set-union empty-set? set->list list->set
set-ormap set-andmap) ;set-map set-for-each set-ormap set-andmap
)
(begin (begin
(define-syntax car (identifier-syntax #%$car)) (define-syntax car (identifier-syntax #%$car))
@ -981,10 +982,9 @@
(syntax-rules () (syntax-rules ()
[(_ x) (#%$fxzero? (#%$fxlogand x 1))]))) [(_ x) (#%$fxzero? (#%$fxlogand x 1))])))
(define shift 4) (define bits 28)
(define mask #xF) (define (index-of n) (fxquotient n bits))
(define (index-of n) (fxsra n shift)) (define (mask-of n) (fxsll 1 (fxremainder n bits)))
(define (mask-of n) (fxsll 1 (fxlogand n mask)))
(define (make-empty-set) 0) (define (make-empty-set) 0)
(define (empty-set? s) (eqv? s 0)) (define (empty-set? s) (eqv? s 0))
@ -1091,87 +1091,87 @@
[else (f (cdr ls) (set-add (car ls) s))]))) [else (f (cdr ls) (set-add (car ls) s))])))
(define (set->list s) (define (set->list s)
(let f ([i 0] [j (fxsll 1 shift)] [s s] [ac '()]) (let f ([i 0] [j 1] [s s] [ac '()])
(cond (cond
[(pair? s) [(pair? s)
(f i (fxsll j 1) (car s) (f i (fxsll j 1) (car s)
(f (fxlogor i j) (fxsll j 1) (cdr s) ac))] (f (fxlogor i j) (fxsll j 1) (cdr s) ac))]
[else [else
(let f ([i i] [m s] [ac ac]) (let f ([i (fx* i bits)] [m s] [ac ac])
(cond (cond
[(fxeven? m) [(fxeven? m)
(if (fxzero? m) (if (fxzero? m)
ac ac
(f (fx+ i 1) (fxsra m 1) ac))] (f (fx+ i 1) (fxsra m 1) ac))]
[else [else
(f (fx+ i 1) (fxsra m 1) (cons i ac))]))]))) (f (fx+ i 1) (fxsra m 1) (cons i ac))]))])))
(define (set-map proc s) ;;; (define (set-map proc s)
(let f ([i 0] [j (fxsll 1 shift)] [s s] [ac '()]) ;;; (let f ([i 0] [j (fxsll 1 shift)] [s s] [ac '()])
(cond ;;; (cond
[(pair? s) ;;; [(pair? s)
(f i (fxsll j 1) (car s) ;;; (f i (fxsll j 1) (car s)
(f (fxlogor i j) (fxsll j 1) (cdr s) ac))] ;;; (f (fxlogor i j) (fxsll j 1) (cdr s) ac))]
[else ;;; [else
(let f ([i i] [m s] [ac ac]) ;;; (let f ([i i] [m s] [ac ac])
(cond ;;; (cond
[(fxeven? m) ;;; [(fxeven? m)
(if (fxzero? m) ;;; (if (fxzero? m)
ac ;;; ac
(f (fx+ i 1) (fxsra m 1) ac))] ;;; (f (fx+ i 1) (fxsra m 1) ac))]
[else ;;; [else
(f (fx+ i 1) (fxsra m 1) (cons (proc i) ac))]))]))) ;;; (f (fx+ i 1) (fxsra m 1) (cons (proc i) ac))]))])))
;;;
(define (set-for-each proc s) ;;; (define (set-for-each proc s)
(let f ([i 0] [j (fxsll 1 shift)] [s s]) ;;; (let f ([i 0] [j (fxsll 1 shift)] [s s])
(cond ;;; (cond
[(pair? s) ;;; [(pair? s)
(f i (fxsll j 1) (car s)) ;;; (f i (fxsll j 1) (car s))
(f (fxlogor i j) (fxsll j 1) (cdr s))] ;;; (f (fxlogor i j) (fxsll j 1) (cdr s))]
[else ;;; [else
(let f ([i i] [m s]) ;;; (let f ([i i] [m s])
(cond ;;; (cond
[(fxeven? m) ;;; [(fxeven? m)
(unless (fxzero? m) ;;; (unless (fxzero? m)
(f (fx+ i 1) (fxsra m 1)))] ;;; (f (fx+ i 1) (fxsra m 1)))]
[else ;;; [else
(proc i) ;;; (proc i)
(f (fx+ i 1) (fxsra m 1))]))]))) ;;; (f (fx+ i 1) (fxsra m 1))]))])))
;;;
(define (set-ormap proc s) ;;; (define (set-ormap proc s)
(let f ([i 0] [j (fxsll 1 shift)] [s s]) ;;; (let f ([i 0] [j (fxsll 1 shift)] [s s])
(cond ;;; (cond
[(pair? s) ;;; [(pair? s)
(or (f i (fxsll j 1) (car s)) ;;; (or (f i (fxsll j 1) (car s))
(f (fxlogor i j) (fxsll j 1) (cdr s)))] ;;; (f (fxlogor i j) (fxsll j 1) (cdr s)))]
[else ;;; [else
(let f ([i i] [m s]) ;;; (let f ([i i] [m s])
(cond ;;; (cond
[(fxeven? m) ;;; [(fxeven? m)
(if (fxzero? m) ;;; (if (fxzero? m)
#f ;;; #f
(f (fx+ i 1) (fxsra m 1)))] ;;; (f (fx+ i 1) (fxsra m 1)))]
[else ;;; [else
(or (proc i) ;;; (or (proc i)
(f (fx+ i 1) (fxsra m 1)))]))]))) ;;; (f (fx+ i 1) (fxsra m 1)))]))])))
;;;
(define (set-andmap proc s) ;;; (define (set-andmap proc s)
(let f ([i 0] [j (fxsll 1 shift)] [s s]) ;;; (let f ([i 0] [j (fxsll 1 shift)] [s s])
(cond ;;; (cond
[(pair? s) ;;; [(pair? s)
(and (f i (fxsll j 1) (car s)) ;;; (and (f i (fxsll j 1) (car s))
(f (fxlogor i j) (fxsll j 1) (cdr s)))] ;;; (f (fxlogor i j) (fxsll j 1) (cdr s)))]
[else ;;; [else
(let f ([i i] [m s]) ;;; (let f ([i i] [m s])
(cond ;;; (cond
[(fxeven? m) ;;; [(fxeven? m)
(if (fxzero? m) ;;; (if (fxzero? m)
#t ;;; #t
(f (fx+ i 1) (fxsra m 1)))] ;;; (f (fx+ i 1) (fxsra m 1)))]
[else ;;; [else
(and (proc i) ;;; (and (proc i)
(f (fx+ i 1) (fxsra m 1)))]))]))) ;;; (f (fx+ i 1) (fxsra m 1)))]))])))
#|IntegerSet|#) #|IntegerSet|#)
(module ListyGraphs (module ListyGraphs