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

fix for/list' to use the new reverse'

Browse Source
This commit is contained in:
Matthew Flatt 2011-07-30 13:10:42 +01:00
parent ec27cbfd90
commit 920867287b
3 changed files with 24 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/racket/private/for.rkt
View File

@ -4,6 +4,7 @@
"misc.rkt"
"define.rkt"
"letstx-scheme.rkt"
"reverse.rkt"
'#%unsafe
(for-syntax '#%kernel
"stx.rkt"
@ -1348,7 +1349,7 @@
(define-for-variants (for/list for*/list)
([fold-var null])
(lambda (x) `(,#'reverse ,x))
(lambda (x) `(,#'alt-reverse ,x))
(lambda (x) x)
(lambda (x) `(,#'cons ,x ,#'fold-var)))

15
collects/racket/private/list.rkt
View File

@ -1,4 +1,5 @@
(module list "pre-base.rkt"
(require "reverse.rkt")
(provide foldl
foldr
@ -26,7 +27,7 @@
build-string
build-list
(rename-out [alt-reverse reverse]
(rename-out [alt-reverse reverse] ; defined in "for.rkt"
[alt-memq memq]
[alt-memv memv]
[alt-member member])
@ -411,18 +412,6 @@
(mk-simple-compose app* f g))))
(values compose1 compose)))
(define alt-reverse
(if (eval-jit-enabled)
(let ([reverse
(lambda (l)
(unless (list? l) (raise-type-error 'reverse "list"))
(let loop ([a null] [l l])
(if (null? l)
a
(loop (cons (car l) a) (cdr l)))))])
reverse)
reverse))
(define-values (alt-memq alt-memv alt-member)
(if (eval-jit-enabled)
(let ()

20
collects/racket/private/reverse.rkt Normal file
View File

@ -0,0 +1,20 @@
(module reverse '#%kernel
(#%provide alt-reverse)
(define-values (alt-reverse)
(if (eval-jit-enabled)
(let-values ([(reverse)
(lambda (l)
(if (list? l)
(void)
(raise-type-error 'reverse "list"))
(letrec-values ([(loop)
(lambda (a l)
(if (null? l)
a
(loop (cons (car l) a) (cdr l))))])
(loop null l)))])
reverse)
reverse)))