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))
'ellipses+vector
(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)
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))
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))
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] ...) ...) ...)
(syntax->datum #'(ell ((ull (+ x ...)
((- x ... y ...) ...))
@ -118,7 +123,8 @@
((ull (+ nn mm) ((- n m 1 2) (- p q 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] ...) ...) ...)
(syntax->datum #'(ell ((ull (+ x ...)
((- x ...) ...))
@ -203,9 +209,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constructed s, se is part of s, part of s tagged
(define s (syntax-property (with-syntax ([five (syntax-property (quote-syntax 5)
'testing
12)])
(define s
(syntax-property
(with-syntax ([five (syntax-property (quote-syntax 5) 'testing 12)])
(syntax (mcr2 five)))
'testing 10))
(define se (expand-once s))
@ -322,7 +328,8 @@
l))])
(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
(test '(aha yep) ssort (syntax-property-symbol-keys
(syntax-property
(syntax-property
(syntax-property #'a 'aha 1)
'yep 2)
@ -469,13 +476,18 @@
(cdddr b))
b)))
(test '('#%kernel case-lambda (lib "scheme/init") case-lambda 0 0 0) identifier-binding* #'case-lambda)
(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)
(test '('#%kernel case-lambda (lib "scheme/init") case-lambda 0 0 0)
identifier-binding* #'case-lambda)
(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]))
(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]))
bcons)) ()
[(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 '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)) ()
[(mod m beg (#%mod-beg (app call-w-vals (lam () cons) prnt)))
(let ([s (syntax cons)])
@ -1275,7 +1288,8 @@
(require '@-n)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Propagating inactive certificates through a transparent macro-expansion result:
;; Propagating inactive certificates through a transparent macro-expansion
;; result:
(module @!m scheme/base
(require (for-syntax scheme/base))