archive/share/lisp/invert.lisp

   1 ;;; -*- Mode: Lisp; Package: Macsyma -*-
   2 ;;; Translated code for LMIVAX::MAX$DISK:[SHARE1]INVERT.MC;2
   3 ;;; Written on 9/12/1984 02:52:37, 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]INVERT.MC;2")
  23
  24 ;;; General declarations required for translated MACSYMA code.
  25
  26 (DECLARE (SPECIAL $SCALARMATRIXP))
  27
  28 (DEFMTRFUN-EXTERNAL ($ADJOINT $ANY MDEFINE NIL NIL))
  29
  30 (DEF-MTRVAR $SCALARMATRIXP '$SCALARMATRIXP 1)
  31
  32 (DEFMTRFUN-EXTERNAL ($INVERT $ANY MDEFINE NIL NIL))
  33
  34
  35 (DEFPROP $ADJOINT T TRANSLATED)
  36
  37 (ADD2LNC '$ADJOINT $PROPS)
  38
  39 (DEFMTRFUN
  40   ($ADJOINT $ANY MDEFINE NIL NIL) ($MAT) NIL
  41   ((LAMBDA ($ADJ $N)
  42      NIL
  43      (SETQ $N (MFUNCTION-CALL $LENGTH $MAT))
  44      (SETQ $ADJ (SIMPLIFY (MFUNCTION-CALL $IDENT $N)))
  45      (COND
  46        ((NOT (LIKE $N 1))
  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               (MARRAYSET
  50                 (MUL* (POWER -1 (+ $I $J))
  51                       (SIMPLIFY
  52                         (MFUNCTION-CALL
  53                           $DETERMINANT
  54                           (SIMPLIFY (MFUNCTION-CALL $MINOR $MAT $J $I)))))
  55                 $ADJ $I $J)))))
  56      $ADJ)
  57    '$ADJ '$N))
  58
  59 (DEFPROP $INVERT T TRANSLATED)
  60
  61 (ADD2LNC '$INVERT $PROPS)
  62
  63 (DEFMTRFUN
  64   ($INVERT $ANY MDEFINE NIL NIL) ($MAT) NIL
  65   ((LAMBDA ($ADJ $ANS)
  66      NIL
  67      (SETQ $ADJ (SIMPLIFY (MFUNCTION-CALL $ADJOINT $MAT)))
  68      (SETQ
  69        $ANS
  70        ((LAMBDA ($SCALARMATRIXP)
  71           NIL (DIV $ADJ (NCMUL2 (SIMPLIFY (MFUNCTION-CALL $ROW $MAT 1))
  72                                 (SIMPLIFY (MFUNCTION-CALL $COL $ADJ 1)))))
  73         T))
  74      (COND ((AND (LIKE (TRD-MSYMEVAL $SCALARMATRIXP '$SCALARMATRIXP) T)
  75                  (= (MFUNCTION-CALL $LENGTH $MAT) 1))
  76               (MARRAYREF $ANS 1 1))
  77            (T $ANS)))
  78    '$ADJ '$ANS))
  79
  80 (compile-forms-to-compile-queue)
  81