add 'not-provide-all-defined and 'nonimal-id suport for rename transformers; fix scheme/foreign and foreign docs to use it

svn: r14195

collects/ffi/private/objc-doc-unsafe.ss

@@ -6,5 +6,11 @@
 
 (objc-unsafe!)
 
-(provide (protect-out (all-defined-out))
+(provide (protect-out objc_msgSend/typed
+                      objc_msgSendSuper/typed
+                      import-class
+                      get-ivar set-ivar!
+                      selector
+                      tell tellv
+                      define-objc-class)
          (all-from-out ffi/objc))

collects/scheme/foreign.ss

@@ -51,7 +51,13 @@
                                                         stx 'to stx)
                                                        ...)])
                            #'(begin (define-syntax id
-                                      (make-rename-transformer #'from))
+                                      (make-rename-transformer (syntax-property
+                                                                (syntax-property
+                                                                 #'from
+                                                                 'not-provide-all-defined
+                                                                 #t)
+                                                                'nominal-id
+                                                                'to)))
                                     ...))]))))])))))
 
 (provide* ctype-sizeof ctype-alignof compiler-sizeof

collects/scheme/private/reqprov.ss

@@ -653,7 +653,16 @@
                      (memq 0 modes))
                  (map (lambda (id)
                         (make-export id (syntax-e id) 0 #f stx))
-                      (filter (same-ctx? free-identifier=?)
+                      (filter (lambda (id)
+                                (and ((same-ctx? free-identifier=?) id)
+                                     (let-values ([(v id) (syntax-local-value/immediate
+                                                           id
+                                                           (lambda () (values #f #f)))])
+                                       (not
+                                        (and (rename-transformer? v)
+                                             (syntax-property 
+                                              (rename-transformer-target v)
+                                              'not-provide-all-defined))))))
                               ids))
                  null)))]))))
 

collects/scribblings/foreign/derived.scrbl

@@ -64,8 +64,6 @@ obtain a tag. The tag is the string form of @schemevarfont{id}.}
 
 @subsection{Unsafe Tagged C Pointer Functions}
 
-@declare-exporting[scribblings/foreign/unsafe-foreign]
-
 @defproc*[([(cpointer-has-tag? [cptr any/c] [tag any/c]) boolean?]
            [(cpointer-push-tag! [cptr any/c] [tag any/c]) void])]{
 
@@ -157,8 +155,6 @@ Converts the list @scheme[lst] to a C vector of the given
 
 @subsection{Unsafe C Vector Construction}
 
-@declare-exporting[scribblings/foreign/unsafe-foreign]
-
 @defproc[(make-cvector* [cptr any/c] [type ctype?]
                         [length exact-nonnegative-integer?])
                         cvector?]{

collects/scribblings/foreign/foreign.scrbl

@@ -5,7 +5,7 @@
 
 @author["Eli Barzilay"]
 
-@defmodule[scheme/foreign]
+@defmodule[scheme/foreign #:use-sources ('#%foreign)]
 
 The @schememodname[scheme/foreign] library enables the direct use of
 C-based APIs within Scheme programs---without writing any new C

collects/scribblings/foreign/libs.scrbl

@@ -19,8 +19,6 @@ Returns @scheme[#t] if @scheme[v] is the result of @scheme[ffi-lib],
 
 @section{Unsafe Library Functions}
 
-@declare-exporting[scribblings/foreign/unsafe-foreign]
-
 @defproc[(ffi-lib [path (or/c path-string? #f)]
                   [version (or/c string? (listof string?) #f) #f]) any]{
 

collects/scribblings/foreign/misc.scrbl

@@ -54,8 +54,6 @@ Like @scheme[list->cblock], but for Scheme vectors.}
 
 @section{Unsafe Miscellaneous Operations}
 
-@declare-exporting[scribblings/foreign/unsafe-foreign]
-
 @defproc[(cblock->list [cblock any/c][type ctype?][length exact-nonnegative-integer?])
          list?]{
 

collects/scribblings/foreign/pointers.scrbl

@@ -50,8 +50,6 @@ offset is always in bytes.}
 
 @section{Unsafe Pointer Operations}
 
-@declare-exporting[scribblings/foreign/unsafe-foreign]
-
 @defproc[(set-ptr-offset! [cptr cpointer?][offset exact-integer?][ctype ctype? _byte]) 
          void?]{
 
@@ -209,8 +207,6 @@ can contain other information).}
 
 @section{Unsafe Memory Management}
 
-@declare-exporting[scribblings/foreign/unsafe-foreign]
-
 For general information on C-level memory management with PLT Scheme,
 see @|InsideMzScheme|.
 

collects/scribblings/foreign/unsafe-foreign.ss

@@ -1,11 +1,31 @@
 #lang scheme/base
-
-(require scheme/foreign)
+(require scheme/foreign
+         (for-syntax scheme/base
+                     scheme/provide-transform))
 
 (error 'unsafe! "only `for-label' use in the documentation")
 
 (unsafe!)
 
-(provide (protect-out (all-defined-out))
+;; This is like `all-defined-out', but it ignores the 'not-provide-all-defined
+;;  property, so that the bindings introduced by `unsafe!' are exported.
+(define-syntax all-unsafe-defined-out
+  (make-provide-transformer
+   (lambda (stx modes)
+     (syntax-case stx ()
+       [(_) 
+        (let-values ([(ids stx-ids) (syntax-local-module-defined-identifiers)]
+                     [(same-ctx?) (lambda (free-identifier=?)
+                                      (lambda (id)
+                                        (free-identifier=? id
+                                                           (datum->syntax
+                                                            stx
+                                                            (syntax-e id)))))])
+          (map (lambda (id)
+                 (make-export id (syntax-e id) 0 #f stx))
+               (filter (same-ctx? free-identifier=?)
+                       ids)))]))))
+
+(provide (protect-out (all-unsafe-defined-out))
          (all-from-out scheme/foreign))
 

collects/scribblings/reference/stx-trans.scrbl

@@ -110,9 +110,15 @@ expressions.
 Such a transformer could be written manually, but the one created by
 @scheme[make-rename-transformer] also causes the parser to install a
 @scheme[free-identifier=?] and @scheme[identifier-binding]
-equivalence, as long as @scheme[id-stx] does not have a true value for the
-@indexed-scheme['not-free-identifier=?] @tech{syntax property}.
-In addition, the rename transformer cooperates specially with
+equivalence, as long as @scheme[id-stx] does not have a true value for
+the @indexed-scheme['not-free-identifier=?] @tech{syntax property}.
+Also, if @scheme[id-stx] has a true value for the
+@indexed-scheme['not-provide-all-defined] @tech{syntax property} and
+it is bound as a module-level transformer, the bound identifier is not
+exported by @scheme[all-defined-out]; the @scheme[provide] form
+otherwise uses a symbol-valued @indexed-scheme['nominal-id] property
+of @scheme[id-stx] to specify the ``nominal source identifier'' of the
+binding. Finally, the rename transformer cooperates specially with
 @scheme[syntax-local-value] and
 @scheme[syntax-local-make-delta-introducer].}
 

collects/scribblings/reference/syntax.scrbl

@@ -713,12 +713,14 @@ follows.
  @defsubform[(all-defined-out)]{ Exports all identifiers that are
  defined at @tech{phase level} 0 or @tech{phase level} 1 within the
  exporting module, and that have the same lexical context as the
- @scheme[(all-defined-out)] form. The external name for each
- identifier is the symbolic form of the identifier. Only identifiers
- accessible from the lexical context of the @scheme[(all-defined-out)]
- form are included; that is, macro-introduced imports are not
- re-exported, unless the @scheme[(all-defined-out)] form was
- introduced at the same time.
+ @scheme[(all-defined-out)] form, excluding bindings to @tech{rename
+ transformers} where the target identifier has the
+ @scheme['not-provide-all-defined] @tech{syntax property}. The
+ external name for each identifier is the symbolic form of the
+ identifier. Only identifiers accessible from the lexical context of
+ the @scheme[(all-defined-out)] form are included; that is,
+ macro-introduced imports are not re-exported, unless the
+ @scheme[(all-defined-out)] form was introduced at the same time.
 
  @defexamples[#:eval (syntax-eval)
    (module test scheme

src/mzscheme/src/module.c

@@ -157,6 +157,7 @@ static Scheme_Object *lib_symbol;
 static Scheme_Object *planet_symbol;
 static Scheme_Object *file_symbol;
 static Scheme_Object *module_name_symbol;
+static Scheme_Object *nominal_id_symbol;
 
 /* global read-only syntax */
 Scheme_Object *scheme_module_stx;
@@ -566,6 +567,9 @@ void scheme_finish_kernel(Scheme_Env *env)
 
   REGISTER_SO(module_name_symbol);
   module_name_symbol = scheme_intern_symbol("enclosing-module-name");
+
+  REGISTER_SO(nominal_id_symbol);
+  nominal_id_symbol = scheme_intern_symbol("nominal-id");
 }
 
 int scheme_is_kernel_modname(Scheme_Object *modname)
@@ -7381,7 +7385,10 @@ static Scheme_Object *extract_free_id_name(Scheme_Object *name,
             /* free-id=? equivalence to a name that is not necessarily imported explicitly */
             if (_implicit_src) {
               *_implicit_src = mod;
-              *_implicit_src_name = id;
+              *_implicit_src_name = id;              
+              name2 = scheme_stx_property(name2, nominal_id_symbol, NULL);
+              if (SCHEME_SYMBOLP(name2))
+                *_implicit_nominal_name = name2;
             }
             *_implicit = 1;
             break;
@@ -7468,7 +7475,8 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table
           prnt_name = name;
 
           name = extract_free_id_name(name, phase, genv, 1, &implicit, 
-                                      NULL, NULL, NULL, NULL, NULL);
+                                      NULL, NULL, NULL, 
+                                      NULL, NULL);
 
           if (!implicit
               && genv 

src/mzscheme/src/stxobj.c

@@ -76,6 +76,7 @@ static Scheme_Object *share_symbol; /* uninterned! */
 static Scheme_Object *origin_symbol;
 static Scheme_Object *lexical_symbol;
 static Scheme_Object *protected_symbol;
+static Scheme_Object *nominal_id_symbol;
 
 static THREAD_LOCAL Scheme_Object *nominal_ipair_cache;
 
@@ -544,11 +545,13 @@ void scheme_init_stx(Scheme_Env *env)
   REGISTER_SO(origin_symbol);
   REGISTER_SO(lexical_symbol);
   REGISTER_SO(protected_symbol);
+  REGISTER_SO(nominal_id_symbol);
   source_symbol = scheme_make_symbol("source"); /* not interned! */
   share_symbol = scheme_make_symbol("share"); /* not interned! */
   origin_symbol = scheme_intern_symbol("origin");
   lexical_symbol = scheme_intern_symbol("lexical");
   protected_symbol = scheme_intern_symbol("protected");
+  nominal_id_symbol = scheme_intern_symbol("nominal-id");
 
   REGISTER_SO(mark_id);
 
@@ -1935,12 +1938,14 @@ static Scheme_Object *extract_module_free_id_binding(Scheme_Object *mrn,
   Scheme_Object *result;
   Scheme_Object *modname;
   Scheme_Object *nominal_modidx;
-  Scheme_Object *nominal_name;
+  Scheme_Object *nominal_name, *nom2;
   Scheme_Object *mod_phase;
   Scheme_Object *src_phase_index;
   Scheme_Object *nominal_src_phase;
   Scheme_Object *lex_env;
   
+  nom2 = scheme_stx_property(orig_id, nominal_id_symbol, NULL);
+
   modname = scheme_stx_module_name(1,
                                    &orig_id, ((Module_Renames *)mrn)->phase, &nominal_modidx,
                                    &nominal_name,
@@ -1949,6 +1954,9 @@ static Scheme_Object *extract_module_free_id_binding(Scheme_Object *mrn,
                                    &nominal_src_phase,
                                    &lex_env,
                                    _sealed);
+ 
+  if (SCHEME_SYMBOLP(nom2))
+    nominal_name = nom2;
   
   if (!modname)
     result = scheme_box(CONS(SCHEME_STX_VAL(orig_id), scheme_false));
@@ -5356,7 +5364,7 @@ static Scheme_Object *extract_free_id_info(Scheme_Object *id)
 {
   Scheme_Object *bind;
   Scheme_Object *nominal_modidx;
-  Scheme_Object *nominal_name;
+  Scheme_Object *nominal_name, *nom2;
   Scheme_Object *mod_phase;
   Scheme_Object *src_phase_index;
   Scheme_Object *nominal_src_phase;
@@ -5366,10 +5374,15 @@ static Scheme_Object *extract_free_id_info(Scheme_Object *id)
   phase = SCHEME_CDR(id);
   id = SCHEME_CAR(id);
 
+  nom2 = scheme_stx_property(id, nominal_id_symbol, NULL);
+
   bind = scheme_stx_module_name(1, 
                                 &id, phase, &nominal_modidx, &nominal_name,
                                 &mod_phase, &src_phase_index, &nominal_src_phase,
                                 &lex_env, NULL);
+
+  if (SCHEME_SYMBOLP(nom2))
+    nominal_name = nom2;
   if (!nominal_name)
     nominal_name = SCHEME_STX_VAL(id);