This commit is contained in:
Rolf-Thomas Happe 2003-02-12 23:26:41 +00:00
parent f45f9f135a
commit 005c65f11c
1 changed files with 2 additions and 50 deletions

View File

@ -1,30 +1,6 @@
; Copyright (c) 2003 RT Happe <rthappe at web de> ; Copyright (c) 2003 RT Happe <rthappe at web de>
; See the file COPYING distributed with the Scheme Untergrund Library ; See the file COPYING distributed with the Scheme Untergrund Library
; See README for documentation.
; Odds and Ends
; that haven't found a natural place, yet.
;
; Synopses
;
; (assert [id] exp) ; syntax
; If not EXP signal an error with suitable message. The optional
; ID may be any printable object, e.g. a symbol naming the enclosing
; procedure. [ This could be done with a procedure, but ASSERT being
; a macro, we can redefine it as the trivial form that doesn't evaluate
; its parameters. ]
;
; (receive/name loop formals exp form0 ...) ; syntax
; Bind LOOP to a macro wrapped around the procedure LUP with parameter
; list FORMALS and body FORM0 ... so that
; * (LOOP multi-valued-expression) calls LUP with the values of
; multi-valued-expression , and
; * (LOOP exp0 ...) becomes (LUP exp0 ...)
;
; (gen-dispatch ((predicate action) ...) e0 e1 ... en) ; syntax
; Dispatch action on type of first argument E0: feed E0 ... EN to the
; first action such that the PREDICATE holds for E0. Signal an error
; if nothing goes.
(define-syntax assert (define-syntax assert
(syntax-rules () (syntax-rules ()
@ -35,31 +11,7 @@
'?x))))) '?x)))))
;; RECEIVE/NAME is a multiple values analogue of named LET.
; RECEIVE/NAME is a multiple values analogue of named LET.
; Syntax: (receive/name <identifier> <formals> <expression> <body>)
; [ non-terminals as in R5RS ]
; Semantics: (receive/name loop (x y) exp0 ; yes, it's a special case
; ... (loop exp1) ...)
; is eqv to
; (receive (x y) exp0
; (let lup ((x x) (y y))
; ... (receive (x y) exp1
; (lup x y)) ...))
;
; And (receive/name loop (x y) exp0
; ... (loop exp1 exp1) ...)
; is eqv to
; (receive (x y) exp0
; (let lup ((x x) (y y))
; ... (lup exp1 exp2) ...))
;
; Absurd example:
; (define (shove n xs) (values (- n 1) (cons n xs)))
; (receive/name loop (n xs) (values 7 '())
; (if (= n 0)
; (display xs)
; (loop (shove n xs))))
(define-syntax receive/name (define-syntax receive/name
(syntax-rules () (syntax-rules ()
((_ ?tag ?tuple ?call ?body0 ?body1 ...) ((_ ?tag ?tuple ?call ?body0 ?body1 ...)