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

53
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,30 +82,28 @@
;; 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)]) (if (null-list? list) (abort '() '()) ; LIST is empty -- bail out
(if (null-list? list) (abort '() '()) ; LIST is empty -- bail out (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)]) (if (null-list? list) (abort '() '()) ; LIST is empty -- bail out
(if (null-list? list) (abort '() '()) ; LIST is empty -- bail out (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)