suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

start mzc scribbling

Browse Source 
svn: r8334

original commit: 8b16cee613d8ea3258c98e2e4c98b3756ae04019
This commit is contained in:
Matthew Flatt 2008-01-15 13:09:40 +00:00
parent 317205cbed
commit dbd9978f63
1 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/scheme/mpair.ss
View File

@ -8,6 +8,7 @@
mappend mappend
mappend! mappend!
mreverse mreverse
mreverse!
mlist-tail mlist-tail
mlist-ref mlist-ref
mmemq mmemq
@ -103,10 +104,11 @@
(case-lambda (case-lambda
[() null] [() null]
[(a) a] [(a) a]
[(a b) (let loop ([atail a]) [(a b) (if (null? a)
(cond [(null? atail) b] b
[(null? (mcdr atail)) (set-mcdr! atail b) a] (let loop ([atail a])
[else (loop (mcdr atail))]))] (cond [(null? (mcdr atail)) (set-mcdr! atail b) a]
[else (loop (mcdr atail))])))]
[(a . l) (mappend! a (apply mappend! l))])) [(a . l) (mappend! a (apply mappend! l))]))
(define (mreverse l) (define (mreverse l)
@ -115,6 +117,14 @@
[(null? l) a] [(null? l) a]
[else (loop (mcdr l) (mcons (mcar 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) (define (mlist-tail l n)
(cond (cond
[(zero? n) l] [(zero? n) l]