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

250 lines
8.7 KiB
Scheme

;;; This is a Scheme48 interface spec for the SRFI-1 list-lib package.
;;; It defines the LIST-LIB-INTERFACE interface and LIST-LIB structure.
;;; Bindings are typed as tightly as one can in Scheme48's type language.
;;; -Olin Shivers
;;; shivers@ai.mit.edu
;;; list-lib
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; xcons cons* make-list list-tabulate list-copy circular-list iota
;;; proper-list? circular-list? dotted-list? not-pair? null-list? list=
;;; first second third fourth fifth sixth seventh eighth ninth tenth
;;; car+cdr
;;; take drop
;;; take-right drop-right
;;; take! drop-right!
;;; take-while drop-while take-while!
;;; split-at split-at!
;;; span break
;;; span! break!
;;; last last-pair
;;; length+
;;; append! reverse! append-reverse append-reverse! concatenate concatenate!
;;; zip unzip1 unzip2 unzip3 unzip4 unzip5
;;; count
;;; unfold unfold-right
;;; fold unfold pair-fold reduce
;;; fold-right unfold-right pair-fold-right reduce-right
;;; append-map append-map! map! pair-for-each filter-map map-in-order
;;; filter partition remove
;;; filter! partition! remove!
;;; find find-tail any every list-index
;;; delete delete! delete-duplicates delete-duplicates!
;;; alist-cons alist-copy
;;; alist-delete alist-delete!
;;;
;;; lset<= lset= lset-adjoin
;;; lset-union lset-union!
;;; lset-intersection lset-intersection!
;;; lset-difference lset-difference!
;;; lset-xor lset-xor!
;;; lset-diff+intersection lset-diff+intersection!
;;;
;;; map for-each member assoc (Extended R4RS procedures)
;;;
;;; cons pair? null? list length append reverse (These are the
;;; car cdr ... cdddar cddddr set-car! set-cdr! list-ref R4RS procedures
;;; memq memv assoc assq assv re-exported by
;;; list-lib unchanged.)
(define-interface list-lib-interface
(export
;; xcons <cdr> <car>
(xcons (proc (:value :value) :value))
;; cons* item ...
(cons* (proc (:value &rest :value) :value))
;; make-list len [fill]
(make-list (proc (:exact-integer &opt :value) :value))
;; list-tabulate elt-proc len
(list-tabulate (proc (:exact-integer (proc (:exact-integer) :value)) :value))
;; list-copy lis
(list-copy (proc (:value) :value))
(circular-list (proc (:value &rest :value) :pair))
; ((:iota iota:)
; (proc (:number &opt :number :number) :value))
(iota (proc (:exact-integer &opt :number :number) :value))
(proper-list? (proc (:value) :boolean))
(dotted-list? (proc (:value) :boolean))
(circular-list? (proc (:value) :boolean))
(not-pair? (proc (:value) :boolean))
(null-list? (proc (:value) :boolean))
(list= (proc ((proc (:value :value) :boolean) &rest :value) :boolean))
((first second third fourth fifth sixth seventh eighth ninth tenth)
(proc (:pair) :value))
(car+cdr (proc (:pair) (some-values :value :value)))
;; take lis i take-right lis i
;; drop lis i drop-right lis i
;; take! lis i drop-right! lis i
((take drop take-right drop-right take! drop-right!)
(proc (:value :exact-integer) :value))
((split-at split-at!)
(proc (:value :exact-integer) (some-values :value :value)))
(last (proc (:pair) :value))
(last-pair (proc (:pair) :pair))
(length+ (proc (:value) :value))
(append! (proc (:value &rest :value) :value))
(reverse! (proc (:value) :value))
((append-reverse append-reverse!) (proc (:value :value) :value))
((concatenate concatenate!) (proc (:value) :value))
(zip (proc (:value &rest :value) :value))
(unzip1 (proc (:value) :value))
(unzip2 (proc (:value) (some-values :value :value)))
(unzip3 (proc (:value) (some-values :value :value :value)))
(unzip4 (proc (:value) (some-values :value :value :value :value)))
(unzip5 (proc (:value) (some-values :value :value :value :value :value)))
(count (proc ((proc (:value &rest :value) :boolean) :value) :exact-integer))
((fold fold-right)
(proc ((proc (:value :value &rest :value) :value)
:value :value &rest :value)
:value))
((unfold unfold-right) (proc ((proc (:value) :boolean)
(proc (:value) :value)
(proc (:value) :value)
:value
&opt (proc (:value) :value))
:value))
((pair-fold pair-fold-right)
(proc ((proc (:pair :value &rest :value) :value)
:value :value &rest :value)
:value))
((reduce reduce-right)
(proc ((proc (:value :value) :value) :value :value) :value))
((append-map append-map! map! filter-map map-in-order)
(proc ((proc (:value &rest :value) :value) :value &rest :value) :value))
(pair-for-each (proc ((proc (:pair &rest :pair) :values) :value &rest :value)
:unspecific))
((filter filter! remove remove!)
(proc ((proc (:value) :boolean) :value) :value))
((partition partition!) (proc ((proc (:value) :boolean) :value)
(some-values :value :value)))
((find find-tail) (proc ((proc (:value) :boolean) :value) :value))
((take-while take-while! drop-while)
(proc ((proc (:value) :boolean) :value) :value))
((span break span! break!)
(proc ((proc (:value) :boolean) :value) (some-values :value :value)))
((any every)
(proc ((proc (:value &rest :value) :value) :value &rest :value) :value))
(list-index (proc ((proc (:value &rest :value) :value) :value &rest :value)
:value))
((delete delete!)
(proc (:value :value &opt (proc (:value :value) :boolean)) :value))
;; Extended from their R5RS definitions to take an optional comparison
;; function: (MEMBER x lis [=]).
(member (proc (:value :value &opt (proc (:value :value) :boolean)) :value))
(assoc (proc (:value :value &opt (proc (:value :value) :boolean)) :value))
((delete-duplicates delete-duplicates!)
(proc (:value &opt (proc (:value :value) :boolean)) :value))
(alist-cons (proc (:value :value :value) :value))
(alist-copy (proc (:value) :value))
((alist-delete alist-delete!)
(proc (:value :value &opt (proc (:value :value) :value)) :value))
;; Extended from their R4RS definitions.
(map (proc ((proc (:value &rest :value) :value) :value &rest :value) :value))
(for-each (proc ((proc (:value &rest :value) :values) :value &rest :value) :unspecific))
;; R4RS exports
(cons (proc (:value :value) :pair))
((pair? null?) (proc (:value) :boolean))
(list-ref (proc (:value :exact-integer) :value))
(list (proc (&rest :value) :value))
(length (proc (:value) :exact-integer))
(append (proc (&rest :value) :value))
(reverse (proc (:value) :value))
((car cdr
caaaar caaadr caadar caaddr caaar caadr caar
cadaar cadadr caddar cadddr cadar caddr cadr
cdaaar cdaadr cdadar cdaddr cdaar cdadr cdar
cddaar cddadr cdddar cddddr cddar cdddr cddr) (proc (:value) :value))
((set-car! set-cdr!) (proc (:pair :value) :unspecific))
((memq memv) (proc (:value :value) :value))
((assq assv) (proc (:value :value) :value))
;; lset-lib
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lset<= = list1 list2 ...
;; lset= = list1 list2 ...
;; lset-adjoin = list elt1 ...
;; lset-union = list1 ...
;; lset-intersection = list1 list2 ...
;; lset-difference = list1 list2 ...
;; lset-xor = list1 ...
;; lset-diff+intersection = list1 list2 ...
;; ... and their side effecting counterparts:
;; lset-union! lset-intersection! lset-difference! lset-xor!
;; lset-diff+intersection!
;; lset= = list1 ... -> boolean
;; lset<= = list1 ... -> boolean
((lset= lset<=)
(proc ((proc (:value :value) :boolean) &rest :value) :boolean))
;; lset-adjoin = list elt1 ...
(lset-adjoin (proc ((proc (:value :value) :boolean) :value &rest :value) :value))
;; lset-union = list1 ... lset-xor = list1 ...
;; lset-union! = list1 ... lset-xor! = list1 ...
((lset-union lset-xor)
(proc ((proc (:value :value) :boolean) &rest :value) :value))
;; lset-intersection = list1 list2 ...
;; lset-intersection! = list1 list2 ...
;; lset-difference = list1 list2 ...
;; lset-difference! = list1 list2 ...
((lset-intersection lset-difference
lset-intersection! lset-difference!)
(proc ((proc (:value :value) :boolean) :value &rest :value) :value))
;; lset-diff+intersection = list1 list2 ...
;; lset-diff+intersection! = list1 list2 ...
((lset-diff+intersection lset-diff+intersection!)
(proc ((proc (:value :value) :boolean) :value &rest :value)
(some-values :value :value)))
))
(define-structure list-lib list-lib-interface
(open error-package ; ERROR procedure
receiving ; RECEIVE m-v macro
let-opt ; LET-OPTIONALS and :OPTIONAL.
scheme)
(begin (define (check-arg pred val caller)
(let lp ((val val))
(if (pred val) val (lp (error "Bad argument" val pred caller))))))
(files list-lib))