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

new doc branch

Browse Source 
svn: r17813
This commit is contained in:
Sam Tobin-Hochstadt 2010-01-25 14:48:11 +00:00
parent 530a3eb5e8
commit e071050f7f
2 changed files with 13 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/typed-scheme/private/base-special-env.ss
View File

@ -12,13 +12,14 @@
string-constants/string-constant
;(prefix-in ce: test-engine/scheme-tests)
(for-syntax
scheme/base syntax/parse
scheme/base syntax/parse mzlib/etc
(utils tc-utils)
(env init-envs)
(except-in (rep filter-rep object-rep type-rep) make-arr)
(types convenience union)
(only-in (types convenience) [make-arr* make-arr])
(typecheck tc-structs)))
(typecheck tc-structs))
(for-meta 2 scheme/base syntax/parse))
(define-for-syntax (initialize-others)
@ -78,11 +79,12 @@
(-> (-lst a) (-val '()) (-lst a))
(-> (-lst a) (-lst b) (-lst (*Un a b)))))
;; make-sequence
[(syntax-parse (local-expand #'(for ([x '()]) x) 'expression #f)
#:context #'make-sequence
#:literals (let-values quote)
[(let-values ([_ (m-s '(_) '())]) . _)
#'m-s])
[(begin-lifted
(syntax-parse (local-expand #'(for ([x '()]) x) 'expression #f)
#:context #'make-sequence
#:literals (let-values quote)
[(let-values ([_ (m-s '(_) '())]) . _)
#'m-s]))
(-poly (a)
(let ([seq-vals
(lambda ([a a])

16
collects/typed-scheme/utils/tc-utils.ss
View File

@ -6,7 +6,8 @@ don't depend on any other portion of the system
|#
(provide (all-defined-out))
(require "syntax-traversal.ss" syntax/parse (for-syntax scheme/base syntax/parse) scheme/match)
(require "syntax-traversal.ss" syntax/parse (for-syntax scheme/base syntax/parse) scheme/match
(for-syntax unstable/syntax))
;; a parameter representing the original location of the syntax being currently checked
(define current-orig-stx (make-parameter #'here))
@ -155,17 +156,8 @@ don't depend on any other portion of the system
#:attributes (ty id)
(pattern [nm:identifier ty]
#:with id #'#'nm)
(pattern [e:expr ty extra-mods ...]
#:with id #'(let ([new-ns
(let* ([ns (make-empty-namespace)])
(namespace-attach-module (current-namespace)
'scheme/base
ns)
ns)])
(parameterize ([current-namespace new-ns])
(namespace-require 'scheme/base)
(namespace-require 'extra-mods) ...
e))))
(pattern [e:expr ty]
#:with id #'e))
(syntax-parse stx
[(_ e:spec ...)
#'(list (list e.id e.ty) ...)]))