Changeset 35125 in project


Ignore:
Timestamp:
02/16/18 20:12:56 (4 months ago)
Author:
kon
Message:

remove unused import , belt-n-suspenders (: & check-) , explicit fx

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/symbol-utils/trunk/symbol-utils.scm

    r35124 r35125  
    2323(use
    2424  (only data-structures
    25     ->string conc)
     25    ->string)
    2626  (only type-checks
    27     define-check+error-type
    28     check-symbol) )
     27    check-symbol check-list) )
    2928
    3029(declare
     
    9493;which means a keyword and a symbol of the same name have the same printname.
    9594
     95(: symbol->keyword (symbol --> symbol))
    9696(define (symbol->keyword sym)
    9797  (if (keyword? sym)
    9898    sym
    99     (string->keyword (symbol->string sym)) ) )
    100 
    101 ;;
    102 
     99    (string->keyword (symbol->string (check-symbol 'symbol->keyword sym))) ) )
     100
     101;;
     102
     103(: *symbol-printname-details (symbol --> string string))
    103104(define (*symbol-printname-details sym)
    104105  (let ((p (##sys#qualified-symbol-prefix sym)) )
     
    110111        (else                         (substring p 1) ) ) ) ) )
    111112
     113(: symbol-printname-details (symbol --> string string))
    112114(define (symbol-printname-details sym)
    113115  (let-values (
    114     ((s p) (*symbol-printname-details sym)))
     116    ((s p) (*symbol-printname-details (check-symbol 'symbol-printname-details sym))))
    115117    ;do not expose the symbol's "raw" printname
    116118    (values (string-copy s) p) ) )
     
    118120;;
    119121
     122(: qualified=? (string string string string --> boolean))
    120123(define (qualified=? px sx py sy)
    121124  (and (string=? px py) (string=? sx sy)) )
    122125
     126(: qualified<? (string string string string --> boolean))
    123127(define (qualified<? px sx py sy)
    124128  (or
     
    126130    (string<? px py)) )
    127131
     132(: symbol-printname=? (symbol symbol --> boolean))
    128133(define (symbol-printname=? x y)
    129134  (let-values (
    130     ((sx px) (*symbol-printname-details x))
    131     ((sy py) (*symbol-printname-details y)) )
     135    ((sx px) (*symbol-printname-details (check-symbol 'symbol-printname=? x)))
     136    ((sy py) (*symbol-printname-details (check-symbol 'symbol-printname=? y))) )
    132137    (qualified=? px sx py sy) ) )
    133138
     139(: symbol-printname<? (symbol symbol --> boolean))
    134140(define (symbol-printname<? x y)
    135141  (let-values (
    136     ((sx px) (*symbol-printname-details x))
    137     ((sy py) (*symbol-printname-details y)) )
     142    ((sx px) (*symbol-printname-details (check-symbol 'symbol-printname<? x)))
     143    ((sy py) (*symbol-printname-details (check-symbol 'symbol-printname<? y))) )
    138144    (qualified<? px sx py sy) ) )
    139145
     
    150156      (string-length (##sys#symbol->string sym)) ) ) )
    151157
     158(: symbol-printname-length (symbol --> fixnum))
    152159(define (symbol-printname-length sym)
    153160  (let (
    154     (len (string-length (##sys#symbol->qualified-string sym))) )
     161    (len
     162      (string-length
     163        (##sys#symbol->qualified-string
     164          (check-symbol 'symbol-printname-length sym)))) )
    155165    (if (keyword? sym)
    156166      (fx- len 2) ;compensate for leading '###' when only a ':' is printed
    157167      len ) ) )
    158168
     169(: max-symbol-printname-length ((list-of symbol) --> fixnum))
    159170(define (max-symbol-printname-length syms)
    160   (if (null? syms)
     171  (if (null? (check-list 'max-symbol-printname-length syms))
    161172    '()
    162173    (apply max (map symbol-printname-length syms)) ) )
     
    174185;Note keywords are in the null namespace!
    175186
     187(: make-qualified-string (symbol * * --> string))
    176188(define (make-qualified-string loc prefix name)
    177189  (let* (
     
    189201;; Chicken namespace qualified symbol.
    190202
     203(: make-qualified-symbol (* * --> symbol))
    191204(define (make-qualified-symbol prefix name)
    192205  (##sys#intern-symbol
    193206    (make-qualified-string 'make-qualified-symbol prefix name)) )
    194207
     208(: make-qualified-uninterned-symbol (* * --> symbol))
    195209(define (make-qualified-uninterned-symbol prefix name)
    196210  (##sys#make-symbol
    197211    (make-qualified-string 'make-qualified-symbol prefix name)) )
    198212
     213(: qualified-symbol? (symbol --> boolean))
    199214(define (qualified-symbol? sym)
    200215  (->boolean
    201216    (##sys#qualified-symbol-prefix (check-symbol 'qualified-symbol? sym))) )
    202217
     218(: symbol->qualified-string (symbol --> string))
    203219(define (symbol->qualified-string sym)
    204220  (##sys#symbol->qualified-string (check-symbol 'symbol->qualified-string sym)) )
    205221
     222(: interned-symbol? (symbol --> boolean))
    206223(define (interned-symbol? sym)
    207224  (##sys#interned-symbol? (check-symbol 'interned-symbol? sym)) )
Note: See TracChangeset for help on using the changeset viewer.