Changeset 34415 in project


Ignore:
Timestamp:
08/27/17 04:56:02 (3 months ago)
Author:
kon
Message:

bump ver, re-flow

Location:
release/4/symbol-utils/trunk
Files:
3 edited

Legend:

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

    r19538 r34415  
    11;;;; symbol-utils.scm
    22;;;; Kon Lovett, Aug '10
     3;;;; Kon Lovett, Aug '17
    34
    45(module symbol-utils
    56
    6   (;export
    7     unbound-value unbound-value? unbound?
    8     symbol-value
    9     unspecified-value unspecified-value? unspecified?
    10     symbol->keyword
    11     symbol-printname-details
    12     symbol-printname=? symbol-printname<?
    13     symbol-printname-length
    14     max-symbol-printname-length
    15     interned-symbol?
    16     symbol->qualified-string
    17     make-qualified-uninterned-symbol
    18     make-qualified-symbol
    19     qualified-symbol? )
    20 
    21   (import
    22     scheme
    23     chicken
    24     (only data-structures
    25       ->string conc)
    26     (only type-checks
    27       define-check+error-type
    28       check-symbol) )
    29 
    30   (require-library
    31     data-structures
    32     type-checks)
    33 
    34   (declare
    35     (always-bound
    36       ##sys#arbitrary-unbound-symbol)
    37     (bound-to-procedure
    38       ##sys#symbol->string
    39       ##sys#interned-symbol?
    40       ##sys#make-symbol
    41       ##sys#symbol->qualified-string
    42       ##sys#qualified-symbol-prefix
    43       ##sys#intern-symbol ) )
     7(;export
     8  unbound-value unbound-value? unbound?
     9  symbol-value
     10  unspecified-value unspecified-value? unspecified?
     11  symbol->keyword
     12  symbol-printname-details
     13  symbol-printname=? symbol-printname<?
     14  symbol-printname-length
     15  max-symbol-printname-length
     16  interned-symbol?
     17  symbol->qualified-string
     18  make-qualified-uninterned-symbol
     19  make-qualified-symbol
     20  qualified-symbol? )
     21
     22(import
     23  scheme
     24  chicken
     25  (only data-structures
     26    ->string conc)
     27  (only type-checks
     28    define-check+error-type
     29    check-symbol) )
     30(require-library
     31  data-structures
     32  type-checks)
     33
     34(declare
     35  (always-bound
     36    ##sys#arbitrary-unbound-symbol)
     37  (bound-to-procedure
     38    ##sys#symbol->string
     39    ##sys#interned-symbol?
     40    ##sys#make-symbol
     41    ##sys#symbol->qualified-string
     42    ##sys#qualified-symbol-prefix
     43    ##sys#intern-symbol ) )
    4444
    4545;;; Special Values
     
    6464(define-syntax symbol-value
    6565        (syntax-rules ()
    66 
     66    ;
    6767    ((_ ?sym ?def)
    6868      (let ((val (##sys#slot ?sym 0)))
    69           (if (unbound-value? val) ?def val) ) )
    70 
     69        (if (unbound-value? val) ?def val) ) )
     70    ;
    7171    ((_ ?sym)
    7272      (symbol-value ?sym #f) ) ) )
     
    9292
    9393(define (symbol->keyword sym)
    94   (if (keyword? sym) sym
    95       (string->keyword (symbol->string sym)) ) )
     94  (if (keyword? sym)
     95    sym
     96    (string->keyword (symbol->string sym)) ) )
    9697
    9798;;
     
    108109(define (symbol-printname-details sym)
    109110  (let-values (((s p) (*symbol-printname-details sym)))
    110     ; do not expose the symbol's "raw" printname
     111    ;do not expose the symbol's "raw" printname
    111112    (values (string-copy s) p) ) )
    112113
     
    114115
    115116(define (symbol-printname=? x y)
    116 
    117  (define (qualified=? px sx py sy)
     117  ;
     118  (define (qualified=? px sx py sy)
    118119    (and (string=? px py) (string=? sx sy)) )
    119 
     120  ;
    120121  (let-values (((sx px) (*symbol-printname-details x))
    121122               ((sy py) (*symbol-printname-details y)) )
     
    123124
    124125(define (symbol-printname<? x y)
    125 
     126  ;
    126127  (define (qualified<? px sx py sy)
    127128    (or (and (string=? px py) (string<? sx sy))
    128129        (string<? px py)) )
    129 
     130  ;
    130131  (let-values (((sx px) (*symbol-printname-details x))
    131132               ((sy py) (*symbol-printname-details y)) )
     
    146147(define (symbol-printname-length sym)
    147148  (let ((len (string-length (##sys#symbol->qualified-string sym))))
    148     (if (keyword? sym) (- len 2) ; compensate for leading '###' when only a ':' is printed
     149    (if (keyword? sym)
     150      (- len 2) ;compensate for leading '###' when only a ':' is printed
    149151      len ) ) )
    150152
    151153(define (max-symbol-printname-length syms)
    152   (if (null? syms) '()
     154  (if (null? syms)
     155    '()
    153156    (apply max (map symbol-printname-length syms)) ) )
    154157
     
    181184
    182185(define (make-qualified-string loc prefix name)
    183   ; symbol or string
     186  ;symbol or string
    184187  (check-symbol-or-string loc prefix "qualifier")   ;namespace
    185188  (check-symbol-or-string loc name "qualified")  ;basename
     
    206209
    207210(define (qualified-symbol? sym)
    208   (check-symbol 'qualified-symbol? sym)
    209   (and (##sys#qualified-symbol-prefix sym)
    210        #t ) )
     211  (and
     212    (##sys#qualified-symbol-prefix (check-symbol 'qualified-symbol? sym))
     213    #t ) )
    211214
    212215(define (symbol->qualified-string sym)
    213   (check-symbol 'symbol->qualified-string sym)
    214   (##sys#symbol->qualified-string sym) )
     216  (##sys#symbol->qualified-string (check-symbol 'symbol->qualified-string sym)) )
    215217
    216218(define (interned-symbol? sym)
    217   (check-symbol 'interned-symbol? sym)
    218   (##sys#interned-symbol? sym) )
     219  (##sys#interned-symbol? (check-symbol 'interned-symbol? sym)) )
    219220
    220221) ;module symbol-utils
  • release/4/symbol-utils/trunk/symbol-utils.setup

    r28423 r34415  
    55(verify-extension-name "symbol-utils")
    66
    7 (setup-shared-extension-module 'symbol-utils (extension-version "1.0.2")
     7(setup-shared-extension-module 'symbol-utils (extension-version "1.0.3")
    88  #:inline? #t
    99  #:types? #t
  • release/4/symbol-utils/trunk/tests/run.scm

    r28423 r34415  
     1;;;;
     2
     3(use test)
     4
    15(use symbol-utils)
    2 (use test)
    36
    47(test #:foo (symbol->keyword 'foo))
Note: See TracChangeset for help on using the changeset viewer.