Changeset 38937 in project


Ignore:
Timestamp:
08/30/20 19:06:47 (4 weeks ago)
Author:
Kon Lovett
Message:

add -strict-types, type is interface

Location:
release/5/string-utils/trunk
Files:
11 edited

Legend:

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

    r38445 r38937  
    2727;;
    2828
     29(: global-string (string -> string))
     30(: string+ (#!rest char -> string))
     31(: make-string+ (number #!optional char -> string))
     32(: *make-string+ (#!rest -> string))
     33
     34;;
     35
    2936(define *empty-string* "")
    3037
    3138;;
    3239
    33 (: global-string (string -> string))
    34 ;
    3540(define (global-string str)
    3641  (*make-string+ (check-string 'global-string str)) )
     
    3843;;
    3944
    40 (: string+ (#!rest char -> string))
    41 ;
     45
    4246(define (string+ . chars)
    4347  (let ((len (length chars)))
     
    5054;; Memeoized `make-string'
    5155
    52 ;len - length of string in chars
    53 (: make-string+ (number #!optional char -> string))
    54 ;
    5556(define (make-string+ len #!optional (fill #\space))
    5657  (*make-string+
     
    6061;;
    6162
    62 (: *make-string+ (#!rest -> string))
    63 ;
     63
    6464(define *make-string+
    6565  (let ((+global-strings+ (make-hash-table equal?)))
  • release/5/string-utils/trunk/string-hexadecimal.scm

    r38445 r38937  
    2323(import (only type-checks check-natural-fixnum check-string))
    2424
    25 ;;;
     25;;
     26
     27(: string->hex (string #!optional fixnum (or boolean fixnum) --> string))
     28(: hex->string (string #!optional fixnum --> string))
     29(: *string->hex (string fixnum fixnum --> string))
     30(: *hex->string (string fixnum fixnum --> string))
     31
     32;;
    2633
    2734(define (check-subvector-indexes loc start end)
     
    3441;;
    3542
    36 (: string->hex (string #!optional fixnum (or boolean fixnum) --> string))
    37 ;
    3843(define (string->hex str #!optional (start 0) (end #f))
    3944  (let* (
     
    4348    (*string->hex str start end) ) )
    4449
    45 (: hex->string (string #!optional fixnum --> string))
    46 ;
    4750(define (hex->string str #!optional (start 0) (end #f))
    4851  (let* (
     
    5659;;
    5760
    58 (: *string->hex (string fixnum fixnum --> string))
    59 ;
    6061(define (*string->hex str start end)
    6162  (let (
     
    6566      (str_to_hex (##sys#make-string (* len 2)) str start len) ) ) )
    6667
    67 (: *hex->string (string fixnum fixnum --> string))
    68 ;
    6968(define (*hex->string str start end)
    7069  (let (
  • release/5/string-utils/trunk/string-interpolation-body.scm

    r38017 r38937  
    88;; - Uses ##sys#print-to-string
    99
    10 (: string-interpolate/sanity (string #!rest --> list))
    11 ;
    1210(define (string-interpolate/sanity str #!key (eval-tag #\#) (bracing? #f))
    1311  (let (
     
    7068            (advance objs (push-char ch)) ) ) ) ) ) )
    7169
    72 (: string-interpolate (string #!rest --> list))
    73 ;
    7470(define (string-interpolate str #!key (eval-tag #\#))
    7571  (parameterize ((parentheses-synonyms #t))
  • release/5/string-utils/trunk/string-interpolation-syntax.scm

    r38445 r38937  
    1515(import (chicken port))
    1616
    17 ;;;
     17;;
    1818
    1919(: set-sharp-string-interpolation-syntax ((or boolean procedure) -> void))
    20 ;
     20
     21;;
     22
    2123(define (set-sharp-string-interpolation-syntax interpolator)
    2224  (set-sharp-read-syntax! #\"
  • release/5/string-utils/trunk/string-interpolator.scm

    r38445 r38937  
    2121(import (only (srfi 13) string-concatenate-reverse))
    2222
     23(: string-interpolate/sanity (string #!rest --> list))
     24(: string-interpolate (string #!rest --> list))
     25
    2326(include "string-interpolation-body")
    2427
  • release/5/string-utils/trunk/string-utils.egg

    r38445 r38937  
    1818  (extension string-interpolation-syntax
    1919    (types-file)
    20     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks-for-toplevel-bindings") )
     20    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings") )
    2121  (extension string-interpolator
    2222    (types-file)
    2323    (source-dependencies string-interpolation-body.scm)
    24     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks-for-toplevel-bindings") )
     24    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings") )
    2525  (extension utf8-string-interpolator
    2626    (types-file)
    2727    (source-dependencies string-interpolation-body.scm)
    28     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks-for-toplevel-bindings") )
     28    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings") )
    2929  (extension string-interpolation
    3030    (types-file)
    3131    (component-dependencies string-interpolator string-interpolation-syntax)
    32     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks-for-toplevel-bindings") )
     32    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings") )
    3333  (extension utf8-string-interpolation
    3434    (types-file)
    3535    (component-dependencies utf8-string-interpolator string-interpolation-syntax)
    36     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks-for-toplevel-bindings") )
     36    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings") )
    3737  (extension to-hex
    3838    (types-file)
    39     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks" "-no-bound-checks" "-no-argc-checks") )
     39    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks" "-no-argc-checks") )
    4040  (extension string-hexadecimal
    4141    (types-file)
    4242    (component-dependencies to-hex)
    43     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks" "-no-bound-checks") )
     43    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") )
    4444  (extension unicode-utils
    4545    (types-file)
    46     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks" "-no-bound-checks") )
     46    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") )
    4747  (extension memoized-string
    4848    (types-file)
    4949    (component-dependencies unicode-utils)
    50     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks" "-no-bound-checks") )
     50    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") )
    5151  (extension string-utils
    5252    (types-file)
    5353    (component-dependencies memoized-string)
    54     (csc-options "-local" "-O3" "-d1" "-no-procedure-checks" "-no-bound-checks") ) ) )
     54    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) ) )
  • release/5/string-utils/trunk/string-utils.scm

    r38445 r38937  
    2121;;
    2222
     23(: *string-longest-common-prefix (string (list-of string) procedure --> *))
     24(: string-longest-common-prefix (string (list-of string) --> (or boolean string)))
     25(: string-fixed-length (string fixnum #!rest --> string))
     26
     27;;
     28
    2329(define string-longest-common-prefix-length string-prefix-length)
    2430
    2531;;
    2632
    27 (: *string-longest-common-prefix (string (list-of string) procedure --> *))
    28 ;
    2933(define (*string-longest-common-prefix cand others handler)
    3034  ;-> (<prefix-length> <∈ others>)
     
    7882;;
    7983
    80 (: string-longest-common-prefix (string (list-of string) --> (or boolean string)))
    81 ;
    8284(define (string-longest-common-prefix cand others)
    8385  (define (longest coalesced)
     
    142144;;
    143145
    144 (: string-fixed-length (string fixnum #!rest --> string))
    145 ;
    146146(define (string-fixed-length s n #!key (pad-char #\space) (trailing "..."))
    147147  (let (
  • release/5/string-utils/trunk/tests/run.scm

    r38445 r38937  
    99;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    1010
    11 (import (only (chicken pathname) make-pathname))
     11(import (only (chicken pathname)
     12  make-pathname pathname-file pathname-replace-directory pathname-strip-extension))
    1213(import (only (chicken process) system))
    1314(import (only (chicken process-context) argv))
    1415(import (only (chicken format) format))
     16(import (only (chicken file) file-exists? find-files))
     17(import (only (chicken irregex) irregex irregex-match?))
    1518
    1619(define *args* (argv))
    1720
    18 ;no -disable-interrupts
    19 (define *csc-options* "-inline-global \
     21(define (egg-name args #!optional (def EGG-NAME))
     22  (cond
     23    ((<= 4 (length *args*)) (cadddr *args*) )
     24    (def                    def )
     25    (else
     26      (error 'run "cannot determine egg-name") ) ) )
     27
     28(define *current-directory* (cond-expand (unix "./") (else #f)))
     29(define *egg* (egg-name *args*))
     30
     31;no -disable-interrupts or -no-lambda-info
     32(define *csc-options* "-inline-global -local -inline \
    2033  -specialize -optimize-leaf-routines -clustering -lfa2 \
    21   -local -inline")
     34  -no-trace -unsafe \
     35  -strict-types")
    2236
    23 (define (test-name #!optional (eggnam EGG-NAME))
    24   (string-append eggnam "-test") )
     37(define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))
     38(define (test-filename name) (string-append name "-test"))
     39(define (test-files) (find-files "." #:test *test-files-rx* #:limit 1))
    2540
    26 (define (egg-name #!optional (def EGG-NAME))
    27   (cond
    28     ((<= 4 (length *args*))
    29       (cadddr *args*) )
    30     (def
    31       def )
    32     (else
    33       (error 'test "cannot determine egg-name") ) ) )
     41(define (ensure-test-source-name name)
     42  (if (irregex-match? *test-files-rx* name)
     43    name
     44    (make-pathname *current-directory* (test-filename name) "scm") ) )
     45
     46(define (run-test-evaluated source)
     47  (format #t "*** ~A - csi ***~%" (pathname-file source))
     48  (system (string-append "csi -s " source)) )
     49
     50(define (run-test-compiled source csc-options)
     51  (format #t "*** ~A - csc ~A ***~%" (pathname-file source) csc-options)
     52  ;csc output is in current directory
     53  (system (string-append "csc" " " csc-options " " source))
     54  (system (pathname-replace-directory (pathname-strip-extension source) *current-directory*)) )
    3455
    3556;;;
    3657
    37 (set! EGG-NAME (egg-name))
     58(define (run-test #!optional (name *egg*) (csc-options *csc-options*))
     59  (let (
     60    (source (ensure-test-source-name name)) )
     61    (unless (file-exists? source)
     62      (error 'run "no such file" source) )
     63    (run-test-evaluated source)
     64    (newline)
     65    (run-test-compiled source csc-options) ) )
    3866
    39 (define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
    40   (let ((tstnam (test-name eggnam)))
    41     (format #t "*** csi ***~%")
    42     (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
    43     (newline)
    44     (format #t "*** csc ~s ***~%" cscopts)
    45     (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
    46     (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
     67(define (run-tests #!optional (tests (test-files)) (csc-options *csc-options*))
     68  (for-each (cut run-test <> csc-options) tests) )
    4769
    48 (define (run-tests eggnams #!optional (cscopts *csc-options*))
    49   (for-each (cut run-test <> cscopts) eggnams) )
     70;;; Do Test
    5071
    51 ;;;
    52 
    53 (run-test)
     72(run-tests)
  • release/5/string-utils/trunk/to-hex.scm

    r38445 r38937  
    6161(import (chicken foreign))
    6262
    63 ;;;
     63;;
     64
     65(: str_to_hex (string string fixnum fixnum -> string))
     66(: blob_to_hex (string blob fixnum fixnum -> string))
     67(: u8vec_to_hex (string u8vector fixnum fixnum -> string))
     68(: s8vec_to_hex (string s8vector fixnum fixnum -> string))
     69(: mem_to_hex (string pointer fixnum fixnum -> string))
     70(: hex_to_str (string string fixnum fixnum -> string))
     71(: hex_to_blob (blob string fixnum fixnum -> blob))
    6472
    6573;;
     
    8997;;
    9098
    91 (: str_to_hex (string string fixnum fixnum -> string))
    92 ;
    9399(define (str_to_hex out in off len)
    94100  (C_str_to_hex out in off len)
    95101  out )
    96102
    97 (: blob_to_hex (string blob fixnum fixnum -> string))
    98 ;
    99103(define (blob_to_hex out in off len)
    100104  (C_blob_to_hex out in off len)
    101105  out )
    102106
    103 (: u8vec_to_hex (string u8vector fixnum fixnum -> string))
    104 ;
    105107(define (u8vec_to_hex out in off len)
    106108  (C_u8vec_to_hex out in off len)
    107109  out )
    108110
    109 (: s8vec_to_hex (string s8vector fixnum fixnum -> string))
    110 ;
    111111(define (s8vec_to_hex out in off len)
    112112  (C_s8vec_to_hex out in off len)
    113113  out )
    114114
    115 (: mem_to_hex (string pointer fixnum fixnum -> string))
    116 ;
    117115(define (mem_to_hex out in off len)
    118116  (C_mem_to_hex out in off len)
     
    121119;;
    122120
    123 (: hex_to_str (string string fixnum fixnum -> string))
    124 ;
    125121(define (hex_to_str out in off len)
    126122  (C_hex_to_str out in off len)
    127123  out )
    128124
    129 (: hex_to_blob (blob string fixnum fixnum -> blob))
    130 ;
    131125(define (hex_to_blob out in off len)
    132126  (C_hex_to_str out in off len)
  • release/5/string-utils/trunk/unicode-utils.scm

    r38445 r38937  
    3232(import (only type-checks check-list check-natural-fixnum check-char))
    3333
     34;;
     35
     36(: ascii-codepoint? (* -> boolean : char))
     37(: unicode-surrogate? (* -> boolean : fixnum))
     38(: unicode-char->string (char -> string))
     39(: *unicode-string ((list-of char) -> string))
     40(: unicode-string (#!rest -> string))
     41(: *unicode-make-string (fixnum char -> string))
     42(: unicode-make-string (fixnum #!optional char -> string))
     43(: unicode-surrogates->codepoint (fixnum fixnum -> (or boolean fixnum)))
     44
    3445;; Simple UTF 8
    3546
    3647;nul is not accepted!
    37 (: ascii-codepoint? (* -> boolean : char))
    38 ;
    3948(define (ascii-codepoint? ch)
    4049  (and
     
    4251    (<= 0 (char->integer ch) #x7f) ) )
    4352
    44 (: unicode-surrogate? (* -> boolean : fixnum))
    45 ;
    4653(define (unicode-surrogate? n)
    4754  (and
     
    4956    (##sys#unicode-surrogate? n) ) )
    5057
    51 (: unicode-char->string (char -> string))
    52 ;
    5358(define (unicode-char->string ch)
    5459  (##sys#char->utf8-string (check-char 'unicode-char->string ch)) )
    5560
    56 (: *unicode-string ((list-of char) -> string))
    57 ;
    5861(define (*unicode-string chs)
    5962  (cond
     
    7073
    7174;inefficient
    72 (: unicode-string (#!rest -> string))
    73 ;
    7475(define (unicode-string . chs)
    7576  (if (null? chs)
     
    8182      (*unicode-string chs) ) ) )
    8283
    83 (: *unicode-make-string (fixnum char -> string))
    84 ;
    8584(define (*unicode-make-string len fill)
    8685  (cond
     
    9392      (##sys#make-string len fill) ) ) )
    9493
    95 (: unicode-make-string (fixnum #!optional char -> string))
    96 ;
    9794(define (unicode-make-string len #!optional (fill #\space))
    9895  (*unicode-make-string
     
    10299(define generic-make-string unicode-make-string)
    103100
    104 (: unicode-surrogates->codepoint (fixnum fixnum -> (or boolean fixnum)))
    105 ;
    106101(define (unicode-surrogates->codepoint hi lo)
    107102  (##sys#surrogates->codepoint
  • release/5/string-utils/trunk/utf8-string-interpolator.scm

    r38445 r38937  
    1919(import (only utf8-srfi-13 string-concatenate-reverse))
    2020
     21(: string-interpolate/sanity (string #!rest --> list))
     22(: string-interpolate (string #!rest --> list))
     23
    2124;utf8 version (not same semantics!)
    22 (define-inline (reverse-list->string chs)
    23   (list->string (reverse! chs)) )
     25(define-inline (reverse-list->string chs) (list->string (reverse! chs)))
    2426
    2527(include "string-interpolation-body")
Note: See TracChangeset for help on using the changeset viewer.