archive/share/lisp/vect.lisp

   1 ;;; -*- Mode: Lisp; Package: Macsyma -*-
   2 ;;; Translated code for LMIVAX::MAX$DISK:[SHARE]VECT.MC;14
   3 ;;; Written on 10/01/1984 03:48:38, 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:[SHARE]VECT.MC;14")
  23
  24 ;;; General declarations required for translated MACSYMA code.
  25
  26 (DECLARE
  27   (FIXNUM $DIMENSION $DIMENIMBED $TRYLENGTH $BESTLENGTH)
  28   (SPECIAL
  29     $POTENTIALZEROLOC $DOTDISTRIB $EXPANDFLAGS $DOTSCRULES $DOTASSOC
  30     $DOTEXPTSIMP $INFLAG $EXPN $PIECE $JACOBIAN $FIRSTCROSSSCALAR
  31     $EXPANDCROSSPLUS $EXPANDCROSSCROSS $EXPANDCROSS $EXPANDLAPLACIANPROD
  32     $EXPANDLAPLACIANTODIVGRAD $EXPANDCURLCURL $EXPANDDIVPROD
  33     $EXPANDGRADPROD $EXPANDPROD $EXPANDLAPLACIANPLUS $EXPANDLAPLACIAN
  34     $EXPANDCURLPLUS $EXPANDCURL $EXPANDDIVPLUS $EXPANDDIV $EXPANDGRADPLUS
  35     $EXPANDPLUS $EXPANDGRAD $EXPANDDOTPLUS $EXPANDDOT $EXPANDALL $SF
  36     $SFPROD $BESTLENGTH $TRYLENGTH $DIMENIMBED $DIMENSION $COORDINATES
  37     $TR_BOUND_FUNCTION_APPLYP $VTRUE $TTRUE $ETRUE $LESSP $SCALARM))
  38
  39 (DECLARE (SPECIAL $SCALARM))
  40
  41 (DECLARE (SPECIAL $LESSP))
  42
  43 (DECLARE (SPECIAL $ETRUE))
  44
  45 (DECLARE (SPECIAL $TTRUE))
  46
  47 (DECLARE (SPECIAL $VTRUE))
  48
  49 (DECLARE (SPECIAL $COORDINATES))
  50
  51 (DECLARE (SPECIAL $DIMENSION))
  52
  53 (DECLARE (SPECIAL $DIMENIMBED))
  54
  55 (DECLARE (SPECIAL $TRYLENGTH))
  56
  57 (DECLARE (SPECIAL $BESTLENGTH))
  58
  59 (DECLARE (SPECIAL $SFPROD))
  60
  61 (DECLARE (SPECIAL $SF))
  62
  63 (DECLARE (SPECIAL $EXPANDALL))
  64
  65 (DECLARE (SPECIAL $EXPANDDOT))
  66
  67 (DECLARE (SPECIAL $EXPANDDOTPLUS))
  68
  69 (DECLARE (SPECIAL $EXPANDGRAD))
  70
  71 (DECLARE (SPECIAL $EXPANDPLUS))
  72
  73 (DECLARE (SPECIAL $EXPANDGRADPLUS))
  74
  75 (DECLARE (SPECIAL $EXPANDDIV))
  76
  77 (DECLARE (SPECIAL $EXPANDDIVPLUS))
  78
  79 (DECLARE (SPECIAL $EXPANDCURL))
  80
  81 (DECLARE (SPECIAL $EXPANDCURLPLUS))
  82
  83 (DECLARE (SPECIAL $EXPANDLAPLACIAN))
  84
  85 (DECLARE (SPECIAL $EXPANDLAPLACIANPLUS))
  86
  87 (DECLARE (SPECIAL $EXPANDPROD))
  88
  89 (DECLARE (SPECIAL $EXPANDGRADPROD))
  90
  91 (DECLARE (SPECIAL $EXPANDDIVPROD))
  92
  93 (DECLARE (SPECIAL $EXPANDCURLCURL))
  94
  95 (DECLARE (SPECIAL $EXPANDLAPLACIANTODIVGRAD))
  96
  97 (DECLARE (SPECIAL $EXPANDLAPLACIANPROD))
  98
  99 (DECLARE (SPECIAL $EXPANDCROSS))
 100
 101 (DECLARE (SPECIAL $EXPANDCROSSCROSS))
 102
 103 (DECLARE (SPECIAL $EXPANDCROSSPLUS))
 104
 105 (DECLARE (SPECIAL $FIRSTCROSSSCALAR))
 106
 107 (DEFMTRFUN-EXTERNAL ($EV_DIFF $ANY MDEFINE NIL NIL))
 108
 109 (DEF-MTRVAR $JACOBIAN '$JACOBIAN 1)
 110
 111 (DEFMTRFUN-EXTERNAL ($SCALEFACTORS $ANY MDEFINE NIL NIL))
 112
 113 (DEFMTRFUN-EXTERNAL ($GCOV $ANY MDEFINE NIL NIL))
 114
 115 (DEF-MTRVAR $PIECE '$PIECE 1)
 116
 117 (DEFMTRFUN-EXTERNAL ($EXPRESS1 $ANY MDEFINE NIL NIL))
 118
 119 (DEFMTRFUN-EXTERNAL ($TRIGSIMP $ANY MDEFINE NIL NIL))
 120
 121 (DEFMTRFUN-EXTERNAL ($TRIGSIMP1 $ANY MDEFINE NIL NIL))
 122
 123 (DEFMTRFUN-EXTERNAL ($IMPROVE $ANY MDEFINE NIL NIL))
 124
 125 (DEFMTRFUN-EXTERNAL ($LISTOFTRIGSQ $ANY MDEFINE NIL NIL))
 126
 127 (DEFMTRFUN-EXTERNAL ($SPECIALUNION $ANY MDEFINE NIL NIL))
 128
 129 (DEFMTRFUN-EXTERNAL ($UPDATE $ANY MDEFINE NIL NIL))
 130
 131 (DEFMTRFUN-EXTERNAL ($EXPNLENGTH $ANY MDEFINE NIL NIL))
 132
 133 (DEFMTRFUN-EXTERNAL ($ARGSLENGTH $ANY MDEFINE NIL NIL))
 134
 135 (DECLARE (SPECIAL $EXPANDFLAGS))
 136
 137 (DEFMTRFUN-EXTERNAL ($FLAG_RESET $ANY MDEFINE NIL NIL))
 138
 139 (DEFMTRFUN-EXTERNAL ($VECTORSIMP $ANY MDEFINE NIL NIL))
 140
 141 (DEFMTRFUN-EXTERNAL ($BEFORE $ANY MDEFINE NIL NIL))
 142
 143 (DEFMTRFUN-EXTERNAL ($VSCALARP $BOOLEAN MDEFINE NIL NIL))
 144
 145 (PUTPROP 'MAPLIST_TR (OR (GET 'MARRAYREF 'AUTOLOAD) T) 'AUTOLOAD)
 146
 147 (DEFMTRFUN-EXTERNAL ($VSIMP $ANY MDEFINE NIL NIL))
 148
 149 (DEFMTRFUN-EXTERNAL ($CROSSSIMP $ANY MDEFINE NIL NIL))
 150
 151 (DEFMTRFUN-EXTERNAL ($REMOVECROSSSC $ANY MDEFINE NIL NIL))
 152
 153 (DEFMTRFUN-EXTERNAL ($REMOVECROSSSC1 $ANY MDEFINE NIL NIL))
 154
 155 (DEFMTRFUN-EXTERNAL ($PARTITIONSC $ANY MDEFINE NIL NIL))
 156
 157 (DEFMTRFUN-EXTERNAL ($TRYCROSSPLUS $ANY MDEFINE NIL NIL))
 158
 159 (DEFMTRFUN-EXTERNAL ($TRYCROSSCROSS $ANY MDEFINE NIL NIL))
 160
 161 (DEFMTRFUN-EXTERNAL ($PVCROSS $ANY MDEFINE NIL NIL))
 162
 163 (DEFMTRFUN-EXTERNAL ($CROSSRV $ANY MDEFINE NIL NIL))
 164
 165 (DEFMTRFUN-EXTERNAL ($GRADPROD $ANY MDEFINE NIL NIL))
 166
 167 (DEFMTRFUN-EXTERNAL ($DIVPROD $ANY MDEFINE NIL NIL))
 168
 169 (DEFMTRFUN-EXTERNAL ($POTENTIAL1 $ANY MDEFINE NIL NIL))
 170
 171 (DECLARE (SPECIAL $POTENTIALZEROLOC))
 172
 173 (DEFMTRFUN-EXTERNAL ($ZEROLOC $ANY MDEFINE NIL NIL))
 174
 175 (DEFMTRFUN-EXTERNAL ($VPOT $ANY MDEFINE NIL NIL))
 176
 177 (DEFMTRFUN-EXTERNAL ($DISJUNCT $ANY MDEFINE NIL NIL))
 178
 179 (DEFMTRFUN-EXTERNAL ($SETDIFF $ANY MDEFINE NIL NIL))
 180
 181 (DEFMTRFUN-EXTERNAL ($SUBLESS $ANY MDEFINE NIL NIL))
 182
 183 (DEFMTRFUN-EXTERNAL ($MYINT $ANY MDEFINE NIL NIL))
 184
 185 (DEFMTRFUN-EXTERNAL ($EVLIMIT $ANY MDEFINE NIL NIL))
 186
 187
 188 (SIMPLIFY (MFUNCTION-CALL $HERALD_PACKAGE '$VECT))
 189
 190 (SIMPLIFY (MFUNCTION-CALL $PUT '$VECT T '$VERSION))
 191
 192 ((PROGN 'COMPILE
 193         (PROGN 'COMPILE (MEVAL* '(($MODEDECLARE) $SCALARM $ANY))
 194                (MEVAL* '(($DECLARE) $SCALARM $SPECIAL))
 195                NIL (DEF-MTRVAR $SCALARM '$SCALARM))
 196         (PROGN 'COMPILE (MEVAL* '(($MODEDECLARE) $LESSP $ANY))
 197                (MEVAL* '(($DECLARE) $LESSP $SPECIAL))
 198                NIL (DEF-MTRVAR $LESSP '$LESSP))
 199         (PROGN 'COMPILE (MEVAL* '(($MODEDECLARE) $ETRUE $ANY))
 200                (MEVAL* '(($DECLARE) $ETRUE $SPECIAL))
 201                NIL (DEF-MTRVAR $ETRUE '$ETRUE))
 202         (PROGN 'COMPILE (MEVAL* '(($MODEDECLARE) $TTRUE $ANY))
 203                (MEVAL* '(($DECLARE) $TTRUE $SPECIAL))
 204                NIL (DEF-MTRVAR $TTRUE '$TTRUE))
 205         (PROGN 'COMPILE (MEVAL* '(($MODEDECLARE) $VTRUE $ANY))
 206                (MEVAL* '(($DECLARE) $VTRUE $SPECIAL))
 207                NIL (DEF-MTRVAR $VTRUE '$VTRUE))
 208         (PROGN 'COMPILE)))
 209
 210 (SETQ $TR_BOUND_FUNCTION_APPLYP NIL)
 211
 212 (MEVAL* '(($INFIX) &~ 134 133 $EXPR $EXPR $EXPR))
 213
 214 (MEVAL*
 215   '(($DECLARE) ((MLIST) &. $ORDER) $COMMUTATIVE $ORDERN $NARY
 216     ((MLIST) &GRAD &DIV &CURL &LAPLACIAN) $OUTATIVE &CURL $NONSCALAR))
 217
 218 (MEVAL* '(($MODEDECLARE) $COORDINATES $ANY))
 219
 220 (MEVAL* '(($DECLARE) $COORDINATES $SPECIAL))
 221
 222 (DEF-MTRVAR $COORDINATES '((MLIST) $X $Y $Z))
 223
 224 (MEVAL* '(($MODEDECLARE) $DIMENSION $FIXNUM))
 225
 226 (MEVAL* '(($DECLARE) $DIMENSION $SPECIAL))
 227
 228 (DEFPROP $DIMENSION ASSIGN-MODE-CHECK ASSIGN)
 229
 230 (DEF-MTRVAR $DIMENSION 3)
 231
 232 (MEVAL* '(($MODEDECLARE) $DIMENIMBED $FIXNUM))
 233
 234 (MEVAL* '(($DECLARE) $DIMENIMBED $SPECIAL))
 235
 236 (DEFPROP $DIMENIMBED ASSIGN-MODE-CHECK ASSIGN)
 237
 238 (DEF-MTRVAR $DIMENIMBED 1)
 239
 240 (MEVAL* '(($MODEDECLARE) $TRYLENGTH $FIXNUM))
 241
 242 (MEVAL* '(($DECLARE) $TRYLENGTH $SPECIAL))
 243
 244 (DEFPROP $TRYLENGTH ASSIGN-MODE-CHECK ASSIGN)
 245
 246 (DEF-MTRVAR $TRYLENGTH 1)
 247
 248 (MEVAL* '(($MODEDECLARE) $BESTLENGTH $FIXNUM))
 249
 250 (MEVAL* '(($DECLARE) $BESTLENGTH $SPECIAL))
 251
 252 (DEFPROP $BESTLENGTH ASSIGN-MODE-CHECK ASSIGN)
 253
 254 (DEF-MTRVAR $BESTLENGTH 1)
 255
 256 (MEVAL* '(($MODEDECLARE) $SFPROD $ANY))
 257
 258 (MEVAL* '(($DECLARE) $SFPROD $SPECIAL))
 259
 260 (DEF-MTRVAR $SFPROD 1)
 261
 262 (MEVAL* '(($MODEDECLARE) $SF $LIST))
 263
 264 (MEVAL* '(($DECLARE) $SF $SPECIAL))
 265
 266 (DEFPROP $SF ASSIGN-MODE-CHECK ASSIGN)
 267
 268 (DEF-MTRVAR $SF (LIST '(MLIST) 1 1 1))
 269
 270 (MEVAL* '(($MODEDECLARE) $EXPANDALL $BOOLEAN))
 271
 272 (MEVAL* '(($DECLARE) $EXPANDALL $SPECIAL))
 273
 274 (DEFPROP $EXPANDALL ASSIGN-MODE-CHECK ASSIGN)
 275
 276 (DEF-MTRVAR $EXPANDALL T)
 277
 278 (MEVAL* '(($MODEDECLARE) $EXPANDDOT $BOOLEAN))
 279
 280 (MEVAL* '(($DECLARE) $EXPANDDOT $SPECIAL))
 281
 282 (DEFPROP $EXPANDDOT ASSIGN-MODE-CHECK ASSIGN)
 283
 284 (DEF-MTRVAR $EXPANDDOT T)
 285
 286 (MEVAL* '(($MODEDECLARE) $EXPANDDOTPLUS $BOOLEAN))
 287
 288 (MEVAL* '(($DECLARE) $EXPANDDOTPLUS $SPECIAL))
 289
 290 (DEFPROP $EXPANDDOTPLUS ASSIGN-MODE-CHECK ASSIGN)
 291
 292 (DEF-MTRVAR $EXPANDDOTPLUS T)
 293
 294 (MEVAL* '(($MODEDECLARE) $EXPANDGRAD $BOOLEAN))
 295
 296 (MEVAL* '(($DECLARE) $EXPANDGRAD $SPECIAL))
 297
 298 (DEFPROP $EXPANDGRAD ASSIGN-MODE-CHECK ASSIGN)
 299
 300 (DEF-MTRVAR $EXPANDGRAD T)
 301
 302 (MEVAL* '(($MODEDECLARE) $EXPANDPLUS $BOOLEAN))
 303
 304 (MEVAL* '(($DECLARE) $EXPANDPLUS $SPECIAL))
 305
 306 (DEFPROP $EXPANDPLUS ASSIGN-MODE-CHECK ASSIGN)
 307
 308 (DEF-MTRVAR $EXPANDPLUS T)
 309
 310 (MEVAL* '(($MODEDECLARE) $EXPANDALL $BOOLEAN))
 311
 312 (MEVAL* '(($DECLARE) $EXPANDALL $SPECIAL))
 313
 314 (DEFPROP $EXPANDALL ASSIGN-MODE-CHECK ASSIGN)
 315
 316 (DEF-MTRVAR $EXPANDALL T)
 317
 318 (MEVAL* '(($MODEDECLARE) $EXPANDGRADPLUS $BOOLEAN))
 319
 320 (MEVAL* '(($DECLARE) $EXPANDGRADPLUS $SPECIAL))
 321
 322 (DEFPROP $EXPANDGRADPLUS ASSIGN-MODE-CHECK ASSIGN)
 323
 324 (DEF-MTRVAR $EXPANDGRADPLUS T)
 325
 326 (MEVAL* '(($MODEDECLARE) $EXPANDDIV $BOOLEAN))
 327
 328 (MEVAL* '(($DECLARE) $EXPANDDIV $SPECIAL))
 329
 330 (DEFPROP $EXPANDDIV ASSIGN-MODE-CHECK ASSIGN)
 331
 332 (DEF-MTRVAR $EXPANDDIV T)
 333
 334 (MEVAL* '(($MODEDECLARE) $EXPANDDIVPLUS $BOOLEAN))
 335
 336 (MEVAL* '(($DECLARE) $EXPANDDIVPLUS $SPECIAL))
 337
 338 (DEFPROP $EXPANDDIVPLUS ASSIGN-MODE-CHECK ASSIGN)
 339
 340 (DEF-MTRVAR $EXPANDDIVPLUS T)
 341
 342 (MEVAL* '(($MODEDECLARE) $EXPANDCURL $BOOLEAN))
 343
 344 (MEVAL* '(($DECLARE) $EXPANDCURL $SPECIAL))
 345
 346 (DEFPROP $EXPANDCURL ASSIGN-MODE-CHECK ASSIGN)
 347
 348 (DEF-MTRVAR $EXPANDCURL T)
 349
 350 (MEVAL* '(($MODEDECLARE) $EXPANDCURLPLUS $BOOLEAN))
 351
 352 (MEVAL* '(($DECLARE) $EXPANDCURLPLUS $SPECIAL))
 353
 354 (DEFPROP $EXPANDCURLPLUS ASSIGN-MODE-CHECK ASSIGN)
 355
 356 (DEF-MTRVAR $EXPANDCURLPLUS T)
 357
 358 (MEVAL* '(($MODEDECLARE) $EXPANDLAPLACIAN $BOOLEAN))
 359
 360 (MEVAL* '(($DECLARE) $EXPANDLAPLACIAN $SPECIAL))
 361
 362 (DEFPROP $EXPANDLAPLACIAN ASSIGN-MODE-CHECK ASSIGN)
 363
 364 (DEF-MTRVAR $EXPANDLAPLACIAN T)
 365
 366 (MEVAL* '(($MODEDECLARE) $EXPANDLAPLACIANPLUS $BOOLEAN))
 367
 368 (MEVAL* '(($DECLARE) $EXPANDLAPLACIANPLUS $SPECIAL))
 369
 370 (DEFPROP $EXPANDLAPLACIANPLUS ASSIGN-MODE-CHECK ASSIGN)
 371
 372 (DEF-MTRVAR $EXPANDLAPLACIANPLUS T)
 373
 374 (MEVAL* '(($MODEDECLARE) $EXPANDPROD $BOOLEAN))
 375
 376 (MEVAL* '(($DECLARE) $EXPANDPROD $SPECIAL))
 377
 378 (DEFPROP $EXPANDPROD ASSIGN-MODE-CHECK ASSIGN)
 379
 380 (DEF-MTRVAR $EXPANDPROD T)
 381
 382 (MEVAL* '(($MODEDECLARE) $EXPANDGRADPROD $BOOLEAN))
 383
 384 (MEVAL* '(($DECLARE) $EXPANDGRADPROD $SPECIAL))
 385
 386 (DEFPROP $EXPANDGRADPROD ASSIGN-MODE-CHECK ASSIGN)
 387
 388 (DEF-MTRVAR $EXPANDGRADPROD T)
 389
 390 (MEVAL* '(($MODEDECLARE) $EXPANDDIVPROD $BOOLEAN))
 391
 392 (MEVAL* '(($DECLARE) $EXPANDDIVPROD $SPECIAL))
 393
 394 (DEFPROP $EXPANDDIVPROD ASSIGN-MODE-CHECK ASSIGN)
 395
 396 (DEF-MTRVAR $EXPANDDIVPROD T)
 397
 398 (MEVAL* '(($MODEDECLARE) $EXPANDCURLCURL $BOOLEAN))
 399
 400 (MEVAL* '(($DECLARE) $EXPANDCURLCURL $SPECIAL))
 401
 402 (DEFPROP $EXPANDCURLCURL ASSIGN-MODE-CHECK ASSIGN)
 403
 404 (DEF-MTRVAR $EXPANDCURLCURL T)
 405
 406 (MEVAL* '(($MODEDECLARE) $EXPANDLAPLACIANTODIVGRAD $BOOLEAN))
 407
 408 (MEVAL* '(($DECLARE) $EXPANDLAPLACIANTODIVGRAD $SPECIAL))
 409
 410 (DEFPROP $EXPANDLAPLACIANTODIVGRAD ASSIGN-MODE-CHECK ASSIGN)
 411
 412 (DEF-MTRVAR $EXPANDLAPLACIANTODIVGRAD T)
 413
 414 (MEVAL* '(($MODEDECLARE) $EXPANDLAPLACIANPROD $BOOLEAN))
 415
 416 (MEVAL* '(($DECLARE) $EXPANDLAPLACIANPROD $SPECIAL))
 417
 418 (DEFPROP $EXPANDLAPLACIANPROD ASSIGN-MODE-CHECK ASSIGN)
 419
 420 (DEF-MTRVAR $EXPANDLAPLACIANPROD T)
 421
 422 (MEVAL* '(($MODEDECLARE) $EXPANDCROSS $BOOLEAN))
 423
 424 (MEVAL* '(($DECLARE) $EXPANDCROSS $SPECIAL))
 425
 426 (DEFPROP $EXPANDCROSS ASSIGN-MODE-CHECK ASSIGN)
 427
 428 (DEF-MTRVAR $EXPANDCROSS T)
 429
 430 (MEVAL* '(($MODEDECLARE) $EXPANDCROSSCROSS $BOOLEAN))
 431
 432 (MEVAL* '(($DECLARE) $EXPANDCROSSCROSS $SPECIAL))
 433
 434 (DEFPROP $EXPANDCROSSCROSS ASSIGN-MODE-CHECK ASSIGN)
 435
 436 (DEF-MTRVAR $EXPANDCROSSCROSS T)
 437
 438 (MEVAL* '(($MODEDECLARE) $EXPANDCROSSPLUS $BOOLEAN))
 439
 440 (MEVAL* '(($DECLARE) $EXPANDCROSSPLUS $SPECIAL))
 441
 442 (DEFPROP $EXPANDCROSSPLUS ASSIGN-MODE-CHECK ASSIGN)
 443
 444 (DEF-MTRVAR $EXPANDCROSSPLUS T)
 445
 446 (MEVAL* '(($MODEDECLARE) $FIRSTCROSSSCALAR $BOOLEAN))
 447
 448 (MEVAL* '(($DECLARE) $FIRSTCROSSSCALAR $SPECIAL))
 449
 450 (DEFPROP $FIRSTCROSSSCALAR ASSIGN-MODE-CHECK ASSIGN)
 451
 452 (DEF-MTRVAR $FIRSTCROSSSCALAR T)
 453
 454 (DEFPROP $EV_DIFF T TRANSLATED)
 455
 456 (ADD2LNC '$EV_DIFF $PROPS)
 457
 458 (DEFMTRFUN ($EV_DIFF $ANY MDEFINE NIL NIL) ($X) NIL
 459            (SIMPLIFY (MFUNCALL '$EV $X '$DIFF)))
 460
 461 (MEVAL* '(($DECLARE) $JACOBIAN $SPECIAL))
 462
 463 (DEFPROP $SCALEFACTORS T TRANSLATED)
 464
 465 (ADD2LNC '$SCALEFACTORS $PROPS)
 466
 467 (DEFMTRFUN
 468  ($SCALEFACTORS $ANY MDEFINE NIL NIL) ($TRANSFORMATION) NIL
 469  ((LAMBDA ()
 470    NIL
 471    (COND
 472      ((MFUNCTION-CALL $LISTP (SIMPLIFY ($FIRST $TRANSFORMATION)))
 473         (SETQ
 474           $COORDINATES (SIMPLIFY (MFUNCTION-CALL $REST $TRANSFORMATION)))
 475         (SETQ $TRANSFORMATION (SIMPLIFY ($FIRST $TRANSFORMATION))))
 476      (T (SETQ $COORDINATES
 477               (SIMPLIFY (MFUNCTION-CALL $LISTOFVARS $TRANSFORMATION)))))
 478    ((LAMBDA (|tr-gensym~16|)
 479       (PROGN (ASSIGN-MODE-CHECK '$DIMENSION |tr-gensym~16|)
 480              (SETQ $DIMENSION |tr-gensym~16|)))
 481     (MFUNCTION-CALL $LENGTH (TRD-MSYMEVAL $COORDINATES '$COORDINATES)))
 482    ((LAMBDA (|tr-gensym~17|)
 483       (PROGN (ASSIGN-MODE-CHECK '$DIMENIMBED |tr-gensym~17|)
 484              (SETQ $DIMENIMBED |tr-gensym~17|)))
 485     (MFUNCTION-CALL $LENGTH $TRANSFORMATION))
 486    (DO (($ROW 1 (+ 1 $ROW))) ((> $ROW (TRD-MSYMEVAL $DIMENSION 0)) '$DONE)
 487      (DO (($COL 1 (+ 1 $COL)))
 488          ((> $COL (TRD-MSYMEVAL $DIMENIMBED 0)) '$DONE)
 489        (MARRAYSET
 490          (SIMPLIFY
 491            (MFUNCTION-CALL
 492              $TRIGSIMP
 493              (SIMPLIFY
 494                (MFUNCTION-CALL
 495                  $RATSIMP
 496                  (SIMPLIFY
 497                    (MFUNCTION-CALL
 498                      $DIFF (MARRAYREF $TRANSFORMATION $COL)
 499                      (MARRAYREF (TRD-MSYMEVAL $COORDINATES '$COORDINATES)
 500                                 $ROW)))))))
 501          (TRD-MSYMEVAL $JACOBIAN '$JACOBIAN) $ROW $COL)))
 502    (SETQ $SFPROD 1)
 503    (DO (($ROW 1 (+ 1 $ROW))) ((> $ROW (TRD-MSYMEVAL $DIMENSION 0)) '$DONE)
 504     (DO (($COL 1 (+ 1 $COL))) ((> $COL (+ $ROW -1)) '$DONE)
 505      (MARRAYSET (SIMPLIFY (MFUNCTION-CALL $GCOV $ROW $COL))
 506                 (TRD-MSYMEVAL $SF '((MLIST))) $ROW)
 507      (COND
 508       ((NOT (LIKE (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) $ROW) 0))
 509        (SIMPLIFY
 510         (MFUNCTION-CALL
 511          $PRINT
 512          '|&WARNING: COORDINATE SYSTEM IS NONORTHOGONAL UNLESS FOLLOWING SIMPLIFIES TO ZERO:|
 513          (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) $ROW))))))
 514     (MARRAYSET
 515       (SIMPLIFY
 516         (MFUNCTION-CALL
 517           $RADCAN
 518           (SIMPLIFY
 519             (LIST '(%SQRT) (SIMPLIFY (MFUNCTION-CALL $GCOV $ROW $ROW))))))
 520       (TRD-MSYMEVAL $SF '((MLIST))) $ROW)
 521     (SETQ
 522       $SFPROD (MUL* (TRD-MSYMEVAL $SFPROD '$SFPROD)
 523                     (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) $ROW)))))))
 524
 525 (DEFPROP $GCOV T TRANSLATED)
 526
 527 (ADD2LNC '$GCOV $PROPS)
 528
 529 (DEFMTRFUN
 530  ($GCOV $ANY MDEFINE NIL NIL) ($II $JJ) NIL
 531  (SIMPLIFY
 532   (MFUNCTION-CALL
 533     $TRIGSIMP
 534     (SIMPLIFY
 535       (MFUNCTION-CALL
 536         $RATSIMP
 537         ((LAMBDA (|0| N)
 538            (COND
 539              ((NOT (< N |0|))
 540                 (DO
 541                   (($KK |0| (1+ $KK))
 542                    (SUM0009
 543                      0
 544                      (ADD*
 545                        SUM0009
 546                        (MUL* (MARRAYREF
 547                                (TRD-MSYMEVAL $JACOBIAN '$JACOBIAN) $II $KK)
 548                              (MARRAYREF (TRD-MSYMEVAL $JACOBIAN '$JACOBIAN)
 549                                         $JJ $KK)))))
 550                   ((< N $KK) SUM0009)))
 551              ((= N (1- |0|)) 0)
 552              (T (INTERVAL-ERROR '$SUM |0| N))))
 553          1 (TRD-MSYMEVAL $DIMENIMBED 0)))))))
 554
 555 (DEFPROP $EXPRESS1 T TRANSLATED)
 556
 557 (ADD2LNC '$EXPRESS1 $PROPS)
 558
 559 (DEFMTRFUN
 560  ($EXPRESS1 $ANY MDEFINE NIL NIL) ($EXPN) NIL
 561  ((LAMBDA ($ANS)
 562    NIL
 563    (PROG ()
 564      (COND
 565        ((MFUNCTION-CALL $MAPATOM $EXPN)
 566           (COND
 567             ((MFUNCTION-CALL $NONSCALARP $EXPN)
 568                (SETQ $ANS '((MLIST)))
 569                (DO (($JJ (TRD-MSYMEVAL $DIMENSION 0) (+ -1 $JJ)))
 570                    ((< $JJ 1) '$DONE)
 571                  (SETQ $ANS
 572                        (SIMPLIFY
 573                          (MFUNCTION-CALL
 574                            $CONS
 575                            (MARRAYREF
 576                              $EXPN
 577                              (MARRAYREF
 578                                (TRD-MSYMEVAL $COORDINATES '$COORDINATES)
 579                                $JJ))
 580                            $ANS))))
 581                (RETURN $ANS))
 582             (T (RETURN $EXPN)))))
 583      (SETQ $EXPN (SIMPLIFY (MAP1 (GETOPR '$EXPRESS1) $EXPN)))
 584      (COND ((OR (MFUNCTION-CALL $MAPATOM $EXPN)
 585                 (MFUNCTION-CALL $LISTP $EXPN))
 586               (RETURN $EXPN)))
 587      (COND
 588        ((LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 0)) '&GRAD)
 589           (SETQ $ANS '((MLIST)))
 590           (SETQ $EXPN (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))
 591           (DO (($JJ (TRD-MSYMEVAL $DIMENSION 0) (+ -1 $JJ)))
 592               ((< $JJ 1) '$DONE)
 593             (SETQ
 594               $ANS
 595               (SIMPLIFY
 596                 (MFUNCTION-CALL
 597                   $CONS
 598                   (DIV
 599                     (SIMPLIFY
 600                       (LIST '(%DERIVATIVE) $EXPN
 601                             (MARRAYREF
 602                               (TRD-MSYMEVAL $COORDINATES '$COORDINATES)
 603                               $JJ)))
 604                     (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) $JJ))
 605                   $ANS))))
 606           (RETURN $ANS)))
 607      (COND
 608        ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '&DIV)
 609          (SETQ $EXPN (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))
 610          (COND
 611            ((NOT (MFUNCTION-CALL $LISTP $EXPN))
 612               (SIMPLIFY (MFUNCTION-CALL
 613                           $ERROR '|&DIV CALLED ON SCALAR ARG:| $EXPN))))
 614          (RETURN
 615            (DIV
 616              ((LAMBDA (|0| N)
 617                 (COND
 618                   ((NOT (< N |0|))
 619                      (DO
 620                        (($JJ |0| (1+ $JJ))
 621                         (SUM0010
 622                           0
 623                           (ADD*
 624                             SUM0010
 625                             (SIMPLIFY
 626                               (LIST
 627                                 '(%DERIVATIVE)
 628                                 (DIV
 629                                   (MUL* (TRD-MSYMEVAL $SFPROD '$SFPROD)
 630                                         (MARRAYREF $EXPN $JJ))
 631                                   (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST)))
 632                                              $JJ))
 633                                 (MARRAYREF (TRD-MSYMEVAL
 634                                              $COORDINATES '$COORDINATES)
 635                                            $JJ))))))
 636                        ((< N $JJ) SUM0010)))
 637                   ((= N (1- |0|)) 0)
 638                   (T (INTERVAL-ERROR '$SUM |0| N))))
 639               1 (TRD-MSYMEVAL $DIMENSION 0))
 640              (TRD-MSYMEVAL $SFPROD '$SFPROD)))))
 641      (COND
 642        ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '&LAPLACIAN)
 643          (RETURN
 644            (DIV
 645              ((LAMBDA (|0| N)
 646                 (COND
 647                   ((NOT (< N |0|))
 648                      (DO
 649                        (($JJ |0| (1+ $JJ))
 650                         (SUM0011
 651                           0
 652                           (ADD*
 653                             SUM0011
 654                             (SIMPLIFY
 655                               (LIST
 656                                 '(%DERIVATIVE)
 657                                 (DIV
 658                                   (MUL*
 659                                     (TRD-MSYMEVAL $SFPROD '$SFPROD)
 660                                     (SIMPLIFY
 661                                       (LIST
 662                                         '(%DERIVATIVE)
 663                                         (SIMPLIFY
 664                                           (MFUNCTION-CALL $INPART $EXPN 1))
 665                                         (MARRAYREF
 666                                           (TRD-MSYMEVAL $COORDINATES
 667                                                         '$COORDINATES)
 668                                           $JJ))))
 669                                   (POWER (MARRAYREF
 670                                            (TRD-MSYMEVAL $SF '((MLIST)))
 671                                            $JJ)
 672                                          2))
 673                                 (MARRAYREF (TRD-MSYMEVAL
 674                                              $COORDINATES '$COORDINATES)
 675                                            $JJ))))))
 676                        ((< N $JJ) SUM0011)))
 677                   ((= N (1- |0|)) 0)
 678                   (T (INTERVAL-ERROR '$SUM |0| N))))
 679               1 (TRD-MSYMEVAL $DIMENSION 0))
 680              (TRD-MSYMEVAL $SFPROD '$SFPROD)))))
 681      (COND
 682        ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '&CURL)
 683          (SETQ $EXPN (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))
 684          (COND
 685            ((MFUNCTION-CALL $LISTP $EXPN)
 686              (COND
 687                ((= (MFUNCTION-CALL $LENGTH $EXPN) 2)
 688                   (RETURN
 689                     (DIV
 690                       (DIV
 691                         (ADD*
 692                           (SIMPLIFY
 693                             (LIST
 694                               '(%DERIVATIVE)
 695                               (MUL* (MARRAYREF
 696                                       (TRD-MSYMEVAL $SF '((MLIST))) 2)
 697                                     (MARRAYREF $EXPN 2))
 698                               (MARRAYREF
 699                                 (TRD-MSYMEVAL $COORDINATES '$COORDINATES)
 700                                 1)))
 701                           (*MMINUS
 702                             (SIMPLIFY
 703                               (LIST
 704                                 '(%DERIVATIVE)
 705                                 (MUL* (MARRAYREF
 706                                         (TRD-MSYMEVAL $SF '((MLIST))) 1)
 707                                       (MARRAYREF $EXPN 1))
 708                                 (MARRAYREF (TRD-MSYMEVAL
 709                                              $COORDINATES '$COORDINATES)
 710                                            2)))))
 711                         (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) 1))
 712                       (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) 2)))))
 713              (COND
 714                ((= (TRD-MSYMEVAL $DIMENSION 0) 3)
 715                   (RETURN
 716                     (LIST
 717                       '(MLIST)
 718                       (DIV
 719                         (DIV
 720                           (ADD*
 721                             (SIMPLIFY
 722                               (LIST
 723                                 '(%DERIVATIVE)
 724                                 (MUL* (MARRAYREF
 725                                         (TRD-MSYMEVAL $SF '((MLIST))) 3)
 726                                       (MARRAYREF $EXPN 3))
 727                                 (MARRAYREF (TRD-MSYMEVAL
 728                                              $COORDINATES '$COORDINATES)
 729                                            2)))
 730                             (*MMINUS
 731                               (SIMPLIFY
 732                                 (LIST
 733                                   '(%DERIVATIVE)
 734                                   (MUL* (MARRAYREF
 735                                           (TRD-MSYMEVAL $SF '((MLIST)))
 736                                           2)
 737                                         (MARRAYREF $EXPN 2))
 738                                   (MARRAYREF (TRD-MSYMEVAL
 739                                                $COORDINATES '$COORDINATES)
 740                                              3)))))
 741                           (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) 2))
 742                         (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) 3))
 743                       (DIV
 744                         (DIV
 745                           (ADD*
 746                             (SIMPLIFY
 747                               (LIST
 748                                 '(%DERIVATIVE)
 749                                 (MUL* (MARRAYREF
 750                                         (TRD-MSYMEVAL $SF '((MLIST))) 1)
 751                                       (MARRAYREF $EXPN 1))
 752                                 (MARRAYREF (TRD-MSYMEVAL
 753                                              $COORDINATES '$COORDINATES)
 754                                            3)))
 755                             (*MMINUS
 756                               (SIMPLIFY
 757                                 (LIST
 758                                   '(%DERIVATIVE)
 759                                   (MUL* (MARRAYREF
 760                                           (TRD-MSYMEVAL $SF '((MLIST)))
 761                                           3)
 762                                         (MARRAYREF $EXPN 3))
 763                                   (MARRAYREF (TRD-MSYMEVAL
 764                                                $COORDINATES '$COORDINATES)
 765                                              1)))))
 766                           (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) 1))
 767                         (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) 3))
 768                       (DIV
 769                         (DIV
 770                           (ADD*
 771                             (SIMPLIFY
 772                               (LIST
 773                                 '(%DERIVATIVE)
 774                                 (MUL* (MARRAYREF
 775                                         (TRD-MSYMEVAL $SF '((MLIST))) 2)
 776                                       (MARRAYREF $EXPN 2))
 777                                 (MARRAYREF (TRD-MSYMEVAL
 778                                              $COORDINATES '$COORDINATES)
 779                                            1)))
 780                             (*MMINUS
 781                               (SIMPLIFY
 782                                 (LIST
 783                                   '(%DERIVATIVE)
 784                                   (MUL* (MARRAYREF
 785                                           (TRD-MSYMEVAL $SF '((MLIST)))
 786                                           1)
 787                                         (MARRAYREF $EXPN 1))
 788                                   (MARRAYREF (TRD-MSYMEVAL
 789                                                $COORDINATES '$COORDINATES)
 790                                              2)))))
 791                           (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) 1))
 792                         (MARRAYREF
 793                           (TRD-MSYMEVAL $SF '((MLIST))) 2))))))))
 794          (SIMPLIFY
 795            (MFUNCTION-CALL
 796              $ERROR '|&CURL USED IN SPACE OF WRONG DIMENSION|))))
 797      (COND
 798        ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '&~)
 799           (SETQ $ANS (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))
 800           (SETQ $EXPN (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 2)))
 801           (COND
 802             ((AND (MFUNCTION-CALL $LISTP $ANS)
 803                   (MFUNCTION-CALL $LISTP $EXPN)
 804                   (= (MFUNCTION-CALL $LENGTH $ANS)
 805                      (MFUNCTION-CALL $LENGTH $EXPN)))
 806                (COND
 807                  ((= (MFUNCTION-CALL $LENGTH $ANS) 2)
 808                     (RETURN
 809                       (ADD* (MUL* (MARRAYREF $ANS 1) (MARRAYREF $EXPN 2))
 810                             (*MMINUS (MUL* (MARRAYREF $ANS 2)
 811                                            (MARRAYREF $EXPN 1)))))))
 812                (COND
 813                  ((= (MFUNCTION-CALL $LENGTH $ANS) 3)
 814                     (RETURN
 815                       (LIST
 816                         '(MLIST)
 817                         (ADD*
 818                           (MUL* (MARRAYREF $ANS 2) (MARRAYREF $EXPN 3))
 819                           (*MMINUS (MUL* (MARRAYREF $ANS 3)
 820                                          (MARRAYREF $EXPN 2))))
 821                         (ADD*
 822                           (MUL* (MARRAYREF $ANS 3) (MARRAYREF $EXPN 1))
 823                           (*MMINUS (MUL* (MARRAYREF $ANS 1)
 824                                          (MARRAYREF $EXPN 3))))
 825                         (ADD*
 826                           (MUL* (MARRAYREF $ANS 1) (MARRAYREF $EXPN 2))
 827                           (*MMINUS (MUL* (MARRAYREF $ANS 2)
 828                                          (MARRAYREF $EXPN 1))))))))))
 829           (SIMPLIFY
 830             (MFUNCTION-CALL $ERROR '|&~ USED WITH IMPROPER ARGUMENTS:|
 831                             $ANS $EXPN))))
 832      (RETURN $EXPN)))
 833   '$ANS))
 834
 835 (DEFPROP $TRIGSIMP T TRANSLATED)
 836
 837 (ADD2LNC '$TRIGSIMP $PROPS)
 838
 839 (DEFMTRFUN
 840   ($TRIGSIMP $ANY MDEFINE NIL NIL) ($EXPN) NIL
 841   (SIMPLIFY
 842     (MFUNCTION-CALL
 843       $RATSIMP
 844       (DIV (SIMPLIFY (MFUNCTION-CALL
 845                        $TRIGSIMP1 (SIMPLIFY (MFUNCTION-CALL $NUM $EXPN))))
 846            (SIMPLIFY
 847              (MFUNCTION-CALL
 848                $TRIGSIMP1 (SIMPLIFY (MFUNCTION-CALL $DENOM $EXPN))))))))
 849
 850 (DEFPROP $TRIGSIMP1 T TRANSLATED)
 851
 852 (ADD2LNC '$TRIGSIMP1 $PROPS)
 853
 854 (DEFMTRFUN
 855   ($TRIGSIMP1 $ANY MDEFINE NIL NIL) ($EXPN) NIL
 856   ((LAMBDA ($LISTOFTRIGSQ $BESTLENGTH $TRYLENGTH)
 857      NIL
 858      (ASSIGN-MODE-CHECK '$TRYLENGTH $TRYLENGTH)
 859      (ASSIGN-MODE-CHECK '$BESTLENGTH $BESTLENGTH)
 860      (PROG ()
 861           (SETQ
 862             $LISTOFTRIGSQ (SIMPLIFY (MFUNCTION-CALL $LISTOFTRIGSQ $EXPN)))
 863           (PROGN (ASSIGN-MODE-CHECK '$BESTLENGTH 999999)
 864                  (SETQ $BESTLENGTH 999999))
 865           (COND
 866             ((NOT (LIKE $LISTOFTRIGSQ '((MLIST))))
 867                (SIMPLIFY (MFUNCTION-CALL $IMPROVE $EXPN $LISTOFTRIGSQ))))
 868           (RETURN $EXPN)))
 869    '$LISTOFTRIGSQ 0 0))
 870
 871 (DEFPROP $IMPROVE T TRANSLATED)
 872
 873 (ADD2LNC '$IMPROVE $PROPS)
 874
 875 (DEFMTRFUN
 876  ($IMPROVE $ANY MDEFINE NIL NIL) ($SUBSOFAR $LISTOFTRIGSQ) NIL
 877  (COND
 878   ((LIKE $LISTOFTRIGSQ '((MLIST)))
 879      ((LAMBDA (|tr-gensym~19|)
 880         (PROGN (ASSIGN-MODE-CHECK '$TRYLENGTH |tr-gensym~19|)
 881                (SETQ $TRYLENGTH |tr-gensym~19|)))
 882       (SIMPLIFY (MFUNCTION-CALL $EXPNLENGTH $SUBSOFAR)))
 883      (COND ((< (TRD-MSYMEVAL $TRYLENGTH 0) (TRD-MSYMEVAL $BESTLENGTH 0))
 884               (SETQ $EXPN $SUBSOFAR)
 885               ((LAMBDA (|tr-gensym~20|)
 886                  (PROGN (ASSIGN-MODE-CHECK '$BESTLENGTH |tr-gensym~20|)
 887                         (SETQ $BESTLENGTH |tr-gensym~20|)))
 888                (TRD-MSYMEVAL $TRYLENGTH 0)))))
 889   (T
 890    (SIMPLIFY
 891      (MFUNCTION-CALL $IMPROVE $SUBSOFAR
 892                      (SIMPLIFY (MFUNCTION-CALL $REST $LISTOFTRIGSQ))))
 893    (DO (($ALT) (MDO (CDR (SIMPLIFY ($FIRST $LISTOFTRIGSQ))) (CDR MDO)))
 894        ((NULL MDO) '$DONE)
 895     (SETQ $ALT (CAR MDO))
 896     (SIMPLIFY
 897       (MFUNCTION-CALL
 898         $IMPROVE
 899         (SIMPLIFY
 900           (MFUNCTION-CALL
 901             $RATSUBST
 902             (COND
 903               ((LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $ALT 0)) '%SIN)
 904                  (ADD*
 905                    1
 906                    (*MMINUS
 907                      (POWER
 908                        (SIMPLIFY
 909                          (LIST '(%COS)
 910                                (SIMPLIFY (MFUNCTION-CALL $INPART $ALT 1))))
 911                        2))))
 912               ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '%COS)
 913                  (ADD*
 914                    1
 915                    (*MMINUS
 916                      (POWER
 917                        (SIMPLIFY
 918                          (LIST '(%SIN)
 919                                (SIMPLIFY (MFUNCTION-CALL $INPART $ALT 1))))
 920                        2))))
 921               ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '%SINH)
 922                  (ADD*
 923                    (POWER
 924                      (SIMPLIFY
 925                        (LIST '(%COSH)
 926                              (SIMPLIFY (MFUNCTION-CALL $INPART $ALT 1))))
 927                      2)
 928                    -1))
 929               (T (ADD*
 930                    1
 931                    (POWER
 932                      (SIMPLIFY
 933                        (LIST '(%SINH)
 934                              (SIMPLIFY (MFUNCTION-CALL $INPART $ALT 1))))
 935                      2))))
 936             (POWER $ALT 2) $SUBSOFAR))
 937         (SIMPLIFY (MFUNCTION-CALL $REST $LISTOFTRIGSQ))))))))
 938
 939 (DEFPROP $LISTOFTRIGSQ T TRANSLATED)
 940
 941 (ADD2LNC '$LISTOFTRIGSQ $PROPS)
 942
 943 (DEFMTRFUN
 944  ($LISTOFTRIGSQ $ANY MDEFINE NIL NIL) ($EXPN) NIL
 945  (COND
 946   ((MFUNCTION-CALL $ATOM $EXPN) '((MLIST)))
 947   (T
 948     ((LAMBDA ($INFLAG $ANS)
 949        NIL
 950        (PROG ()
 951            (COND
 952              ((AND
 953                 (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 0)) '&^)
 954                 (MFUNCTION-CALL
 955                   $INTEGERP (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 2)))
 956                 (NOT
 957                   (IS-BOOLE-CHECK (MLSP (TRD-MSYMEVAL $PIECE '$PIECE) 2))))
 958                 (COND
 959                   ((MFUNCTION-CALL
 960                      $ATOM
 961                      (SETQ $EXPN
 962                            (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1))))
 963                      (RETURN '((MLIST))))
 964                   ((MFUNCTION-CALL
 965                      $MEMBER (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 0))
 966                      '((MLIST) %SIN %COS %SINH %COSH))
 967                      (RETURN (LIST '(MLIST) (LIST '(MLIST) $EXPN)))))))
 968            (SETQ $INFLAG T)
 969            (SETQ $ANS '((MLIST)))
 970            (DO (($ARG) (MDO (CDR $EXPN) (CDR MDO))) ((NULL MDO) '$DONE)
 971              (SETQ $ARG (CAR MDO))
 972              (SETQ
 973                $ANS
 974                (SIMPLIFY (MFUNCTION-CALL
 975                            $SPECIALUNION
 976                            (SIMPLIFY (MFUNCTION-CALL $LISTOFTRIGSQ $ARG))
 977                            $ANS))))
 978            (RETURN $ANS)))
 979      '$INFLAG '$ANS))))
 980
 981 (DEFPROP $SPECIALUNION T TRANSLATED)
 982
 983 (ADD2LNC '$SPECIALUNION $PROPS)
 984
 985 (DEFMTRFUN
 986  ($SPECIALUNION $ANY MDEFINE NIL NIL) ($LIST1 $LIST2) NIL
 987  (COND
 988   ((LIKE $LIST1 '((MLIST))) $LIST2)
 989   ((LIKE $LIST2 '((MLIST))) $LIST1)
 990   (T
 991     ((LAMBDA ($ALTERNATES)
 992        NIL
 993        (PROG ()
 994            (SETQ $ALTERNATES (SIMPLIFY ($FIRST $LIST1)))
 995            (DO (($ALT) (MDO (CDR $ALTERNATES) (CDR MDO)))
 996                ((NULL MDO) '$DONE)
 997              (SETQ $ALT (CAR MDO))
 998              (SETQ
 999                $LIST2
1000                (COND
1001                  ((LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $ALT 0)) '%SIN)
1002                     (SIMPLIFY (MFUNCTION-CALL $UPDATE $ALT '%COS $LIST2)))
1003                  ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '%COS)
1004                     (SIMPLIFY (MFUNCTION-CALL $UPDATE $ALT '%SIN $LIST2)))
1005                  ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '%SINH)
1006                     (SIMPLIFY (MFUNCTION-CALL $UPDATE $ALT '%COSH $LIST2)))
1007                  (T (SIMPLIFY
1008                       (MFUNCTION-CALL $UPDATE $ALT '%SINH $LIST2))))))
1009            (RETURN
1010              (SIMPLIFY
1011                (MFUNCTION-CALL
1012                  $SPECIALUNION
1013                  (SIMPLIFY (MFUNCTION-CALL $REST $LIST1)) $LIST2)))))
1014      '$ALTERNATES))))
1015
1016 (DEFPROP $UPDATE T TRANSLATED)
1017
1018 (ADD2LNC '$UPDATE $PROPS)
1019
1020 (DEFMTRFUN
1021  ($UPDATE $ANY MDEFINE NIL NIL) ($FORM $COMPLEMENT $LIST2) NIL
1022  ((LAMBDA ($ANS)
1023     NIL
1024     (SETQ $COMPLEMENT
1025           (SIMPLIFY
1026             (MFUNCALL
1027               '$COMPLEMENT (SIMPLIFY (MFUNCTION-CALL $INPART $FORM 1)))))
1028     (SETQ
1029       $ANS
1030       (DO (($ELEMENT) (MDO (CDR $LIST2) (CDR MDO))) ((NULL MDO) '$DONE)
1031         (SETQ $ELEMENT (CAR MDO))
1032         (COND
1033           ((MFUNCTION-CALL $MEMBER $FORM $ELEMENT) (RETURN '$FOUND))
1034           ((MFUNCTION-CALL $MEMBER $COMPLEMENT $ELEMENT)
1035              (RETURN (SIMPLIFY
1036                        (MFUNCTION-CALL
1037                          $CONS (LIST '(MLIST) $FORM $COMPLEMENT)
1038                          (SIMPLIFY
1039                            (MFUNCTION-CALL $DELETE $ELEMENT $LIST2)))))))))
1040     (COND
1041       ((LIKE $ANS '$FOUND) $LIST2)
1042       ((LIKE $ANS '$DONE)
1043          (SIMPLIFY (MFUNCTION-CALL $CONS (LIST '(MLIST) $FORM) $LIST2)))
1044       (T $ANS)))
1045   '$ANS))
1046
1047 (DEFPROP $EXPNLENGTH T TRANSLATED)
1048
1049 (ADD2LNC '$EXPNLENGTH $PROPS)
1050
1051 (DEFMTRFUN
1052   ($EXPNLENGTH $ANY MDEFINE NIL NIL) ($EXPR) NIL
1053   (COND
1054     ((MFUNCTION-CALL $ATOM $EXPR) 1)
1055     (T (ADD*
1056          1
1057          (SIMPLIFY
1058            (MFUNCTION-CALL
1059              $ARGSLENGTH
1060              (SIMPLIFY
1061                (PART1
1062                  (LIST (LIST '(MQUOTE SIMP) '&[)
1063                        (LIST '(MQUOTE SIMP) $EXPR) (LIST '(MQUOTE SIMP) 0))
1064                  T NIL T))))))))
1065
1066 (DEFPROP $ARGSLENGTH T TRANSLATED)
1067
1068 (ADD2LNC '$ARGSLENGTH $PROPS)
1069
1070 (DEFMTRFUN
1071   ($ARGSLENGTH $ANY MDEFINE NIL NIL) ($ARGS) NIL
1072   (COND
1073     ((LIKE $ARGS '((MLIST))) 0)
1074     (T (ADD*
1075          (SIMPLIFY (MFUNCTION-CALL $EXPNLENGTH (SIMPLIFY ($FIRST $ARGS))))
1076          (SIMPLIFY
1077            (MFUNCTION-CALL
1078              $ARGSLENGTH (SIMPLIFY (MFUNCTION-CALL $REST $ARGS))))))))
1079
1080 ((LAMBDA (|tr-gensym~21|)
1081    (PROGN
1082      (MSETCHK '$DOTASSOC |tr-gensym~21|) (SETQ $DOTASSOC |tr-gensym~21|)))
1083  (SETQ $DOTEXPTSIMP NIL))
1084
1085 (SETQ $DOTSCRULES T)
1086
1087 (MEVAL* '(($MODEDECLARE) $EXPANDFLAGS $LIST))
1088
1089 (MEVAL* '(($DECLARE) $EXPANDFLAGS $SPECIAL))
1090
1091 (DEFPROP $EXPANDFLAGS ASSIGN-MODE-CHECK ASSIGN)
1092
1093 (DEF-MTRVAR
1094   $EXPANDFLAGS '((MLIST) $EXPANDALL $EXPANDDOT $EXPANDDOTPLUS $EXPANDCROSS
1095                  $EXPANDCROSSPLUS $EXPANDCROSSCROSS $EXPANDGRAD
1096                  $EXPANDGRADPLUS $EXPANDGRADPROD $EXPANDDIV $EXPANDDIVPLUS
1097                  $EXPANDDIVPROD $EXPANDCURL $EXPANDCURLPLUS $EXPANDCURLCURL
1098                  $EXPANDLAPLACIAN $EXPANDLAPLACIANPLUS $EXPANDLAPLACIANPROD
1099                  $EXPANDLAPLACIANTODIVGRAD $EXPANDPLUS $EXPANDPROD))
1100
1101 (SIMPLIFY (MFUNCALL '$DECLARE '$EXPANDFLAGS '$EVFLAG))
1102
1103 (DEFPROP $FLAG_RESET T TRANSLATED)
1104
1105 (ADD2LNC '$FLAG_RESET $PROPS)
1106
1107 (DEFMTRFUN
1108   ($FLAG_RESET $ANY MDEFINE NIL NIL) NIL NIL
1109   (DO
1110     (($FLAG) (MDO (CDR (TRD-MSYMEVAL $EXPANDFLAGS '((MLIST)))) (CDR MDO)))
1111     ((NULL MDO) '$DONE)
1112     (SETQ $FLAG (CAR MDO)) (SIMPLIFY (MFUNCTION-CALL MSET $FLAG NIL))))
1113
1114 (DEFPROP $VECTORSIMP T TRANSLATED)
1115
1116 (ADD2LNC '$VECTORSIMP $PROPS)
1117
1118 (DEFMTRFUN
1119   ($VECTORSIMP $ANY MDEFINE NIL NIL) ($EXPN) NIL
1120   ((LAMBDA ($DOTDISTRIB $DOTSCRULES $INFLAG $FIRSTCROSSSCALAR)
1121      NIL
1122      (ASSIGN-MODE-CHECK '$FIRSTCROSSSCALAR $FIRSTCROSSSCALAR)
1123      (SETQ $INFLAG (PROGN (ASSIGN-MODE-CHECK '$FIRSTCROSSSCALAR T)
1124                           (SETQ $FIRSTCROSSSCALAR T)))
1125      (SETQ
1126        $DOTDISTRIB
1127        (OR
1128          (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDDOT NIL)
1129          (TRD-MSYMEVAL $EXPANDDOTPLUS NIL) (TRD-MSYMEVAL $EXPANDPLUS NIL)))
1130      (COND
1131        ((OR (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDGRAD NIL)
1132             (TRD-MSYMEVAL $EXPANDGRADPLUS NIL)
1133             (TRD-MSYMEVAL $EXPANDPLUS NIL))
1134           ($DECLARE &GRAD $ADDITIVE)))
1135      (COND
1136        ((OR
1137           (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDDIV NIL)
1138           (TRD-MSYMEVAL $EXPANDDIVPLUS NIL) (TRD-MSYMEVAL $EXPANDPLUS NIL))
1139           ($DECLARE &DIV $ADDITIVE)))
1140      (COND
1141        ((OR (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDCURL NIL)
1142             (TRD-MSYMEVAL $EXPANDCURLPLUS NIL)
1143             (TRD-MSYMEVAL $EXPANDPLUS NIL))
1144           ($DECLARE &CURL $ADDITIVE)))
1145      (COND
1146        ((OR
1147           (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDLAPLACIAN NIL)
1148           (TRD-MSYMEVAL $EXPANDLAPLACIANPLUS NIL)
1149           (TRD-MSYMEVAL $EXPANDPLUS NIL))
1150           ($DECLARE &LAPLACIAN $ADDITIVE)))
1151      (SETQ $EXPN (SIMPLIFY (MFUNCTION-CALL $VSIMP $EXPN)))
1152      (COND ((TRD-MSYMEVAL $EXPANDALL NIL)
1153               (SETQ $EXPN (SIMPLIFY (MFUNCTION-CALL $RATEXPAND $EXPN)))))
1154      (COND
1155        ((OR (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDGRAD NIL)
1156             (TRD-MSYMEVAL $EXPANDGRADPLUS NIL)
1157             (TRD-MSYMEVAL $EXPANDPLUS NIL))
1158           (MEVAL '(($REMOVE) &GRAD $ADDITIVE))))
1159      (COND
1160        ((OR
1161           (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDDIV NIL)
1162           (TRD-MSYMEVAL $EXPANDDIVPLUS NIL) (TRD-MSYMEVAL $EXPANDPLUS NIL))
1163           (MEVAL '(($REMOVE) &DIV $ADDITIVE))))
1164      (COND
1165        ((OR (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDCURL NIL)
1166             (TRD-MSYMEVAL $EXPANDCURLPLUS NIL)
1167             (TRD-MSYMEVAL $EXPANDPLUS NIL))
1168           (MEVAL '(($REMOVE) &CURL $ADDITIVE))))
1169      (COND
1170        ((OR
1171           (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDLAPLACIAN NIL)
1172           (TRD-MSYMEVAL $EXPANDLAPLACIANPLUS NIL)
1173           (TRD-MSYMEVAL $EXPANDPLUS NIL))
1174           (MEVAL '(($REMOVE) &LAPLACIAN $ADDITIVE))))
1175      $EXPN)
1176    '$DOTDISTRIB '$DOTSCRULES '$INFLAG '$FIRSTCROSSSCALAR))
1177
1178 (DEFPROP $BEFORE T TRANSLATED)
1179
1180 (ADD2LNC '$BEFORE $PROPS)
1181
1182 (DEFMTRFUN
1183   ($BEFORE $ANY MDEFINE NIL NIL) ($ARG) NIL
1184   (SIMPLIFY
1185     (LIST
1186       '(MNOTEQUAL)
1187       (SIMPLIFY
1188         (MFUNCTION-CALL
1189           $INPART
1190           (SIMPLIFY (LIST '($ORDER) (TRD-MSYMEVAL $ETRUE '$ETRUE) $ARG))
1191           1))
1192       (TRD-MSYMEVAL $ETRUE '$ETRUE))))
1193
1194 (DEFPROP $VSCALARP T TRANSLATED)
1195
1196 (ADD2LNC '$VSCALARP $PROPS)
1197
1198 (DEFMTRFUN ($VSCALARP $BOOLEAN MDEFINE NIL NIL) ($ARG)
1199            NIL (NOT (MFUNCTION-CALL $NONSCALARP $ARG)))
1200
1201 (DEFPROP $VSIMP T TRANSLATED)
1202
1203 (ADD2LNC '$VSIMP $PROPS)
1204
1205 (DEFMTRFUN
1206  ($VSIMP $ANY MDEFINE NIL NIL) ($EXPN) NIL
1207  (COND
1208   ((MFUNCTION-CALL $MAPATOM $EXPN) $EXPN)
1209   (T
1210    ((LAMBDA ($PV $QV $RV $SV)
1211       NIL
1212       (PROG ()
1213          (SETQ $EXPN (SIMPLIFY (MAP1 (GETOPR '$VSIMP) $EXPN)))
1214          (COND ((MFUNCTION-CALL $MAPATOM $EXPN) (RETURN $EXPN)))
1215          (COND
1216            ((LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 0)) '&~)
1217               (SETQ
1218                 $EXPN
1219                 (SIMPLIFY
1220                   (MFUNCTION-CALL $REMOVECROSSSC1 $EXPN $PV $RV $SV))))
1221            ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '&GRAD)
1222               (COND
1223                 ((AND
1224                    (OR (TRD-MSYMEVAL $EXPANDALL NIL)
1225                        (TRD-MSYMEVAL $EXPANDGRAD NIL)
1226                        (TRD-MSYMEVAL $EXPANDGRADPROD NIL)
1227                        (TRD-MSYMEVAL $EXPANDPROD NIL))
1228                    (NOT
1229                      (MFUNCTION-CALL
1230                        $MAPATOM
1231                        (SETQ
1232                          $PV
1233                          (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))))
1234                    (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $PV 0)) '&*))
1235                    (SETQ
1236                      $EXPN
1237                      (SIMPLIFY
1238                        (MAPPLY-TR
1239                          '&+
1240                          (MAPLIST_TR
1241                            (M-TLAMBDA&ENV
1242                              (($U) ($PV)) NIL
1243                              (SIMPLIFY (MFUNCTION-CALL $GRADPROD $U $PV)))
1244                            $PV)))))))
1245            ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '&DIV)
1246               (COND
1247                 ((AND
1248                    (OR (TRD-MSYMEVAL $EXPANDALL NIL)
1249                        (TRD-MSYMEVAL $EXPANDDIV NIL)
1250                        (TRD-MSYMEVAL $EXPANDDIVPROD NIL)
1251                        (TRD-MSYMEVAL $EXPANDPROD NIL))
1252                    (NOT
1253                      (MFUNCTION-CALL
1254                        $MAPATOM
1255                        (SETQ
1256                          $PV
1257                          (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))))
1258                    (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $PV 0)) '&*))
1259                    (SETQ
1260                      $EXPN
1261                      (SIMPLIFY
1262                        (MAPPLY-TR
1263                          '&+
1264                          (MAPLIST_TR
1265                            (M-TLAMBDA&ENV
1266                              (($U) ($PV)) NIL
1267                              (SIMPLIFY (MFUNCTION-CALL $DIVPROD $U $PV)))
1268                            $PV)))))))
1269            ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '&CURL)
1270               (COND
1271                 ((AND
1272                    (OR (TRD-MSYMEVAL $EXPANDALL NIL)
1273                        (TRD-MSYMEVAL $EXPANDCURL NIL)
1274                        (TRD-MSYMEVAL $EXPANDCURLCURL NIL))
1275                    (NOT
1276                      (MFUNCTION-CALL
1277                        $MAPATOM
1278                        (SETQ
1279                          $PV
1280                          (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))))
1281                    (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $PV 0))
1282                          '&CURL))
1283                    (SETQ
1284                      $EXPN
1285                      (ADD*
1286                        (SIMPLIFY
1287                          (MFUNCTION-CALL
1288                            $GRAD
1289                            (SIMPLIFY
1290                              (LIST
1291                                '($DIV)
1292                                (SETQ $PV
1293                                      (SIMPLIFY
1294                                        (MFUNCTION-CALL $INPART $PV 1)))))))
1295                        (*MMINUS
1296                          (SIMPLIFY (MFUNCTION-CALL $LAPLACIAN $PV))))))))
1297            ((LIKE (TRD-MSYMEVAL $PIECE '$PIECE) '&LAPLACIAN)
1298               (COND
1299                 ((TRD-MSYMEVAL $EXPANDLAPLACIANTODIVGRAD NIL)
1300                    (SETQ
1301                      $EXPN
1302                      (SIMPLIFY
1303                        (LIST '($DIV)
1304                              (SIMPLIFY
1305                                (MFUNCTION-CALL
1306                                  $GRAD
1307                                  (SIMPLIFY
1308                                    (MFUNCTION-CALL $INPART $EXPN 1))))))))
1309                 ((AND
1310                    (OR (TRD-MSYMEVAL $EXPANDALL NIL)
1311                        (TRD-MSYMEVAL $EXPANDLAPLACIAN NIL)
1312                        (TRD-MSYMEVAL $EXPANDLAPLACIANPROD NIL)
1313                        (TRD-MSYMEVAL $EXPANDPROD NIL))
1314                    (NOT
1315                      (MFUNCTION-CALL
1316                        $MAPATOM
1317                        (SETQ
1318                          $PV
1319                          (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))))
1320                    (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $PV 0)) '&*))
1321                    (SETQ $QV (SIMPLIFY (MFUNCTION-CALL $INPART $PV 1)))
1322                    (SETQ $RV (SIMPLIFY (MFUNCTION-CALL $DELETE $QV $PV)))
1323                    (SETQ
1324                      $EXPN
1325                      (ADD*
1326                        (MUL* $RV
1327                              (SIMPLIFY (MFUNCTION-CALL $LAPLACIAN $QV)))
1328                        (MUL* 2 (SIMPLIFY (MFUNCTION-CALL $GRAD $RV))
1329                              (SIMPLIFY (MFUNCTION-CALL $GRAD $QV)))
1330                        (MUL*
1331                          $QV
1332                          (SIMPLIFY (MFUNCTION-CALL $LAPLACIAN $RV)))))))))
1333          (RETURN $EXPN)))
1334     '$PV '$QV '$RV '$SV))))
1335
1336 (DEFPROP $CROSSSIMP T TRANSLATED)
1337
1338 (ADD2LNC '$CROSSSIMP $PROPS)
1339
1340 (DEFMTRFUN
1341   ($CROSSSIMP $ANY MDEFINE NIL NIL) ($EX $PV $RV $SV) NIL
1342   (COND
1343     ((AND (NOT (MFUNCTION-CALL $MAPATOM $EX))
1344           (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $EX 0)) '&~))
1345        (COND
1346          ((OR (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDCROSS NIL)
1347               (TRD-MSYMEVAL $EXPANDCROSSCROSS NIL))
1348             (SETQ
1349               $EX
1350               (SIMPLIFY (MFUNCTION-CALL $TRYCROSSCROSS $EX $PV $RV $SV)))))
1351        (COND
1352          ((AND
1353             (NOT (MFUNCTION-CALL $MAPATOM $EX))
1354             (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $EX 0)) '&~)
1355             (OR
1356               (TRD-MSYMEVAL $EXPANDALL NIL) (TRD-MSYMEVAL $EXPANDCROSS NIL)
1357               (TRD-MSYMEVAL $EXPANDCROSSPLUS NIL)
1358               (TRD-MSYMEVAL $EXPANDPLUS NIL)))
1359             (SETQ
1360               $EX
1361               (SIMPLIFY (MFUNCTION-CALL $TRYCROSSPLUS $EX $PV $RV $SV)))))
1362        $EX)
1363     (T $EX)))
1364
1365 (DEFPROP $REMOVECROSSSC T TRANSLATED)
1366
1367 (ADD2LNC '$REMOVECROSSSC $PROPS)
1368
1369 (DEFMTRFUN
1370   ($REMOVECROSSSC $ANY MDEFINE NIL NIL) ($EXPN $PV $RV $SV) NIL
1371   (COND ((AND (NOT (MFUNCTION-CALL $MAPATOM $EXPN))
1372               (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 0)) '&~))
1373            (SIMPLIFY (MFUNCTION-CALL $REMOVECROSSSC1 $EXPN $PV $RV $SV)))
1374         (T $EXPN)))
1375
1376 (DEFPROP $REMOVECROSSSC1 T TRANSLATED)
1377
1378 (ADD2LNC '$REMOVECROSSSC1 $PROPS)
1379
1380 (DEFMTRFUN
1381  ($REMOVECROSSSC1 $ANY MDEFINE NIL NIL) ($EXPN $PV $RV $SV) NIL
1382  ((LAMBDA ($LEFT $RIGHT)
1383    NIL
1384    (PROG ()
1385     (SETQ
1386       $LEFT
1387       (SIMPLIFY
1388         (MFUNCTION-CALL
1389           $PARTITIONSC (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))))
1390     (SETQ
1391       $RIGHT
1392       (SIMPLIFY
1393         (MFUNCTION-CALL
1394           $PARTITIONSC (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 2)))))
1395     (COND
1396      ((AND (TRD-MSYMEVAL $FIRSTCROSSSCALAR NIL)
1397            (OR (LIKE (MARRAYREF $LEFT 2) 1)
1398                (LIKE (MARRAYREF $RIGHT 2) 1)))
1399       (SIMPLIFY
1400        (MFUNCTION-CALL
1401         $PRINT
1402         '|&WARNING: DECLARE VECTOR INDETERMINANTS
1403 NONSCALAR TO AVOID ERRORS & TO GET FULL SIMPLIFICATION|))
1404       (PROGN (ASSIGN-MODE-CHECK '$FIRSTCROSSSCALAR NIL)
1405              (SETQ $FIRSTCROSSSCALAR NIL))
1406       (RETURN $EXPN)))
1407     (RETURN
1408       (MUL*
1409         (MARRAYREF $LEFT 1) (MARRAYREF $RIGHT 1)
1410         (SIMPLIFY
1411           (MFUNCTION-CALL
1412             $CROSSSIMP
1413             (SIMPLIFY
1414               (LIST '($~) (MARRAYREF $LEFT 2) (MARRAYREF $RIGHT 2)))
1415             $PV $RV $SV))))))
1416   '$LEFT '$RIGHT))
1417
1418 (DEFPROP $PARTITIONSC T TRANSLATED)
1419
1420 (ADD2LNC '$PARTITIONSC $PROPS)
1421
1422 (DEFMTRFUN
1423   ($PARTITIONSC $ANY MDEFINE NIL NIL) ($EX) NIL
1424   (COND ((MFUNCTION-CALL $MAPATOM $EX)
1425            (COND ((MFUNCTION-CALL $NONSCALARP $EX) (LIST '(MLIST) 1 $EX))
1426                  (T (LIST '(MLIST) $EX 1))))
1427         ((LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $EX 0)) '&*)
1428            ((LAMBDA ($SC $NONSC)
1429               NIL
1430               (SETQ $SC (SETQ $NONSC 1))
1431               (DO (($FACT) (MDO (CDR $EX) (CDR MDO))) ((NULL MDO) '$DONE)
1432                 (SETQ $FACT (CAR MDO))
1433                 (COND ((MFUNCTION-CALL $NONSCALARP $FACT)
1434                          (SETQ $NONSC (MUL* $NONSC $FACT)))
1435                       (T (SETQ $SC (MUL* $SC $FACT)))))
1436               (LIST '(MLIST) $SC $NONSC))
1437             '$SC '$NONSC))
1438         (T (LIST '(MLIST) 1 $EX))))
1439
1440 (DEFPROP $TRYCROSSPLUS T TRANSLATED)
1441
1442 (ADD2LNC '$TRYCROSSPLUS $PROPS)
1443
1444 (DEFMTRFUN
1445  ($TRYCROSSPLUS $ANY MDEFINE NIL NIL) ($EXPN $PV $RV $SV) NIL
1446  (PROGN
1447    (SETQ $PV (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))
1448    (SETQ $RV (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 2)))
1449    (COND
1450      ((AND (NOT (MFUNCTION-CALL $MAPATOM $PV))
1451            (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $PV 0)) '&+))
1452         (COND
1453           ((AND (NOT (MFUNCTION-CALL $MAPATOM $RV))
1454                 (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $RV 0)) '&+))
1455              (SIMPLIFY
1456                (MAP1
1457                  (GETOPR
1458                    (M-TLAMBDA&ENV
1459                      (($U) ($PV $RV $SV)) NIL
1460                      (SIMPLIFY
1461                        (MFUNCTION-CALL $TRYCROSSPLUS $U $PV $RV $SV))))
1462                  (SIMPLIFY
1463                    (MAP1
1464                      (GETOPR
1465                        (M-TLAMBDA&ENV
1466                          (($U) ($RV $SV)) NIL
1467                          (SIMPLIFY (MFUNCTION-CALL $CROSSRV $U $RV $SV))))
1468                      $PV)))))
1469           (T
1470             (SIMPLIFY
1471               (MAP1
1472                 (GETOPR (M-TLAMBDA&ENV
1473                           (($U) ($RV $SV)) NIL
1474                           (SIMPLIFY (MFUNCTION-CALL $CROSSRV $U $RV $SV))))
1475                 $PV)))))
1476      ((AND (NOT (MFUNCTION-CALL $MAPATOM $RV))
1477            (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $RV 0)) '&+))
1478         (SIMPLIFY
1479           (MAP1 (GETOPR (M-TLAMBDA&ENV
1480                           (($U) ($PV $SV)) NIL
1481                           (SIMPLIFY (MFUNCTION-CALL $PVCROSS $PV $U $SV))))
1482                 $RV)))
1483      (T $EXPN))))
1484
1485 (DEFPROP $TRYCROSSCROSS T TRANSLATED)
1486
1487 (ADD2LNC '$TRYCROSSCROSS $PROPS)
1488
1489 (DEFMTRFUN
1490   ($TRYCROSSCROSS $ANY MDEFINE NIL NIL) ($EXPN $PV $RV $SV) NIL
1491   (PROGN (SETQ $PV (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 1)))
1492          (SETQ $RV (SIMPLIFY (MFUNCTION-CALL $INPART $EXPN 2)))
1493          (COND ((AND (NOT (MFUNCTION-CALL $MAPATOM $RV))
1494                      (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $RV 0)) '&~))
1495                   (SETQ $SV (SIMPLIFY (MFUNCTION-CALL $INPART $RV 2)))
1496                   (SETQ $RV (SIMPLIFY (MFUNCTION-CALL $INPART $RV 1)))
1497                   (ADD* (MUL* $RV (NCMUL2 $PV $SV))
1498                         (*MMINUS (MUL* $SV (NCMUL2 $PV $RV)))))
1499                ((AND (NOT (MFUNCTION-CALL $MAPATOM $PV))
1500                      (LIKE (SIMPLIFY (MFUNCTION-CALL $INPART $PV 0)) '&~))
1501                   (SETQ $SV (SIMPLIFY (MFUNCTION-CALL $INPART $PV 2)))
1502                   (SETQ $PV (SIMPLIFY (MFUNCTION-CALL $INPART $PV 1)))
1503                   (ADD* (MUL* $SV (NCMUL2 $RV $PV))
1504                         (*MMINUS (MUL* $PV (NCMUL2 $RV $SV)))))
1505                (T $EXPN))))
1506
1507 (DEFPROP $PVCROSS T TRANSLATED)
1508
1509 (ADD2LNC '$PVCROSS $PROPS)
1510
1511 (DEFMTRFUN
1512   ($PVCROSS $ANY MDEFINE NIL NIL) ($PV $RV $SV) NIL
1513   (SIMPLIFY (MFUNCTION-CALL
1514               $REMOVECROSSSC (SIMPLIFY (LIST '($~) $PV $RV)) $PV $RV $SV)))
1515
1516 (DEFPROP $CROSSRV T TRANSLATED)
1517
1518 (ADD2LNC '$CROSSRV $PROPS)
1519
1520 (DEFMTRFUN
1521   ($CROSSRV $ANY MDEFINE NIL NIL) ($PV $RV $SV) NIL
1522   (SIMPLIFY (MFUNCTION-CALL
1523               $REMOVECROSSSC (SIMPLIFY (LIST '($~) $PV $RV)) $PV $RV $SV)))
1524
1525 (DEFPROP $GRADPROD T TRANSLATED)
1526
1527 (ADD2LNC '$GRADPROD $PROPS)
1528
1529 (DEFMTRFUN ($GRADPROD $ANY MDEFINE NIL NIL) ($UU $PV) NIL
1530            (MUL* (SIMPLIFY (MFUNCTION-CALL $DELETE $UU $PV))
1531                  (SIMPLIFY (MFUNCTION-CALL $GRAD $UU))))
1532
1533 (DEFPROP $DIVPROD T TRANSLATED)
1534
1535 (ADD2LNC '$DIVPROD $PROPS)
1536
1537 (DEFMTRFUN ($DIVPROD $ANY MDEFINE NIL NIL) ($UU $PV) NIL
1538            ((LAMBDA ($DOTSCRULES)
1539               NIL
1540               (SETQ $DOTSCRULES NIL)
1541               (COND ((MFUNCTION-CALL $NONSCALARP $UU)
1542                        (MUL* (SIMPLIFY (MFUNCTION-CALL $DELETE $UU $PV))
1543                              (SIMPLIFY (LIST '($DIV) $UU))))
1544                     (T (NCMUL2 (SIMPLIFY (MFUNCTION-CALL $DELETE $UU $PV))
1545                                (SIMPLIFY (MFUNCTION-CALL $GRAD $UU))))))
1546             '$DOTSCRULES))
1547
1548 (DEFPROP $POTENTIAL1 T TRANSLATED)
1549
1550 (ADD2LNC '$POTENTIAL1 $PROPS)
1551
1552 (DEFMTRFUN
1553  ($POTENTIAL1 $ANY MDEFINE NIL NIL) ($GR) NIL
1554  ((LAMBDA ($ORIGIN $GRPERM $JJ $RESULT $%DUM)
1555     (DECLARE (FIXNUM $ORIGIN))
1556     (COND
1557       ((OR (NOT (MFUNCTION-CALL $LISTP $GR))
1558            (NOT
1559              (= (MFUNCTION-CALL $LENGTH $GR) (TRD-MSYMEVAL $DIMENSION 0))))
1560          (SIMPLIFY
1561            (MFUNCTION-CALL
1562              $ERROR
1563              '|&1ST ARG OF POTENTIAL MUST BE A LIST OF LENGTH EQUAL TO|
1564              '|&THE DIMENSIONALITY OF THE COORDINATE SYSTEM|))))
1565     (SETQ $ORIGIN (SIMPLIFY (MFUNCTION-CALL $ZEROLOC)))
1566     (SETQ $RESULT '((MLIST)))
1567     (DO (($JJ (TRD-MSYMEVAL $DIMENSION 0) (+ -1 $JJ))) ((< $JJ 1) '$DONE)
1568       (SETQ $RESULT
1569             (SIMPLIFY (MFUNCTION-CALL
1570                         $CONS
1571                         (MUL* (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST))) $JJ)
1572                               (MARRAYREF $GR $JJ))
1573                         $RESULT))))
1574     (SETQ $GRPERM '((MLIST)))
1575     (DO (($EQN) (MDO (CDR $ORIGIN) (CDR MDO))) ((NULL MDO) '$DONE)
1576       (SETQ $EQN (CAR MDO))
1577       (SETQ $JJ 1)
1578       (DO ((MDO 1 (+ 1 MDO)))
1579           ((LIKE (SIMPLIFY (MFUNCTION-CALL $LHS $EQN))
1580                  (MARRAYREF (TRD-MSYMEVAL $COORDINATES '$COORDINATES) $JJ))
1581              '$DONE)
1582         (SETQ $JJ (ADD* $JJ 1)))
1583       (SETQ $GRPERM
1584             (SIMPLIFY
1585               (MFUNCTION-CALL $ENDCONS (MARRAYREF $RESULT $JJ) $GRPERM))))
1586     (SETQ
1587       $RESULT
1588       ((LAMBDA (|0| N)
1589          (COND
1590            ((NOT (< N |0|))
1591               (DO (($JJ |0| (1+ $JJ))
1592                    (SUM0012
1593                      0
1594                      (ADD*
1595                        SUM0012
1596                        (SIMPLIFY
1597                          (MFUNCTION-CALL
1598                            $MYINT
1599                            (SIMPLIFY
1600                              (MFUNCTION-CALL $SUBLESS $JJ $ORIGIN $GRPERM))
1601                            $%DUM
1602                            (SIMPLIFY
1603                              (MFUNCTION-CALL $RHS (MARRAYREF $ORIGIN $JJ)))
1604                            (SIMPLIFY (MFUNCTION-CALL
1605                                        $LHS (MARRAYREF $ORIGIN $JJ))))))))
1606                   ((< N $JJ) SUM0012)))
1607            ((= N (1- |0|)) 0)
1608            (T (INTERVAL-ERROR '$SUM |0| N))))
1609        1 (TRD-MSYMEVAL $DIMENSION 0)))
1610     (SETQ
1611       $GR
1612       (ADD*
1613         $GR (*MMINUS
1614               (SIMPLIFY
1615                 (MFUNCTION-CALL
1616                   $EXPRESS1 (SIMPLIFY (MFUNCTION-CALL $GRAD $RESULT)))))))
1617     (SETQ $GR (SIMPLIFY (MFUNCTION-CALL $EV_DIFF $GR)))
1618     (SETQ
1619       $GR (SIMPLIFY (MFUNCTION-CALL
1620                       $TRIGSIMP (SIMPLIFY (MFUNCTION-CALL $RADCAN $GR)))))
1621     (SETQ $ORIGIN 1)
1622     (DO ((MDO 1 (+ 1 MDO)))
1623         ((NOT
1624            (AND
1625              (NOT
1626                (IS-BOOLE-CHECK (MGRP $ORIGIN (TRD-MSYMEVAL $DIMENSION 0))))
1627              (LIKE (MARRAYREF $GR $ORIGIN) 0)))
1628            '$DONE)
1629       NIL (SETQ $ORIGIN (+ $ORIGIN 1)))
1630     (COND
1631       ((NOT (> $ORIGIN (TRD-MSYMEVAL $DIMENSION 0)))
1632          (SIMPLIFY
1633            (MFUNCTION-CALL
1634              $PRINT '|&UNABLE TO PROVE THAT THE|
1635              '|&FOLLOWING DIFFERENCE BETWEEN THE INPUT AND THE GRADIENT|
1636              '|&OF THE RETURNED RESULT IS ZERO| $GR))))
1637     (SIMPLIFY (MFUNCTION-CALL
1638                 $TRIGSIMP (SIMPLIFY (MFUNCTION-CALL $RADCAN $RESULT)))))
1639   0 '$GRPERM '$JJ '$RESULT '$%DUM))
1640
1641 (MEVAL* '(($MODEDECLARE) $POTENTIALZEROLOC $ANY))
1642
1643 (MEVAL* '(($DECLARE) $POTENTIALZEROLOC $SPECIAL))
1644
1645 (DEF-MTRVAR $POTENTIALZEROLOC 0)
1646
1647 (DEFPROP $ZEROLOC T TRANSLATED)
1648
1649 (ADD2LNC '$ZEROLOC $PROPS)
1650
1651 (DEFMTRFUN
1652  ($ZEROLOC $ANY MDEFINE NIL NIL) NIL NIL
1653  (COND
1654    ((NOT (MFUNCTION-CALL
1655            $LISTP (TRD-MSYMEVAL $POTENTIALZEROLOC '$POTENTIALZEROLOC)))
1656       (SIMPLIFY
1657         (MAP1
1658           (GETOPR
1659             (M-TLAMBDA
1660               ($UU) NIL
1661               (SIMPLIFY
1662                 (LIST
1663                   '(MEQUAL) $UU
1664                   (TRD-MSYMEVAL $POTENTIALZEROLOC '$POTENTIALZEROLOC)))))
1665           (TRD-MSYMEVAL $COORDINATES '$COORDINATES))))
1666    ((NOT
1667       (LIKE
1668         (SIMPLIFY
1669           (MFUNCTION-CALL
1670             $DISJUNCT (TRD-MSYMEVAL $COORDINATES '$COORDINATES)
1671             (SIMPLIFY
1672               (MAP1 (GETOPR '$LHS)
1673                     (TRD-MSYMEVAL $POTENTIALZEROLOC '$POTENTIALZEROLOC)))))
1674         '((MLIST))))
1675       (SIMPLIFY (MFUNCTION-CALL
1676                   $ERROR '|&POTENTIALZEROLOC MUST BE A LIST OF LENGTH|
1677                   '|&EQUALING THE DIMENSIONALITY OF THE COORDINATE SYSTEM|
1678                   '|&CONTAINING EQUATIONS WITH EACH COORDINATE VARIABLE|
1679                   '|&ON THE LHS OF EXACTLY 1 EQUATION,|
1680                   '|&OR ELSE POTENTIALZEROLOC MUST NOT BE A LIST|)))
1681    (T (TRD-MSYMEVAL $POTENTIALZEROLOC '$POTENTIALZEROLOC))))
1682
1683 (DEFPROP $CYC T TRANSLATED)
1684
1685 (ADD2LNC '$CYC $PROPS)
1686
1687 (DEFMTRFUN
1688   ($CYC $ANY MDEFMACRO NIL NIL) ($II) NIL
1689   (MBUILDQ-SUBST (LIST (CONS '$II $II))
1690                  '((MPLUS) 1 (($REMAINDER) ((MPLUS) $II $SHIFT) 3))))
1691
1692 (DEFPROP $VPOT T TRANSLATED)
1693
1694 (ADD2LNC '$VPOT $PROPS)
1695
1696 (DEFMTRFUN
1697  ($VPOT $ANY MDEFINE NIL NIL) ($KURL) NIL
1698  ((LAMBDA ($ORIGIN $SHIFT)
1699    (DECLARE (FIXNUM $SHIFT))
1700    NIL
1701    (COND
1702      ((OR (NOT (MFUNCTION-CALL $LISTP $KURL))
1703           (NOT (= (MFUNCTION-CALL $LENGTH $KURL) 3)))
1704         (SIMPLIFY
1705           (MFUNCTION-CALL
1706             $ERROR
1707             '|&1ST ARG OF VECTORPOTENTIAL MUST BE A LIST OF LENGTH 3|))))
1708    (SETQ $ORIGIN (SIMPLIFY (MFUNCTION-CALL $ZEROLOC)))
1709    (SETQ $SHIFT 1)
1710    (DO
1711      ((MDO 1 (+ 1 MDO)))
1712      ((NOT
1713         (AND
1714           (NOT (> $SHIFT 3))
1715           (NOT
1716             (LIKE (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN 1)))
1717                   (MARRAYREF
1718                     (TRD-MSYMEVAL $COORDINATES '$COORDINATES) $SHIFT)))))
1719         '$DONE)
1720      (SETQ $SHIFT (+ $SHIFT 1)))
1721    (SETQ $SHIFT (+ $SHIFT 1))
1722    (COND
1723      ((OR
1724         (> $SHIFT 4)
1725         (NOT (LIKE (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN 2)))
1726                    (MARRAYREF (TRD-MSYMEVAL $COORDINATES '$COORDINATES)
1727                               (+ 1 (REMAINDER (+ 2 $SHIFT) 3)))))
1728         (NOT (LIKE (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN 3)))
1729                    (MARRAYREF (TRD-MSYMEVAL $COORDINATES '$COORDINATES)
1730                               (+ 1 (REMAINDER (+ 3 $SHIFT) 3))))))
1731         (SIMPLIFY
1732           (MFUNCTION-CALL
1733             $ERROR '|&LEFT SIDES OF POTENTIALZEROLOC MUST BE A CYCLIC|
1734             '|&PERMUTATION OF COORDINATES|))))
1735    (SETQ
1736     $ORIGIN
1737     (LIST
1738       '(MLIST)
1739       (DIV
1740         (ADD*
1741           (SIMPLIFY
1742             (MFUNCTION-CALL
1743               $MYINT
1744               (MUL* (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST)))
1745                                (+ 1 (REMAINDER (+ 1 $SHIFT) 3)))
1746                     (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST)))
1747                                (+ 1 (REMAINDER (+ 3 $SHIFT) 3)))
1748                     (MARRAYREF $KURL (+ 1 (REMAINDER (+ 2 $SHIFT) 3))))
1749               (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN 3)))
1750               (SIMPLIFY (MFUNCTION-CALL $RHS (MARRAYREF $ORIGIN 3)))
1751               (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN 3)))))
1752           (*MMINUS
1753             (SIMPLIFY
1754               (MFUNCTION-CALL
1755                 $MYINT
1756                 (MUL*
1757                   (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST)))
1758                              (+ 1 (REMAINDER (+ 1 $SHIFT) 3)))
1759                   (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST)))
1760                              (+ 1 (REMAINDER (+ 2 $SHIFT) 3)))
1761                   (SIMPLIFY
1762                     (MFUNCTION-CALL
1763                       $SUBSTITUTE (MARRAYREF $ORIGIN 3)
1764                       (MARRAYREF $KURL (+ 1 (REMAINDER (+ 3 $SHIFT) 3))))))
1765                 (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN 2)))
1766                 (SIMPLIFY (MFUNCTION-CALL $RHS (MARRAYREF $ORIGIN 2)))
1767                 (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN 2)))))))
1768         (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST)))
1769                    (+ 1 (REMAINDER (+ 1 $SHIFT) 3))))
1770       (DIV
1771         (*MMINUS
1772           (SIMPLIFY
1773             (MFUNCTION-CALL
1774               $MYINT
1775               (MUL* (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST)))
1776                                (+ 1 (REMAINDER (+ 2 $SHIFT) 3)))
1777                     (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST)))
1778                                (+ 1 (REMAINDER (+ 3 $SHIFT) 3)))
1779                     (MARRAYREF $KURL (+ 1 (REMAINDER (+ 1 $SHIFT) 3))))
1780               (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN 3)))
1781               (SIMPLIFY (MFUNCTION-CALL $RHS (MARRAYREF $ORIGIN 3)))
1782               (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN 3))))))
1783         (MARRAYREF (TRD-MSYMEVAL $SF '((MLIST)))
1784                    (+ 1 (REMAINDER (+ 2 $SHIFT) 3))))
1785       0))
1786    (SETQ
1787      $ORIGIN
1788      (LIST
1789        '(MLIST)
1790        (MARRAYREF
1791          $ORIGIN
1792          (+ 1 (REMAINDER (+ (+ 1 (REMAINDER (+ 1 $SHIFT) 3)) $SHIFT) 3)))
1793        (MARRAYREF
1794          $ORIGIN
1795          (+ 1 (REMAINDER (+ (+ 1 (REMAINDER (+ 2 $SHIFT) 3)) $SHIFT) 3)))
1796        (MARRAYREF
1797          $ORIGIN
1798          (+ 1
1799             (REMAINDER (+ (+ 1 (REMAINDER (+ 3 $SHIFT) 3)) $SHIFT) 3)))))
1800    (SETQ
1801      $KURL
1802      (ADD* $KURL
1803            (*MMINUS
1804              (SIMPLIFY (MFUNCTION-CALL
1805                          $EXPRESS1 (SIMPLIFY (LIST '($CURL) $ORIGIN)))))))
1806    (SETQ $KURL (SIMPLIFY (MFUNCTION-CALL $EV_DIFF $KURL)))
1807    (SETQ
1808      $KURL
1809      (SIMPLIFY (MFUNCTION-CALL
1810                  $TRIGSIMP (SIMPLIFY (MFUNCTION-CALL $RADCAN $KURL)))))
1811    (DO (($JJ 1 (+ 1 $JJ))) ((> $JJ 3) '$DONE)
1812      (COND
1813        ((NOT (LIKE (MARRAYREF $KURL $JJ) 0))
1814           (SIMPLIFY
1815             (MFUNCTION-CALL
1816               $PRINT
1817               '|&UNABLE TO PROVE THAT THE FOLLOWING DIFFERENCE BETWEEN A|
1818               '|&COMPONENT OF THE INPUT AND OF THE CURL OUTPUT IS ZERO|
1819               (MARRAYREF $KURL $JJ))))))
1820    $ORIGIN)
1821   '$ORIGIN 0))
1822
1823 (DEFPROP $DISJUNCT T TRANSLATED)
1824
1825 (ADD2LNC '$DISJUNCT $PROPS)
1826
1827 (DEFMTRFUN
1828   ($DISJUNCT $ANY MDEFINE NIL NIL) ($L1 $L2) NIL
1829   (SIMPLIFY
1830     (MFUNCTION-CALL $APPEND (SIMPLIFY (MFUNCTION-CALL $SETDIFF $L1 $L2))
1831                     (SIMPLIFY (MFUNCTION-CALL $SETDIFF $L2 $L1)))))
1832
1833 (DEFPROP $SETDIFF T TRANSLATED)
1834
1835 (ADD2LNC '$SETDIFF $PROPS)
1836
1837 (DEFMTRFUN
1838   ($SETDIFF $ANY MDEFINE NIL NIL) ($L1 $L2) NIL
1839   (COND
1840     ((LIKE $L1 '((MLIST))) '((MLIST)))
1841     ((MFUNCTION-CALL $MEMBER (SIMPLIFY ($FIRST $L1)) $L2)
1842        (SIMPLIFY (MFUNCTION-CALL
1843                    $SETDIFF (SIMPLIFY (MFUNCTION-CALL $REST $L1)) $L2)))
1844     (T (SIMPLIFY
1845          (MFUNCTION-CALL
1846            $CONS (SIMPLIFY ($FIRST $L1))
1847            (SIMPLIFY
1848              (MFUNCTION-CALL
1849                $SETDIFF (SIMPLIFY (MFUNCTION-CALL $REST $L1)) $L2)))))))
1850
1851 (DEFPROP $SUBLESS T TRANSLATED)
1852
1853 (ADD2LNC '$SUBLESS $PROPS)
1854
1855 (DEFMTRFUN
1856   ($SUBLESS $ANY MDEFINE NIL NIL)
1857   ($KK $ORIGIN $GRPERM) (DECLARE (FIXNUM $KK))
1858   (PROGN
1859     NIL
1860     ((LAMBDA ($ANS $%DUM)
1861        NIL
1862        (SETQ
1863          $ANS (SIMPLIFY
1864                 (MFUNCTION-CALL
1865                   $RATSUBST $%DUM
1866                   (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN $KK)))
1867                   (MARRAYREF $GRPERM $KK))))
1868        (DO (($L1 1 (+ 1 $L1))) ((> $L1 (+ $KK -1)) '$DONE)
1869          (SETQ $ANS
1870                (SIMPLIFY
1871                  (MFUNCTION-CALL
1872                    $RATSUBST
1873                    (SIMPLIFY (MFUNCTION-CALL $RHS (MARRAYREF $ORIGIN $L1)))
1874                    (SIMPLIFY (MFUNCTION-CALL $LHS (MARRAYREF $ORIGIN $L1)))
1875                    $ANS))))
1876        $ANS)
1877      '$ANS '$%DUM)))
1878
1879 (DEFPROP $MYINT T TRANSLATED)
1880
1881 (ADD2LNC '$MYINT $PROPS)
1882
1883 (DEFMTRFUN
1884  ($MYINT $ANY MDEFINE NIL NIL) ($FUN $VAR $LOW $HIGH) NIL
1885  ((LAMBDA ($RESULT $ATLOW $ATHIGH)
1886     NIL
1887     (PROG ()
1888         (SETQ $RESULT (SIMPLIFY (MFUNCTION-CALL $INTEGRATE $FUN $VAR)))
1889         (COND
1890           ((MFUNCTION-CALL
1891              $FREEOF (SIMPLIFY (MFUNCTION-CALL $NOUNIFY '$INTEGRATE))
1892              $RESULT)
1893              (SETQ $ATLOW
1894                    (SIMPLIFY (MFUNCTION-CALL $EVLIMIT $RESULT $VAR $LOW)))
1895              (COND ((LIKE $ATLOW NIL) (GO $NOGOOD)))
1896              (SETQ $ATHIGH
1897                    (SIMPLIFY (MFUNCTION-CALL $EVLIMIT $RESULT $VAR $HIGH)))
1898              (COND ((LIKE $ATHIGH NIL) (GO $NOGOOD)))
1899              (RETURN
1900                (SIMPLIFY (MFUNCTION-CALL
1901                            $RADCAN (ADD* $ATHIGH (*MMINUS $ATLOW)))))))
1902         $NOGOOD
1903         (RETURN
1904           (SIMPLIFY (MFUNCTION-CALL $DEFINT $FUN $VAR $LOW $HIGH)))))
1905   '$RESULT '$ATLOW '$ATHIGH))
1906
1907 (DEFPROP $EVLIMIT T TRANSLATED)
1908
1909 (ADD2LNC '$EVLIMIT $PROPS)
1910
1911 (DEFMTRFUN
1912   ($EVLIMIT $ANY MDEFINE NIL NIL) ($EXPR $VAR $LIM) NIL
1913   ((LAMBDA ($TEMP)
1914      NIL
1915      (PROG ()
1916           (COND ((OR (LIKE $LIM '$MINF) (LIKE $LIM '$INF)) (GO $USELIMIT)))
1917           (SETQ
1918             $TEMP
1919             ((LAMBDA (ERRCATCH RET)
1920                (COND
1921                  ((NULL
1922                     (SETQ
1923                       RET
1924                       (ERRSET
1925                         (PROGN
1926                           (SIMPLIFY
1927                             (MFUNCTION-CALL $SUBSTITUTE $LIM $VAR $EXPR)))
1928                         LISPERRPRINT)))
1929                     (ERRLFUN1 ERRCATCH)))
1930                (CONS '(MLIST) RET))
1931              (CONS BINDLIST LOCLIST) NIL))
1932           (COND
1933             ((NOT (LIKE $TEMP '((MLIST)))) (RETURN (MARRAYREF $TEMP 1))))
1934           $USELIMIT
1935           (SETQ $TEMP (SIMPLIFY (MFUNCTION-CALL $LIMIT $EXPR $VAR $LIM)))
1936           (COND ((MFUNCTION-CALL
1937                    $MEMBER $TEMP '((MLIST) $INF $MINF $UND $IND $INFINITY))
1938                    (RETURN NIL)))
1939           (RETURN
1940             (COND ((MFUNCTION-CALL
1941                      $FREEOF
1942                      (SIMPLIFY (MFUNCTION-CALL $NOUNIFY '$LIMIT)) $TEMP)
1943                      $TEMP)))))
1944    '$TEMP))
1945
1946 (compile-forms-to-compile-queue)
1947