[Chicken-hackers] [PATCH 1/4] Exempt explicitly-namespaced symbols from module aliasing

[Evan Hanson]

This adds an "escape hatch" to variable resolution for namespaced
symbols (e.g. `foo#bar`), allowing them to be used across module
boundaries just like qualified symbols.

This is done by simple string scanning of the identifier's name, which
is emphatically not ideal as it means the compiler has to do more work
as it checks whether a symbol is "namespaced" or not. The performance of
generated programs isn't affected (besides `eval` of course), but we
will still want to fix this before too long, probably when fixing #1077.

The one test case that checked for the inverse behaviour (no visibility
of unimported namespaced symbols) has been removed.

This change also avoids unnecessarily hiding identifiers when qualified
symbols are bound to a value within a module. Previously, things like
'|foo#\x03sysbar| would be marked hidden despite never being bound,
since ##sys#toplevel-definition-hook wouldn't considering whether or not
the symbol would really be aliased by ##sys#alias-global-hook. This
didn't cause any problems, but it was inaccurate.
---
 chicken.h              |  7 +++++++
 expand.scm             |  9 ++-------
 internal.scm           |  9 ++++++---
 modules.scm            |  6 +++---
 runtime.c              |  2 +-
 support.scm            | 14 ++++++++++----
 tests/syntax-tests.scm | 10 ----------
 7 files changed, 29 insertions(+), 28 deletions(-)

diff --git a/chicken.h b/chicken.h
index d03109ac..d6af3bb7 100644
--- a/chicken.h
+++ b/chicken.h
@@ -899,6 +899,7 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 # define C_strcmp                   strcmp
 # define C_strncmp                  strncmp
 # define C_strlen                   strlen
+# define C_memchr                   memchr
 # define C_memset                   memset
 # define C_memmove                  memmove
 # define C_strncasecmp              strncasecmp
@@ -1022,6 +1023,7 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 #define C_bignum_size(b)           
(C_bytestowords(C_header_size(C_internal_bignum_vector(b)))-1)
 #define C_make_header(type, size)  ((C_header)(((type) & C_HEADER_BITS_MASK) | 
((size) & C_HEADER_SIZE_MASK)))
 #define C_symbol_value(x)          (C_block_item(x, 0))
+#define C_symbol_name(x)           (C_block_item(x, 1))
 #define C_symbol_plist(x)          (C_block_item(x, 2))
 #define C_save(x)                 (*(--C_temporary_stack) = (C_word)(x))
 #define C_rescue(x, i)             (C_temporary_stack[ i ] = (x))
@@ -2247,6 +2249,11 @@ inline static C_word C_permanentp(C_word x)
                    !C_in_scratchspacep(x));
 }
 
