archive/share/lisp/lrats.lisp

   1 ;;; -*- Mode: Lisp; Package: Macsyma -*-
   2 ;;; Translated code for LMIVAX::MAX$DISK:[SHARE2]LRATS.MC;1
   3 ;;; Written on 9/15/1984 22:43:46, from MACSYMA 302
   4 ;;; Translated for LPH
   5
   6 ;;; TRANSL-AUTOLOAD version NIL
   7 ;;; TRANSS version 87 TRANSL version 1157 TRUTIL version 27
   8 ;;; TRANS1 version 108 TRANS2 version 39 TRANS3 version 50
   9 ;;; TRANS4 version 29 TRANS5 version 26 TRANSF version NIL
  10 ;;; TROPER version 15 TRPRED version 6 MTAGS version NIL
  11 ;;; MDEFUN version 58 TRANSQ version 88 FCALL version 40
  12 ;;; ACALL version 70 TRDATA version 68 MCOMPI version 146
  13 ;;; TRMODE version 73 TRHOOK version NIL
  14 (eval-when (compile eval)
  15       (setq *infile-name-key*
  16                   (namestring (truename '#.standard-input))))
  17
  18 (eval-when (compile)
  19    (setq $tr_semicompile 'NIL)
  20    (setq forms-to-compile-queue ()))
  21
  22 (comment "MAX$DISK:[SHARE2]LRATS.MC;1")
  23
  24 ;;; General declarations required for translated MACSYMA code.
  25
  26 (DECLARE
  27   (SPECIAL $DUM $PIECE $INFLAG $PARTSWITCH $FULLRATSUBSTFLAG $MESSLRATS2))
  28
  29 (DECLARE (SPECIAL $MESSLRATS2))
  30
  31 (DECLARE (SPECIAL $FULLRATSUBSTFLAG))
  32
  33 (DEFMTRFUN-EXTERNAL ($LRATSUBST $ANY MDEFINE NIL NIL))
  34
  35 (DEF-MTRVAR $DUM '$DUM 1)
  36
  37 (DEFMTRFUN-EXTERNAL ($LRATSUBST1 $ANY MDEFINE NIL NIL))
  38
  39 (DEFMTRFUN-EXTERNAL ($FULLRATSUBST1 $ANY MDEFINE NIL NIL))
  40
  41 (DEFMTRFUN-EXTERNAL ($FULLRATSUBST $ANY MDEFINE T NIL))
  42
  43
  44 (SIMPLIFY (MFUNCTION-CALL $PUT '$LRATS 3 '$DIAGEVAL_VERSION))
  45
  46 (MEVAL* '(($MODEDECLARE) $MESSLRATS2 $ANY))
  47
  48 (MEVAL* '(($DECLARE) $MESSLRATS2 $SPECIAL))
  49
  50 (DEF-MTRVAR $MESSLRATS2 '|&Invalid argument to FULLRATSUBST:|)
  51
  52 (MEVAL* '(($MODEDECLARE) $FULLRATSUBSTFLAG $BOOLEAN))
  53
  54 (MEVAL* '(($DECLARE) $FULLRATSUBSTFLAG $SPECIAL))
  55
  56 (DEFPROP $FULLRATSUBSTFLAG ASSIGN-MODE-CHECK ASSIGN)
  57
  58 (DEF-MTRVAR $FULLRATSUBSTFLAG NIL)
  59
  60 (DEFPROP $LRATSUBST T TRANSLATED)
  61
  62 (ADD2LNC '$LRATSUBST $PROPS)
  63
  64 (DEFMTRFUN
  65  ($LRATSUBST $ANY MDEFINE NIL NIL) ($LISTOFEQNS $EXP) NIL
  66  ((LAMBDA ($PARTSWITCH $INFLAG $PIECE)
  67     NIL
  68     (COND
  69       ((NOT (MFUNCTION-CALL $LISTP $LISTOFEQNS))
  70          (COND
  71            ((LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $LISTOFEQNS 0)) '&=)
  72               (SETQ $LISTOFEQNS (LIST '(MLIST) $LISTOFEQNS)))
  73            ((LIKE (TRD-MSYMEVAL $FULLRATSUBSTFLAG NIL) T)
  74               (SIMPLIFY (MFUNCTION-CALL
  75                           $ERROR (TRD-MSYMEVAL $MESSLRATS2 '$MESSLRATS2)
  76                           (LIST '(MLIST) $LISTOFEQNS $EXP))))
  77            (T (SIMPLIFY
  78                 (MFUNCTION-CALL $ERROR '|&Invalid argument to LRATSUBST:|
  79                                 (LIST '(MLIST) $LISTOFEQNS $EXP)))))))
  80     (DO (($IDUM) (MDO (CDR $LISTOFEQNS) (CDR MDO))) ((NULL MDO) '$DONE)
  81       (SETQ $IDUM (CAR MDO))
  82       (COND
  83         ((NOT (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $IDUM 0)) '&=))
  84            (COND
  85              ((LIKE (TRD-MSYMEVAL $FULLRATSUBSTFLAG NIL) T)
  86                 (SIMPLIFY (MFUNCTION-CALL
  87                             $ERROR (TRD-MSYMEVAL $MESSLRATS2 '$MESSLRATS2)
  88                             (LIST '(MLIST) $LISTOFEQNS $EXP))))
  89              (T (SIMPLIFY
  90                   (MFUNCTION-CALL $ERROR '|&Invalid argument to LRATSUBST:|
  91                                   (LIST '(MLIST) $LISTOFEQNS $EXP))))))))
  92     (SIMPLIFY (MFUNCTION-CALL $LRATSUBST1 $LISTOFEQNS $EXP)))
  93   T T '$PIECE))
  94
  95 (DEFPROP $LRATSUBST1 T TRANSLATED)
  96
  97 (ADD2LNC '$LRATSUBST1 $PROPS)
  98
  99 (DEFMTRFUN
 100   ($LRATSUBST1 $ANY MDEFINE NIL NIL) ($LISTOFEQNS $EXP) NIL
 101   ((LAMBDA ($DUM)
 102      NIL
 103      NIL
 104      (COND
 105        ((AND (LIKE (TRD-MSYMEVAL $FULLRATSUBSTFLAG NIL) T)
 106              (NOT (LIKE (TRD-MSYMEVAL $DUM '$DUM) $EXP)))
 107           (SIMPLIFY (MFUNCTION-CALL
 108                       $LRATSUBST1 $LISTOFEQNS (TRD-MSYMEVAL $DUM '$DUM))))
 109        ((NOT (LIKE (TRD-MSYMEVAL $DUM '$DUM) $EXP))
 110           (TRD-MSYMEVAL $DUM '$DUM))
 111        (T $EXP)))
 112    (COND
 113      ((LIKE $LISTOFEQNS '((MLIST))) $EXP)
 114      ((LIKE (SIMPLIFY (MFUNCTION-CALL $REST $LISTOFEQNS)) '((MLIST)))
 115         (SIMPLIFY
 116           (MFUNCTION-CALL
 117             $RATSUBST (SIMPLIFY (MFUNCTION-CALL $INPART $LISTOFEQNS 1 2))
 118             (SIMPLIFY (MFUNCTION-CALL $INPART $LISTOFEQNS 1 1)) $EXP)))
 119      (T
 120        (SIMPLIFY
 121          (MFUNCTION-CALL
 122            $LRATSUBST1 (SIMPLIFY (MFUNCTION-CALL $REST $LISTOFEQNS))
 123            (COND ((LIKE (TRD-MSYMEVAL $FULLRATSUBSTFLAG NIL) T)
 124                     (SIMPLIFY
 125                       (MFUNCTION-CALL
 126                         $FULLRATSUBST1
 127                         (SIMPLIFY (MFUNCTION-CALL $INPART $LISTOFEQNS 1 2))
 128                         (SIMPLIFY (MFUNCTION-CALL $INPART $LISTOFEQNS 1 1))
 129                         $EXP)))
 130                  (T (SIMPLIFY
 131                       (MFUNCTION-CALL
 132                         $RATSUBST
 133                         (SIMPLIFY (MFUNCTION-CALL $INPART $LISTOFEQNS 1 2))
 134                         (SIMPLIFY (MFUNCTION-CALL $INPART $LISTOFEQNS 1 1))
 135                         $EXP))))))))))
 136
 137 (DEFPROP $FULLRATSUBST1 T TRANSLATED)
 138
 139 (ADD2LNC '$FULLRATSUBST1 $PROPS)
 140
 141 (DEFMTRFUN
 142   ($FULLRATSUBST1 $ANY MDEFINE NIL NIL) ($SUBSTEXP $FOREXP $EXP) NIL
 143   ((LAMBDA ($DUM)
 144      NIL
 145      (COND ((LIKE $DUM $EXP) $EXP)
 146            (T (SIMPLIFY
 147                 (MFUNCTION-CALL $FULLRATSUBST1 $SUBSTEXP $FOREXP $DUM)))))
 148    (SIMPLIFY (MFUNCTION-CALL $RATSUBST $SUBSTEXP $FOREXP $EXP))))
 149
 150 (DEFPROP $FULLRATSUBST T TRANSLATED)
 151
 152 (ADD2LNC '$FULLRATSUBST $PROPS)
 153
 154 (DEFMTRFUN
 155  ($FULLRATSUBST $ANY MDEFINE T NIL) ($ARGLIST) NIL
 156  ((LAMBDA
 157      ($FULLRATSUBSTFLAG $LARGLISTDUM $FARGLIST $PARTSWITCH $INFLAG $PIECE)
 158     NIL
 159     (ASSIGN-MODE-CHECK '$FULLRATSUBSTFLAG $FULLRATSUBSTFLAG)
 160     (COND
 161       ((LIKE $LARGLISTDUM 2)
 162          (COND
 163            ((OR (MFUNCTION-CALL
 164                   $LISTP (SETQ $FARGLIST (SIMPLIFY ($FIRST $ARGLIST))))
 165                 (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $FARGLIST 0)) '&=))
 166               (SIMPLIFY (MFUNCTION-CALL
 167                           $LRATSUBST $FARGLIST
 168                           (SIMPLIFY (MFUNCTION-CALL $LAST $ARGLIST)))))
 169            (T (SIMPLIFY (MFUNCTION-CALL
 170                           $ERROR (TRD-MSYMEVAL $MESSLRATS2 '$MESSLRATS2)
 171                           $ARGLIST)))))
 172       ((LIKE $LARGLISTDUM 3)
 173          (SIMPLIFY (MAPPLY-TR '$FULLRATSUBST1 $ARGLIST)))
 174       (T (SIMPLIFY
 175            (MFUNCTION-CALL
 176              $ERROR (TRD-MSYMEVAL $MESSLRATS2 '$MESSLRATS2) $ARGLIST)))))
 177   T (MFUNCTION-CALL $LENGTH $ARGLIST) '$FARGLIST T T '$PIECE))
 178
 179 (compile-forms-to-compile-queue)
 180