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

* removed uses of fx primitives from ikarus.syntax.ss

This commit is contained in:
Abdulaziz Ghuloum 2007-05-09 11:26:26 -04:00
parent fd91a5bafc
commit 457ed6aa4b
4 changed files with 16 additions and 14 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.

7
src/ikarus.numerics.ss
View File

@ -22,14 +22,15 @@
(library (ikarus generic-arithmetic) (library (ikarus generic-arithmetic)
(export + - * = < <= > >= add1 sub1 quotient remainder (export + - * zero? = < <= > >= add1 sub1 quotient remainder
quotient+remainder number->string string->number) quotient+remainder number->string string->number)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $chars) (ikarus system $chars)
(ikarus system $strings) (ikarus system $strings)
(except (ikarus) + - * = < <= > >= add1 sub1 quotient remainder (except (ikarus) + - * zero? = < <= > >= add1 sub1 quotient
quotient+remainder number->string string->number)) remainder quotient+remainder number->string
string->number))
(define (fixnum->flonum x) (define (fixnum->flonum x)
(foreign-call "ikrt_fixnum_to_flonum" x)) (foreign-call "ikrt_fixnum_to_flonum" x))

22
src/ikarus.syntax.ss
View File

@ -14,8 +14,8 @@
(only (ikarus compiler) eval-core) (only (ikarus compiler) eval-core)
(chez modules) (chez modules)
(ikarus symbols) (ikarus symbols)
(only (ikarus) error ormap andmap fxadd1 fx= fxsub1 sub1 list* (only (ikarus) error ormap andmap list*
add1 format make-record-type parameterize format make-record-type parameterize
void make-parameter) void make-parameter)
(rename (r6rs) (rename (r6rs)
(free-identifier=? sys:free-identifier=?) (free-identifier=? sys:free-identifier=?)
@ -311,14 +311,14 @@
(let ([i (let ([i
(let f ([i idx]) (let f ([i idx])
(cond (cond
[(fx= i 0) 0] [(zero? i) 0]
[else [else
(let ([j (fxsub1 i)]) (let ([j (- i 1)])
(cond (cond
[(fx= freq (vector-ref freq* j)) (f j)] [(= freq (vector-ref freq* j)) (f j)]
[else i]))]))]) [else i]))]))])
(vector-set! freq* i (fxadd1 freq)) (vector-set! freq* i (+ freq 1))
(unless (fx= i idx) (unless (= i idx)
(let ([sym* (rib-sym* rib)] (let ([sym* (rib-sym* rib)]
[mark** (rib-mark** rib)] [mark** (rib-mark** rib)]
[label* (rib-label* rib)]) [label* (rib-label* rib)])
@ -344,7 +344,7 @@
(cond (cond
[(rib-sealed/freq rib) [(rib-sealed/freq rib)
(let ([sym* (rib-sym* rib)]) (let ([sym* (rib-sym* rib)])
(let f ([i 0] [n (sub1 (vector-length sym*))]) (let f ([i 0] [n (- (vector-length sym*) 1)])
(cond (cond
[(and (eq? (vector-ref sym* i) sym) [(and (eq? (vector-ref sym* i) sym)
(same-marks? mark* (same-marks? mark*
@ -352,8 +352,8 @@
(let ([label (vector-ref (rib-label* rib) i)]) (let ([label (vector-ref (rib-label* rib) i)])
(increment-rib-frequency! rib i) (increment-rib-frequency! rib i)
label)] label)]
[(fx= i n) (search (cdr subst*) mark*)] [(= i n) (search (cdr subst*) mark*)]
[else (f (fxadd1 i) n)])))] [else (f (+ i 1) n)])))]
[else [else
(let f ([sym* (rib-sym* rib)] (let f ([sym* (rib-sym* rib)]
[mark** (rib-mark** rib)] [mark** (rib-mark** rib)]
@ -952,7 +952,7 @@
(let f ([i 0] [ls ls]) (let f ([i 0] [ls ls])
(cond (cond
[(null? ls) '()] [(null? ls) '()]
[else (cons i (f (add1 i) (cdr ls)))])))) [else (cons i (f (+ i 1) (cdr ls)))]))))
(define mkid (define mkid
(lambda (id str) (lambda (id str)
(datum->stx id (string->symbol str)))) (datum->stx id (string->symbol str))))

1
src/makefile.ss
View File

@ -275,6 +275,7 @@
[> i r] [> i r]
[<= i r] [<= i r]
[>= i r] [>= i r]
[zero? i r]
[* i r] [* i r]
[+ i r] [+ i r]
[add1 i] [add1 i]