(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-padl string k [char start end] 
   ;; string-padr string k [char start end] 
   ((string-padl string-padr)
    (proc (:string :exact-integer &opt :char :exact-integer :exact-integer)
	  :string))

   ;; string-trim  string [char/char-set/pred start end] 
   ;; string-triml string [char/char-set/pred start end] 
   ;; string-trimr string [char/char-set/pred start end] 
   ((string-trim string-triml string-trimr)
    (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))
   ))


(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))
  (open char-set-package
	receiving
	error-package
	let-opt
	structure-refs
	scsh-utilities	; FOLD-RIGHT
	scheme)
  (access scheme	; Original SUBSTRING
	  silly)	; Primitive reverse-list->string
  (files stringlib)
  (optimize auto-integrate))



;;; CPP Lib
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Character->Character Partial functions
 
;;; Many of these types are pretty weak, but there is no way to
;;; specify that a parameter must be a particular record type.
;;; Every little bit helps, though.

(define-interface ccp-lib-interface
  (export
   ;; ccp? x -> boolean
   (ccp? (proc (:value) :boolean))

   ;; ccp-domain ccp -> char-set
   (ccp-domain (proc (:value) :value)) ; Not very informative.

   ;; ccp-copy ccp -> ccp
   (ccp-copy (proc (:value) :value))

   ;; ccp=  ccp1 ccp2 ...
   ;; ccp<= ccp1 ccp2 ...
   ((ccp= ccp<=) (proc (&rest :value) :boolean)) ; Not very informative.

   ;; ccp-fold kons knil ccp -> value
   (ccp-fold (proc ((proc (:char :char :value) :value) :value :value) :value))
   
   ;; ccp-for-each proc ccp
   (ccp-for-each (proc ((proc (:char :char) :values)) :unspecific))

   ;; ccp->alist ccp -> alist
   (ccp->alist (proc (:value) :value))

   ;; ccp-restrict  ccp cset -> ccp
   ;; ccp-restrict! ccp cset -> ccp
   ((ccp-restrict ccp-restrict!) (proc (:value :value) :value))

   ;; ccp-adjoin  ccp from-char1 to-char1 ... -> ccp
   ;; ccp-adjoin! ccp from-char1 to-char1 ... -> ccp
   ;; ccp-delete  ccp from-char1 ... -> ccp
   ;; ccp-delete! ccp from-char1 ... -> ccp
   ((ccp-adjoin ccp-adjoin!) (proc (:value &rest :char) :value))
   ((ccp-delete ccp-delete!) (proc (:value &rest :char) :value))

   ;; ccp-extend  ccp1 ... -> ccp
   ;; ccp-extend! ccp1 ... -> ccp
   ((ccp-extend ccp-extend!) (proc (&rest :value) :value))

   ;; ccp-compose ccp1 ... -> ccp
   (ccp-compose (proc (&rest :value) :value))

   ;; alist->ccp  char/char-alist [ccp] -> ccp
   ;; alist->ccp! char/char-alist [ccp] -> ccp
   ((alist->ccp alist->ccp!) (proc (:value &opt :value) :value))

   ;; proc->ccp  proc [domain ccp] -> ccp
   ;; proc->ccp! proc [domain ccp] -> ccp
   ((proc->ccp proc->ccp!) (proc ((proc (:char) :char) &opt :value :value)
				 :value))

   ;; constant-ccp  char [domain ccp] -> ccp
   ;; constant-ccp! char  domain ccp  -> ccp
   ((constant-ccp constant-ccp!) (proc (:char &opt :value :value) :value))

   ;; ccp/mappings from1 to1 ... -> ccp
   ;; extend-ccp/mappings  ccp from1 to1 ... -> ccp
   ;; extend-ccp/mappings! ccp from1 to1 ... -> ccp
   (ccp/mappings (proc (&rest :value) :value))
   ((extend-ccp/mappings extend-ccp/mappings!)
    (proc (:value &rest :value) :value))

   ;; construct-ccp  ccp elt ... -> ccp
   ;; construct-ccp! ccp elt ... -> ccp
   ((construct-ccp construct-ccp!) (proc (:value &rest :value) :value))

   ;; ccp-unfold p f g seed -> ccp
   (ccp-unfold (proc ((proc (:value) :boolean)
		      (procedure :value (some-values :char :char))
		      (proc (:value) :value)
		      :value)
		     :value))

   ;; tr       ccp string [start end] -> string
   ;; ccp-map  ccp string [start end] -> string
   ;; ccp-map! ccp string [start end]
   ;; ccp-app ccp char -> char or false
   ((tr ccp-map)
    (proc (:value :string &opt :exact-integer :exact-integer) :string))
   (ccp-map! (proc (:value :string &opt :exact-integer :exact-integer) :unspecific))
   (ccp-app (proc (:value :char) :value))

   ;; Primitive CCP's.
   ccp:0 ccp:1 ccp:upcase ccp:downcase
   ))

(define-structure ccp-lib ccp-lib-interface
  (open char-set-package
	ascii
	defrec-package
	string-lib
	let-opt
	receiving
	scsh-utilities	; every
	error-package
	scheme)
  (files ccp)
  (optimize auto-integrate))