archive/share/lisp/determ.lisp

   1 ;;; -*- Mode: Lisp; Package: Macsyma -*-
   2 ;;; Translated code for LMIVAX::MAX$DISK:[SHARE1]DETERM.MC;10
   3 ;;; Written on 9/24/1984 02:26:22, 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:[SHARE1]DETERM.MC;10")
  23
  24 ;;; General declarations required for translated MACSYMA code.
  25
  26 (DECLARE (SPECIAL $TAKEGCD))
  27
  28 (DEFMTRFUN-EXTERNAL ($DET $ANY MDEFINE NIL NIL))
  29
  30
  31 (SIMPLIFY (MFUNCTION-CALL $LOAD '|functs|))
  32
  33 (DEFPROP $DET T TRANSLATED)
  34
  35 (ADD2LNC '$DET $PROPS)
  36
  37 (DEFMTRFUN
  38  ($DET $ANY MDEFINE NIL NIL) ($M) NIL
  39  ((LAMBDA ($N $A)
  40    NIL
  41    (SETQ $N (MFUNCTION-CALL $LENGTH $M))
  42    (COND
  43      ((IS-BOOLE-CHECK (MLSP $N 2))
  44         (SIMPLIFY (MFUNCTION-CALL $ERROR '|&Improper argument:| $M))))
  45    (SETQ $A (SIMPLIFY (MFUNCTION-CALL GENSYM)))
  46    (SIMPLIFY (MFUNCALL '$ARRAY $A $N $N))
  47    (DO (($I 1 (+ 1 $I))) ((IS-BOOLE-CHECK (MGRP $I $N)) '$DONE)
  48      (DO (($J 1 (+ 1 $J))) ((IS-BOOLE-CHECK (MGRP $J $N)) '$DONE)
  49        (SIMPLIFY
  50          (MFUNCTION-CALL
  51            MSET
  52            (SIMPLIFY
  53              (MFUNCTION-CALL $ARRAYAPPLY $A (LIST '(MLIST) $I $J)))
  54            (MARRAYREF $M $I $J)))))
  55    (SIMPLIFY
  56      (MFUNCTION-CALL
  57        MSET
  58        (SIMPLIFY (MFUNCTION-CALL $ARRAYAPPLY $A (LIST '(MLIST) 0 0))) 1))
  59    ((LAMBDA ()
  60      ((LAMBDA (MCATCH)
  61        (PROG2
  62         NIL
  63         (*CATCH
  64           'MCATCH
  65           (PROGN
  66             (DO (($K 2 (+ 2 $K)))
  67                 ((IS-BOOLE-CHECK (MGRP $K $N)) '$DONE)
  68               (COND
  69                 ((NOT (LIKE $K $N))
  70                   ((LAMBDA ($C0 $L1 $L2 $U)
  71                      NIL
  72                      (PROG ()
  73                         (SETQ
  74                           $L1
  75                           (COND
  76                             ((NOT
  77                                (LIKE (MARRAYREF $A (+ $K -1) (+ $K -1))
  78                                      0))
  79                                NIL)
  80                             (T
  81                               (DO (($S $K (+ 1 $S)))
  82                                   ((IS-BOOLE-CHECK (MGRP $S $N)) '$DONE)
  83                                 (COND
  84                                   ((NOT
  85                                      (LIKE (MARRAYREF $A $S (+ $K -1))
  86                                            0))
  87                                      (DO (($J 1 (+ 1 $J)))
  88                                          ((IS-BOOLE-CHECK (MGRP $J $N))
  89                                             '$DONE)
  90                                        ((LAMBDA ($T)
  91                                           NIL
  92                                           (SETQ
  93                                             $T
  94                                             (MARRAYREF $A (+ $K -1) $J))
  95                                           (MARRAYSET (MARRAYREF $A $S $J)
  96                                                      $A (+ $K -1) $J)
  97                                           (MARRAYSET $T $A $S $J))
  98                                         '$T))
  99                                      (RETURN NIL))
 100                                   ((LIKE $S $N)
 101                                      ((LAMBDA (X)
 102                                         (COND
 103                                           ((NULL MCATCH)
 104                                              (DISPLA X)
 105                                              (*MERROR
 106                                                '|THROW not within CATCH|)))
 107                                         (*THROW 'MCATCH X))
 108                                       0)))))))
 109                         (SETQ
 110                           $L2
 111                           (COND
 112                             ((IS-BOOLE-CHECK $L1) T)
 113                             (T
 114                               (DO (($T $K (+ 1 $T)))
 115                                   ((IS-BOOLE-CHECK (MGRP $T $N)) '$DONE)
 116                                 (SETQ
 117                                   $C0
 118                                   (SIMPLIFY
 119                                     (MFUNCTION-CALL
 120                                       $DETERMINANT
 121                                       (SIMPLIFY
 122                                         (LIST
 123                                           '($MATRIX)
 124                                           (LIST
 125                                             '(MLIST)
 126                                             (MARRAYREF $A (+ $K -1)
 127                                                        (+ $K -1))
 128                                             (MARRAYREF $A (+ $K -1) $K))
 129                                           (LIST
 130                                             '(MLIST)
 131                                             (MARRAYREF $A $T (+ $K -1))
 132                                             (MARRAYREF $A $T $K)))))))
 133                                 (COND
 134                                   ((NOT (LIKE $C0 0))
 135                                      (SETQ $U $T) (RETURN NIL))
 136                                   ((LIKE $T $N)
 137                                      ((LAMBDA (X)
 138                                         (COND
 139                                           ((NULL MCATCH)
 140                                              (DISPLA X)
 141                                              (*MERROR
 142                                                '|THROW not within CATCH|)))
 143                                         (*THROW 'MCATCH X))
 144                                       0)))))))
 145                         (RETURN
 146                           (COND
 147                             ((IS-BOOLE-CHECK $L2) (RETURN T))
 148                             (T
 149                               (SETQ
 150                                 $C0
 151                                 (SIMPLIFY ($GCDIVIDE
 152                                             $C0
 153                                             (MARRAYREF
 154                                               $A (+ $K -2) (+ $K -2)))))
 155                               (COND
 156                                 ((NOT (LIKE $U $K))
 157                                    (DO (($J 1 (+ 1 $J)))
 158                                        ((IS-BOOLE-CHECK (MGRP $J $N))
 159                                           '$DONE)
 160                                      ((LAMBDA ($T)
 161                                         NIL
 162                                         (SETQ $T (MARRAYREF $A $K $J))
 163                                         (MARRAYSET (MARRAYREF $A $T $J)
 164                                                    $A $K $J)
 165                                         (MARRAYSET $T $A $T $J))
 166                                       '$T))))
 167                               (DO (($I (+ $K 1) (+ 1 $I)))
 168                                   ((IS-BOOLE-CHECK (MGRP $I $N)) '$DONE)
 169                                 ((LAMBDA ($C1 $C2)
 170                                    NIL
 171                                    (SETQ
 172                                      $C1
 173                                      (SIMPLIFY
 174                                        ($GCDIVIDE
 175                                          (*MMINUS
 176                                            (SIMPLIFY
 177                                              (MFUNCTION-CALL
 178                                                $DETERMINANT
 179                                                (SIMPLIFY
 180                                                  (LIST
 181                                                    '($MATRIX)
 182                                                    (LIST '(MLIST)
 183                                                          (MARRAYREF
 184                                                            $A (+ $K -1)
 185                                                            (+ $K -1))
 186                                                          (MARRAYREF
 187                                                            $A (+ $K -1)
 188                                                            $K))
 189                                                    (LIST
 190                                                      '(MLIST)
 191                                                      (MARRAYREF $A $I
 192                                                                 (+ $K -1))
 193                                                      (MARRAYREF $A $I
 194                                                                 $K)))))))
 195                                          (MARRAYREF $A (+ $K -2)
 196                                                     (+ $K -2)))))
 197                                    (SETQ
 198                                      $C2
 199                                      (SIMPLIFY
 200                                        ($GCDIVIDE
 201                                          (SIMPLIFY
 202                                            (MFUNCTION-CALL
 203                                              $DETERMINANT
 204                                              (SIMPLIFY
 205                                                (LIST
 206                                                  '($MATRIX)
 207                                                  (LIST
 208                                                    '(MLIST)
 209                                                    (MARRAYREF $A $K
 210                                                               (+ $K -1))
 211                                                    (MARRAYREF $A $K $K))
 212                                                  (LIST
 213                                                    '(MLIST)
 214                                                    (MARRAYREF $A $I
 215                                                               (+ $K -1))
 216                                                    (MARRAYREF
 217                                                      $A $I $K))))))
 218                                          (MARRAYREF $A (+ $K -2)
 219                                                     (+ $K -2)))))
 220                                    (MARRAYSET 0 $A $I (+ $K -1))
 221                                    (MARRAYSET 0 $A $I $K)
 222                                    (DO (($J (+ $K 1) (+ 1 $J)))
 223                                        ((IS-BOOLE-CHECK (MGRP $J $N))
 224                                           '$DONE)
 225                                      (MARRAYSET
 226                                        (SIMPLIFY
 227                                          ($GCDIVIDE
 228                                            (ADD*
 229                                              (MUL* $C0
 230                                                    (MARRAYREF $A $I $J))
 231                                              (MUL* $C1
 232                                                    (MARRAYREF $A $K $J))
 233                                              (MUL* $C2
 234                                                    (MARRAYREF
 235                                                      $A (+ $K -1) $J)))
 236                                            (MARRAYREF $A (+ $K -2)
 237                                                       (+ $K -2))))
 238                                        $A $I $J)))
 239                                  '$C1 '$C2))
 240                               (SETQ $C0 0)
 241                               (DO (($J (+ $K 1) (+ 1 $J)))
 242                                   ((IS-BOOLE-CHECK (MGRP $J $N)) '$DONE)
 243                                 (MARRAYSET 0 $A $K $J)
 244                                 (MARRAYSET 0 $A (+ $K -1) $J)))))))
 245                    '$C0 '$L1 '$L2 '$U)))
 246               (MARRAYSET
 247                 (COND
 248                   ((LIKE $K (ADD* $N -1)) 0)
 249                   (T
 250                     (SIMPLIFY
 251                       ($GCDIVIDE
 252                         (SIMPLIFY
 253                           (MFUNCTION-CALL
 254                             $DETERMINANT
 255                             (SIMPLIFY (MFUNCTION-CALL
 256                                         $GENMATRIX $A $K $K (+ $K -1)))))
 257                         (MARRAYREF $A (+ $K -2) (+ $K -2))))))
 258                 $A $K $K)
 259               (MARRAYSET 0 $A (+ $K -2) (+ $K -2))
 260               (MARRAYSET 0 $A (+ $K -1) (+ $K -1))
 261               (MARRAYSET 0 $A $K (+ $K -1))
 262               (MARRAYSET 0 $A (+ $K -1) $K)
 263               (COND ((OR (LIKE $K $N) (LIKE $K (ADD* $N -1)))
 264                        (RETURN NIL))))
 265             (MARRAYREF $A $N $N)))
 266         (ERRLFUN1 MCATCH)))
 267       (CONS BINDLIST LOCLIST)))))
 268   '$N '$A))
 269
 270 (compile-forms-to-compile-queue)
 271