+inline static C_word C_namespaced_symbolp(C_word x)
+{
+  C_word s = C_symbol_name(x);
+  return C_mk_bool(C_memchr(C_data_pointer(s), '#', C_header_size(s)));
+}
 
 inline static C_word C_flonum(C_word **ptr, double n)
 {
diff --git a/expand.scm b/expand.scm
index 4397d22a..3813ac1c 100644
--- a/expand.scm
+++ b/expand.scm
@@ -33,8 +33,7 @@
   (disable-interrupts)
   (fixnum)
   (hide check-for-multiple-bindings)
-  (not inline ##sys#syntax-error-hook ##sys#compiler-syntax-hook
-       ##sys#toplevel-definition-hook))
+  (not inline ##sys#syntax-error-hook ##sys#compiler-syntax-hook))
 
 (module chicken.expand
   (expand
@@ -107,11 +106,7 @@
        (else #f)))
 
 (define (macro-alias var se)
-  (if (or (##sys#qualified-symbol? var)
-         (let* ((str (##sys#slot var 1))
-                (len (##sys#size str)))
-           (and (fx> len 0)
-                (char=? #\# (##core#inline "C_subchar" str 0)))))
+  (if (or (##sys#qualified-symbol? var) (namespaced-symbol? var))
       var
       (let* ((alias (gensym var))
             (ua (or (lookup var se) var))
diff --git a/internal.scm b/internal.scm
index 3f8c870d..6f05b2f0 100644
--- a/internal.scm
+++ b/internal.scm
@@ -40,8 +40,8 @@
     ;; Parse library specifications
     library-id valid-library-specifier?
 
-    ;; Requirement identifier for modules
-    module-requirement
+    ;; Module helpers
+    module-requirement namespaced-symbol?
 
     ;; Low-level hash table support
     hash-table-ref hash-table-set! hash-table-update!
@@ -105,7 +105,10 @@
          (##sys#intern-symbol str))))))
 
 
-;;; Requirement identifier for modules:
+;;; Modules and namespaces:
+
+(define (namespaced-symbol? sym)
+  (##core#inline "C_namespaced_symbolp" sym))
 
 (define (module-requirement id)
   (##sys#string->symbol
diff --git a/modules.scm b/modules.scm
index 2bf32c6c..32b7671e 100644
--- a/modules.scm
+++ b/modules.scm
@@ -173,7 +173,7 @@
          (set-module-exist-list! mod (append el exps)))
        (set-module-export-list! mod (append xl exps)))))
 
-(define (##sys#toplevel-definition-hook sym mod exp val) #f)
+(define (##sys#toplevel-definition-hook sym renamed exported?) #f)
 
 (define (##sys#register-meta-expression exp)
   (and-let* ((mod (##sys#current-module)))
@@ -191,8 +191,7 @@
                   (find-export sym mod #t)))
          (ulist (module-undefined-list mod)))
       (##sys#toplevel-definition-hook  ; in compiler, hides unexported bindings
-       (module-rename sym (module-name mod))
-       mod exp #f)
+       sym (module-rename sym (module-name mod)) exp)
       (and-let* ((a (assq sym ulist)))
        (set-module-undefined-list! mod (delete a ulist eq?)))
       (check-for-redef sym (##sys#current-environment) 
(##sys#macro-environment))
@@ -778,6 +777,7 @@
        ((getp sym '##core#aliased) 
         (dm "(ALIAS) marked: " sym)
         sym)
+       ((namespaced-symbol? sym) sym)
        ((assq sym ((##sys#active-eval-environment))) =>
         (lambda (a)
           (let ((sym2 (cdr a)))
diff --git a/runtime.c b/runtime.c
index febf4d6c..1d6dedec 100644
--- a/runtime.c
+++ b/runtime.c
@@ -4604,7 +4604,7 @@ C_word C_message(C_word msg)
    * Strictly speaking this isn't necessary for the non-gui-mode,
    * but let's try and keep this consistent across modes.
    */
-  if (memchr(C_c_string(msg), '\0', n) != NULL)
+  if (C_memchr(C_c_string(msg), '\0', n) != NULL)
     barf(C_ASCIIZ_REPRESENTATION_ERROR, "##sys#message", msg);
 
   if(C_gui_mode) {
diff --git a/support.scm b/support.scm
index 3d2f413b..e0402d2a 100644
--- a/support.scm
+++ b/support.scm
@@ -909,10 +909,13 @@
 ;;; change hook function to hide non-exported module bindings
 
 (set! ##sys#toplevel-definition-hook
-  (lambda (sym mod exp val)
-    (when (and (not val) (not exp))
-      (debugging 'o "hiding nonexported module bindings" sym)
-      (hide-variable sym))))
+  (lambda (sym renamed exported?)
+    (cond ((or (##sys#qualified-symbol? sym) (namespaced-symbol? sym))
+          (unhide-variable sym))
+         ((not exported?)
+          (debugging 'o "hiding unexported module binding" renamed)
+          (hide-variable renamed)))))
+
 
 ;;; Foreign callback stub and type tables:
 
@@ -1604,6 +1607,9 @@
 (define (variable-hidden? sym)
   (eq? (##sys#get sym '##compiler#visibility) 'hidden))
 
+(define (unhide-variable sym)
+  (when (variable-hidden? sym) (remprop! sym '##compiler#visibility)))
+
 (define (variable-visible? sym block-compilation)
   (let ((p (##sys#get sym '##compiler#visibility)))
     (case p
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index 1c4941a9..3f061fbf 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -899,16 +899,6 @@
 (import (prefix rfoo f:))
 (f:rbar 1)
 
-;;; Internal hash-prefixed names shouldn't work within modules
-
-(module one (always-one)
-  (import scheme)
-  (define (always-one) 1))
-
-(f (eval '(module two ()
-            (import scheme)
-            (define (always-two) (+ (one#always-one) 1)))))
-
 ;;; SRFI-2 (and-let*)
 
 (t 1 (and-let* ((a 1)) a))
-- 
2.11.0