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

untabity and minor formatting

Browse Source 
svn: r17222
This commit is contained in:
Eli Barzilay 2009-12-06 05:06:40 +00:00
parent eb95fbfda3
commit 259350a7e1
1 changed files with 328 additions and 314 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -94,19 +94,24 @@
(test '(#(1) #(2 3)) (test '(#(1) #(2 3))
'ellipses+vector 'ellipses+vector
(syntax->datum (syntax->datum
(syntax-case '((1) (2 3)) () [((a ...) ...) #'(#(a ...) ...)]))) (syntax-case '((1) (2 3)) ()
[((a ...) ...) #'(#(a ...) ...)])))
(test '(1 2 3 6 8 9 0 1 2 3) (test '(1 2 3 6 8 9 0 1 2 3)
syntax->datum syntax->datum
(syntax-case '(((1) (2 3)) ((6)) ((8 9 0) (1 2 3))) () [(((a ...) ...) ...) #'(a ... ... ...)])) (syntax-case '(((1) (2 3)) ((6)) ((8 9 0) (1 2 3))) ()
[(((a ...) ...) ...) #'(a ... ... ...)]))
(test '((1 2 3) (6) (8 9 0 1 2 3)) (test '((1 2 3) (6) (8 9 0 1 2 3))
syntax->datum syntax->datum
(syntax-case '(((1) (2 3)) ((6)) ((8 9 0) (1 2 3))) () [(((a ...) ...) ...) #'((a ... ...) ...)])) (syntax-case '(((1) (2 3)) ((6)) ((8 9 0) (1 2 3))) ()
[(((a ...) ...) ...) #'((a ... ...) ...)]))
(test '((1) (2 3) (6) (8 9 0) (1 2 3)) (test '((1) (2 3) (6) (8 9 0) (1 2 3))
syntax->datum syntax->datum
(syntax-case '(((1) (2 3)) ((6)) ((8 9 0) (1 2 3))) () [(((a ...) ...) ...) #'((a ...) ... ...)])) (syntax-case '(((1) (2 3)) ((6)) ((8 9 0) (1 2 3))) ()
[(((a ...) ...) ...) #'((a ...) ... ...)]))
(test (syntax-case #'((([n 1] [m 2]) ([p 10] [q 20])) (([nn -1] [mm -2]) ([pp -10] [qq -20]))) () (test (syntax-case #'((([n 1] [m 2]) ([p 10] [q 20]))
(([nn -1] [mm -2]) ([pp -10] [qq -20]))) ()
[((([x y] ...) ...) ...) [((([x y] ...) ...) ...)
(syntax->datum #'(ell ((ull (+ x ...) (syntax->datum #'(ell ((ull (+ x ...)
((- x ... y ...) ...)) ((- x ... y ...) ...))
@ -118,7 +123,8 @@
((ull (+ nn mm) ((- n m 1 2) (- p q 10 20))) ((ull (+ nn mm) ((- n m 1 2) (- p q 10 20)))
(ull (+ pp qq) ((- nn mm -1 -2) (- pp qq -10 -20)))))) (ull (+ pp qq) ((- nn mm -1 -2) (- pp qq -10 -20))))))
(test (syntax-case #'((([n 1] [m 2]) ([p 10] [q 20])) (([nn -1] [mm -2]) ([pp -10] [qq -20]))) () (test (syntax-case #'((([n 1] [m 2]) ([p 10] [q 20]))
(([nn -1] [mm -2]) ([pp -10] [qq -20]))) ()
[((([x y] ...) ...) ...) [((([x y] ...) ...) ...)
(syntax->datum #'(ell ((ull (+ x ...) (syntax->datum #'(ell ((ull (+ x ...)
((- x ...) ...)) ((- x ...) ...))
@ -203,9 +209,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constructed s, se is part of s, part of s tagged ;; Constructed s, se is part of s, part of s tagged
(define s (syntax-property (with-syntax ([five (syntax-property (quote-syntax 5) (define s
'testing (syntax-property
12)]) (with-syntax ([five (syntax-property (quote-syntax 5) 'testing 12)])
(syntax (mcr2 five))) (syntax (mcr2 five)))
'testing 10)) 'testing 10))
(define se (expand-once s)) (define se (expand-once s))
@ -322,7 +328,8 @@
l))]) l))])
(test '(aha) syntax-property-symbol-keys (syntax-property #'a 'aha 1)) (test '(aha) syntax-property-symbol-keys (syntax-property #'a 'aha 1))
(test '(aha yep) ssort (syntax-property-symbol-keys (syntax-property (syntax-property #'a 'aha 1) 'yep 2))) (test '(aha yep) ssort (syntax-property-symbol-keys (syntax-property (syntax-property #'a 'aha 1) 'yep 2)))
(test '(aha yep) ssort (syntax-property-symbol-keys (syntax-property (test '(aha yep) ssort (syntax-property-symbol-keys
(syntax-property
(syntax-property (syntax-property
(syntax-property #'a 'aha 1) (syntax-property #'a 'aha 1)
'yep 2) 'yep 2)
@ -469,13 +476,18 @@
(cdddr b)) (cdddr b))
b))) b)))
(test '('#%kernel case-lambda (lib "scheme/init") case-lambda 0 0 0) identifier-binding* #'case-lambda) (test '('#%kernel case-lambda (lib "scheme/init") case-lambda 0 0 0)
(test '(scheme/promise delay* (lib "scheme/init") delay 0 0 0) identifier-binding* #'delay) identifier-binding* #'case-lambda)
(test '('#%kernel #%module-begin (lib "scheme/init") #%plain-module-begin 0 0 0) identifier-binding* #'#%plain-module-begin) (test '(scheme/promise delay* (lib "scheme/init") delay 0 0 0)
identifier-binding* #'delay)
(test '('#%kernel #%module-begin (lib "scheme/init") #%plain-module-begin 0 0 0)
identifier-binding* #'#%plain-module-begin)
(require (only-in scheme/base [#%plain-module-begin #%pmb])) (require (only-in scheme/base [#%plain-module-begin #%pmb]))
(test '('#%kernel #%module-begin scheme/base #%plain-module-begin 0 0 0) identifier-binding* #'#%pmb) (test '('#%kernel #%module-begin scheme/base #%plain-module-begin 0 0 0)
identifier-binding* #'#%pmb)
(let ([b (identifier-binding (syntax-case (expand #'(module m scheme/base (let ([b (identifier-binding
(syntax-case (expand #'(module m scheme/base
(require (only-in (lib "lang/htdp-intermediate.ss") [cons bcons])) (require (only-in (lib "lang/htdp-intermediate.ss") [cons bcons]))
bcons)) () bcons)) ()
[(mod m mz (#%mod-beg req (app call-with-values (lambda () cons) print))) [(mod m mz (#%mod-beg req (app call-with-values (lambda () cons) print)))
@ -489,7 +501,8 @@
(test '(lib "lang/htdp-intermediate.ss") values nominal) (test '(lib "lang/htdp-intermediate.ss") values nominal)
(test 'cons cadddr b))) (test 'cons cadddr b)))
(let ([b (identifier-binding (syntax-case (expand #'(module m (lib "lang/htdp-intermediate.ss") (let ([b (identifier-binding
(syntax-case (expand #'(module m (lib "lang/htdp-intermediate.ss")
cons)) () cons)) ()
[(mod m beg (#%mod-beg (app call-w-vals (lam () cons) prnt))) [(mod m beg (#%mod-beg (app call-w-vals (lam () cons) prnt)))
(let ([s (syntax cons)]) (let ([s (syntax cons)])
@ -1275,7 +1288,8 @@
(require '@-n) (require '@-n)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Propagating inactive certificates through a transparent macro-expansion result: ;; Propagating inactive certificates through a transparent macro-expansion
;; result:
(module @!m scheme/base (module @!m scheme/base
(require (for-syntax scheme/base)) (require (for-syntax scheme/base))