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

call-with-escape-continuation -> call/ec

Browse Source 
svn: r8990
This commit is contained in:
Eli Barzilay 2008-03-16 15:30:04 +00:00
parent e30a57b5a7
commit 5649006dac
1 changed files with 25 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/srfi/1/util.ss
View File

@ -65,14 +65,13 @@
;; Return (map cdr lists). ;; Return (map cdr lists).
;; However, if any element of LISTS is empty, just abort and return '(). ;; However, if any element of LISTS is empty, just abort and return '().
(define (%cdrs lists) (define (%cdrs lists)
(call-with-escape-continuation (let/ec abort
(lambda (abort)
(let recur ((lists lists)) (let recur ((lists lists))
(if (pair? lists) (if (pair? lists)
(let ((lis (car lists))) (let ((lis (car lists)))
(if (null-list? lis) (abort '()) (if (null-list? lis) (abort '())
(cons (cdr lis) (recur (cdr lists))))) (cons (cdr lis) (recur (cdr lists)))))
'()))))) '()))))
(define (%cars+ lists last-elt) ; (append! (map car lists) (list last-elt)) (define (%cars+ lists last-elt) ; (append! (map car lists) (list last-elt))
(let recur ((lists lists)) (let recur ((lists lists))
@ -83,8 +82,7 @@
;; However, if any of the lists is empty, just abort and return [() ()]. ;; However, if any of the lists is empty, just abort and return [() ()].
(define (%cars+cdrs lists) (define (%cars+cdrs lists)
(call-with-escape-continuation (let/ec
(lambda (abort)
(let recur ((lists lists)) (let recur ((lists lists))
(if (pair? lists) (if (pair? lists)
(let-values ([(list other-lists) (car+cdr lists)]) (let-values ([(list other-lists) (car+cdr lists)])
@ -92,13 +90,12 @@
(let-values ([(a d) (car+cdr list)] (let-values ([(a d) (car+cdr list)]
[(cars cdrs) (recur other-lists)]) [(cars cdrs) (recur other-lists)])
(values (cons a cars) (cons d cdrs))))) (values (cons a cars) (cons d cdrs)))))
(values '() '())))))) (values '() '())))))
;; Like %CARS+CDRS, but we pass in a final elt tacked onto the end of the ;; Like %CARS+CDRS, but we pass in a final elt tacked onto the end of the
;; cars list. What a hack. ;; cars list. What a hack.
(define (%cars+cdrs+ lists cars-final) (define (%cars+cdrs+ lists cars-final)
(call-with-escape-continuation (let/ec abort
(lambda (abort)
(let recur ((lists lists)) (let recur ((lists lists))
(if (pair? lists) (if (pair? lists)
(let-values ([(list other-lists) (car+cdr lists)]) (let-values ([(list other-lists) (car+cdr lists)])
@ -106,7 +103,7 @@
(let-values ([(a d) (car+cdr list)] (let-values ([(a d) (car+cdr list)]
[(cars cdrs) (recur other-lists)]) [(cars cdrs) (recur other-lists)])
(values (cons a cars) (cons d cdrs))))) (values (cons a cars) (cons d cdrs)))))
(values (list cars-final) '())))))) (values (list cars-final) '())))))
;; Like %CARS+CDRS, but blow up if any list is empty. ;; Like %CARS+CDRS, but blow up if any list is empty.
(define (%cars+cdrs/no-test lists) (define (%cars+cdrs/no-test lists)