doc repairs and r6rs repairs

svn: r8754

collects/r6rs/main.ss

@@ -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]
+                                                 [run #'0]
-                                                 [expand #'for-syntax]
+                                                 [expand #'1]
-                                                 [(meta 0) #'except-in]
+                                                 [(meta 0) #'0]
-                                                 [(meta 1) #'for-syntax]
+                                                 [(meta n) #'n]
-                                                 [(meta -1) #'for-template]
-                                                 [(meta n)
-                                                  (raise-syntax-error
-                                                   #f
-                                                   "meta level not supported"
-                                                   orig
-                                                   level)]
                                                  [_
                                                   (raise-syntax-error
                                                    #f
@@ -317,12 +309,11 @@ FIXME:
                                                    orig
                                                    level)]))
                                              (syntax->list #'(level ...)))])
-                                  (with-syntax ([is (parse-import-set orig #'im)]
+                                  (with-syntax ([is (parse-import-set orig #'base-im)])
-                                                [(level ...) (if (null? levels)
+                                    (if (null? levels)
-                                                                 (list #'only-in)
+                                        #'()
-                                                                 null)])
+                                        (with-syntax ([(level ...) levels])
-                                                 
+                                          #`((for-meta level is) ...)))))]
-                                    #`((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)]
+                                  #'rest]
-                                 [_ ex]))
+                                 [one #'((one one))]))
-                             exs)])
+                             exs)]
-           #'(provide ex ...)))])))
+                       [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 ...)))))]))))

collects/rnrs/base-6.ss

@@ -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))
 

collects/scheme/private/reqprov.ss

@@ -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))

collects/scribble/run.ss

@@ -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))))))))))

collects/scribble/struct.ss

@@ -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))))))

collects/scribblings/reference/stx-trans.scrbl

@@ -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]
+          [phase-level (or/c exact-integer? false/c (one-of/c #t))])
-          [syntax-imports? any/c]
+         (listof (cons/c (or/c exact-integer? false/c)
-          [label-imports? any/c])
+                         (listof identifier?)))]{
-         (values (listof identifier?)
-                 (listof identifier?) 
-                 (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
+It returns an association list mapping phase levels to lists of
-imported into the module being expanded using the module path
+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[#f]. The association list includes all identifiers imported
-@scheme[provide] sub-forms like @scheme[all-from-out].
+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.,
+When an identifier is renamed on import, the result association list
-normal) bindings, and the second list corresponds to @tech{phase
+includes the identifier by its internal name. Use
-level} -1 (i.e., for-syntax) bindings, and the last list corresponds
+@scheme[identifier-binding] to obtain more information about the
-corresponds to @tech{label phase level} (i.e., for-label) bindings.
+identifier.}
-
-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.}
 
 @; ----------------------------------------------------------------------
 
@@ -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: