From ade361abb97e30574612eeb5ffa3ab083f551a91 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 12 Feb 2003 19:40:38 +0000 Subject: [PATCH] Properly fix problem with LETREC/definition interaction. This requires an extra environment frame in the syntax expander, to model the frame that is potentially inserted in the output. And we must continue to use the "auxiliary" variable mechanism, since the compiler and several other things depend on it in order to recognize LETREC-like structures. --- v7/src/runtime/mit-syntax.scm | 107 ++++++++++++++++++------------- v7/src/runtime/syntax-output.scm | 31 +++------ 2 files changed, 73 insertions(+), 65 deletions(-) diff --git a/v7/src/runtime/mit-syntax.scm b/v7/src/runtime/mit-syntax.scm index b90928163..650108537 100644 --- a/v7/src/runtime/mit-syntax.scm +++ b/v7/src/runtime/mit-syntax.scm @@ -1,25 +1,26 @@ -;;; -*-Scheme-*- -;;; -;;; $Id: mit-syntax.scm,v 14.10 2002/12/13 18:55:07 cph Exp $ -;;; -;;; Copyright (c) 1989-1991, 2001, 2002 Massachusetts Institute of Technology -;;; -;;; This file is part of MIT Scheme. -;;; -;;; MIT Scheme is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation; either version 2 of the License, -;;; or (at your option) any later version. -;;; -;;; MIT Scheme is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with MIT Scheme; if not, write to the Free Software -;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;;; 02111-1307, USA. +#| -*-Scheme-*- + +$Id: mit-syntax.scm,v 14.11 2003/02/12 19:39:52 cph Exp $ + +Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology + +This file is part of MIT Scheme. + +MIT Scheme is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +MIT Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT Scheme; if not, write to the Free Software Foundation, +Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +|# ;;;; MIT Scheme Syntax @@ -396,10 +397,13 @@ (classifier->keyword (lambda (form environment definition-environment history) definition-environment - (let ((body-environment - (make-internal-syntactic-environment environment))) + (let* ((binding-environment + (make-internal-syntactic-environment environment)) + (body-environment + (make-internal-syntactic-environment binding-environment))) (classify/let-like form environment + binding-environment body-environment body-environment history @@ -434,15 +438,19 @@ (lambda (form environment definition-environment history) definition-environment (syntax-check '(KEYWORD (* (IDENTIFIER ? EXPRESSION)) + FORM) form history) - (let ((body-environment (make-internal-syntactic-environment environment))) + (let* ((binding-environment + (make-internal-syntactic-environment environment)) + (body-environment + (make-internal-syntactic-environment binding-environment))) (for-each (let ((item (make-reserved-name-item history))) (lambda (binding) - (syntactic-environment/define body-environment + (syntactic-environment/define binding-environment (car binding) item))) (cadr form)) (classify/let-like form - body-environment + binding-environment + binding-environment body-environment body-environment history @@ -459,15 +467,19 @@ (define-classifier 'LET-SYNTAX system-global-environment (lambda (form environment definition-environment history) - definition-environment (syntax-check '(KEYWORD (* (IDENTIFIER EXPRESSION)) + FORM) form history) - (classify/let-like form - environment - definition-environment - (make-internal-syntactic-environment environment) - history - syntactic-binding-theory - output/let))) + (let* ((binding-environment + (make-internal-syntactic-environment environment)) + (body-environment + (make-internal-syntactic-environment binding-environment))) + (classify/let-like form + environment + binding-environment + body-environment + definition-environment + history + syntactic-binding-theory + output/let)))) (define-er-macro-transformer 'LET*-SYNTAX system-global-environment (lambda (form rename compare) @@ -476,38 +488,47 @@ (define-classifier 'LETREC-SYNTAX system-global-environment (lambda (form environment definition-environment history) - definition-environment (syntax-check '(KEYWORD (* (IDENTIFIER EXPRESSION)) + FORM) form history) - (let ((body-environment (make-internal-syntactic-environment environment))) + (let* ((binding-environment + (make-internal-syntactic-environment environment)) + (body-environment + (make-internal-syntactic-environment binding-environment))) (for-each (let ((item (make-reserved-name-item history))) (lambda (binding) - (syntactic-environment/define body-environment + (syntactic-environment/define binding-environment (car binding) item))) (cadr form)) (classify/let-like form + binding-environment + binding-environment body-environment definition-environment - body-environment history syntactic-binding-theory output/letrec)))) -(define (classify/let-like form environment definition-environment - body-environment history binding-theory output/let) +(define (classify/let-like form + value-environment + binding-environment + body-environment + definition-environment + history + binding-theory + output/let) ;; Classify right-hand sides first, in order to catch references to ;; reserved names. Then bind names prior to classifying body. (let* ((bindings (delete-matching-items! (map (lambda (binding item) - (binding-theory body-environment + (binding-theory binding-environment (car binding) item history)) (cadr form) (select-map (lambda (binding selector) (classify/subexpression (cadr binding) - environment + value-environment history (selector/add-cadr selector))) diff --git a/v7/src/runtime/syntax-output.scm b/v7/src/runtime/syntax-output.scm index 4ae043c9a..5ffb68caf 100644 --- a/v7/src/runtime/syntax-output.scm +++ b/v7/src/runtime/syntax-output.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: syntax-output.scm,v 14.7 2003/02/09 01:58:09 cph Exp $ +$Id: syntax-output.scm,v 14.8 2003/02/12 19:40:38 cph Exp $ Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology @@ -68,17 +68,9 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (output/named-lambda lambda-tag:unnamed lambda-list body)) (define (output/named-lambda name lambda-list body) - (output/lambda-internal name lambda-list '() body)) - -(define (output/lambda-internal name lambda-list declarations body) (call-with-values (lambda () (parse-mit-lambda-list lambda-list)) (lambda (required optional rest) - (make-lambda* name required optional rest - (let ((declarations (apply append declarations))) - (if (pair? declarations) - (make-sequence (make-block-declaration declarations) - body) - body)))))) + (make-lambda* name required optional rest body)))) (define (output/delay expression) (make-delay expression)) @@ -96,19 +88,14 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (output/combination (output/named-lambda lambda-tag:let names body) values)) (define (output/letrec names values body) - (output/let names - (map (lambda (name) name (output/unassigned)) names) + (output/let '() '() (make-sequence - (map* (list (scan-defines body - (lambda (names declarations body) - (if (or (pair? names) - (pair? declarations)) - (output/let '() '() - (make-open-block names - declarations - body)) - body)))) - output/assignment names values)))) + (append! (map make-definition names values) + (list + (let ((body (scan-defines body make-open-block))) + (if (open-block? body) + (output/let '() '() body) + body))))))) (define (output/body declarations body) (scan-defines (let ((declarations (apply append declarations))) -- 2.25.1