250 lines
8.7 KiB
Scheme
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))
|