2022-2/code/symbols-as-strings.sld

87 lines
2.9 KiB
Scheme

(define-library (symbols-as-strings)
(export symbol-length
symbol<?
symbol-ci<?
symbol-prefix?
symbol-suffix?
symbol-middle
symbol-substring
symbol-append
symbol-transform)
(import (scheme base)
(scheme case-lambda))
(cond-expand ((library (srfi 13))
(import (only (srfi 13)
string-prefix?
string-suffix?)))
((library (srfi 130))
(import (only (srfi 130)
string-prefix?
string-suffix?))))
(begin
(define (symbol-length symbol)
(string-length (symbol->string symbol)))
(define (symbol<? symbol1 symbol2)
(string<? (symbol->string symbol1)
(symbol->string symbol2)))
(define (symbol-ci<? symbol1 symbol2)
(string-ci<? (symbol->string symbol1)
(symbol->string symbol2)))
(define (symbol-prefix? prefix symbol)
(string-prefix? prefix (symbol->string symbol)))
(define (symbol-suffix? suffix symbol)
(string-suffix? suffix (symbol->string symbol)))
(define symbol-middle
(case-lambda
((symbol prefix)
(symbol-middle symbol prefix ""))
((symbol prefix suffix)
(let ((suffix (or suffix ""))
(str (symbol->string symbol)))
(and (string-prefix? prefix str)
(string-suffix? suffix str)
(substring str
(string-length prefix)
(- (string-length str)
(string-length suffix))))))))
(define symbol-substring
(case-lambda
((symbol start)
(let ((str (symbol->string symbol)))
(substring str start (string-length str))))
((symbol start end)
(let ((str (symbol->string symbol)))
(substring str start (or end (string-length str)))))))
(define (symbol-append . parts)
(string->symbol
(apply string-append
(map (lambda (part)
(cond ((string? part)
part)
((char? part)
(string part))
((symbol? part)
(symbol->string part))
((and (integer? part)
(exact? part)
(not (negative? part)))
(number->string part))
((not part)
"")
(else
(error "Bad symbol part" part))))
parts))))
(define (symbol-transform string-proc symbol . args)
(string->symbol (apply string-proc
(symbol->string symbol)
args)))))