minor lib name hacks fixes

This commit is contained in:
dermagen 2024-06-15 16:00:03 -04:00
parent 61c27b403e
commit 6cac06cdbb
2 changed files with 31 additions and 31 deletions

View file

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

26
t.c
View file

@ -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,.1S3<?{.0,'(s1:0)S6}{.0},.0SdX2,'(c%25)c,.4,.1A8L6,.4"
"d,:1^[52}.!0.0^_1[22",
"P", "listname->symbol",
"%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,.1S3<?{.0,'(s1:0)S6}{.0},.0SuX2,'(c%25)c,.4,.1A8L6,.4d,:1^[52"
"}.!0.0^_1[12}.!5&0{%1'(i10),.1E8]1}.!6.7L0~?{${.9,'(s20:invalid librar"
"y name),@(y7:x-error)[02}}.1^,l1,.8,,#0.(i10),.1,.9,.(i12),.(i10),.(i1"
"3),.9,&7{%2.0u?{${.3,:0^cA8,@(y14:%25string-append),@(y13:apply-to-lis"
"t)[02}X5]2}.0aY0?{.1,:2^c,${.3a,:1^[01}c,.1d,:5^[22}.0aI0?{.1,:4^c,${."
"3a,:3^[01}c,.1d,:5^[22}:6,'(s20:invalid library name),@(y7:x-error)[22"
"}.!0.0^_1[82",
"%1,,,,#0#1#2#3'(s0:).!0'(s5:lib:/).!1'(s1:/).!2'(s1:/).!3.4L0~?{${.6,'"
"(s20:invalid library name),@(y7:x-error)[02}}.1^,l1,.5,,#0.7,.1,.8,.8,"
".7,&5{%2.0u?{${.3,:0^cA8,@(y14:%25string-append),@(y13:apply-to-list)["
"02}X5]2}.0aY0?{.1,:1^c,${.3a,@(y21:mangle-symbol->string)[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)",