87 lines
2.9 KiB
Plaintext
87 lines
2.9 KiB
Plaintext
|
(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))
|
||
|
|
||
|
(define (symbol-suffix? suffix symbol)
|
||
|
(string-suffix? suffix 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)))))
|