Move mutable list functions to the compatibility collect.

Mutable pair functions from racket/base are not moved.
This commit is contained in:
Vincent St-Amour 2012-07-27 16:22:40 -04:00
parent ab2226a19e
commit 52439d528b
14 changed files with 378 additions and 343 deletions

View File

@ -0,0 +1,210 @@
#lang racket/base
(require (for-syntax racket/base)
racket/performance-hint)
(provide mmap
mfor-each
mlist
mlist?
mlength
mappend
mappend!
mreverse
mreverse!
mlist-tail
mlist-ref
mmemq
mmemv
mmember
massq
massv
massoc
mlist->list
list->mlist
mlistof)
(begin-encourage-inline
(define mmap
(case-lambda
[(f l) (let loop ([l l])
(cond
[(null? l) null]
[else (mcons (f (mcar l)) (loop (mcdr l)))]))]
[(f l1 l2) (let loop ([l1 l1][l2 l2])
(cond
[(null? l1) null]
[else (mcons (f (mcar l1) (mcar l2))
(loop (mcdr l1) (mcdr l2)))]))]
[(f l . ls) (let loop ([l l][ls ls])
(cond
[(null? l) null]
[else (mcons (apply f (mcar l) (map mcar ls))
(loop (mcdr l) (map mcdr ls)))]))]))
(define mfor-each
(case-lambda
[(f l) (let loop ([l l])
(cond
[(null? l) (void)]
[else (f (mcar l))
(loop (mcdr l))]))]
[(f l1 l2) (let loop ([l1 l1][l2 l2])
(cond
[(null? l1) (void)]
[else (f (mcar l1) (mcar l2))
(loop (mcdr l1) (mcdr l2))]))]
[(f l . ls) (let loop ([l l][ls ls])
(cond
[(null? l) (void)]
[else (apply f (mcar l) (map mcar ls))
(loop (mcdr l) (map mcdr ls))]))])))
(define (list->mlist l)
(cond
[(null? l) null]
[else (mcons (car l) (list->mlist (cdr l)))]))
(define (mlist->list l)
(cond
[(null? l) null]
[else (cons (mcar l) (mlist->list (mcdr l)))]))
(define-syntax mlist
(make-set!-transformer
(lambda (stx)
(syntax-case stx (set!)
[(set! id . _) (raise-syntax-error #f
"cannot mutate imported variable"
stx
#'id)]
[(_ a) #'(mcons a null)]
[(_ a b) #'(mcons a (mcons b null))]
[(_ a b c) #'(mcons a (mcons b (mcons c null)))]
[(_ arg ...) #'(-mlist arg ...)]
[_ #'-mlist]))))
(define -mlist
(let ([mlist
(case-lambda
[() null]
[(a) (mcons a null)]
[(a b) (mcons a (mcons b null))]
[(a b c) (mcons a (mcons b (mcons c null)))]
[(a b c d) (mcons a (mcons b (mcons c (mcons d null))))]
[l (list->mlist l)])])
mlist))
(define (mlist? l)
(cond
[(null? l) #t]
[(mpair? l)
(let loop ([turtle l][hare (mcdr l)])
(cond
[(null? hare) #t]
[(eq? hare turtle) #f]
[(mpair? hare)
(let ([hare (mcdr hare)])
(cond
[(null? hare) #t]
[(eq? hare turtle) #f]
[(mpair? hare)
(loop (mcdr turtle) (mcdr hare))]
[else #f]))]
[else #f]))]
[else #f]))
(define (mlength l)
(let loop ([l l][len 0])
(cond
[(null? l) len]
[else (loop (mcdr l) (add1 len))])))
(define mappend
(case-lambda
[() null]
[(a) a]
[(a b) (let loop ([a a])
(if (null? a)
b
(mcons (mcar a) (loop (mcdr a)))))]
[(a . l) (mappend a (apply mappend l))]))
;; mappend! : like append, but mutate each list to refer to the next.
;; modeled loosely on the v372 behavior
(define mappend!
(case-lambda
[() null]
[(a) a]
[(a b) (if (null? a)
b
(let loop ([atail a])
(cond [(null? (mcdr atail)) (set-mcdr! atail b) a]
[else (loop (mcdr atail))])))]
[(a . l) (mappend! a (apply mappend! l))]))
(define (mreverse l)
(let loop ([l l][a null])
(cond
[(null? l) a]
[else (loop (mcdr l) (mcons (mcar l) a))])))
(define (mreverse! l)
(let loop ([l l][prev null])
(cond
[(null? l) prev]
[else (let ([next (mcdr l)])
(set-mcdr! l prev)
(loop next l))])))
(define (mlist-tail l n)
(cond
[(zero? n) l]
[else (mlist-tail (mcdr l) (sub1 n))]))
(define (mlist-ref l n)
(cond
[(zero? n) (mcar l)]
[else (mlist-ref (mcdr l) (sub1 n))]))
(define (do-member =? v l)
(let loop ([l l])
(cond
[(null? l) #f]
[(=? v (mcar l)) l]
[else (loop (mcdr l))])))
(define (mmemq v l)
(do-member eq? v l))
(define (mmemv v l)
(do-member eqv? v l))
(define (mmember v l)
(do-member equal? v l))
(define (do-assoc =? v l)
(let loop ([l l])
(cond
[(null? l) #f]
[(=? v (mcar (mcar l))) (mcar l)]
[else (loop (mcdr l))])))
(define (massq v l)
(do-assoc eq? v l))
(define (massv v l)
(do-assoc eqv? v l))
(define (massoc v l)
(do-assoc equal? v l))
(define ((mlistof p?) l)
(let loop ([l l])
(cond
[(null? l) #t]
[(not (mpair? l)) #f]
[(p? (mcar l)) (loop (mcdr l))]
[else #f])))

View File

@ -15,6 +15,7 @@ We @emph{strongly} recommend using these alternatives.
@include-section["defmacro.scrbl"]
@include-section["package.scrbl"]
@include-section["mpairs.scrbl"]
@(bibliography
(bib-entry #:key "Waddell99"

View File

@ -0,0 +1,153 @@
#lang scribble/doc
@(require scribblings/reference/mz scribble/racket
(for-label compatibility/mpair))
@title[#:tag "mlists"]{Mutable List Functions}
@(define reference '(lib "scribblings/reference/reference.scrbl"))
@defmodule[compatibility/mpair]
This @racketmodname[compatibility/mpair] library provides support for
@tech[#:doc reference]{mutable list}s.
Support is provided primarily to help porting Lisp/Scheme code to Racket.
Use of mutable lists for modern Racket code is @bold{@italic{strongly}}
discouraged.
Instead, consider using @tech[#:doc reference]{list}s.
For functions described in this section, contracts are not directly
enforced. In particular, when a @tech[#:doc reference]{mutable list}
is expected, supplying any other kind of value (or mutating a value that
starts as a @tech[#:doc reference]{mutable list})
tends to produce an exception from @racket[mcar] or @racket[mcdr].
@defproc[(mlist? [v any/c]) boolean?]{Returns @racket[#t] if
@racket[v] is a @tech[#:doc reference]{mutable list}: either the empty list,
or a @tech[#:doc reference]{mutable pair} whose second element is a
@tech[#:doc reference]{mutable list}.}
@defproc[(mlist [v any/c] ...) mlist?]{Returns a newly allocated
@tech[#:doc reference]{mutable list} containing the @racket[v]s as its
elements.}
@defproc[(list->mlist [lst list?]) mlist?]{
Returns a newly allocated @tech[#:doc reference]{mutable list} with the same
elements as @racket[lst].}
@defproc[(mlist->list [mlst mlist?]) list?]{
Returns a newly allocated list with the same elements as
@racket[mlst].}
@defproc[(mlength [mlst mlist?])
exact-nonnegative-integer?]{
Returns the number of elements in @racket[mlst].}
@defproc[(mlist-ref [mlst mlist?] [pos exact-nonnegative-integer?])
any/c]{
Like @racket[list-ref], but for @tech[#:doc reference]{mutable lists}.}
@defproc[(mlist-tail [mlst mlist?] [pos exact-nonnegative-integer?])
any/c]{
Like @racket[list-tail], but for @tech[#:doc reference]{mutable lists}.}
@defproc*[([(mappend [mlst mlist?] ...) mlist?]
[(mappend [mlst mlist?] ... [v any/c]) any/c])]{
Like @racket[append], but for @tech[#:doc reference]{mutable lists}.}
@defproc*[([(mappend! [mlst mlist?] ...) mlist?]
[(mappend! [mlst mlist?] ... [v any/c]) any/c])]{
The @racket[mappend!] procedure appends the given
@tech[#:doc reference]{mutable lists} by mutating
the tail of each to refer to the next, using @racket[set-mcdr!]. Empty
lists are dropped; in particular, the result of calling
@racket[mappend!] with one or more empty lists is the same as the
result of the call with the empty lists removed from the set of
arguments.}
@defproc[(mreverse [mlst mlist?]) mlist?]{
Like @racket[reverse], but for @tech[#:doc reference]{mutable lists}.}
@defproc[(mreverse! [mlst mlist?]) mlist?]{
Like @racket[mreverse], but destructively reverses the
@tech[#:doc reference]{mutable list} by using all of the mutable pairs in
@racket[mlst] and changing them with @racket[set-mcdr!].}
@defproc[(mmap [proc procedure?] [mlst mlist?] ...+)
mlist?]{
Like @racket[map], but for @tech[#:doc reference]{mutable lists}.}
@defproc[(mfor-each [proc procedure?] [mlst mlist?] ...+)
void?]{
Like @racket[for-each], but for @tech[#:doc reference]{mutable lists}.}
@defproc[(mmember [v any/c] [mlst mlist?])
(or/c mlist? #f)]{
Like @racket[member], but for @tech[#:doc reference]{mutable lists}.}
@defproc[(mmemv [v any/c] [mlst mlist?])
(or/c mlist? #f)]{
Like @racket[memv], but for @tech[#:doc reference]{mutable lists}.}
@defproc[(mmemq [v any/c] [mlst mlist?])
(or/c list? #f)]{
Like @racket[memq], but for @tech[#:doc reference]{mutable lists}.}
@defproc[(massoc [v any/c] [mlst (mlistof mpair?)])
(or/c mpair? #f)]{
Like @racket[assoc], but for @tech[#:doc reference]{mutable lists} of
@tech[#:doc reference]{mutable pairs}.}
@defproc[(massv [v any/c] [mlst (mlistof mpair?)])
(or/c mpair? #f)]{
Like @racket[assv], but for @tech[#:doc reference]{mutable lists} of
@tech[#:doc reference]{mutable pairs}.}
@defproc[(massq [v any/c] [mlst (mlistof mpair?)])
(or/c mpair? #f)]{
Like @racket[assq], but for @tech[#:doc reference]{mutable lists} of
@tech[#:doc reference]{mutable pairs}.}
@defproc[(mlistof [pred (any/c . -> . any/c)])
(any/c . -> . boolean?)]{
Returns a procedure that returns @racket[#t] when given a
@tech[#:doc reference]{mutable list} for which @racket[pred] returns a true
value for all elements.}

View File

@ -7,7 +7,7 @@
racket/list ; for use in specs too
racket/string
racket/file (only-in racket/system system)
(except-in racket/mpair mappend)
(except-in compatibility/mpair mappend)
meta/checker (prefix-in dist: meta/dist-specs) meta/specs)
(define (/-ify x)

View File

@ -2,7 +2,7 @@
(module pconvert mzscheme
(require (only racket/base sort)
racket/mpair
compatibility/mpair
"pconvert-prop.rkt"
"class.rkt")

View File

@ -153,7 +153,7 @@ export from a module that is implemented in an @|r5rs|-like language.
The @racket[cons] of @racketmodname[r5rs] corresponds to
@racketmodname[racket/base]'s @racket[mcons]. Similarly, @racket[cdr]
is @racket[mcdr], and @racket[map] is @racketmodname[racket/mpair]'s
is @racket[mcdr], and @racket[map] is @racketmodname[compatibility/mpair]'s
@racket[mmap], and so on.
An @|r5rs| @defterm{environment} is implemented as a

View File

@ -1,210 +1,6 @@
#lang racket/base
(require (for-syntax racket/base)
"performance-hint.rkt")
;; compatibility library, see compatibility/mpair
(provide mmap
mfor-each
mlist
mlist?
mlength
mappend
mappend!
mreverse
mreverse!
mlist-tail
mlist-ref
mmemq
mmemv
mmember
massq
massv
massoc
mlist->list
list->mlist
mlistof)
(begin-encourage-inline
(define mmap
(case-lambda
[(f l) (let loop ([l l])
(cond
[(null? l) null]
[else (mcons (f (mcar l)) (loop (mcdr l)))]))]
[(f l1 l2) (let loop ([l1 l1][l2 l2])
(cond
[(null? l1) null]
[else (mcons (f (mcar l1) (mcar l2))
(loop (mcdr l1) (mcdr l2)))]))]
[(f l . ls) (let loop ([l l][ls ls])
(cond
[(null? l) null]
[else (mcons (apply f (mcar l) (map mcar ls))
(loop (mcdr l) (map mcdr ls)))]))]))
(define mfor-each
(case-lambda
[(f l) (let loop ([l l])
(cond
[(null? l) (void)]
[else (f (mcar l))
(loop (mcdr l))]))]
[(f l1 l2) (let loop ([l1 l1][l2 l2])
(cond
[(null? l1) (void)]
[else (f (mcar l1) (mcar l2))
(loop (mcdr l1) (mcdr l2))]))]
[(f l . ls) (let loop ([l l][ls ls])
(cond
[(null? l) (void)]
[else (apply f (mcar l) (map mcar ls))
(loop (mcdr l) (map mcdr ls))]))])))
(define (list->mlist l)
(cond
[(null? l) null]
[else (mcons (car l) (list->mlist (cdr l)))]))
(define (mlist->list l)
(cond
[(null? l) null]
[else (cons (mcar l) (mlist->list (mcdr l)))]))
(define-syntax mlist
(make-set!-transformer
(lambda (stx)
(syntax-case stx (set!)
[(set! id . _) (raise-syntax-error #f
"cannot mutate imported variable"
stx
#'id)]
[(_ a) #'(mcons a null)]
[(_ a b) #'(mcons a (mcons b null))]
[(_ a b c) #'(mcons a (mcons b (mcons c null)))]
[(_ arg ...) #'(-mlist arg ...)]
[_ #'-mlist]))))
(define -mlist
(let ([mlist
(case-lambda
[() null]
[(a) (mcons a null)]
[(a b) (mcons a (mcons b null))]
[(a b c) (mcons a (mcons b (mcons c null)))]
[(a b c d) (mcons a (mcons b (mcons c (mcons d null))))]
[l (list->mlist l)])])
mlist))
(define (mlist? l)
(cond
[(null? l) #t]
[(mpair? l)
(let loop ([turtle l][hare (mcdr l)])
(cond
[(null? hare) #t]
[(eq? hare turtle) #f]
[(mpair? hare)
(let ([hare (mcdr hare)])
(cond
[(null? hare) #t]
[(eq? hare turtle) #f]
[(mpair? hare)
(loop (mcdr turtle) (mcdr hare))]
[else #f]))]
[else #f]))]
[else #f]))
(define (mlength l)
(let loop ([l l][len 0])
(cond
[(null? l) len]
[else (loop (mcdr l) (add1 len))])))
(define mappend
(case-lambda
[() null]
[(a) a]
[(a b) (let loop ([a a])
(if (null? a)
b
(mcons (mcar a) (loop (mcdr a)))))]
[(a . l) (mappend a (apply mappend l))]))
;; mappend! : like append, but mutate each list to refer to the next.
;; modeled loosely on the v372 behavior
(define mappend!
(case-lambda
[() null]
[(a) a]
[(a b) (if (null? a)
b
(let loop ([atail a])
(cond [(null? (mcdr atail)) (set-mcdr! atail b) a]
[else (loop (mcdr atail))])))]
[(a . l) (mappend! a (apply mappend! l))]))
(define (mreverse l)
(let loop ([l l][a null])
(cond
[(null? l) a]
[else (loop (mcdr l) (mcons (mcar l) a))])))
(define (mreverse! l)
(let loop ([l l][prev null])
(cond
[(null? l) prev]
[else (let ([next (mcdr l)])
(set-mcdr! l prev)
(loop next l))])))
(define (mlist-tail l n)
(cond
[(zero? n) l]
[else (mlist-tail (mcdr l) (sub1 n))]))
(define (mlist-ref l n)
(cond
[(zero? n) (mcar l)]
[else (mlist-ref (mcdr l) (sub1 n))]))
(define (do-member =? v l)
(let loop ([l l])
(cond
[(null? l) #f]
[(=? v (mcar l)) l]
[else (loop (mcdr l))])))
(define (mmemq v l)
(do-member eq? v l))
(define (mmemv v l)
(do-member eqv? v l))
(define (mmember v l)
(do-member equal? v l))
(define (do-assoc =? v l)
(let loop ([l l])
(cond
[(null? l) #f]
[(=? v (mcar (mcar l))) (mcar l)]
[else (loop (mcdr l))])))
(define (massq v l)
(do-assoc eq? v l))
(define (massv v l)
(do-assoc eqv? v l))
(define (massoc v l)
(do-assoc equal? v l))
(define ((mlistof p?) l)
(let loop ([l l])
(cond
[(null? l) #t]
[(not (mpair? l)) #f]
[(p? (mcar l)) (loop (mcdr l))]
[else #f])))
(require compatibility/mpair)
(provide (all-from-out compatibility/mpair))

View File

@ -56,131 +56,6 @@ Changes the @tech{mutable pair} @racket[p] so that its second element is
@note-lib-only[racket/mpair]
For functions described in this section, contracts are not directly
enforced. In particular, when a @tech{mutable list} is expected,
supplying any other kind of value (or mutating a value that starts as
a @tech{mutable list}) tends to produce an exception from
@racket[mcar] or @racket[mcdr].
@deprecated[@racketmodname[compatibility/mpair]]{}
@defproc[(mlist? [v any/c]) boolean?]{Returns @racket[#t] if
@racket[v] is a @tech{mutable list}: either the empty list, or a
@tech{mutable pair} whose second element is a @tech{mutable list}.}
@defproc[(mlist [v any/c] ...) mlist?]{Returns a newly allocated
@tech{mutable list} containing the @racket[v]s as its elements.}
@defproc[(list->mlist [lst list?]) mlist?]{
Returns a newly allocated @tech{mutable list} with the same elements as
@racket[lst].}
@defproc[(mlist->list [mlst mlist?]) list?]{
Returns a newly allocated list with the same elements as
@racket[mlst].}
@defproc[(mlength [mlst mlist?])
exact-nonnegative-integer?]{
Returns the number of elements in @racket[mlst].}
@defproc[(mlist-ref [mlst mlist?] [pos exact-nonnegative-integer?])
any/c]{
Like @racket[list-ref], but for @tech{mutable lists}.}
@defproc[(mlist-tail [mlst mlist?] [pos exact-nonnegative-integer?])
any/c]{
Like @racket[list-tail], but for @tech{mutable lists}.}
@defproc*[([(mappend [mlst mlist?] ...) mlist?]
[(mappend [mlst mlist?] ... [v any/c]) any/c])]{
Like @racket[append], but for @tech{mutable lists}.}
@defproc*[([(mappend! [mlst mlist?] ...) mlist?]
[(mappend! [mlst mlist?] ... [v any/c]) any/c])]{
The @racket[mappend!] procedure appends the given @tech{mutable lists} by mutating
the tail of each to refer to the next, using @racket[set-mcdr!]. Empty
lists are dropped; in particular, the result of calling
@racket[mappend!] with one or more empty lists is the same as the
result of the call with the empty lists removed from the set of
arguments.}
@defproc[(mreverse [mlst mlist?]) mlist?]{
Like @racket[reverse], but for @tech{mutable lists}.}
@defproc[(mreverse! [mlst mlist?]) mlist?]{
Like @racket[mreverse], but destructively reverses the
@tech{mutable list} by using
all of the mutable pairs in @racket[mlst] and changing them with
@racket[set-mcdr!].}
@defproc[(mmap [proc procedure?] [mlst mlist?] ...+)
mlist?]{
Like @racket[map], but for @tech{mutable lists}.}
@defproc[(mfor-each [proc procedure?] [mlst mlist?] ...+)
void?]{
Like @racket[for-each], but for @tech{mutable lists}.}
@defproc[(mmember [v any/c] [mlst mlist?])
(or/c mlist? #f)]{
Like @racket[member], but for @tech{mutable lists}.}
@defproc[(mmemv [v any/c] [mlst mlist?])
(or/c mlist? #f)]{
Like @racket[memv], but for @tech{mutable lists}.}
@defproc[(mmemq [v any/c] [mlst mlist?])
(or/c list? #f)]{
Like @racket[memq], but for @tech{mutable lists}.}
@defproc[(massoc [v any/c] [mlst (mlistof mpair?)])
(or/c mpair? #f)]{
Like @racket[assoc], but for @tech{mutable lists} of @tech{mutable pairs}.}
@defproc[(massv [v any/c] [mlst (mlistof mpair?)])
(or/c mpair? #f)]{
Like @racket[assv], but for @tech{mutable lists} of @tech{mutable pairs}.}
@defproc[(massq [v any/c] [mlst (mlistof mpair?)])
(or/c mpair? #f)]{
Like @racket[assq], but for @tech{mutable lists} of @tech{mutable pairs}.}
@defproc[(mlistof [pred (any/c . -> . any/c)])
(any/c . -> . boolean?)]{
Returns a procedure that returns @racket[#t] when given a @tech{mutable list}
for which @racket[pred] returns a true value for all elements.}
Re-exports @racketmodname[compatibility/mpair].

View File

@ -3,7 +3,7 @@
(for-syntax racket/base)
(for-label racket/generator
racket/generic
racket/mpair))
compatibility/mpair))
@(define (info-on-seq where what)
@margin-note{See @secref[where] for information on using @|what| as

View File

@ -1,6 +1,6 @@
#lang racket/base
(require racket/mpair)
(require compatibility/mpair)
(define SIZE 10000)
(define (sequence start stop)

View File

@ -1,4 +1,4 @@
(require racket/mpair)
(require compatibility/mpair)
(define SIZE 10000)
(: sequence (Integer Integer -> (MListof Integer)))

View File

@ -3,7 +3,7 @@
(Section 'for)
(require racket/mpair
(require compatibility/mpair
"for-util.rkt")
(test-sequence [(0 1 2)] 3)

View File

@ -50,7 +50,7 @@ TR missed opt: pair.rkt 84:17 (set-mcdr! (ann (quote ()) (MListof Integer)) (ann
)
#lang typed/racket
(require racket/mpair)
(require compatibility/mpair)
;; car/cdr can be optimized if they are guaranteed to be applied only to
;; non-empty lists. otherwise, we miss a potential optimization

View File

@ -15,7 +15,7 @@
(only-in racket/private/pre-base new-apply-proc)
racket/promise racket/system
racket/function
racket/mpair
compatibility/mpair
racket/base
racket/set
racket/place