From 367e33c46488bc1eb29314965b99c655292c1586 Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Fri, 13 Jan 1995 22:11:39 +0000 Subject: [PATCH] Fixed typo in previous edit. --- v7/src/runtime/unpars.scm | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm index 5afc10771..be97108ee 100644 --- a/v7/src/runtime/unpars.scm +++ b/v7/src/runtime/unpars.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: unpars.scm,v 14.39 1995/01/13 21:48:54 adams Exp $ +$Id: unpars.scm,v 14.40 1995/01/13 22:11:39 adams Exp $ Copyright (c) 1988-1994 Massachusetts Institute of Technology @@ -684,18 +684,19 @@ MIT in each case. |# (*unparse-hex ((ucode-primitive primitive-object-datum 1) future))))) (define (unparse/entity entity) - (define (plain name) (*unparse-with-brackets name entity false)) + (define (plain name) + (*unparse-with-brackets name entity false)) + (define (named-arity-dispatched-procedure name) + (*unparse-with-brackets 'ARITY-DISPATCHED-PROCEDURE + entity + (lambda () (*unparse-string name)))) (cond ((continuation? entity) (plain 'CONTINUATION)) ((apply-hook? entity) (plain 'APPLY-HOOK)) ((arity-dispatched-procedure? entity) - (define (print-with-name name) - (*unparse-with-brackets 'ARITY-DISPATCHED-PROCEDURE - entity - (lambda () (*unparse-string name)))) (let ((proc (entity-procedure entity))) (cond ((and (compiled-code-address? proc) (compiled-procedure? proc) (compiled-procedure/name proc)) - => print-with-name) + => named-arity-dispatched-procedure) (else (plain 'ARITY-DISPATCHED-PROCEDURE))))) (else (plain 'ENTITY)))) -- 2.25.1