suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

bitwise ops allow 0 args; new JIT-inlined procs

Browse Source 
svn: r2687
This commit is contained in:
Matthew Flatt 2006-04-17 15:11:44 +00:00
parent 50fdb9be90
commit 0c25abb469
3 changed files with 51 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/mzscheme/number.ss
View File

@ -1002,9 +1002,13 @@
(test #x-155553333 bitwise-xor #x-2aaaa5555 (bitwise-xor #x-2aaaa5555 #x-155553333))
(test #x-15555333 bitwise-xor #x-2aaaa5555 (bitwise-xor #x-2aaaa5555 #x-15555333))
(arity-test bitwise-ior 1 -1)
(arity-test bitwise-and 1 -1)
(arity-test bitwise-xor 1 -1)
(test -1 bitwise-and)
(test 0 bitwise-ior)
(test 0 bitwise-xor)
(arity-test bitwise-ior 0 -1)
(arity-test bitwise-and 0 -1)
(arity-test bitwise-xor 0 -1)
(arity-test bitwise-not 1 1)
(define error-test-bitwise-procs

14
collects/tests/mzscheme/optimize.ss
View File

@ -57,6 +57,7 @@
(test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op ,arg1 x) 'yes 'no))) arg2)))))]
[bin-exact (lambda (v op arg1 arg2)
(check-error-message op (eval `(lambda (x) (,op x ,arg2))))
(check-error-message op (eval `(lambda (x) (,op ,arg1 x))))
(bin0 v op arg1 arg2))]
[bin (lambda (v op arg1 arg2)
(bin-exact v op arg1 arg2)
@ -193,6 +194,19 @@
(un-exact (- (expt 2 30)) 'bitwise-not (sub1 (expt 2 30)))
(un-exact (- -1 (expt 2 32)) 'bitwise-not (expt 2 32))
(bin-exact 'a 'vector-ref #(a b c) 0)
(bin-exact 'b 'vector-ref #(a b c) 1)
(bin-exact 'c 'vector-ref #(a b c) 2)
(bin-exact #\a 'string-ref "abc\u2001" 0)
(bin-exact #\b 'string-ref "abc\u2001" 1)
(bin-exact #\c 'string-ref "abc\u2001" 2)
(bin-exact #\u2001 'string-ref "abc\u2001" 3)
(bin-exact 65 'bytes-ref #"Abc\xF7" 0)
(bin-exact 99 'bytes-ref #"Abc\xF7" 2)
(bin-exact #xF7 'bytes-ref #"Abc\xF7" 3)
))
;; For some comparison, ignore the stack-depth

30
collects/tests/mzscheme/stx.ss
View File

@ -1007,5 +1007,35 @@
(go-once (lambda (e) (eval (expand e)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; layers of lexical binding
(test '(1 2) 'macro-nested-lexical
(let ()
(define-syntax (m stx)
(with-syntax ([x1 (let ([x 0]) #'x)]
[x2 (let ([x 0]) #'x)])
#'(begin
(define x1 1)
(define x2 2)
(list x1 x2))))
(m)))
(module @!$m mzscheme
(define-syntax (d stx)
(syntax-case stx ()
[(_ id)
(with-syntax ([x1 (let ([x 0]) #'x)]
[x2 (let ([x 0]) #'x)])
#'(begin
(define x1 10)
(define x2 20)
(define id (list x1 x2
(list? (identifier-binding (quote-syntax x1)))))))]))
(d @!$get)
(provide @!$get))
(require @!$m)
(test '(10 20 #t) '@!$get @!$get)
(report-errs)