From 791d765dafca01be2558756228f38944101f8037 Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Sat, 9 Mar 1996 18:29:04 +0000 Subject: [PATCH] Changed LAMBDA-LIST/APPLICATE to take an extra parameter, the FORM where the application occurs. This is used in reporting errors. --- v8/src/compiler/midend/cleanup.scm | 8 ++++---- v8/src/compiler/midend/lamlift.scm | 4 ++-- v8/src/compiler/midend/midend.scm | 10 +++++++--- v8/src/compiler/midend/split.scm | 6 +++--- v8/src/compiler/midend/utils.scm | 16 +++++++++++----- 5 files changed, 27 insertions(+), 17 deletions(-) diff --git a/v8/src/compiler/midend/cleanup.scm b/v8/src/compiler/midend/cleanup.scm index 239bf174b..0a04366c8 100644 --- a/v8/src/compiler/midend/cleanup.scm +++ b/v8/src/compiler/midend/cleanup.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: cleanup.scm,v 1.28 1996/03/04 05:10:46 adams Exp $ +$Id: cleanup.scm,v 1.29 1996/03/09 18:28:42 adams Exp $ Copyright (c) 1994-1996 Massachusetts Institute of Technology @@ -176,7 +176,7 @@ MIT in each case. |# (lambda (bindings* body*) (cleanup/pseudo-letify rator bindings* body*)) env - (cleanup/lambda-list->bindings let-names let-values) + (cleanup/lambda-list->bindings form let-names let-values) lambda-body)) (if (call/%make-stack-closure? cont) @@ -561,11 +561,11 @@ MIT in each case. |# (define (cleanup/letify bindings body) `(LET ,bindings ,body)) -(define (cleanup/lambda-list->bindings lambda-list operands) +(define (cleanup/lambda-list->bindings form lambda-list operands) ;; returns LET-like bindings (map (lambda (name operand) (list name operand)) (lambda-list->names lambda-list) - (lambda-list/applicate lambda-list operands))) + (lambda-list/applicate form lambda-list operands))) (define (cleanup/pseudo-letify rator bindings body) ;; If the body is a lookup diff --git a/v8/src/compiler/midend/lamlift.scm b/v8/src/compiler/midend/lamlift.scm index 89c4a0ec4..68e0f1d7c 100644 --- a/v8/src/compiler/midend/lamlift.scm +++ b/v8/src/compiler/midend/lamlift.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: lamlift.scm,v 1.8 1995/07/04 17:56:11 adams Exp $ +$Id: lamlift.scm,v 1.9 1996/03/09 18:28:04 adams Exp $ Copyright (c) 1994-1995 Massachusetts Institute of Technology @@ -455,7 +455,7 @@ MIT in each case. |# call `(CALL (LOOKUP ,var) ,@(reorder (append extra-args - (lambda-list/applicate lambda-list + (lambda-list/applicate call lambda-list (call/cont-and-operands call))))))) (define (lamlift/reorderer original final) diff --git a/v8/src/compiler/midend/midend.scm b/v8/src/compiler/midend/midend.scm index e043e2c87..31c5b786f 100644 --- a/v8/src/compiler/midend/midend.scm +++ b/v8/src/compiler/midend/midend.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: midend.scm,v 1.21 1996/03/08 22:11:34 adams Exp $ +$Id: midend.scm,v 1.22 1996/03/09 18:29:04 adams Exp $ Copyright (c) 1994 Massachusetts Institute of Technology @@ -460,7 +460,11 @@ Example: ;; Turn FORM into something to put in an error message or warning that ;; can help the user figure out where the error is. Currently ;; pretty-prints the DBG expression for FORM if it can be found, and - ;; prefixes each line with "; ". + ;; prefixes each line with "; ", then wraps the whole text in an + ;; error irritant. + ;; + ;; If nothing helpful can be found returns #F. This happens only if + ;; there is a problem in tracking dbg info. (define (string-split string separator) (let ((end (string-length string))) (let loop ((i 0)) @@ -486,7 +490,7 @@ Example: ((new-dbg-continuation/outer dbg-object) => get-source) (else (unhelpful)))) - (define (unhelpful) (error-irritant/noise "")) + (define (unhelpful) #F) #|(error-irritant/noise "")|# (cond ((code-rewrite/original-form form) => get-source) ((code-rewrite/original-form/previous form) => get-source) (else (unhelpful)))) diff --git a/v8/src/compiler/midend/split.scm b/v8/src/compiler/midend/split.scm index 7284923ae..3cda3a01a 100644 --- a/v8/src/compiler/midend/split.scm +++ b/v8/src/compiler/midend/split.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: split.scm,v 1.6 1995/09/04 21:55:10 adams Exp $ +$Id: split.scm,v 1.7 1996/03/09 18:28:22 adams Exp $ Copyright (c) 1994 Massachusetts Institute of Technology @@ -231,14 +231,14 @@ MIT in each case. |# ,(split/remember* `(CALL (LOOKUP ,new-name) ,(third form) - ,@(lambda-list/applicate + ,@(lambda-list/applicate form (cdr lambda-list) (list-tail form 5))) form))) ((HEAP) `(CALL (LOOKUP ,new-name) ,(third form) - ,@(lambda-list/applicate + ,@(lambda-list/applicate form (cdr lambda-list) (list-tail form 4)))) (else (internal-error "Unknown format" diff --git a/v8/src/compiler/midend/utils.scm b/v8/src/compiler/midend/utils.scm index 1f25f0f55..85a0551cc 100644 --- a/v8/src/compiler/midend/utils.scm +++ b/v8/src/compiler/midend/utils.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: utils.scm,v 1.30 1995/09/08 00:56:01 adams Exp $ +$Id: utils.scm,v 1.31 1996/03/09 18:27:52 adams Exp $ Copyright (c) 1994-1995 Massachusetts Institute of Technology @@ -800,14 +800,20 @@ Example use of FORM/COPY-TRANSFORMING: (if (not (= (length args) len)) (internal-error "Wrong number of arguments" len args))) -(define (lambda-list/applicate lambda-list args) - ;; No #!AUX allowed here +(define (lambda-list/applicate form lambda-list args) + ;; If LAMBDA-LIST is to be simplified by removing #!OPTIONAL and #!REST + ;; markers, then the ARGS must be processed to ensure the lambda + ;; bindings are bould to the same values. Returns a list of + ;; expressions. #!AUX is not allowed. FORM is used only for error + ;; reporting to locate the user's source. + (define (bad message) + (user-error message (form->source-irritant form))) (let loop ((ll lambda-list) (ops args) (ops* '())) (cond ((null? ll) (if (not (null? ops)) - (user-error "Too many arguments" lambda-list args)) + (bad "Too many arguments")) (reverse! ops*)) ((eq? (car ll) '#!OPTIONAL) (loop (if (or (null? (cddr ll)) @@ -834,7 +840,7 @@ Example use of FORM/COPY-TRANSFORMING: ,(listify (cdr ops))))) ops*))) ((null? ops) - (user-error "Too few arguments" lambda-list args)) + (bad "Too few arguments")) (else (loop (cdr ll) (cdr ops) (cons (car ops) ops*)))))) -- 2.25.1