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

enable R5RS map' & for-each' (i.e., mmap' and mfor-each') inlining

Browse Source 
original commit: 4b1f74671429f6d8955c6afa98569821fec9e8c7
This commit is contained in:
Matthew Flatt 2011-12-16 09:33:30 -07:00
parent 5a80a3b6e4
commit d2112c9652
1 changed files with 34 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
collects/racket/mpair.rkt
View File

@ -1,6 +1,7 @@
#lang scheme/base #lang scheme/base
(require (for-syntax scheme/base)) (require (for-syntax scheme/base)
"performance-hint.rkt")
(provide mmap (provide mmap
mfor-each mfor-each
@ -23,40 +24,41 @@
list->mlist list->mlist
mlistof) mlistof)
(define mmap (begin-encourage-inline
(case-lambda (define mmap
[(f l) (let loop ([l l]) (case-lambda
(cond [(f l) (let loop ([l l])
[(null? l) null] (cond
[else (mcons (f (mcar l)) (loop (mcdr l)))]))] [(null? l) null]
[(f l1 l2) (let loop ([l1 l1][l2 l2]) [else (mcons (f (mcar l)) (loop (mcdr l)))]))]
(cond [(f l1 l2) (let loop ([l1 l1][l2 l2])
[(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 (cond
[(null? l) null] [(null? l1) null]
[else (mcons (apply f (mcar l) (map mcar ls)) [else (mcons (f (mcar l1) (mcar l2))
(loop (mcdr l) (map mcdr ls)))]))])) (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 (define mfor-each
(case-lambda (case-lambda
[(f l) (let loop ([l l]) [(f l) (let loop ([l l])
(cond (cond
[(null? l) (void)] [(null? l) (void)]
[else (f (mcar l)) [else (f (mcar l))
(loop (mcdr l))]))] (loop (mcdr l))]))]
[(f l1 l2) (let loop ([l1 l1][l2 l2]) [(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 (cond
[(null? l) (void)] [(null? l1) (void)]
[else (apply f (mcar l) (map mcar ls)) [else (f (mcar l1) (mcar l2))
(loop (mcdr l) (map mcdr ls))]))])) (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) (define (list->mlist l)
(cond (cond