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

doc repairs and r6rs repairs

Browse Source 
svn: r8754
This commit is contained in:
Matthew Flatt 2008-02-21 14:49:58 +00:00
parent b953b448ba
commit f39b12a555
6 changed files with 137 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
collects/r6rs/main.ss
View File

@ -2,14 +2,13 @@
#|
FIXME:
* (for ... expand) should shift all exports, not just run-time (requires a mzscheme change)
* need meta levels other than 0, 1, and -1
* Check that each identifier is imported only once across phases.
|#
(require (for-syntax scheme/base
syntax/kerncase
"private/find-version.ss"))
"private/find-version.ss"
scheme/provide-transform))
(provide (rename-out [module-begin #%module-begin]))
@ -299,17 +298,10 @@ FIXME:
(let* ([levels
(map (lambda (level)
(syntax-case* level (run expand meta) symbolic-identifier=?
[run #'except-in]
[expand #'for-syntax]
[(meta 0) #'except-in]
[(meta 1) #'for-syntax]
[(meta -1) #'for-template]
[(meta n)
(raise-syntax-error
#f
"meta level not supported"
orig
level)]
[run #'0]
[expand #'1]
[(meta 0) #'0]
[(meta n) #'n]
[_
(raise-syntax-error
#f
@ -317,12 +309,11 @@ FIXME:
orig
level)]))
(syntax->list #'(level ...)))])
(with-syntax ([is (parse-import-set orig #'im)]
[(level ...) (if (null? levels)
(list #'only-in)
null)])
#`((level is) ...)))]
(with-syntax ([is (parse-import-set orig #'base-im)])
(if (null? levels)
#'()
(with-syntax ([(level ...) levels])
#`((for-meta level is) ...)))))]
[(for . _)
(raise-syntax-error
#f
@ -371,11 +362,57 @@ FIXME:
orig
ex)])))
exs)
(with-syntax ([(ex ...)
(with-syntax ([((ex ...) ...)
(map (lambda (ex)
(syntax-case ex ()
[(rename . rest)
#'(rename-out . rest)]
[_ ex]))
exs)])
#'(provide ex ...)))])))
#'rest]
[one #'((one one))]))
exs)]
[orig orig])
#'(provide (all-levels-out orig ex ... ...))))])))
(define-syntax all-levels-out
(make-provide-transformer
(lambda (stx mode)
(syntax-case stx ()
[(_ orig (local-id ext-id) ...)
(let* ([table (make-hash-table)]
[map-id (lambda (phase)
(lambda (id)
(let ([l (hash-table-get table (syntax-e id) null)])
(unless (ormap (lambda (e)
(and (equal? (cdr e) phase)
(free-identifier=? (car e) id phase)))
l)
(hash-table-put! table
(syntax-e id)
(cons (cons id phase) l))))))])
(let-values ([(ids for-syntax-ids) (syntax-local-module-defined-identifiers)])
(for-each (map-id 0) ids)
(for-each (map-id 1) for-syntax-ids))
(for-each (lambda (l)
(for-each (map-id (car l)) (cdr l)))
(syntax-local-module-required-identifiers #f #t))
(apply
append
(map (lambda (local-id ext-id)
(let* ([l (hash-table-get table (syntax-e local-id) null)]
[l (filter (lambda (e)
(free-identifier=? (car e) local-id (cdr e)))
l)])
(unless l
(raise-syntax-error
#f
"identifier not defined or imported"
#'orig
local-id))
(map (lambda (e)
(make-export local-id
(syntax-e ext-id)
(cdr e)
#f
local-id))
l)))
(syntax->list #'(local-id ...))
(syntax->list #'(ext-id ...)))))]))))

49
collects/rnrs/base-6.ss
View File

@ -62,7 +62,10 @@
even? finite? infinite? nan?
min max
+ * - /
abs gcd lcm
abs
div-and-mod div mod
div0-and-mod0 div0 mod0
gcd lcm
numerator denominator
floor ceiling truncate round
rationalize
@ -197,6 +200,50 @@
(define (nan? n)
(eqv? n +nan.0))
;; Someone needs to look more closely at div and mod.
;; I started with the code from Enger04, and poked it
;; until the results matched the examples in R6RS.
(define (div x y)
(let ([n (* (numerator x)
(denominator y))]
[d (* (denominator x)
(numerator y))])
(if (negative? n)
(- (quotient (- (abs d) n 1) d))
(quotient n d))))
(define (div0 x y)
(cond
[(zero? y) 0]
[(positive? y)
(if (negative? x)
(- (div (- x) y))
(div x y))]
[(negative? y)
(let ([n (* -2
(numerator x)
(denominator y))]
[d (* (denominator x)
(- (numerator y)))])
(if (< n d)
(- (quotient (- d n) (* 2 d)))
(quotient (+ n d -1) (* 2 d))))]))
(define (mod x y)
(- x (* (div x y) y)))
(define (div-and-mod x y)
(let ([d (div x y)])
(values d (- x (* d y)))))
(define (mod0 x y)
(- x (* (div0 x y) y)))
(define (div0-and-mod0 x y)
(let ([d (div0 x y)])
(values d (- x (* d y)))))
(define (r6rs:number->string z [radix 10] [precision #f])
(number->string z radix))

9
collects/scheme/private/reqprov.ss
View File

@ -292,7 +292,14 @@
[transform-one
(lambda (in)
;; Recognize `for-syntax', etc. for simple cases:
(syntax-case in ()
(syntax-case in (for-meta)
[(for-meta n elem ...)
(or (exact-integer? (syntax-e #'n))
(not (syntax-e #'n)))
(apply append
(map (lambda (in)
(transform-simple in (syntax-e #'n)))
(syntax->list #'(elem ...))))]
[(for-something elem ...)
(and (identifier? #'for-something)
(ormap (lambda (i) (free-identifier=? i #'for-something))

4
collects/scribble/run.ss
View File

@ -92,6 +92,6 @@
(when (current-info-output-file)
(let ([s (send renderer serialize-info r-info)])
(with-output-to-file (current-info-output-file)
#:exists 'truncate/replace
(lambda ()
(write s))))))))))))
(write s))
'truncate/replace))))))))))

4
collects/scribble/struct.ss
View File

@ -191,7 +191,7 @@
(with-handlers ([exn:fail:contract?
(lambda (exn)
(error 'serialize-delayed-element
"serialization failed (wrong resolve info?); ~a"
"serialization failed (wrong resolve info? delayed element never rendered?); ~a"
(exn-message exn)))])
(vector
(make-element #f (delayed-element-content d ri))))))
@ -234,7 +234,7 @@
(with-handlers ([exn:fail:contract?
(lambda (exn)
(error 'serialize-part-relative-element
"serialization failed (wrong resolve info?); ~a"
"serialization failed (wrong resolve info? part-relative element never rendered?); ~a"
(exn-message exn)))])
(vector
(make-element #f (part-relative-element-content d ri))))))

39
collects/scribblings/reference/stx-trans.scrbl
View File

@ -481,35 +481,26 @@ for-syntax) definitions.}
@defproc[(syntax-local-module-required-identifiers
[mod-path (or/c module-path? false/c)]
[normal-imports? any/c]
[syntax-imports? any/c]
[label-imports? any/c])
(values (listof identifier?)
(listof identifier?)
(listof identifier?))]{
[phase-level (or/c exact-integer? false/c (one-of/c #t))])
(listof (cons/c (or/c exact-integer? false/c)
(listof identifier?)))]{
Can be called only while
@scheme[syntax-local-transforming-module-provides?] returns
@scheme[#t].
It returns three lists of identifiers corresponding to all bindings
imported into the module being expanded using the module path
It returns an association list mapping phase levels to lists of
identifiers. Each list of identifiers includes all bindings imported
(into the module being expanded) using the module path
@scheme[mod-path], or all modules if @scheme[mod-path] is
@scheme[#f]. This information is used for implementing
@scheme[provide] sub-forms like @scheme[all-from-out].
@scheme[#f]. The association list includes all identifiers imported
with a @scheme[phase-level] shift, of all shifts if
@scheme[phase-level] is @scheme[#t].
The first result list corresponds to @tech{phase level} 0 (i.e.,
normal) bindings, and the second list corresponds to @tech{phase
level} -1 (i.e., for-syntax) bindings, and the last list corresponds
corresponds to @tech{label phase level} (i.e., for-label) bindings.
The @scheme[normal-imports?], @scheme[syntax-imports?], and
@scheme[label-imports?] arguments determine whether each of normal,
@scheme[for-syntax], and @scheme[for-label] @scheme[require]s are
considered in building the result lists. Note that normal
@scheme[require]s can add to all three lists, while
@scheme[for-syntax] and @scheme[for-label] @scheme[require]s
contribute only to one of the latter two lists, respectively.}
When an identifier is renamed on import, the result association list
includes the identifier by its internal name. Use
@scheme[identifier-binding] to obtain more information about the
identifier.}
@; ----------------------------------------------------------------------
@ -672,9 +663,9 @@ Returns @scheme[#t] if @scheme[v] has the
@defstruct[export ([local-id identifier?]
[out-sym symbol?]
[orig-stx syntax?]
[mode (or/c exact-integer? false/c)]
[protect? any/c]
[mode (or/c exact-integer? false/c)])]{
[orig-stx syntax?])]{
A structure representing a single imported identifier: