archive/share/lisp/nchrpl.lisp

   1 ;;; -*- Mode: Lisp; Package: Macsyma -*-
   2 ;;; Translated code for LMIVAX::MAX$DISK:[SHARE1]NCHRPL.MC;1
   3 ;;; Written on 9/12/1984 04:58:26, 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]NCHRPL.MC;1")
  23
  24 ;;; General declarations required for translated MACSYMA code.
  25
  26 (DECLARE (SPECIAL $MAPPRINT $MAPERROR))
  27
  28 (DEFMTRFUN-EXTERNAL ($MATTRACE $ANY MDEFINE NIL NIL))
  29
  30 (PUTPROP 'MAPLIST_TR (OR (GET 'MARRAYREF 'AUTOLOAD) T) 'AUTOLOAD)
  31
  32 (DEFMTRFUN-EXTERNAL ($NCHARPOLY $ANY MDEFINE NIL NIL))
  33
  34
  35 (DEFPROP $MATTRACE T TRANSLATED)
  36
  37 (ADD2LNC '$MATTRACE $PROPS)
  38
  39 (DEFMTRFUN
  40   ($MATTRACE $ANY MDEFINE NIL NIL) ($A) NIL
  41   ((LAMBDA ($ANS)
  42      NIL
  43      (DO (($I 1 (+ 1 $I))) ((> $I (MFUNCTION-CALL $LENGTH $A)) '$DONE)
  44        (SETQ $ANS (ADD* $ANS (MARRAYREF $A $I $I))))
  45      $ANS)
  46    0))
  47
  48 (DEFPROP $NCHARPOLY T TRANSLATED)
  49
  50 (ADD2LNC '$NCHARPOLY $PROPS)
  51
  52 (DEFMTRFUN
  53   ($NCHARPOLY $ANY MDEFINE NIL NIL) ($A $VAR) NIL
  54   ((LAMBDA ($AK $TRLIST $SYMLIST $K $P $MAPERROR $MAPPRINT)
  55      NIL
  56      (DO ((MDO 1 (+ 1 MDO)))
  57          ((> MDO (+ (MFUNCTION-CALL $LENGTH $A) -1)) '$DONE)
  58        ((LAMBDA ()
  59           NIL
  60           (SETQ $AK (NCMUL2 $A $AK))
  61           (SETQ $TRLIST
  62                 (SIMPLIFY (MFUNCTION-CALL
  63                             $CONS (SIMPLIFY (MFUNCTION-CALL $MATTRACE $AK))
  64                             $TRLIST))))))
  65      (SETQ $TRLIST (SIMPLIFY (MFUNCTION-CALL $REVERSE $TRLIST)))
  66      (DO (($I) (MDO (CDR $TRLIST) (CDR MDO))) ((NULL MDO) '$DONE)
  67        (SETQ $I (CAR MDO))
  68        (SETQ $K (ADD* $K 1))
  69        (SETQ
  70          $SYMLIST
  71          (SIMPLIFY
  72            (MFUNCTION-CALL
  73              $CONS
  74              (DIV
  75                (SIMPLIFY (MAPPLY-TR '&+ (MAPLIST_TR '&* $SYMLIST $TRLIST)))
  76                (*MMINUS $K))
  77              $SYMLIST))))
  78      (DO (($I 0 (+ 1 $I))) ((LIKE $SYMLIST '((MLIST))) '$DONE)
  79        ((LAMBDA ()
  80           NIL
  81           (SETQ
  82             $P
  83             (ADD* $P (MUL* (SIMPLIFY ($FIRST $SYMLIST)) (POWER $VAR $I))))
  84           (SETQ $SYMLIST (SIMPLIFY (MFUNCTION-CALL $REST $SYMLIST))))))
  85      (SIMPLIFY (MFUNCTION-CALL $RATSIMP $P $VAR)))
  86    $A (LIST '(MLIST) (SIMPLIFY (MFUNCTION-CALL $MATTRACE $A)))
  87    (LIST '(MLIST) 1) 0 0 NIL NIL))
  88
  89 (compile-forms-to-compile-queue)
  90