Changeset 35129 in project for release


Ignore:
Timestamp:
02/16/18 21:34:04 (2 months ago)
Author:
kon
Message:

relax , types for everyone

Location:
release/4/string-utils/trunk
Files:
9 edited

Legend:

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

    r34813 r35129  
    1414  make-string*)
    1515
    16 (import scheme)
     16(import scheme chicken)
    1717
    18 (import chicken)
    19 
    20 (import
     18(use
    2119  (only srfi-1 every)
    2220  (only srfi-69
     
    3028  (only type-checks
    3129    check-natural-fixnum check-char check-string))
    32 (require-library srfi-1 srfi-69 unicode-utils type-checks)
    3330
    3431;;
     
    6461;;
    6562
     63(: *make-string+ (#!rest -> string))
    6664(define *make-string+
    6765  (let ((+global-strings+ (make-hash-table equal?)))
  • release/4/string-utils/trunk/string-hexadecimal.scm

    r34441 r35129  
    99  hex->string *hex->string)
    1010
    11 (import scheme)
     11(import scheme chicken)
    1212
    13 (import chicken)
    14 
    15 (import
    16   (only lolevel number-of-bytes))
    17 (require-library lolevel)
    18 
    19 (import
     13(use
     14  (only lolevel number-of-bytes)
    2015  (only to-hex str_to_hex hex_to_str)
    2116  (only type-checks check-natural-fixnum check-string))
    22 (require-library to-hex type-checks)
    2317
    2418(declare
     
    2721    ##sys#make-string))
    2822
    29 ;;
     23;;;
    3024
    31 (define-inline (fxzero? x) (fx= 0 x))
     25(define-inline (fxzero? x)
     26  (fx= 0 x) )
     27
     28;;;
     29
     30(define (check-subvector-indexes loc start end)
     31  (unless
     32    (fx<=
     33      (check-natural-fixnum loc start 'start)
     34      (check-natural-fixnum loc end 'end))
     35    (##sys#signal-hook #:bounds-error loc "illegal subvector specification" start end) )
     36  #; ;cannot deal w/ (values start end)
     37  (void) )
    3238
    3339;;
    3440
    35 (define (check-subvector-indexes loc start end)
    36   (unless (<= (check-natural-fixnum loc start 'start)
    37               (check-natural-fixnum loc end 'end))
    38     (##sys#signal-hook
    39       #:bounds-error loc
    40       "illegal subvector specification" start end) )
    41   #;(values start end) )
    42 
    43 ;;
    44 
     41(: string->hex (string #!optional fixnum (or boolean fixnum) --> string))
    4542(define (string->hex str #!optional (start 0) (end #f))
    4643  (check-string 'string->hex str)
     
    4946    (*string->hex str start end) ) )
    5047
     48(: hex->string (string #!optional fixnum --> string))
    5149(define (hex->string str #!optional (start 0) (end #f))
    5250  (let ((len (number-of-bytes (check-string 'hex->string str))))
     
    5957;;
    6058
     59(: *string->hex (string fixnum fixnum --> string))
    6160(define (*string->hex str start end)
    6261  (let ((len (fx- end start)))
    63     (if (fx= 0 len)
     62    (if (fxzero? len)
    6463      ""
    6564      (str_to_hex (##sys#make-string (fx* len 2)) str start len) ) ) )
    6665
     66(: *hex->string (string fixnum fixnum --> string))
    6767(define (*hex->string str start end)
    6868  (let ((len (fx- end start)))
    69     (if (fx= 0 len)
     69    (if (fxzero? len)
    7070      ""
    7171      (hex_to_str (##sys#make-string (fx/ len 2)) str start len) ) ) )
    7272
    7373#|
    74 (import
     74(use
    7575  (only (srfi 1) drop drop-right)
    76   (only (srfi 13) string-pad string-concatenate))
    77 (require-library (srfi 1) (srfi 13))
     76  (only (srfi 13) string-pad string-concatenate  reverse-list->string))
    7877
    7978(define (*string->hex str start end)
     
    8786          (string-pad (number->string (char->integer c) 16) 2 #\0))
    8887      ls)) ) )
    89 |#
    90 
    91 #|
    92 (import (only (srfi 13) reverse-list->string))
    93 (require-library (srfi 13))
    9488
    9589(define (*hex->string str)
  • release/4/string-utils/trunk/string-interpolation-body.scm

    r34665 r35129  
    55(: string-interpolate (string #!rest --> string))
    66(define (string-interpolate str
    7           #!key (eval-env (interaction-environment)) (eval-tag #\#))
    8   (let ((strp (open-input-string str)))
     7          #!key
     8          (eval-env (interaction-environment))
     9          (eval-tag #\#))
     10  (let ((strp (open-input-string (check-string 'string-interpolate str))))
    911    (parameterize ((parentheses-synonyms #t))
    1012      (let loop ((ls '()) (sl #f))
  • release/4/string-utils/trunk/string-interpolation-syntax.scm

    r34657 r35129  
    77  set-sharp-string-interpolation-syntax)
    88
    9 (import scheme)
     9(import scheme chicken)
    1010
    11 (import chicken)
    12 ;interaction-environment
    13 ;parentheses-synonyms
     11;refs interaction-environment parentheses-synonyms
    1412
    15 (import (only ports make-concatenated-port call-with-input-string))
    16 (require-library ports)
    17 
    18 (import (only data-structures identity))
    19 (require-library data-structures)
     13(use
     14  (only ports make-concatenated-port call-with-input-string)
     15  (only data-structures identity))
    2016
    2117;;;
    22 
    23 ;;
    2418
    2519;(string --> string)
  • release/4/string-utils/trunk/string-interpolation.scm

    r34657 r35129  
    77  string-interpolate)
    88
    9 (import scheme)
     9(import scheme chicken)
    1010
    11 (import chicken)
    12 ;interaction-environment
    13 ;parentheses-synonyms
    14 ;reverse-list->string
     11;refs interaction-environment parentheses-synonyms reverse-list->string
    1512
    16 (import (only srfi-13 string-concatenate-reverse #;reverse-list->string))
    17 (require-library srfi-13)
    18 
    19 (import (only data-structures ->string))
    20 (require-library data-structures)
     13(use
     14  (only srfi-13 string-concatenate-reverse)
     15  (only data-structures ->string)
     16  (only type-checks check-string))
    2117
    2218;;;
    23 
    24 ;;
    2519
    2620(include "string-interpolation-body")
  • release/4/string-utils/trunk/string-utils.setup

    r34823 r35129  
    55(verify-extension-name "string-utils")
    66
    7 (setup-shared-extension-module 'string-interpolation-syntax (extension-version "1.5.5")
     7(setup-shared-extension-module 'string-interpolation-syntax (extension-version "1.5.6")
    88  ;#:inline? #t
    99  #:types? #t
     
    1313    -no-procedure-checks))
    1414
    15 (setup-shared-extension-module 'string-interpolation (extension-version "1.5.5")
     15(setup-shared-extension-module 'string-interpolation (extension-version "1.5.6")
    1616  ;#:inline? #t
    1717  #:types? #t
     
    2121    -no-procedure-checks))
    2222
    23 (setup-shared-extension-module 'utf8-string-interpolation (extension-version "1.5.5")
     23(setup-shared-extension-module 'utf8-string-interpolation (extension-version "1.5.6")
    2424  ;#:inline? #t
    2525  #:types? #t
     
    2929    -no-procedure-checks))
    3030
    31 (setup-shared-extension-module 'unicode-utils (extension-version "1.5.5")
     31(setup-shared-extension-module 'unicode-utils (extension-version "1.5.6")
    3232  #:inline? #t
    3333  #:types? #t
     
    3838    -no-procedure-checks))
    3939
    40 (setup-shared-extension-module 'memoized-string (extension-version "1.5.5")
     40(setup-shared-extension-module 'memoized-string (extension-version "1.5.6")
    4141  #:inline? #t
    4242  #:types? #t
     
    4848    -no-procedure-checks))
    4949
    50 (setup-shared-extension-module 'to-hex (extension-version "1.5.5"))
     50(setup-shared-extension-module 'to-hex (extension-version "1.5.6"))
    5151
    52 (setup-shared-extension-module 'string-hexadecimal (extension-version "1.5.5")
     52(setup-shared-extension-module 'string-hexadecimal (extension-version "1.5.6")
    5353  #:inline? #t
    5454  #:types? #t
     
    5959    -no-procedure-checks))
    6060
    61 (setup-shared-extension-module 'string-utils (extension-version "1.5.5")
     61(setup-shared-extension-module 'string-utils (extension-version "1.5.6")
    6262  #:inline? #t
    6363  #:types? #t
  • release/4/string-utils/trunk/to-hex.scm

    r34682 r35129  
    1515  hex_to_blob)
    1616
    17 (import scheme)
    18 (import chicken foreign)
     17(import scheme chicken foreign)
    1918
    2019;;;
     
    8180;;
    8281
     82(: str_to_hex (string string fixnum fixnum -> string))
    8383(define (str_to_hex out in off len)
    8484  (C_str_to_hex out in off len)
    8585  out )
    8686
     87(: blob_to_hex (string blob fixnum fixnum -> string))
    8788(define (blob_to_hex out in off len)
    8889  (C_blob_to_hex out in off len)
    8990  out )
    9091
     92(: u8vec_to_hex (string u8vector fixnum fixnum -> string))
    9193(define (u8vec_to_hex out in off len)
    9294  (C_u8vec_to_hex out in off len)
    9395  out )
    9496
     97(: s8vec_to_hex (string s8vector fixnum fixnum -> string))
    9598(define (s8vec_to_hex out in off len)
    9699  (C_s8vec_to_hex out in off len)
    97100  out )
    98101
     102(: mem_to_hex (string pointer fixnum fixnum -> string))
    99103(define (mem_to_hex out in off len)
    100104  (C_mem_to_hex out in off len)
     
    103107;;
    104108
     109(: hex_to_str (string string fixnum fixnum -> string))
    105110(define (hex_to_str out in off len)
    106111  (C_hex_to_str out in off len)
    107112  out )
    108113
     114(: hex_to_blob (blob string fixnum fixnum -> blob))
    109115(define (hex_to_blob out in off len)
    110116  (C_hex_to_str out in off len)
  • release/4/string-utils/trunk/unicode-utils.scm

    r34816 r35129  
    1717  unicode-surrogates->codepoint)
    1818
    19 (import scheme)
     19(import scheme chicken)
    2020
    21 (import chicken)
    22 
    23 (import
     21(use
    2422  (only srfi-1 every make-list)
    2523  (only srfi-13 string-concatenate)
    2624  (only type-checks check-natural-fixnum check-char))
    27 (require-library srfi-1 srfi-13 type-checks)
    2825
    2926(declare
     
    3633;; Simple UTF 8
    3734
     35(: ascii-codepoint? (* -> boolean : char))
    3836(define (ascii-codepoint? ch)
    39   (let ((x (char->integer (check-char 'ascii-codepoint? ch))))
    40     (and (fx<= 0 x) (fx<= x #x7f)) ) )
     37  (and
     38    (char? ch)
     39    (let ((x (char->integer ch)))
     40      (and (fx<= 0 x) (fx<= x #x7f)) ) ) )
    4141
     42(: unicode-char->string (char --> string))
    4243(define (unicode-char->string ch)
    4344  (##sys#char->utf8-string (check-char 'unicode-char->string ch)) )
    4445
    4546;inefficient
     47(: unicode-string (#!rest (list-of char) --> string))
    4648(define (unicode-string . chs)
    4749  (if (null? chs)
     
    5355      (*unicode-string chs) ) ) )
    5456
     57(: generic-make-string (fixnum char --> string))
    5558(define (generic-make-string len ch)
    5659  (if (ascii-codepoint? ch)
     
    5861    (unicode-make-string len ch) ) )
    5962
     63(: unicode-make-string (fixnum #!optional char --> string))
    6064(define (unicode-make-string len #!optional (fill #\space))
    6165  (*unicode-make-string
     
    6367    (check-char 'unicode-make-string fill)) )
    6468
     69(: unicode-surrogate? (* -> boolean : fixnum))
    6570(define (unicode-surrogate? n)
    66   (##sys#unicode-surrogate? (check-natural-fixnum 'unicode-surrogate? n)) )
     71  (and
     72    (fixnum? n)
     73    (##sys#unicode-surrogate? n) ) )
    6774
     75(: unicode-surrogates->codepoint (fixnum fixnum --> (or boolean fixnum)))
    6876(define (unicode-surrogates->codepoint hi lo)
    6977  (##sys#surrogates->codepoint
     
    7179    (check-natural-fixnum 'unicode-surrogates->codepoint lo "low")) )
    7280
     81(: *unicode-make-string (fixnum char --> string))
    7382(define (*unicode-make-string len fill)
    7483  (cond
     
    8190
    8291;inefficient
     92(: *unicode-string ((list-of char) --> string))
    8393(define (*unicode-string chs)
    8494  (cond
  • release/4/string-utils/trunk/utf8-string-interpolation.scm

    r34657 r35129  
    77  string-interpolate)
    88
    9 (import scheme)
    10 (import (except scheme #;peek-char read-char #;read))
     9(import
     10  (except scheme read-char #;peek-char #;read)
     11  (except chicken reverse-list->string))
    1112
    12 (import (except chicken reverse-list->string))
    13 ;interaction-environment
    14 ;parentheses-synonyms
     13;refs interaction-environment parentheses-synonyms
    1514
    16 (import (only utf8-srfi-13 string-concatenate-reverse #;reverse-list->string))
    17 (require-library utf8-srfi-13)
    18 (import (only utf8 #;peek-char read-char #;read list->string))
    19 (require-library utf8)
    20 
    21 (import (only (srfi 1) reverse!))
    22 (require-library (srfi 1))
    23 
    24 (import (only data-structures ->string))
    25 (require-library data-structures)
     15(use
     16  (only utf8-srfi-13 string-concatenate-reverse #;reverse-list->string)
     17  (only utf8 #;peek-char read-char #;read list->string)
     18  (only (srfi 1) reverse!)
     19  (only data-structures ->string)
     20  (only type-checks check-string))
    2621
    2722;;;
    28 
    29 ;;
    3023
    3124(define-inline (reverse-list->string clist)
    3225  (list->string (reverse! clist)) )
    3326
    34 ;;;
    35 
    36 ;;
    37 
    3827(include "string-interpolation-body")
    3928
Note: See TracChangeset for help on using the changeset viewer.