Re: Module name mangling

[Martin Grabmueller]

> From: Martin Grabmueller <address@hidden>
> Date: Mon, 08 Jan 2001 20:06:18 +0100
> 
> has anyone taken care of the module name mangling (necessary to work
> with strange module names like `and-let*') yet?  If not, I will do
> that.  I had a look at boot-9.scm, and found two places where module
> names are converted to file names:
[snip]

Seems I am too impatient...  Anyway, at the end of this post I attached
a hack at boot-9.scm, which implements the module name mangling.  I
tested it by renaming `and-let*.scm' to `and-let%2A.scm' and typing
`(use-modules (ice-9 and-let*))', which worked fine.  The dynamic
linking code is a bit confusing to me, but it should work too.

In the case that is what we want, I can surely clean it up, fix any
bugs I introduced etc.  Just let me know.

Thx,
  'mgrabmue
-- 
Martin Grabmueller              address@hidden
http://www.pintus.de/mgrabmue/  address@hidden on EFnet

===File ~/cvs/guile-core/ice-9/diff=========================
Index: boot-9.scm
===================================================================
RCS file: /cvs/guile/guile-core/ice-9/boot-9.scm,v
retrieving revision 1.220
diff -u -r1.220 boot-9.scm
--- boot-9.scm  2000/12/29 15:47:16     1.220
+++ boot-9.scm  2001/01/08 22:03:04
@@ -1666,6 +1666,36 @@
 (define (local-define names val) (nested-define! (current-module) names val))
 (define (local-remove names) (nested-remove! (current-module) names))
 
+
+;;; Support for URL-encoded module names
+
+(define (string-url-encode string)
+  (define (int->hexchar i)
+    (cond ((< i 10)
+          (integer->char (+ i (char->integer #\0))))
+         (else
+          (integer->char (+ (- i 10) (char->integer #\A))))))
+
+  (define (char-url-encode ch)
+    (cond ((or (char-alphabetic? ch)
+              (char-numeric? ch)
+              (memv ch '(#\_ #\-)))
+          (list ch))
+         (else
+          (list #\%
+                (int->hexchar (logand (ash (char->integer ch) -4) #xF))
+                (int->hexchar (logand (char->integer ch) #xF))))))
+
+  (let lp ((src (string->list string))
+          (dest '()))
+    (cond ((null? src)
+          (list->string (reverse dest)))
+         (else
+          (lp (cdr src)
+              (append (reverse (char-url-encode (car src))) dest))))))
+
+(define (symbol->url-encoded-string sym)
+  (string-url-encode (symbol->string sym)))
 
 
 ;;; {The (app) module}
@@ -1860,11 +1890,12 @@
 
 (define (try-module-autoload module-name)
   (let* ((reverse-name (reverse module-name))
-        (name (symbol->string (car reverse-name)))
+        (name (symbol->url-encoded-string (car reverse-name)))
         (dir-hint-module-name (reverse (cdr reverse-name)))
         (dir-hint (apply string-append
                          (map (lambda (elt)
-                                (string-append (symbol->string elt) "/"))
+                                (string-append
+                                 (symbol->url-encoded-string elt) "/"))
                               dir-hint-module-name))))
     (resolve-module dir-hint-module-name #f)
     (and (not (autoload-done-or-in-progress? dir-hint name))
@@ -2007,13 +2038,13 @@
         (let loop ((dirs "")
                    (syms module-name))
           (if (null? (cdr syms))
-              (cons dirs (string-append "lib" (symbol->string (car syms))))
-              (loop (string-append dirs (symbol->string (car syms)) "/")
+              (cons dirs (string-append "lib" (symbol->url-encoded-string (car 
syms))))
+              (loop (string-append dirs (symbol->url-encoded-string (car 
syms)) "/")
                     (cdr syms)))))
        (init (make-init-name (apply string-append
                                     (map (lambda (s)
                                            (string-append "_"
-                                                          (symbol->string s)))
+                                                          
(symbol->url-encoded-string s)))
                                          module-name)))))
     (let ((subdir (car subdir-and-libname))
          (libname (cdr subdir-and-libname)))
============================================================