;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     The data in this file contains enhancments.                    ;;;;;
;;;                                                                    ;;;;;
;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
;;;     All rights reserved                                            ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;       1001 TRANSLATE properties for everyone.                        ;;;
;;;       (c) Copyright 1980 Massachusetts Institute of Technology       ;;;
;;;       Maintained by GJC                                              ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "MAXIMA")
;;; This file handles System FSUBR translation properties that
;;; were not handled in TRANSL. 

(macsyma-module trans1)


(TRANSL-MODULE TRANS1)

;; Also defined in TRANSL;TRANSS
#-CL (DEFVAR $TR_WINDY T)


;;;;;;;; THE FOLLOWING ARE MOSTLY FROM JPG MLISP ;;;;;;;;;;;;;;;;;;;;;
;;;
;;; MMAPEV DOES error checking and a macar of MEVAL down the arguments.
;;; The second arg to MMAPEV is purely for printing of error messages
;;; except for SCANMAP, which is obscure.

(comment

(DEFMFUN MMAPEV (MAPFUN L) 
	 (IF (< (LENGTH L) 2)
	     (MERROR "~:M called with fewer than 2 args" MAPFUN))
	 (LET ((U (GETOPR (MEVAL (CAR L)))))
	      (AUTOLDCHK U)
	      (BADFUNCHK (CAR L) U NIL)
	      (IF (ATOM U)
		  ;; number of argument checking before mapping,
		  ;; some efficiency gain, really, how minor.
		  ;; he should instead do some trampolining and
		  ;; get some real efficiency gains.
		  (MARGCHK U (COND ((EQ MAPFUN '$SCANMAP)
				    (NCONS (CADR L)))
				   (T (CDR L)))))
	      (CONS U (MAPCAR 'MEVAL (CDR L)))))
)

(comment
 (DEFMFUN $APPLY FEXPR (L)
 (TWO-ARG-CHECK L)
 ((LAMBDA (FUN ARG)
   (COND ((NOT ($LISTP ARG))
	  (DISPLA FUN) (DISPLA ARG) (MERROR "Second arg to APPLY must be a list")))
   (AUTOLDCHK (SETQ FUN (GETOPR FUN)))
   (COND ((EQ (GET FUN 'DIMENSION) 'DIMENSION-INFIX) (TWOARGCHK ARG FUN)))
   (MAPPLY FUN (CDR ARG) (CAR L)))
  (MEVAL (CAR L)) (MEVAL (CADR L))))
)

;;; APPLY(F,[X]) is an idiom for funcall.

(DEFUN QUOTED-SYMBOLP (FORM)
  (AND (EQ (ml-typep FORM) 'list)
       (EQ 'QUOTE (CAR FORM))
       (SYMBOLP (CADR FORM))))

(DEF%TR $APPLY (FORM)
	(LET* ((FUN (DTRANSLATE (CADR FORM)))
	       (MODE (COND ((ATOM FUN)
			    (FUNCTION-MODE-@ FUN))
			   ((QUOTED-SYMBOLP FUN)
			    (FUNCTION-MODE (CADR FUN)))
			   ('ELSE
			    '$ANY))))
	      (COND (($LISTP (CADDR FORM))
		     (LET ((ARGS (TR-ARGS (CDR (CADDR FORM)))))
			  (CALL-AND-SIMP MODE
					 'MFUNCALL
					 `(,FUN ,@ARGS))))
		    (T
		     (LET ((ARG (DTRANSLATE (CADDR FORM))))
			  (CALL-AND-SIMP MODE 'MAPPLY-TR
					 `(,FUN ,ARG)))))))

;;; (DEFMFUN $MAP FEXPR (L) (APPLY 'MAP1 (MMAPEV 'MAP L)))

(DEF%TR $MAP (FORM)
	(LET (((FUN . ARGS) (TR-ARGS (CDR FORM))))
	     (CALL-AND-SIMP '$ANY 'MAP1 `((GETOPR ,FUN) . ,ARGS))))

;;; (DEFMFUN $MAPLIST FEXPR (L) 
;;;  ((LAMBDA (MAPLP RES)
;;;   (SETQ RES (APPLY 'MAP1 (MMAPEV 'MAPLIST L)))
;;;   (COND ((ATOM RES) (LIST '(MLIST) RES))
;;;	 ((EQ (CAAR RES) 'MLIST) RES)
;;;	 (T (CONS '(MLIST) (CDR RES)))))
;;;    T NIL))

(DEF%TR $MAPLIST (FORM)
  (LET (((FUN . ARGS) (TR-ARGS (CDR FORM))))
    ;; this statement saves the trouble of adding autoload definitions
    ;; for runtime translator support.
    (PUSH-AUTOLOAD-DEF 'MARRAYREF '(MAPLIST_TR))
    `($ANY . (MAPLIST_TR ,FUN ,@ARGS))))

;;; (DEFMFUN $FULLMAP FEXPR (L)
;;;        (SETQ L (MMAPEV 'FULLMAP L)) (FMAP1 (CAR L) (CDR L) NIL))

(DEF%TR $FULLMAP (FORM)
	(LET (((FUN . ARGS) (TR-ARGS (CDR FORM))))
	     (CALL-AND-SIMP '$ANY 'FMAP1 `((GETOPR ,FUN) (LIST . ,ARGS) NIL))))

;;; (DEFMFUN $MATRIXMAP FEXPR (L)
;;;        ((LAMBDA (FMAPLVL) (APPLY 'FMAPL1 (MMAPEV 'MATRIXMAP L))) 2))

(DEF%TR $MATRIXMAP (FORM)
	(LET (((FUN . ARGS) (TR-ARGS (CDR FORM))))
	     (CALL-AND-SIMP '$ANY `(LAMBDA (FMAPLVL)
					   (FMAPL1 (GETOPR ,FUN) . ,ARGS))
			    '(2))))
		       
;;; (DEFMFUN $FULLMAPL FEXPR (L) (APPLY 'FMAPL1 (MMAPEV 'FULLMAPL L)))

(DEF%TR $FULLMAPL (FORM)
	(LET (((FUN . ARGS) (TR-ARGS (CDR FORM))))
	     (CALL-AND-SIMP '$ANY 'FMAPL1 `((GETOPR ,FUN) . ,ARGS))))

;;;(DEFMFUN $OUTERMAP FEXPR (L)
;;; (APPLY (COND ((= (LENGTH L) 2) 'FMAPL1) (T 'OUTERMAP1)) (MMAPEV 'OUTERMAP L)))

(DEF%TR $OUTERMAP (FORM)
	(LET (((FUN . ARGS) (TR-ARGS (CDR FORM))))
	     (CALL-AND-SIMP '$ANY (COND ((= (LENGTH ARGS) 1) 'FMAPL1)
					(T 'OUTERMAP1))
			    `((GETOPR ,FUN)  ,@ARGS))))


;;;(DEFMFUN $SCANMAP FEXPR (L)
;;; (LET ((SCANMAPP T)) (SSIMPLIFYA (APPLY 'SCANMAP1 (MMAPEV '$SCANMAP L)))))

(DEF%TR $SCANMAP (FORM)
	(PUSH-AUTOLOAD-DEF '$SCANMAP '(SCANMAP1))
	;; there's something more fundamental about the above than
	;; just autoload definitions.
	(LET (((FUN . ARGS) (TR-ARGS (CDR FORM))))
	     (CALL-AND-SIMP '$ANY 'SCANMAP1 `((GETOPR ,FUN) ,@ARGS))))

;;;(DEFMFUN $QPUT FEXPR (L)
;;; (COND ((NOT (= (LENGTH L) 3)) (ERLIST '|Wrong number of args to QPUT|)))
;;; ($PUT (CAR L) (CADR L) (CADDR L)))

(DEF%TR $QPUT (FORM)
	`($ANY $PUT ',(CADR FORM) ',(CADDR FORM) ',(CADDDR FORM)))

;;;(DEFMFUN $SUBVAR FEXPR (L)
;;; (COND ((NULL L) (ERLIST "Wrong number of args to SUBVAR")))
;;; (MEVAL (CONS '(MQAPPLY ARRAY) L)))

(DEF%TR $SUBVAR (FORM)
	(TRANSLATE (CONS '(MQAPPLY ARRAY) (CDR FORM))))

;;; From JPG;COMM >
;;;(DEFMFUN $PART N (PART1 (LISTIFY N) NIL NIL $INFLAG))
;;;
;;;(DEFMFUN $INPART N (PART1 (LISTIFY N) NIL NIL T))
;;;
;;;(DEFMFUN $SUBSTPART FEXPR (L) (PART1 L T NIL $INFLAG))
;;;
;;;(DEFMFUN $SUBSTINPART FEXPR (L) (PART1 L T NIL T))
;;;
;;;(DEFUN PART1 (ARGLIST SUBSTFLAG DISPFLAG INFLAG) ....)

;;; If the evaluation of the first argument does not depend on the
;;; setting of the special variable PIECE, then it need not be 
;;; evaluated inside of PART1. If the PIECE feature is used, then
;;; we must send down an expression to PART1 which when evaluated has
;;; the proper environment for the compiled-away variable names in the
;;; environment of the calling function. 
;;; It is possible to get unbelivebly strange results from the order of
;;; evaluation of the arguments to $SUBSTPART, these crocks shall not
;;; be supported.
;;; The PIECE feature is not as often used as say,
;;; SUBSTPART("*",EXP,0) is.

(DEF%TR $SUBSTPART (FORM)
	(SUBSTPART-TRANSLATION FORM T NIL '$INFLAG))

(DEF%TR $SUBSTINPART (FORM)
	(SUBSTPART-TRANSLATION FORM T NIL T))

(DEFUN FOR-EVAL-THEN-MQUOTE-SIMP-ARGL (L)
;       (MAPCAR #'(LAMBDA (U) ;;; consing not important here.
;			 `(LIST '(MQUOTE SIMP) ,U))
;	       L)
; JONL broke the fucking compiler. So I re-write this as=>
       (PROG (V)
	     LOOP
	     (IF (NULL L) (RETURN (NREVERSE V)))
	     (PUSH `(LIST '(MQUOTE SIMP) ,(POP L)) V)
	     (GO LOOP)))

(DEFUN  SUBSTPART-TRANSLATION (FORM FLAG1 FLAG2 FLAG3)
	(LET* ((SUBST-ITEM (DTRANSLATE (CADR FORM)))
	       (FREEVARS (FREE-LISP-VARS SUBST-ITEM))
	       (ARGL (TR-ARGS (CDDR FORM))))
	      (COND ((NULL (ASSQ '$PIECE FREEVARS))
		     ; this code is just to screw the people who
		     ; would use $PIECE non lexicaly. Not really, the
                     ; closure hacking is a lot slower at run time than
		     ; this easy case, so no sense screwing the people who
		     ; don't use $PIECE in foolish ways.
		     `($ANY . (SIMPLIFY
			       (PART1
				(LIST  ,@(FOR-EVAL-THEN-MQUOTE-SIMP-ARGL
					  (CONS SUBST-ITEM ARGL)))

			       ,FLAG1 ,FLAG2 ,FLAG3))))
		    (T
		     (SETQ FREEVARS (TBOUND-FREE-VARS FREEVARS))
		     (SIDE-EFFECT-FREE-CHECK (CADR FREEVARS) (CADR FORM))
		     `($ANY . (SIMPLIFY
			       (PART1 (LIST (FUNGEN&ENV-FOR-MEVAL
					     ,(zl-DELETE '$PIECE (CAR FREEVARS))
					     ($PIECE) ,SUBST-ITEM)
					    ,@(FOR-EVAL-THEN-MQUOTE-SIMP-ARGL ARGL))
				      ,FLAG1 ,FLAG2 ,FLAG3)))))))




;;; From JPG;SUPRV >
(comment
(DEFMFUN $ERRCATCH FEXPR (X)
       ((LAMBDA (ERRCATCH RET)
		(COND ((NULL (SETQ RET
				   (ERRSET (APPLY 'MPROGN X)
					   LISPERRPRINT)))
		       (ERRLFUN1 ERRCATCH)))
		(CONS '(MLIST) RET))
	(CONS BINDLIST LOCLIST) NIL)))

;;; This is could be done better on the LISPM

(DEF%TR $ERRCATCH (FORM)
	(SETQ FORM (TRANSLATE `((MPROGN) ,@(CDR FORM))))
	`(,(CAR FORM) . ((LAMBDA (ERRCATCH RET) ;;; ERRCATCH SPECIAL IN TINCLU >
				 (COND ((NULL (SETQ RET
						    (ERRSET ,(CDR FORM)
							    LISPERRPRINT)))
					(ERRLFUN1 ERRCATCH)))
				 (CONS '(MLIST) RET))
			 (CONS BINDLIST LOCLIST) NIL)))


(COMMENT 
 (DEFMFUN $CATCH FEXPR (X)
	((LAMBDA (MCATCH)
		 (PROG2 NIL (CATCH 'MCATCH (APPLY 'MPROGN X))
			(ERRLFUN1 MCATCH)))
  (CONS BINDLIST LOCLIST))))

;;; The MODE of a CATCH could either be the MODE of the last of the PROGN
;;; or the mode of the THROW. The THROW may be hard to find, so this goes
;;; on the assumption that the mode of the PROGN is enough to tell.

(DEF%TR $CATCH (FORM)
	(LET (((MODE . BODY) (TRANSLATE `((MPROGN) . ,(CDR FORM)))))
	     `(,MODE . ((LAMBDA ()
				((LAMBDA (MCATCH)
					 (PROG2 NIL
						(CATCH
						 'MCATCH ,BODY)
						(ERRLFUN1 MCATCH)))
				 (CONS BINDLIST LOCLIST)))))))
(COMMENT
 (DEFMFUN $THROW (X)
 (COND ((NULL MCATCH) (DISPLA X) (ERLIST '|THROW not within CATCH|)))
 (THROW 'MCATCH X)))

(DEF%TR $THROW (FORM)
	(LET (((MODE . EXP) (TRANSLATE (CADR FORM))))
	     `(,MODE . ((LAMBDA (X)
				(COND ((NULL MCATCH)
				       (DISPLA X)
				       (*MERROR '|THROW not within CATCH|)))
				(THROW 'MCATCH X))
			,EXP))))

;;; From RZ;ASUM >. He should know better.
(comment 
 (DEFMFUN $sum fexpr (l)
    (cond ((not (= (length l) 4))
	   (erlist '|Wrong no. of args to SUM|))
	  ((dosum (car l) (cadr l) (meval (caddr l)) (meval (cadddr l)) t)
	   ))))

;;; From RZ;COMBIN >
(comment
 (DEFMFUN $product fexpr (l)
    (cond ((not (= (length l) 4)) (erlist '|Wrong no. of args to product|))
	  ((dosum (car l) (cadr l)   (meval (caddr l)) (meval (cadddr l)) nil)))))
;;; "dosum" will call MEVAL and act like a special form if it can.
;;; MEVAL will work on LISP expression, so we can translate those args.

(DEFUN START-VAL (SUMP MODE)
       (CASE MODE
	      (($FLOAT)
	       (IF SUMP 0.0 1.0))
	      (T
	       (IF SUMP 0 1))))

(DEF%TR $SUM (FORM)
	(LET (((|0| N) (MAPCAR #'TRANSLATE (CDDDR FORM)))
	      (FLAG (EQ (CAAR FORM) '$SUM))
	      (VAR (CADDR FORM))
	      (SUM (GENSYM)))
	     (COND ((AND (EQ (CAR |0|) '$FIXNUM)
			 (EQ (CAR N) '$FIXNUM))
		    (LET ((SUM-EXP
			   (TR-LOCAL-EXP `((,(COND (FLAG 'MPLUS)
						   (T 'MTIMES)))
					   ,SUM ,(CADR FORM))
					 SUM '$FIXNUM
					 VAR '$FIXNUM)))
			 ;; here is the bummer. We need to know the
			 ;; mode of SUM before we know the mode of the
			 ;; SUM-EXP, but that tells us something about
			 ;; the mode of the SUM.
			 ;; When the mode is float we really need to know
			 ;; because of the initialization of the SUM, which
			 ;; must be correct if COMPLR is to win on things
			 ;; like (*$ (DO ...) ...)
			 (IF (EQ (CAR SUM-EXP) '$FLOAT)
			     (SETQ SUM-EXP
				   (TR-LOCAL-EXP
				    `((,(COND (FLAG 'MPLUS)
					      (T 'MTIMES)))
				      ,SUM ,(CADR FORM))
				    SUM '$FLOAT
				    VAR '$FIXNUM)))
			 ;; hey if this changes Modes on us, forget it man,
			 ;; geezz. lets not bother checking, and just
			 ;; catch this bad-boy in the COMPLR.
			 ;; What do we say to the user anyway about such
			 ;; crazzyness?

			 `(,(CAR SUM-EXP)
			   . ((LAMBDA (|0| N)
				      ;; should be gensyms. WHY does GJC
				      ;; lose like this?
				      (COND ((NOT (< N |0|))
					     (DO ((,VAR |0| (f1+ ,VAR))
						  (,SUM ,(START-VAL
							  FLAG
							  (CAR SUM-EXP))
							,(CDR SUM-EXP)))
						 ((< N ,VAR) ,SUM)
						 ))
					    ((= N (f1- |0|))
					     ,(START-VAL FLAG (CAR SUM-EXP)))
					    (T
					     (INTERVAL-ERROR ',(caar form) |0| N))))
			      ,(CDR |0|)
			      ,(CDR N)))))
		   (T
		    (LET* ((SUMARG (CDR (TR-LOCAL-EXP (CADR FORM) (CADDR FORM)
						      '$ANY)))
			   (VAR (CADDR FORM))
			   (FREE-VAR-INFO (TBOUND-FREE-VARS (FREE-LISP-VARS SUMARG))))
			  (SIDE-EFFECT-FREE-CHECK (CADR FREE-VAR-INFO)
						  (CADR FORM))
			  `($ANY . (DOSUM (FUNGEN&ENV-FOR-MEVALSUMARG
					   ,(zl-DELETE VAR (CAR FREE-VAR-INFO))
					   (,VAR)
					   ,SUMARG
					   ;; the original form is here for when we
					   ;; get mevalsumarged, otherwise we use
					   ;; the translated SUMARG when we get
					   ;; MEVAL'ed.
					   ,(CADR FORM))
					  ',VAR ,(CDR |0|) ,(CDR N) ,FLAG)))))))


(DEF%TR-INHERIT $SUM $PRODUCT)



;;; Makelist is a very sorry FSUBR. All these FSUBRS are just to avoid
;;; writing LAMBDA. But lots of users use MAKELIST now. 
;;; MAKELIST(EXP,X,0,N) with 4 args it is an iteration, with three it
;;; is a mapping over a list (the third argument).

(DEF%TR $MAKELIST (FORM)
	(SETQ FORM (CDR FORM))
	(COND ((= (LENGTH FORM) 3)
	       (LET  (((EXP X LLIST) FORM)
		      (SUM (GENSYM))
		      (LIL (GENSYM)))
		     `($ANY . (DO ((,LIL (CDR ,(DTRANSLATE LLIST)) (CDR ,LIL))
				   (,SUM NIL)
				   (,X))
				  ((NULL ,LIL)
				   `((MLIST) ,@(NREVERSE ,SUM)))
				  (SETQ ,X (CAR ,LIL)
					,SUM (CONS ,(CDR (TR-LOCAL-EXP EXP
								       X
								       (VALUE-MODE X)))
						   ,SUM))))))
	      ((= (LENGTH FORM) 4)
	       (LET (((EXP X |0| N) FORM)
		     (|00| (GENSYM))
		     (NN (GENSYM))
		     (SUM (GENSYM)))
		    (SETQ |0| (DTRANSLATE |0|) ; I had forgotten this before!
			  N (DTRANSLATE N))  ; never noticed.
		    `($ANY . ((LAMBDA (,|00| ,NN)
				      ; bogus -gjc
				      ;(DECLARE (FIXNUM ,|00| ,NN))
				      (COND ((NOT (< ,NN ,|00|))
					     (DO ((,X ,|00| (f1+ ,X))
						  (,SUM
						   NIL
						   (CONS
						    ,(CDR (TR-LOCAL-EXP EXP
									X
									'$FIXNUM))

						    ,SUM)))
						 ((> ,X ,NN)
						  `((MLIST) ,@(NREVERSE ,SUM)))
						 (DECLARE (FIXNUM ,X))))
					     (T
					      (INTERVAL-ERROR
					       '$MAKELIST ,|00| ,NN))))
			      ,|0| ,N))))
	      (T
	       (MFORMAT *TRANSLATION-MSGS-FILES*
			"Wrong number of args to MAKELIST")
	       (SETQ TR-ABORT T)
	       '($ANY . '$**ERROR**))))

(comment
 |jpg;suprv >|
 (DEFMFUN $KILL FEXPR (L) (MAPC 'KILL1 L) #+GC (GCTWA) '$DONE))

(DEF%TR $KILL (FORM)
	(COND ($TR_WINDY
	       (TR-TELL "
Warning:" FORM
"Use of KILL in translated program is not recommended. See GJC for
a replacement form. Translating anyway though.")))
	`($ANY . (APPLY '$KILL ',(CDR FORM))))

;;; Macsyma arrays are the biggest crock since STATUS PUNT NIL days.
;;; The basic idea of ARRAY(<frob>,type,dims...) is that
;;; if type is of
;;;(ASSQ (CADR X) '(($COMPLETE . T) ($INTEGER . FIXNUM) ($FIXNUM . FIXNUM)
;;;			  ($FLOAT . FLONUM) ($FLONUM . FLONUM)))
;;; then the dims are evaluated. But, if type is not one of those,
;;; it "must" be a dim spec! Of course, I must make this "analysis"
;;; at translate time, in order to preserve referential transparency
;;; in compiled code.

(DEF%TR $ARRAY (FORM)
	(SETQ FORM (CDR FORM))
	(LET ((NAME (CAR FORM))
	      (SPECP (ASSQ (CADR FORM)
			   '(($COMPLETE . T) ($INTEGER . FIXNUM) ($FIXNUM . FIXNUM)
					     ($FLOAT . FLONUM) ($FLONUM . FLONUM)))))
	     (COND (SPECP
		    `($ANY . (APPLY '$ARRAY (LIST ',NAME
						  ',(CADR FORM)
						  ,@(TR-ARGS (CDDR FORM))))))
		   (T
		    `($ANY . (APPLY '$ARRAY (LIST ',NAME
						  ,@(TR-ARGS (CDR FORM)))))))))


(comment
(DEFMFUN $DEFINE FEXPR (L)
 (COND ((OR (NULL L) (NULL (CDR L)) (CDDR L))
	(ERLIST '|Wrong number of args to DEFINE|)))
 (APPLY 'MDEFINE
	(LIST (COND ((MQUOTEP (CAR L)) (CADAR L)) (T (DISP2 (CAR L)))) (MEVAL (CADR L))))))

;;; MDEFINE is an FSUBR also.

(DEF%TR $DEFINE (FORM)
	(LET (((HEADER BODY) (CDR FORM)))
	     `($ANY . (APPLY 'MDEFINE
			     (LIST ',(COND ((MQUOTEP HEADER) (CADR HEADER))
					   (T (DISP2 HEADER)))
				   ,(DTRANSLATE BODY))))))


;;; it seems TRANSL has all sorts of code for hacking some kind of
;;; $CRE mode. somehow there is no translate property for MRAT. who
;;; knows. anyway here is something in the mean time before this
;;; I have time to do up TRANSL correctly.
;;;(DEFUN MRATEVAL (X)
;;; ((LAMBDA (VARLIST)
;;;   (COND (EVP (MEVAL ($RATDISREP X)))
;;;	 ((OR (AND $FLOAT $KEEPFLOAT) (NOT (ALIKE VARLIST (MAPCAR 'MEVAL VARLIST))))
;;;	  (RATF (MEVAL ($RATDISREP X))))
;;;	 (T X)))
;;;  (CADDAR X)))
;;; EVP is a hack for $EV I think. The MEVAL down the varlist is to see if the
;;; variables have any values, if not, then the result of (ratf (meval ($ratdisrep)))
;;; will be alike to what you started with, so it is an efficiency hack! What a
;;; joke!
;;;(DEFPROP MRAT (LAMBDA (X) (MRATEVAL X)) MFEXPR*)

(def%tr mrat (form)
	(let ((t-form (translate ($ratdisrep form))))
	     (cond ((memq (car t-form) '($float $fixnum $number)) t-form)
		   (t `($ANY . (RATF ,(CDR T-FORM)))))))


;;; The following special forms do not call the evaluator.







(DEF%TR $batcon (FORM)
  `($ANY . (MEVAL ',FORM)))  
;;most of these will lose in common since a local variable will not
;;have its value accessible to the mfexpr*.  They should
;;be redone as macros with any necessary info passed along.

(DEF%TR $REMARRAY           $batcon)
(DEF%TR $REARRAY $batcon)
(DEF%TR $ALIAS $batcon)
(DEF%TR $ALLOC $batcon)
(DEF%TR $BATCH $batcon)
(DEF%TR $BATCHLOAD          $batcon)
;(DEF%TR $BATCON $batcon)
(DEF%TR $CLOSEFILE $batcon)
(DEF%TR $COMPFILE           $batcon)
(DEF%TR $DELFILE $batcon)
(DEF%TR $DEMO $batcon)
(DEF%TR $DEPENDENCIES $batcon)
(DEF%TR $DESCRIBE           $batcon)
(DEF%TR $DISKFREE $batcon)
(DEF%TR $DISKUSE $batcon)
(DEF%TR $DISPFUN $batcon)
(DEF%TR $DISPRULE $batcon)
(DEF%TR $FILELENGTH $batcon)
(DEF%TR $FILELIST $batcon)
(DEF%TR $FUNDEF $batcon)
(DEF%TR $FULLDISKUSE $batcon)
(DEF%TR $GRADEF $batcon)
(DEF%TR $LISTFILES $batcon)
(DEF%TR $LOADFILE $batcon)
(DEF%TR $LOADARRAYS         $batcon)
(DEF%TR $LOADPLOTS $batcon)
(DEF%TR $MAKEATOMIC $batcon)
(DEF%TR $NAMEFILE $batcon)
(DEF%TR $NUMERVAL           $batcon)
(DEF%TR $OPTIONS $batcon)
(DEF%TR $ORDERGREAT $batcon)
(DEF%TR $ORDERLESS $batcon)
(DEF%TR $PLOTMODE $batcon)
(DEF%TR $PRIMER $batcon)
(DEF%TR $PRINTDISKUSE $batcon)
(DEF%TR $PRINTFILE $batcon)
(DEF%TR $PRINTPROPS $batcon)
(DEF%TR $PROPERTIES $batcon)
(DEF%TR $PROPVARS $batcon)
(DEF%TR $QLISTFILES $batcon)
(DEF%TR $REMFILE            $batcon)
(DEF%TR $REMFUNCTION $batcon)
(DEF%TR $REMOVE $batcon)
(DEF%TR $REMVALUE           $batcon)
(DEF%TR $RENAMEFILE $batcon)
(DEF%TR $RESTORE $batcon)
(DEF%TR $TRANSLATE          $batcon)
(DEF%TR $WRITEFILE $batcon)
(DEF%TR $HARDCOPY $batcon)
(DEF%TR $LABELS $batcon)
(DEF%TR $SETUP_AUTOLOAD $batcon)
(DEF%TR $TOBREAK $batcon  )


;; Local Modes:
;; Mode: LISP
;; Comment Col: 40
;; END: