;;; 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))