scsh-0.6/scsh/lib/string-pack.scm

316 lines
12 KiB
Scheme

;;; string-lib
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; string-map string-map!
;;; string-fold string-fold-right
;;; string-unfold string-tabulate
;;; string-for-each string-iter
;;; string-every string-any
;;; string-compare string-compare-ci
;;; substring-compare substring-compare-ci
;;; string= string< string> string<= string>= string<>
;;; string-ci= string-ci< string-ci> string-ci<= string-ci>= string-ci<>
;;; substring= substring<> substring-ci= substring-ci<>
;;; substring< substring> substring-ci< substring-ci>
;;; substring<= substring>= substring-ci<= substring-ci>=
;;; string-upper-case? string-lower-case?
;;; capitalize-string capitalize-words string-downcase string-upcase
;;; capitalize-string! capitalize-words! string-downcase! string-upcase!
;;; string-take string-drop
;;; string-pad string-pad-right
;;; string-trim string-trim-right string-trim-both
;;; string-filter string-delete
;;; string-index string-index-right string-skip string-skip-right
;;; string-prefix-count string-prefix-count-ci
;;; string-suffix-count string-suffix-count-ci
;;; substring-prefix-count substring-prefix-count-ci
;;; substring-suffix-count substring-suffix-count-ci
;;; string-prefix? string-prefix-ci?
;;; string-suffix? string-suffix-ci?
;;; substring-prefix? substring-prefix-ci?
;;; substring-suffix? substring-suffix-ci?
;;; substring? substring-ci?
;;; string-fill! string-copy! string-copy substring
;;; string-reverse string-reverse! reverse-list->string
;;; string->list
;;; string-concat string-concat/shared string-append/shared
;;; xsubstring string-xcopy!
;;; string-null?
;;; join-strings
;;;
;;; string? make-string string string-length string-ref string-set!
;;; string-append list->string
(define-interface string-lib-interface
(export
;; string-map proc s [start end] -> s
(string-map (proc ((proc (:char) :char)
:string
&opt :exact-integer :exact-integer)
:string))
;; string-map! proc s [start end] -> unspecific
(string-map! (proc ((proc (:char) :values)
:string
&opt :exact-integer :exact-integer)
:unspecific))
;; string-fold kons knil s [start end] -> value
;; string-fold-right kons knil s [start end] -> value
((string-fold string-fold-right)
(proc ((proc (:char :value) :value)
:value :string
&opt :exact-integer :exact-integer)
:value))
;; string-unfold p f g seed -> string
(string-unfold (proc ((proc (:value) :boolean)
(proc (:value) :char)
(proc (:value) :value)
:value)
:string))
; Enough is enough.
; ;; string-unfoldn p f g seed ... -> string
; (string-unfoldn (proc ((procedure :values :boolean)
; (procedure :values :char)
; (procedure :values :values)
; &rest :value)
; :string))
;; string-tabulate proc len -> string
(string-tabulate (proc ((proc (:exact-integer) :char) :exact-integer)
:string))
;; string-for-each proc s [start end] -> unspecific
;; string-iter proc s [start end] -> unspecific
((string-for-each string-iter)
(proc ((proc (:char) :values) :string &opt :exact-integer :exact-integer)
:unspecific))
;; string-every pred s [start end]
;; string-any pred s [start end]
(string-every
(proc ((proc (:char) :boolean) :string &opt :exact-integer :exact-integer)
:boolean))
(string-any
(proc ((proc (:char) :boolean) :string &opt :exact-integer :exact-integer)
:value))
;; string-compare string1 string2 lt-proc eq-proc gt-proc
;; string-compare-ci string1 string2 lt-proc eq-proc gt-proc
((string-compare string-compare-ci)
(proc (:string :string (proc (:exact-integer) :values)
(proc (:exact-integer) :values)
(proc (:exact-integer) :values))
:values))
;; substring-compare string1 start1 end1 string2 start2 end2 lt eq gt
;; substring-compare-ci string1 start1 end1 string2 start2 end2 lt eq gt
((substring-compare substring-compare-ci)
(proc (:string :exact-integer :exact-integer
:string :exact-integer :exact-integer
(proc (:exact-integer) :values)
(proc (:exact-integer) :values)
(proc (:exact-integer) :values))
:values))
;; string< string1 string2
((string= string< string> string<= string>= string<>
string-ci= string-ci< string-ci> string-ci<= string-ci>= string-ci<>)
(proc (&rest :string) :value))
;; substring< string1 start1 end1 string2 start2 end2
((substring= substring<> substring-ci= substring-ci<>
substring< substring> substring-ci< substring-ci>
substring<= substring>= substring-ci<= substring-ci>=)
(proc (:string :exact-integer :exact-integer
:string :exact-integer :exact-integer)
:value))
;; string-upper-case? string [start end]
;; string-lower-case? string [start end]
((string-upper-case? string-lower-case?)
(proc (:string &opt :exact-integer :exact-integer) :boolean))
;; capitalize-string string [start end]
;; capitalize-words string [start end]
;; string-downcase string [start end]
;; string-upcase string [start end]
;; capitalize-string! string [start end]
;; capitalize-words! string [start end]
;; string-downcase! string [start end]
;; string-upcase! string [start end]
((capitalize-string capitalize-words string-downcase string-upcase)
(proc (:string &opt :exact-integer :exact-integer) :string))
((capitalize-string! capitalize-words! string-downcase! string-upcase!)
(proc (:string &opt :exact-integer :exact-integer) :unspecific))
;; string-take string nchars
;; string-drop string nchars
((string-take string-drop) (proc (:string :exact-integer) :string))
;; string-pad string k [char start end]
;; string-pad-right string k [char start end]
((string-pad string-pad-right)
(proc (:string :exact-integer &opt :char :exact-integer :exact-integer)
:string))
;; string-trim string [char/char-set/pred start end]
;; string-trim-right string [char/char-set/pred start end]
;; string-trim-both string [char/char-set/pred start end]
((string-trim string-trim-right string-trim-both)
(proc (:string &opt :value :exact-integer :exact-integer)
:string))
;; string-filter char/char-set/pred string [start end]
;; string-delete char/char-set/pred string [start end]
((string-filter string-delete)
(proc (:value :string &opt :exact-integer :exact-integer) :string))
;; string-index string char/char-set/pred [start end]
;; string-index-right string char/char-set/pred [end start]
;; string-skip string char/char-set/pred [start end]
;; string-skip-right string char/char-set/pred [end start]
((string-index string-index-right string-skip string-skip-right)
(proc (:string :value &opt :exact-integer :exact-integer)
:value))
;; string-prefix-count string1 string2
;; string-suffix-count string1 string2
;; string-prefix-count-ci string1 string2
;; string-suffix-count-ci string1 string2
((string-prefix-count string-prefix-count-ci
string-suffix-count string-suffix-count-ci)
(proc (:string :string) :exact-integer))
;; substring-prefix-count string1 start1 end1 string2 start2 end2
;; substring-suffix-count string1 start1 end1 string2 start2 end2
;; substring-prefix-count-ci string1 start1 end1 string2 start2 end2
;; substring-suffix-count-ci string1 start1 end1 string2 start2 end2
((substring-prefix-count substring-prefix-count-ci
substring-suffix-count substring-suffix-count-ci)
(proc (:string :exact-integer :exact-integer
:string :exact-integer :exact-integer)
:exact-integer))
;; string-prefix? string1 string2
;; string-suffix? string1 string2
;; string-prefix-ci? string1 string2
;; string-suffix-ci? string1 string2
((string-prefix? string-prefix-ci?
string-suffix? string-suffix-ci?)
(proc (:string :string) :boolean))
;; substring-prefix? string1 start1 end1 string2 start2 end2
;; substring-suffix? string1 start1 end1 string2 start2 end2
;; substring-prefix-ci? string1 start1 end1 string2 start2 end2
;; substring-suffix-ci? string1 start1 end1 string2 start2 end2
((substring-prefix? substring-prefix-ci?
substring-suffix? substring-suffix-ci?)
(proc (:string :exact-integer :exact-integer
:string :exact-integer :exact-integer)
:boolean))
;; substring? pattern string [start end]
;; substring-ci? pattern string [start end]
((substring? substring-ci?)
(proc (:string :string &opt :exact-integer :exact-integer)
:value))
;; string-fill! string char [start end]
(string-fill! (proc (:string :char &opt :exact-integer :exact-integer)
:unspecific))
;; string-copy! to tstart from [fstart fend]
(string-copy! (proc (:string :exact-integer :string
&opt :exact-integer :exact-integer)
:unspecific))
;; string-copy s [start end] -> string
;; substring s start [end] -> string
(string-copy (proc (:string &opt :exact-integer :exact-integer) :string))
(substring (proc (:string :exact-integer &opt :exact-integer) :string))
;; string-reverse s [start end]
;; string-reverse! s [start end]
(string-reverse (proc (:string &opt :exact-integer :exact-integer) :string))
(string-reverse! (proc (:string &opt :exact-integer :exact-integer) :unspecific))
;; reverse-list->string char-list
;; string->list s [start end]
;; string-concat string-list
;; string-concat/shared string-list
;; string-append/shared s ...
(reverse-list->string (proc (:value) :string))
(string->list (proc (:string &opt :exact-integer :exact-integer) :value))
((string-concat string-concat/shared) (proc (:value) :string))
(string-append/shared (proc (&rest :string) :string))
;; xsubstring s from [to start end]
;; string-xcopy! target tstart s from [to start end]
(xsubstring (proc (:string :exact-integer &opt
:exact-integer :exact-integer :exact-integer)
:string))
(string-xcopy! (proc (:string :exact-integer :string :exact-integer &opt
:exact-integer :exact-integer :exact-integer)
:unspecific))
;; string-null? s
(string-null? (proc (:string) :boolean))
(join-strings (proc (:value &opt :string :symbol) :string))
;; Here are the R4RS procs
(string? (proc (:value) :boolean))
(make-string (proc (:exact-integer &opt :char) :string))
(string (proc (&rest :char) :string))
(string-length (proc (:string) :exact-integer))
(string-ref (proc (:string :exact-integer) :char))
(string-set! (proc (:string :exact-integer :char) :unspecific))
; Not provided by string-lib.
;((string=? string-ci=? string<? string-ci<?
; string>? string-ci>? string<=? string-ci<=?
; string>=? string-ci>=?) (proc (:string :string) :boolean))
;; These are the R4RS types for SUBSTRING, STRING-COPY, STRING-FILL!,
;; and STRING->LIST. The string-lib types are different -- extended.
;(substring (proc (:string :exact-integer :exact-integer) :string))
;(string-copy (proc (:string) :string))
;(string-fill! (proc (:string :char) :unspecific))
;(string->list (proc (:string) :value))
(string-append (proc (&rest :string) :string))
(list->string (proc (:value) :string))
))
;;; make-kmp-restart-vector
;;; parse-final-start+end
;;; parse-start+end
;;; check-substring-spec
(define-interface string-lib-internals-interface
(export
(parse-final-start+end (proc ((procedure :values :values) :string :value)
(some-values :exact-integer :exact-integer)))
(parse-start+end (proc ((procedure :values :values) :string :value)
(some-values :exact-integer :exact-integer :value)))
(check-substring-spec (proc ((procedure :values :values) :string :exact-integer :exact-integer)
:unspecific))
(make-kmp-restart-vector (proc (:string (proc (:char :char) :boolean))
:vector))))
(define-structures ((string-lib string-lib-interface)
(string-lib-internals string-lib-internals-interface))
(access scheme) ; Get at R5RS SUBSTRING
(open receiving ; RECEIVE
char-set-package; Various
error-package ; ERROR
let-opt ; LET-OPTIONALS :OPTIONAL
structure-refs ; STRUCTURE-REF
scheme)
(files string-lib))