From a06fe566026858c9ac912564e02edc7921bad556 Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Sat, 11 Feb 2012 17:51:08 -0800 Subject: [PATCH] Better unsyntaxing of lambda and extended-lambda. --- src/runtime/unsyn.scm | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/src/runtime/unsyn.scm b/src/runtime/unsyn.scm index 65161c5fc..1aa292708 100644 --- a/src/runtime/unsyn.scm +++ b/src/runtime/unsyn.scm @@ -41,6 +41,7 @@ USA. (DEFINITION ,unsyntax-DEFINITION-object) (DELAY ,unsyntax-DELAY-object) (DISJUNCTION ,unsyntax-DISJUNCTION-object) + (EXTENDED-LAMBDA ,unsyntax-EXTENDED-LAMBDA-object) (LAMBDA ,unsyntax-LAMBDA-object) (OPEN-BLOCK ,unsyntax-OPEN-BLOCK-object) (QUOTATION ,unsyntax-QUOTATION) @@ -317,23 +318,27 @@ USA. ;;;; Lambdas +(define (unsyntax-EXTENDED-LAMBDA-object expression) + (if unsyntaxer:macroize? + (unsyntax-lambda expression) + `(&XLAMBDA (,(lambda-name expression) ,@(lambda-interface expression)) + ,(unsyntax-object (lambda-immediate-body expression))))) + (define (unsyntax-LAMBDA-object expression) (if unsyntaxer:macroize? - (lambda-components** expression - (lambda (name required optional rest body) - (collect-lambda name - (make-lambda-list required optional rest '()) - (with-bindings required optional rest - unsyntax-lambda-body body)))) - (lambda-components expression - (lambda (name required optional rest auxiliary declarations body) - (collect-lambda name - (make-lambda-list required optional rest auxiliary) - (let ((body (unsyntax-sequence body))) - (if (null? declarations) - body - `((DECLARE ,@declarations) - ,@body)))))))) + (unsyntax-lambda expression) + (collect-lambda (lambda-name expression) + (lambda-interface expression) + (list (unsyntax-object + (lambda-immediate-body expression)))))) + +(define (unsyntax-lambda expression) + (lambda-components** expression + (lambda (name required optional rest body) + (collect-lambda name + (make-lambda-list required optional rest '()) + (with-bindings required optional rest + unsyntax-lambda-body body))))) (define (collect-lambda name bvl body) (if (eq? name lambda-tag:unnamed) -- 2.25.1