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

* moved fxlogor, fxlogand, fxlogxor, fxsll, and fxsra to the fixnums 

library
This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 04:36:52 -04:00
parent 6995d57df0
commit ca660f5e75
3 changed files with 48 additions and 48 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.

45
src/ikarus.core.ss
View File

@ -64,51 +64,6 @@
(set-top-level-value! x v))) (set-top-level-value! x v)))
(primitive-set! 'fxlogor
(lambda (x y)
(unless (fixnum? x)
(error 'fxlogor "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxlogor "~s is not a fixnum" y))
($fxlogor x y)))
(primitive-set! 'fxlogxor
(lambda (x y)
(unless (fixnum? x)
(error 'fxlogxor "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxlogxor "~s is not a fixnum" y))
($fxlogxor x y)))
(primitive-set! 'fxlogand
(lambda (x y)
(unless (fixnum? x)
(error 'fxlogand "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxlogand "~s is not a fixnum" y))
($fxlogand x y)))
(primitive-set! 'fxsra
(lambda (x y)
(unless (fixnum? x)
(error 'fxsra "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxsra "~s is not a fixnum" y))
(unless ($fx>= y 0)
(error 'fxsra "negative shift not allowed, got ~s" y))
($fxsra x y)))
(primitive-set! 'fxsll
(lambda (x y)
(unless (fixnum? x)
(error 'fxsll "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxsll "~s is not a fixnum" y))
(unless ($fx>= y 0)
(error 'fxsll "negative shift not allowed, got ~s" y))
($fxsll x y)))
(primitive-set! 'fx= (primitive-set! 'fx=
(lambda (x y) (lambda (x y)
(unless (fixnum? x) (unless (fixnum? x)

51
src/ikarus.fixnums.ss
View File

@ -1,12 +1,14 @@
(library (ikarus fixnums) (library (ikarus fixnums)
(export fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* fxquotient (export fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* fxquotient
fxremainder fxmodulo) fxremainder fxmodulo fxlogor fxlogand fxlogxor fxsll fxsra)
(import (import
(only (scheme) $fxadd1 $fxsub1 $fxlognot $fxzero? $fxquotient (only (scheme) $fxadd1 $fxsub1 $fxlognot $fxzero? $fxquotient
$fxmodulo $fx+ $fx- $fx*) $fxmodulo $fx+ $fx- $fx* $fxlogor $fxlogand $fxlogxor
$fxsll $fxsra $fx>=)
(except (ikarus) fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* (except (ikarus) fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx*
fxquotient fxremainder fxmodulo)) fxquotient fxremainder fxmodulo fxlogor fxlogand
fxlogxor fxsll fxsra))
(define fxzero? (define fxzero?
(lambda (x) (lambda (x)
@ -88,5 +90,48 @@
(error 'fxmodulo "zero dividend ~s" y)) (error 'fxmodulo "zero dividend ~s" y))
($fxmodulo x y))) ($fxmodulo x y)))
(define fxlogor
(lambda (x y)
(unless (fixnum? x)
(error 'fxlogor "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxlogor "~s is not a fixnum" y))
($fxlogor x y)))
(define fxlogxor
(lambda (x y)
(unless (fixnum? x)
(error 'fxlogxor "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxlogxor "~s is not a fixnum" y))
($fxlogxor x y)))
(define fxlogand
(lambda (x y)
(unless (fixnum? x)
(error 'fxlogand "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxlogand "~s is not a fixnum" y))
($fxlogand x y)))
(define fxsra
(lambda (x y)
(unless (fixnum? x)
(error 'fxsra "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxsra "~s is not a fixnum" y))
(unless ($fx>= y 0)
(error 'fxsra "negative shift not allowed, got ~s" y))
($fxsra x y)))
(define fxsll
(lambda (x y)
(unless (fixnum? x)
(error 'fxsll "~s is not a fixnum" x))
(unless (fixnum? y)
(error 'fxsll "~s is not a fixnum" y))
(unless ($fx>= y 0)
(error 'fxsll "negative shift not allowed, got ~s" y))
($fxsll x y)))
) )