diff --git a/src/t.scm b/src/t.scm index c5bb50f..0a78e5d 100644 --- a/src/t.scm +++ b/src/t.scm @@ -1262,42 +1262,40 @@ ; Library names and library file lookup ;--------------------------------------------------------------------------------------------- -(define (listname->symbol lib) - (define postfix "/") - (define prefix "") - (define commons '(#\- #\< #\= #\>)) - (define symbol-prefix "/") - (define number-prefix ".") - (define (mangle-symbol sym) + (define (mangle-symbol->string sym) + (define safe '(#\! #\$ #\- #\_ #\=)) (let loop ([lst (string->list (symbol->string sym))] [text '()]) (cond [(null? lst) (list->string (reverse text))] - [(or (char-alphabetic? (car lst)) (char-numeric? (car lst))) + [(or (char-lower-case? (car lst)) (char-numeric? (car lst))) (loop (cdr lst) (cons (car lst) text))] - [(memv (car lst) commons) + [(memv (car lst) safe) (loop (cdr lst) (cons (car lst) text))] - [else + [else ; use % encoding for everything else (let* ([s (number->string (char->integer (car lst)) 16)] [s (if (< (string-length s) 2) (string-append "0" s) s)] - [l (cons #\% (string->list (string-upcase s)))]) + [l (cons #\% (string->list (string-downcase s)))]) (loop (cdr lst) (append (reverse l) text)))]))) - (define (mangle-number num) - (number->string num)) + +(define (listname->symbol lib) + (define postfix "") + (define prefix "lib:/") + (define symbol-prefix "/") + (define number-prefix "/") (unless (list? lib) (x-error "invalid library name" lib)) (let loop ([lst lib] [parts (list prefix)]) (if (null? lst) (string->symbol (apply string-append (reverse (cons postfix parts)))) (cond [(symbol? (car lst)) - (loop (cdr lst) (cons (mangle-symbol (car lst)) (cons symbol-prefix parts)))] + (loop (cdr lst) (cons (mangle-symbol->string (car lst)) (cons symbol-prefix parts)))] [(exact-integer? (car lst)) - (loop (cdr lst) (cons (mangle-number (car lst)) (cons number-prefix parts)))] + (loop (cdr lst) (cons (number->string (car lst)) (cons number-prefix parts)))] [else (x-error "invalid library name" lib)])))) (define (listname-segment->string s) - (cond [(symbol? s) (symbol->string s)] - [(number? s) (number->string s)] - [(string? s) s] - [else (c-error "invalid symbolic file name element" s)])) + (cond [(symbol? s) (mangle-symbol->string s)] + [(exact-integer? s) (number->string s)] + [else (c-error "invalid library name name element" s)])) (define modname-separator "_") diff --git a/t.c b/t.c index 685f04d..bb0b051 100644 --- a/t.c +++ b/t.c @@ -647,21 +647,23 @@ char *t_code[] = { "(y14:path-directory)[01},.2,@(y34:file-resolve-relative-to-base-path)[" "22}.1]2}.0]1", + "P", "mangle-symbol->string", + "%1,#0'(l5:c!;c$;c-;c_;c=;).!0n,.2X4X2,,#0.0,.4,&2{%2.0u?{.1A8X3]2}.0aC" + "2,.0?{.0}{.1aC5}_1?{.1,.1ac,.1d,:1^[22}:0^,.1aA1?{.1,.1ac,.1d,:1^[22}'" + "(i16),.1aX8E8,'2,.1S3symbol", - "%1,,,,,,,#0#1#2#3#4#5#6'(s1:/).!0'(s0:).!1'(l4:c-;c<;c=;c>;).!2'(s1:/)" - ".!3'(s1:.).!4.2,&1{%1n,.1X4X2,,#0.0,:0,&2{%2.0u?{.1A8X3]2}.0aC4,.0?{.0" - "}{.1aC5}_1?{.1,.1ac,.1d,:1^[22}:0^,.1aA1?{.1,.1ac,.1d,:1^[22}'(i16),.1" - "aX8E8,'2,.1S3string)[01}c,.1d,:3^" + "[22}.0aI0?{.1,:2^c,'(i10),.2aE8c,.1d,:3^[22}:4,'(s20:invalid library n" + "ame),@(y7:x-error)[22}.!0.0^_1[52", "P", "listname-segment->string", - "%1.0Y0?{.0X4]1}.0N0?{'(i10),.1E8]1}.0S0?{.0]1}.0,'(s34:invalid symboli" - "c file name element),@(y7:c-error)[12", + "%1.0Y0?{.0,@(y21:mangle-symbol->string)[11}.0I0?{'(i10),.1E8]1}.0,'(s3" + "3:invalid library name name element),@(y7:c-error)[12", "C", 0, "'(s1:_)@!(y17:modname-separator)",