archive/share/lisp/rncomb.lisp

   1 ;;; -*- Mode: Lisp; Package: Macsyma -*-
   2 ;;; Translated code for LMIVAX::MAX$DISK:[SHARE1]RNCOMB.MC;1
   3 ;;; Written on 9/13/1984 03:20:28, 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]RNCOMB.MC;1")
  23
  24 ;;; General declarations required for translated MACSYMA code.
  25
  26 (DECLARE (SPECIAL $PFEFORMAT $PIECE $INFLAG $PARTSWITCH))
  27
  28 (DEFMTRFUN-EXTERNAL ($RNCOMBINE $ANY MDEFINE NIL NIL))
  29
  30 (DEFMTRFUN-EXTERNAL ($LCM_L $ANY MDEFINE NIL NIL))
  31
  32 (DEFMTRFUN-EXTERNAL ($RNCOMBINE1 $ANY MDEFINE NIL NIL))
  33
  34 (PUTPROP 'MAPLIST_TR (OR (GET 'MARRAYREF 'AUTOLOAD) T) 'AUTOLOAD)
  35
  36 (DEFMTRFUN-EXTERNAL ($DENOMTHRU $ANY MDEFINE NIL NIL))
  37
  38 (DEFMTRFUN-EXTERNAL ($RLOIEWL $ANY MDEFINE NIL NIL))
  39
  40 (DEFMTRFUN-EXTERNAL ($PREDPARTITION $ANY MDEFINE NIL NIL))
  41
  42
  43 (SIMPLIFY (MFUNCTION-CALL $PUT '$RNCOMB 2 '$VERSION))
  44
  45 (DEFPROP $RNCOMBINE T TRANSLATED)
  46
  47 (ADD2LNC '$RNCOMBINE $PROPS)
  48
  49 (DEFMTRFUN
  50  ($RNCOMBINE $ANY MDEFINE NIL NIL) ($EXP) NIL
  51  ((LAMBDA ($PARTSWITCH $INFLAG $PIECE $PFEFORMAT)
  52     NIL
  53     (SETQ
  54       $EXP
  55       (SIMPLIFY (MFUNCTION-CALL
  56                   $RLOIEWL '&+ (SIMPLIFY (MFUNCTION-CALL $COMBINE $EXP)))))
  57     (SETQ $PFEFORMAT NIL)
  58     (SIMPLIFY (MFUNCTION-CALL $RNCOMBINE1 $EXP)))
  59   T T '$PIECE T))
  60
  61 (DEFPROP $LCM_L T TRANSLATED)
  62
  63 (ADD2LNC '$LCM_L $PROPS)
  64
  65 (DEFMTRFUN
  66  ($LCM_L $ANY MDEFINE NIL NIL) ($LIST) NIL
  67  (COND
  68   ((LIKE $LIST '((MLIST))) 1)
  69   (T
  70    ((LAMBDA ($RLIST $FLIST $FRLIST $PARTSWITCH $INFLAG $PIECE)
  71       NIL
  72       (COND
  73         ((LIKE $RLIST '((MLIST))) $FLIST)
  74         (T
  75           (SIMPLIFY
  76             (MFUNCTION-CALL
  77               $LCM_L
  78               (SIMPLIFY
  79                 (MFUNCTION-CALL
  80                   $CONS
  81                   (DIV
  82                     (MUL* $FLIST (SETQ $FRLIST (SIMPLIFY ($FIRST $RLIST))))
  83                     (SIMPLIFY (MFUNCTION-CALL $GCD $FLIST $FRLIST)))
  84                   (SIMPLIFY (MFUNCTION-CALL $REST $RLIST)))))))))
  85     (SIMPLIFY (MFUNCTION-CALL $REST $LIST))
  86     (SIMPLIFY ($FIRST $LIST)) '$FRLIST T T '$PIECE))))
  87
  88 (DEFPROP $RNCOMBINE1 T TRANSLATED)
  89
  90 (ADD2LNC '$RNCOMBINE1 $PROPS)
  91
  92 (DEFMTRFUN
  93  ($RNCOMBINE1 $ANY MDEFINE NIL NIL) ($LIST) NIL
  94  ((LAMBDA ($FLIST $SPLITDUM $LSPLITDUM $FLIST_DENOM)
  95     NIL
  96     (PROG ()
  97        (COND ((LIKE $LIST '((MLIST))) (RETURN 0)))
  98        (SETQ $FLIST (SIMPLIFY ($FIRST $LIST)))
  99        (COND
 100          ((= (MFUNCTION-CALL $LENGTH $LIST) 1)
 101             (RETURN
 102               (COND
 103                 ((LIKE
 104                    (SIMPLIFY (MFUNCTION-CALL
 105                                $INPART
 106                                (SIMPLIFY (MFUNCTION-CALL $NUM $FLIST)) 0))
 107                    '&+)
 108                    (DIV (SIMPLIFY
 109                           (MFUNCTION-CALL
 110                             $RNCOMBINE1
 111                             (SIMPLIFY
 112                               (MFUNCTION-CALL
 113                                 $ARGS
 114                                 (SIMPLIFY (MFUNCTION-CALL $NUM $FLIST))))))
 115                         (SIMPLIFY (MFUNCTION-CALL $DENOM $FLIST))))
 116                 (T $FLIST)))))
 117        (SETQ
 118          $FLIST_DENOM
 119          (DIV
 120            (SETQ $FLIST_DENOM (SIMPLIFY (MFUNCTION-CALL $DENOM $FLIST)))
 121            (SIMPLIFY (MFUNCTION-CALL $NUMFACTOR $FLIST_DENOM))))
 122        (SETQ $FLIST (MUL* $FLIST $FLIST_DENOM))
 123        (SETQ
 124          $SPLITDUM
 125          (SIMPLIFY
 126            (MFUNCTION-CALL
 127              $PREDPARTITION (SIMPLIFY (MFUNCTION-CALL $REST $LIST))
 128              (M-TLAMBDA&ENV
 129                (($DUM) ($FLIST_DENOM)) NIL
 130                (MFUNCTION-CALL
 131                  $NUMBERP (DIV (SIMPLIFY (MFUNCTION-CALL $DENOM $DUM))
 132                                $FLIST_DENOM))))))
 133        (COND
 134          ((NOT (LIKE
 135                  (SETQ
 136                    $LSPLITDUM (SIMPLIFY (MFUNCTION-CALL $LAST $SPLITDUM)))
 137                  '((MLIST))))
 138             (SETQ
 139               $FLIST
 140               (DIV (SIMPLIFY
 141                      (MFUNCTION-CALL
 142                        $DENOMTHRU
 143                        (SIMPLIFY
 144                          (MFUNCTION-CALL
 145                            $CONS $FLIST (MUL* $LSPLITDUM $FLIST_DENOM)))))
 146                    $FLIST_DENOM))))
 147        (RETURN
 148          (ADD* $FLIST
 149                (SIMPLIFY (MFUNCTION-CALL
 150                            $RNCOMBINE1 (SIMPLIFY ($FIRST $SPLITDUM))))))))
 151   '$FLIST '$SPLITDUM '$LSPLITDUM '$FLIST_DENOM))
 152
 153 (DEFPROP $DENOMTHRU T TRANSLATED)
 154
 155 (ADD2LNC '$DENOMTHRU $PROPS)
 156
 157 (DEFMTRFUN
 158   ($DENOMTHRU $ANY MDEFINE NIL NIL) ($EXP) NIL
 159   ((LAMBDA ($LCMDUM)
 160      NIL (DIV (SIMPLIFY (MAPPLY-TR '&+ (MUL* $LCMDUM $EXP))) $LCMDUM))
 161    (SIMPLIFY (MFUNCTION-CALL $LCM_L (MAPLIST_TR '$DENOM $EXP)))))
 162
 163 (DEFPROP $RLOIEWL T TRANSLATED)
 164
 165 (ADD2LNC '$RLOIEWL $PROPS)
 166
 167 (DEFMTRFUN
 168   ($RLOIEWL $ANY MDEFINE NIL NIL) ($OP $EXP) NIL
 169   ((LAMBDA ($PARTSWITCH $INFLAG $PIECE)
 170      NIL (COND ((LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $EXP 0)) $OP)
 171                   (SIMPLIFY (MFUNCTION-CALL $ARGS $EXP)))
 172                (T (LIST '(MLIST) $EXP))))
 173    T T '$PIECE))
 174
 175 (DEFPROP $PREDPARTITION T TRANSLATED)
 176
 177 (ADD2LNC '$PREDPARTITION $PROPS)
 178
 179 (DEFMTRFUN
 180  ($PREDPARTITION $ANY MDEFINE NIL NIL) ($LIST $PREDICATE) NIL
 181  ((LAMBDA ($NOLIST $YESLIST)
 182     NIL
 183     (DO (($IDUM)
 184          (MDO (CDR (SIMPLIFY (MFUNCTION-CALL $REVERSE $LIST))) (CDR MDO)))
 185         ((NULL MDO) '$DONE)
 186       (SETQ $IDUM (CAR MDO))
 187       (COND
 188         ((SIMPLIFY (MFUNCALL $PREDICATE $IDUM))
 189            (SETQ
 190              $YESLIST (SIMPLIFY (MFUNCTION-CALL $CONS $IDUM $YESLIST))))
 191         (T
 192           (SETQ $NOLIST (SIMPLIFY (MFUNCTION-CALL $CONS $IDUM $NOLIST))))))
 193     (LIST '(MLIST) $NOLIST $YESLIST))
 194   '((MLIST)) '((MLIST))))
 195
 196 (compile-forms-to-compile-queue)
 197