From 2e5e2342573888cc2dadae2754e3992659abdd24 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Fri, 13 Feb 1998 16:09:48 +0000
Subject: [PATCH] ANSI CL compat. changes: o Add an optional environment
 argument to constantp; ignored by CMUCL. o Add the :element-type keyword to
 make-string.

---
 code/eval.lisp           | 5 +++--
 code/string.lisp         | 7 ++++---
 compiler/array-tran.lisp | 7 ++++---
 compiler/fndb.lisp       | 8 +++++---
 4 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/code/eval.lisp b/code/eval.lisp
index ffeaf0f1c..221861fb3 100644
--- a/code/eval.lisp
+++ b/code/eval.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/eval.lisp,v 1.26 1997/02/08 17:22:46 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/eval.lisp,v 1.27 1998/02/13 16:09:43 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -452,9 +452,10 @@ internally...
     (frob form env)))
 |#
 
-(defun constantp (object)
+(defun constantp (object &optional environment)
   "True of any Lisp object that has a constant value: types that eval to
   themselves, keywords, constants, and list whose car is QUOTE."
+  (declare (ignore environment))
   (typecase object
     (number t)
     (character t)
diff --git a/code/string.lisp b/code/string.lisp
index d34388662..92e065fe9 100644
--- a/code/string.lisp
+++ b/code/string.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.8 1996/07/12 18:55:24 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.9 1998/02/13 16:09:42 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -355,10 +355,11 @@
   (string-not-greaterp* string1 string2 start1 end1 start2 end2))
 
 
-(defun make-string (count &key ((:initial-element fill-char)))
+(defun make-string (count &key element-type ((:initial-element fill-char)))
   "Given a character count and an optional fill character, makes and returns
    a new string Count long filled with the fill character."
-  (declare (fixnum count))
+  (declare (fixnum count)
+	   (ignore element-type))
   (if fill-char
       (do ((i 0 (1+ i))
 	   (string (make-string count)))
diff --git a/compiler/array-tran.lisp b/compiler/array-tran.lisp
index 34e0dd03e..ba8987e1c 100644
--- a/compiler/array-tran.lisp
+++ b/compiler/array-tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.23 1998/01/10 05:02:26 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.24 1998/02/13 16:09:48 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -189,11 +189,12 @@
 ;;; 
 ;;; Just convert it into a make-array.
 ;;;
-(def-source-transform make-string (length &key (initial-element #\NULL))
+(def-source-transform make-string (length &key (element-type ''base-char)
+					  (initial-element #\NULL))
   (if (byte-compiling)
       (values nil t)
       `(make-array (the index ,length)
-		   :element-type 'base-char
+		   :element-type ,element-type
 		   :initial-element ,initial-element)))
 
 (defconstant array-info
diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp
index 44291b1a3..2b834ef01 100644
--- a/compiler/fndb.lisp
+++ b/compiler/fndb.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.78 1997/12/20 19:52:01 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.79 1998/02/13 16:09:46 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -786,7 +786,8 @@
   (or index null)
   (foldable flushable))
 
-(defknown make-string (index &key (:initial-element character))
+(defknown make-string (index &key (:element-type type-specifier)
+		       (:initial-element character))
   simple-string (flushable))
 
 (defknown (string-trim string-left-trim string-right-trim)
@@ -820,7 +821,8 @@
 ;;;; In the "Eval" chapter:
 
 (defknown eval (t) *)
-(defknown constantp (t) boolean (foldable flushable))
+(defknown constantp (t &optional lexical-environment) boolean
+  (foldable flushable))
 
 
 ;;;; In the "Streams" chapter:
-- 
GitLab