Skip to content

Instantly share code, notes, and snippets.

@ijp
Created November 11, 2011 21:31
Show Gist options
  • Save ijp/1359350 to your computer and use it in GitHub Desktop.
Save ijp/1359350 to your computer and use it in GitHub Desktop.
#!r6rs
;; a permissive version of receive, that allows extra values without
;; error, and supplies a default for missing ones
;;
;; tested on guile and racket
(library (permissive-receive)
(export receive*)
(import (rnrs)
(for (only (srfi :1 lists) iota) expand))
(define-syntax receive*
(lambda (stx)
(syntax-case stx ()
[(receive (args ...) expr body rest ...)
(let* ((args #'(args ...))
(num-args (length args)))
#`(call-with-values (lambda () expr)
(lambda multiple-values
(let ((vec (make-vector #,num-args #f)))
(let loop ((lst multiple-values) (idx 0))
(unless (or (null? lst) (>= idx #,num-args))
(vector-set! vec idx (car lst))
(loop (cdr lst) (+ idx 1))))
(let #,(map (lambda (arg index)
#`(#,arg (vector-ref vec #,index)))
args
(iota num-args))
body rest ...)))))]
[(receive id expr body rest ...)
(identifier? #'id)
#'(call-with-values
(lambda () expr)
(lambda id body rest ...))])))
)
;; (receive* a (values 1 2 3) a) ; (1 2 3)
;; (receive* (a b c) (values 1 2 3) (list a b c)) ; (1 2 3)
;; (receive* (a b) (values 1 2 3) (list a b)) ; (1 2)
;; (receive* (a b c d) (values 1 2 3) (list a b c d)) ; (1 2 3 #f)
;; extending this to allow rest lists e.g.
;; (receive* (a b c . d) ...)
;; is left as an exercise
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment