add map/values from carl, and `debug' prints exceptions

svn: r18197
This commit is contained in:
Sam Tobin-Hochstadt 2010-02-19 23:25:14 +00:00
parent f7447ee6ae
commit d9fabc314b
3 changed files with 58 additions and 3 deletions

View File

@ -12,7 +12,10 @@
(for/list ([arg 'args]
[val l])
(printf "\t~a: ~a~n" arg val))
(let ([e (apply f l)])
(printf "result was ~a~n" e)
(let ([e (with-handlers ([values (lambda (exn)
(printf "~a raised exception ~a~n" 'f exn)
(raise exn))])
(apply f l))])
(printf "~a result was ~a~n" 'f e)
e)))]
[(_ f . args) (debug (f . args))]))

View File

@ -1,6 +1,7 @@
#lang scheme/base
(require scheme/contract
scheme/dict)
scheme/dict
(for-syntax scheme/base))
; list-prefix : list? list? -> boolean?
; Is l a prefix or r?
@ -84,3 +85,30 @@
(same? key-item prev))
(car items)
(loop (cdr items) (cons key-item sofar)))))))
;; sam added from carl
(define-syntax (values->list stx)
(syntax-case stx ()
[(vl expr)
(syntax/loc stx
(call-with-values (lambda () expr) list))]))
(define (map/list n f ls)
(cond
[(andmap null? ls) (build-list n (lambda (i) null))]
[(andmap pair? ls)
(let* ([vs (values->list (apply f (map car ls)))]
[k (length vs)])
(unless (= k n)
(error 'map/values
"~a produced ~a values, not ~a: ~e"
f k n vs))
(map cons vs (map/list n f (map cdr ls))))]
[else (error 'map/values "list lengths differ")]))
(define (map/values n f . ls)
(apply values (map/list n f ls)))
(provide map/values)

View File

@ -79,3 +79,27 @@ true value. The procedures @scheme[equal?], @scheme[eqv?], and
(dict-map id-t list)
]
}
@addition{Carl Eastlund}
@defproc[(map/values [n natural-number/c]
[f (-> A ... (values B_1 ... B_n))]
[lst (listof A)]
...)
(values (listof B_1) ... (listof B_n))]{
Produces lists of the respective values of @scheme[f] applied to the elements in
@scheme[lst ...] sequentially.
@defexamples[
#:eval the-eval
(map/values
3
(lambda (x)
(values (+ x 1) x (- x 1)))
(list 1 2 3))
]
}