diff --git a/s48/krims/krims.scm b/s48/krims/krims.scm index 1a4f9fc..96643b2 100644 --- a/s48/krims/krims.scm +++ b/s48/krims/krims.scm @@ -1,30 +1,6 @@ ; Copyright (c) 2003 RT Happe ; See the file COPYING distributed with the Scheme Untergrund Library - -; 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. - +; See README for documentation. (define-syntax assert (syntax-rules () @@ -35,31 +11,7 @@ '?x))))) - -; RECEIVE/NAME is a multiple values analogue of named LET. -; Syntax: (receive/name ) -; [ 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)))) +;; RECEIVE/NAME is a multiple values analogue of named LET. (define-syntax receive/name (syntax-rules () ((_ ?tag ?tuple ?call ?body0 ?body1 ...)