diff --git a/collects/unstable/debug.ss b/collects/unstable/debug.ss index b614fbbfe3..dd48296c8b 100644 --- a/collects/unstable/debug.ss +++ b/collects/unstable/debug.ss @@ -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))])) \ No newline at end of file diff --git a/collects/unstable/list.ss b/collects/unstable/list.ss index f8609a42c4..5f8182c6c0 100644 --- a/collects/unstable/list.ss +++ b/collects/unstable/list.ss @@ -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) + diff --git a/collects/unstable/scribblings/list.scrbl b/collects/unstable/scribblings/list.scrbl index de7a524a35..fbacc79c64 100644 --- a/collects/unstable/scribblings/list.scrbl +++ b/collects/unstable/scribblings/list.scrbl @@ -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)) +] + +} +