[Maxima-commits] CVS: maxima/src compat.lisp,1.7,1.8

[Andreas E. <ar...@us...>]

Update of /cvsroot/maxima/maxima/src
In directory sc8-pr-cvs7.sourceforge.net:/tmp/cvs-serv6020

Modified Files:
	compat.lisp 
Log Message:
removed unused functions and macros.


Index: compat.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/compat.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- compat.lisp	7 Nov 2005 17:37:11 -0000	1.7
+++ compat.lisp	7 Mar 2007 19:35:39 -0000	1.8
@@ -7,106 +7,18 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (in-package :maxima)
-;; Maclisp compatibility definitions for the Lisp Machine.  This file
-;; is for Lisp differences only.  No knowledge of Macsyma should be
-;; contained in this file.
-
-;; Translated code still uses this.
-(defquote includef (  filename) filename)
-
-;; Couldn't this copy to some static area?
-(defmacro purcopy (x) x)
-
-#-nocp
-(defmacro charpos (ignor)ignor  '(cdr (cursorpos)))
-(defmacro maxima-sleep (seconds) `(process-sleep (fix (f* ,seconds 60.))))
-
-(defun linel (&optional stream)
-  #+lispm 
-  (funcall (si:decode-print-arg stream) ':size-in-characters)
-  #-lispm stream
-  #-lispm 80 
-  )
-
-;; Perhaps this should do something.
-(defmacro nointerrupt (ignor)ignor  nil)
 
-(defmacro without-tty-interrupts (&rest form)
-  `(let (#+lispm (tv:kbd-intercepted-characters nil))
-    ,@ form))
+;; Maclisp compatibility definitions.
+;; This file is for Lisp differences only.  No knowledge of Macsyma should be
+;; contained in this file.
 
-(defmacro fixnum-identity (x) x)
-(defmacro flonum-identity (x) x)
+(proclaim '(inline *quo))
 
-(proclaim '(inline *quo *dif))
-#+cl
 (defun *quo (x y)
   (cond ((and (integerp x) (integerp y))
 	 (truncate x y))
 	(t (/ x y))))
-#+cl
-(defun *dif (x y) (- x y))
 
-
-;; Keep the compiler quiet.
-;; Use GET-PNAME or FORMAT instead of EXPLODE, EXPLODEN, EXPLODEC.
-;; Use AREF instead of GETCHAR and GETCHARN.
-;; Use MAKE-SYMBOL instead of MAKNAM.
-;; Use INTERN instead of IMPLODE.
-;; Use STRING-LESSP instead of ALPHALESSP.
-#+lispm 
-(progn 
-  (remprop 'explode       'compiler:style-checker)
-  (remprop 'explodec      'compiler:style-checker)
-  (remprop 'exploden      'compiler:style-checker)
-  (remprop 'alphalessp    'compiler:style-checker)
-  (remprop 'getcharn      'compiler:style-checker)
-  (remprop 'getchar       'compiler:style-checker)
-  (remprop 'implode       'compiler:style-checker)
-  (remprop 'maknam        'compiler:style-checker)
-  )
-
-(defmacro sfa-call (stream operation arg)
-  `(funcall ,stream (read-from-string (string-append #\: ,operation)) ,arg))
-
-;; Things that appear within DECLARE bodies.
-
-;; Why doesn't this work?
-;; Because of the brain-damaged way the lispm compiler is written. -gjc
-;; (PUTPROP 'DECLARE '(DECLARE-OPTIMIZER) 'COMPILER:OPTIMIZERS)
-;;
-;; (DEFUN DECLARE-OPTIMIZER (DECLARE-FORM &AUX (RETURN-FORM NIL))
-;;   (DO ((L (REVERSE (CDR DECLARE-FORM)) (CDR L)))
-;;       ((NULL L))
-;;     (IF (NOT (MEMQ (CAAR L)
-;; 		   '(FIXNUM FLONUM NOTYPE MACROS ARRAY* GENPREFIX
-;; 			    CLOSED MUZZLED MAPEX SPLITFILE)))
-;; 	(PUSH (CAR L) RETURN-FORM)))
-;;   (IF RETURN-FORM (CONS 'DECLARE RETURN-FORM) NIL))
-
-;; These are in global, so avoid redefinition warning by using FDEFINE
-;; rather than DEFun.
-
-;;(FDEFINE (kw FLONUM) #'(LAMBDA ( &REST IGNOR)ignor  NIL))
-;;(FDEFINE (kw FIXNUM) #'(LAMBDA (&QUOTE &REST IGNOR)ignor  NIL))
-;;(FDEFINE 'ARGS	 #'(LAMBDA (&QUOTE &REST IGNOR)ignor  NIL))
-
-(defmacro args (&rest ignor)ignor  nil)
-
-#-cl
-(progn
-  (defmacro flonum (&rest ignor)ignor  nil)
-  (defmacro fixnum (&rest ignor)ignor  nil)
-  (defmacro macros	     ( &rest ignor)ignor  nil)
-  (defmacro closed	     ( &rest ignor)ignor  nil)
-  (defmacro notype	     ( &rest ignor)ignor  nil)
-  (defmacro array*	     ( &rest ignor)ignor  nil)
-  (defmacro genprefix     ( &rest ignor)ignor  nil)
-  (defmacro muzzled	     ( &rest ignor)ignor  nil)
-  (defmacro mapex	     ( &rest ignor)ignor  nil)
-  (defmacro splitfile     ( &rest ignor)ignor  nil)
-  (defmacro expr-hash     ( &rest ignor)ignor  nil)
-  )
 ;; Run time stuff
 
 (defun symbolconc (&rest syms)
@@ -121,22 +33,6 @@
 				   (t sym)))
 			 syms))))
 
-;;(DEFUN QUOTED-ARGS (&QUOTE &REST L)
-;;  (MAPCAR #'(LAMBDA (X) (PUTPROP X '((1005 (FEF-ARG-OPT FEF-QT-QT))) 'ARGDESC))
-;;	  L))
-
-
-
-(defmacro quote-args ( &rest l)
-  `(quoted-args-aux ',l))
-(defun quoted-args-aux (l)
-  (mapcar #'(lambda (x) (putprop x '((1005 (fef-arg-opt fef-qt-qt))) 'argdesc))
-	  l))
-
-
-#+cl
-(progn 'compile
-
 ;;; On the 3600, STORE isn't implemented.  So, implement enough of
 ;;; it here to satisfy the cases the Macsyma uses.  I have yet to find
 ;;; it using complicated side effects of the array reference -- it's either
@@ -145,49 +41,40 @@
 ;;; of the first form isn't ARRAYCALL or FUNCALL, then it's a STORE of the third
 ;;; form.
 
-       (defun store-macro-helper (array-ref new-value)
-	 ;;this is redundant and should be caught by store but a bug in compiler..
-	 (cond ((or (eql (car array-ref) 'aref))(equal (car array-ref) '(function aref))
-		`(setf (aref ,@ (cdr array-ref)) ,new-value))
-	       (t
-		(case (length array-ref)
-		  (2 `(store-internal-1d ,@array-ref ,new-value))
-		  (3 `(store-internal-2d ,@array-ref ,new-value))
-		  (otherwise (error "Cannot expand `store' for array reference ~S" array-ref))))))
-
-
+(defun store-macro-helper (array-ref new-value)
+  ;;this is redundant and should be caught by store but a bug in compiler..
+  (cond ((or (eql (car array-ref) 'aref) (equal (car array-ref) '(function aref)))
+	 `(setf (aref ,@(cdr array-ref)) ,new-value))
+	(t
+	 (case (length array-ref)
+	   (2 `(store-internal-1d ,@array-ref ,new-value))
+	   (3 `(store-internal-2d ,@array-ref ,new-value))
+	   (otherwise (error "Cannot expand `store' for array reference ~S" array-ref))))))
 
-       (defmacro store (array-ref new-value &aux expand-1 &environment env)
-	 (cond ((not (memq (car array-ref ) '(aref arraycall)))
-		(setq expand-1 (macroexpand-1 array-ref env))
-		(setq array-ref
-		      (cond ((memq (car expand-1 ) '(aref arraycall))
-			     expand-1)
-			    (t  (macroexpand array-ref env))))))
+(defmacro store (array-ref new-value &aux expand-1 &environment env)
+  (cond ((not (memq (car array-ref ) '(aref arraycall)))
+	 (setq expand-1 (macroexpand-1 array-ref env))
+	 (setq array-ref
+	       (cond ((memq (car expand-1 ) '(aref arraycall))
+		      expand-1)
+		     (t  (macroexpand array-ref env))))))
   
-	 (case (first array-ref)
-	   (funcall (store-macro-helper (cdr array-ref) new-value))
-	   ;;    (ARRAYCALL (STORE-MACRO-HELPER (CDDR ARRAY-REF) NEW-VALUE))
-	   ;;the arrays ought to all be on in the symbol location by now --wfs
-	   (arraycall `(setf ,array-ref ,new-value))
-	   (aref `(setf ,array-ref ,new-value))
-	   (otherwise (store-macro-helper `(#',(first array-ref) . ,(cdr array-ref)) new-value))))
-
-
-       (defun store-internal-1d (array-spec index new-value)
-	 (loop until (arrayp array-spec)
-		do (cond ((symbolp array-spec) (setq array-spec (symbol-array array-spec)))
-			 (t (error "`store' failed -- can't find array for ~S" array-spec))))
-	 (setf (aref array-spec index) new-value))
-
-       (defun store-internal-2d (array-spec i1 i2 new-value)
-	 (loop until (arrayp array-spec)
-		do (cond ((symbolp array-spec) (setq array-spec (symbol-array array-spec)))
-			 (t (error "`store' failed -- can't find array for ~S" array-spec))))
-	 (setf (aref array-spec i1 i2) new-value))
-
-       )				;End PROGN 'COMPILE
-
+  (case (first array-ref)
+    (funcall (store-macro-helper (cdr array-ref) new-value))
+    ;;the arrays ought to all be on in the symbol location by now --wfs
+    (arraycall `(setf ,array-ref ,new-value))
+    (aref `(setf ,array-ref ,new-value))
+    (otherwise (store-macro-helper `(#',(first array-ref) . ,(cdr array-ref)) new-value))))
 
 
+(defun store-internal-1d (array-spec index new-value)
+  (loop until (arrayp array-spec)
+     do (cond ((symbolp array-spec) (setq array-spec (symbol-array array-spec)))
+	      (t (error "`store' failed -- can't find array for ~S" array-spec))))
+  (setf (aref array-spec index) new-value))
 
+(defun store-internal-2d (array-spec i1 i2 new-value)
+  (loop until (arrayp array-spec)
+     do (cond ((symbolp array-spec) (setq array-spec (symbol-array array-spec)))
+	      (t (error "`store' failed -- can't find array for ~S" array-spec))))
+  (setf (aref array-spec i1 i2) new-value))