Changeset 37043 in project


Ignore:
Timestamp:
01/16/19 15:54:56 (3 months ago)
Author:
kon
Message:

quick "fix" for no more qualified symbols

Location:
release/5/symbol-utils/trunk
Files:
5 edited

Legend:

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

    r35798 r37043  
    11;;;; symbol-name-utils.scm  -*- Scheme -*-
    22;;;; Kon Lovett, Jul '18
    3 
    4 (declare
    5   (bound-to-procedure
    6     ##sys#symbol->qualified-string
    7     ##sys#qualified-symbol-prefix))
    83
    94(module symbol-name-utils
     
    2318  (chicken fixnum)
    2419  (chicken type)
    25   (only symbol-qualified-utils
    26     exploded-qualified-symbol=? exploded-qualified-symbol<?)
    2720  (only type-checks check-symbol check-list))
     21
     22;;; Support
     23
     24;;
     25
     26(: exploded-qualified-symbol=? (string string string string --> boolean))
     27;
     28(define (exploded-qualified-symbol=? px sx py sy)
     29  (and (string=? px py) (string=? sx sy)) )
     30
     31(: exploded-qualified-symbol<? (string string string string --> boolean))
     32;
     33(define (exploded-qualified-symbol<? px sx py sy)
     34  (or
     35    (and (string=? px py) (string<? sx sy))
     36    (string<? px py)) )
     37
     38;;;
    2839
    2940;;
     
    4960  (if (keyword? sym)
    5061    sym
    51     (string->keyword (symbol->string
    52       (check-symbol 'symbol->keyword sym))) ) )
     62    (string->keyword (symbol->string (check-symbol 'symbol->keyword sym))) ) )
    5363
    5464;;
     
    5767;
    5868(define (*symbol-printname-details sym)
     69  (values (symbol->string sym) "")
     70#;
    5971  (let ((p (##sys#qualified-symbol-prefix sym)))
    6072    (values
     
    95107(define (symbol-printname-length sym)
    96108  (let (
    97     (len
    98       (string-length
    99         (##sys#symbol->qualified-string
    100           (check-symbol 'symbol-printname-length sym)))) )
     109    (len (string-length (symbol->string (check-symbol 'symbol-printname-length sym)))) )
    101110    (if (keyword? sym)
    102111      (fx- len 2) ;compensate for leading '###' when only a ':' is printed
  • release/5/symbol-utils/trunk/symbol-qualified-utils.scm

    r35798 r37043  
    55  (bound-to-procedure
    66    ##sys#size
    7     ##sys#symbol->qualified-string
    8     ##sys#qualified-symbol-prefix
    97    ##sys#fragments->string
    108    ##sys#intern-symbol
     
    3331;;;
    3432
     33;;
     34
    3535(define-type ##sys#fragments->string (fixnum (list-of string) -> string))
     36(define-type ##sys#size (string -> fixnum))
    3637
    37 (define-type ##sys#size (string -> fixnum))
     38;;
    3839
    3940(define (->boolean obj)
  • release/5/symbol-utils/trunk/symbol-utils.egg

    r35958 r37043  
    33
    44((synopsis "symbol-utils")
    5  (version "2.0.0")
     5 (version "2.0.1")
    66 (category data)
    77 (author "[[kon lovett]]")
     
    1515    (types-file)
    1616    (csc-options "-O3" "-d1" "-no-procedure-checks") )
     17  #;
    1718  (extension symbol-qualified-utils
    1819    #;(inline-file)
     
    2223    #;(inline-file)
    2324    (types-file)
    24     (component-dependencies symbol-qualified-utils)
     25    #;(component-dependencies symbol-qualified-utils)
    2526    (csc-options "-O3" "-d1" "-no-procedure-checks") )
    2627  (extension symbol-value-utils
     
    3233    (types-file)
    3334    (component-dependencies
    34       symbol-lolevel-utils symbol-qualified-utils symbol-name-utils symbol-value-utils)
     35      symbol-lolevel-utils #;symbol-qualified-utils symbol-name-utils symbol-value-utils)
    3536    (csc-options "-O3" "-d1" "-no-procedure-checks") ) ) )
  • release/5/symbol-utils/trunk/symbol-utils.scm

    r35798 r37043  
    88(import scheme (chicken module))
    99(import
    10   symbol-name-utils symbol-value-utils symbol-qualified-utils symbol-lolevel-utils)
     10  symbol-name-utils symbol-value-utils #;symbol-qualified-utils symbol-lolevel-utils)
    1111
    1212(reexport
    13   symbol-name-utils symbol-value-utils symbol-qualified-utils symbol-lolevel-utils)
     13  symbol-name-utils symbol-value-utils #;symbol-qualified-utils symbol-lolevel-utils)
    1414
    1515) ;module symbol-utils
  • release/5/symbol-utils/trunk/tests/symbol-utils-test.scm

    r35798 r37043  
    2929(test-assert (symbol-printname<? 'bar 'foo))
    3030(test-assert (not (symbol-printname<? '##sys#list->string '##sys#list->string)))
    31 (test-assert (symbol-printname<? 'list->string '##sys#list->string))
     31#;(test-assert (symbol-printname<? 'list->string '##sys#list->string))
    3232
    3333(test 3 (symbol-printname-length 'foo))
     
    3535(test 3 (max-symbol-printname-length '(a abc ab)))
    3636
    37 (test '##foo#bar (make-qualified-symbol "foo" 'bar))
     37#;(test '##foo#bar (make-qualified-symbol "foo" 'bar))
    3838
    39 (test-assert (qualified-symbol? '##sys#list->string))
    40 (test-assert (not (qualified-symbol? 'sym)))
     39#;(test-assert (qualified-symbol? '##sys#list->string))
     40#;(test-assert (not (qualified-symbol? 'sym)))
    4141
    42 (test "##sys#list->string" (symbol->qualified-string '##sys#list->string))
    43 (test "list->string" (symbol->qualified-string 'list->string))
     42#;(test "##sys#list->string" (symbol->qualified-string '##sys#list->string))
     43#;(test "list->string" (symbol->qualified-string 'list->string))
    4444
    4545(test-assert (interned-symbol? 'foo))
    4646(test-assert (not (interned-symbol? (gensym))))
    4747
    48 (test-assert (not (interned-symbol? (make-qualified-uninterned-symbol "bar" 'foo))))
     48#;(test-assert (not (interned-symbol? (make-qualified-uninterned-symbol "bar" 'foo))))
    4949
    5050;;;
Note: See TracChangeset for help on using the changeset viewer.