Changeset 37670 in project


Ignore:
Timestamp:
06/09/19 19:34:29 (6 weeks ago)
Author:
kon
Message:

keyword is disjoint

File:
1 edited

Legend:

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

    r37121 r37670  
    4040;;
    4141
    42 (: keyword->symbol (symbol --> symbol))
     42(: keyword->symbol (keyword --> symbol))
    4343;
    4444(define (keyword->symbol kwd)
    4545  (string->symbol (keyword->string kwd)) )
    4646
    47 (: keyword->uninterned-symbol (symbol --> symbol))
     47(: keyword->uninterned-symbol (keyword --> symbol))
    4848;
    4949(define (keyword->uninterned-symbol kwd)
     
    5555;which means a keyword and a symbol of the same name have the same printname.
    5656
    57 (: symbol->keyword (symbol --> symbol))
     57(: symbol->keyword ((or keyword symbol) --> keyword))
    5858;
    5959(define (symbol->keyword sym)
    60   (if (keyword? sym)
    61     sym
    62     (string->keyword (symbol->string (check-symbol 'symbol->keyword sym))) ) )
     60  (cond
     61    ((keyword? sym) (the keyword sym))
     62    (else           (string->keyword (symbol->string sym)) ) ) )
    6363
    6464;;
    6565
    66 (: *symbol-printname-details (symbol --> string string))
     66(: *symbol-printname-details ((or keyword symbol) --> string string))
    6767;
    6868(define (*symbol-printname-details sym)
    69   (values (symbol->string sym) (if (keyword? sym) ":" "")) )
     69  (cond
     70    ((keyword? sym) (values (keyword->string sym) ":"))
     71    (else           (values (symbol->string sym) ""))) )
    7072
    71 (: symbol-printname-details (symbol --> string string))
     73(: symbol-printname-details ((or keyword symbol) --> string string))
    7274;
    7375(define (symbol-printname-details sym)
    7476  (let-values (
    75     ((s p) (*symbol-printname-details (check-symbol 'symbol-printname-details sym))))
     77    ((s p) (*symbol-printname-details sym)))
    7678    ;do not expose the symbol's "raw" printname
    7779    (values (string-copy s) p) ) )
    7880
    79 (: symbol-printname=? (symbol symbol --> boolean))
     81;FIXME (forall (a ...) (a a --> boolean))
     82
     83(: symbol-printname=? ((or keyword symbol) (or keyword symbol) --> boolean))
    8084;
    8185(define (symbol-printname=? x y)
    8286  (let-values (
    83     ((sx px) (*symbol-printname-details (check-symbol 'symbol-printname=? x)))
    84     ((sy py) (*symbol-printname-details (check-symbol 'symbol-printname=? y))) )
     87    ((sx px) (*symbol-printname-details x))
     88    ((sy py) (*symbol-printname-details y)) )
    8589    (exploded-qualified-symbol=? px sx py sy) ) )
    8690
    87 (: symbol-printname<? (symbol symbol --> boolean))
     91(: symbol-printname<? ((or keyword symbol) (or keyword symbol) --> boolean))
    8892;
    8993(define (symbol-printname<? x y)
    9094  (let-values (
    91     ((sx px) (*symbol-printname-details (check-symbol 'symbol-printname<? x)))
    92     ((sy py) (*symbol-printname-details (check-symbol 'symbol-printname<? y))) )
     95    ((sx px) (*symbol-printname-details x))
     96    ((sy py) (*symbol-printname-details y)) )
    9397    (exploded-qualified-symbol<? px sx py sy) ) )
    9498
    9599;;
    96100
    97 (: symbol-printname-length (symbol --> fixnum))
     101(: symbol-printname-length ((or keyword symbol) --> fixnum))
    98102;
    99103(define (symbol-printname-length sym)
    100   (let (
    101     (len (string-length (symbol->string (check-symbol 'symbol-printname-length sym)))) )
    102     (if (keyword? sym)
    103       (fx- len 2) ;compensate for leading '###' when only a ':' is printed
    104       len ) ) )
     104  (cond
     105    ((keyword? sym)
     106      ;compensate for leading '###' when only a ':' is printed
     107      (- (string-length (keyword->string sym)) 2) )
     108    (else
     109      (string-length (symbol->string sym)) ) ) )
    105110
    106111(: max-symbol-printname-length ((list-of symbol) --> fixnum))
     
    109114  (if (null? (check-list 'max-symbol-printname-length syms))
    110115    '()
    111     (apply max (map symbol-printname-length syms)) ) )
     116    (apply max 0 (map symbol-printname-length syms)) ) )
    112117
    113118) ;module symbol-name-utils
Note: See TracChangeset for help on using the changeset viewer.