From 73f0a1e0d9ea6e6e28faa209713f070954fe3e61 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Wed, 19 Sep 1990 21:31:12 +0000 Subject: [PATCH] Put interpreted function printing back in the printer after William thoughtfully merged it out. --- code/print.lisp | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/code/print.lisp b/code/print.lisp index 75a7fda8b..b4b5e24fb 100644 --- a/code/print.lisp +++ b/code/print.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.10 1990/09/18 22:42:23 ram Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.11 1990/09/19 21:31:12 ram Exp $ ;;; ;;; CMU Common Lisp printer. ;;; @@ -1215,6 +1215,20 @@ (write-string "Function " stream) (prin1 name stream))) + +;;; OUTPUT-INTERPRETED-FUNCTION -- Internal +;;; +;;; Print the name or definition of an interpreted function. +;;; +(defun output-interpreted-function (subr stream) + (multiple-value-bind + (def ignore name) + (eval:interpreted-function-lambda-expression subr) + (declare (ignore ignore)) + (let ((*print-level* 3)) + (format stream "Interpreted Function ~S" (or name def))))) + + ;;; FINISH-RANDOM is a helping function for OUTPUT-RANDOM below. ;;; It outputs the numerical value of the low 28 bits of ;;; RANDOM-OBJECT, enclosed in braces, followed by the closing @@ -1244,9 +1258,13 @@ (#.vm:return-pc-header-type (write-string "Return PC Object" stream)) (#.vm:closure-header-type - (write-string "Closure Over " stream) - (output-function-object (%primitive c::closure-function object) - stream)) + (cond + ((eval:interpreted-function-p object) + (output-interpreted-function object stream)) + (t + (write-string "Closure Over " stream) + (output-function-object (%primitive c::closure-function object) + stream)))) (#.vm:value-cell-header-type (write-string "Value Cell" stream)) (#.vm:unbound-marker-type -- GitLab