 file ARITH%.MUS                              GAE - Feb. 1982
Make a new version of file ARITH.MUS as follows:
(1)  Start with the original file ARITH.MUS.
(2)  Delete FUNCTION ^ .  This begins approximately 500 lines
     from the beginning of the file.  Delete everything through
     ENDFUN $ .  It is about 50 lines.
(3)  In the place where the deletion was made, insert the new
     FUNCTION ^ from this file (ARITH%.MUS).  It begins just
     after the line ( ------ ) below, and is also about 50
     lines.  It runs up to (but not including) the next line
     ( ---------- ).
(4)  Next delete everything between the two lines of stars
     ( ******** )  This is the `optional fractional-power
     package'.
(5)  Replace it with the same package from this file (ARITH%.
     MUS).  This is everything between the two lines of stars
     ( ******** ), about 80 lines.
---------------------------------------------------------------

FUNCTION ^ (EX1, EX2),
  WHEN INTEGER (EX2),
    WHEN INTEGER (EX1),
      WHEN EX1 EQ 1, 1 EXIT,
      WHEN ZERO(EX1) AND ZERO(EX2), ?(LIST('^, EX1, EX2)) EXIT,
      WHEN NEGATIVE (EX2),
        WHEN ZERO (EX1), ?(LIST('^, EX1, EX2)) EXIT,
        EX1: EXPT (EX1, -EX2),
        WHEN NEGATIVE (EX1), -((-EX1)^-1) EXIT,
	WHEN EX1 EQ 1, EX1 EXIT,
        LIST ('^, EX1, -1) EXIT,
      EXPT (EX1, EX2) EXIT,
    WHEN EX2 EQ 1, EX1 EXIT,
    WHEN ZERO (EX2) AND ZEROEXPT, 1 EXIT,
    WHEN EX1 EQ #I,
      EX2: MOD (EX2, 4),
      WHEN EX2 EQ 2, -1 EXIT,
      WHEN EX2 EQ 3, -#I EXIT,
      EX1^EX2 EXIT,
    WHEN ATOM (EX1), LIST ('^, EX1, EX2) EXIT,
    WHEN APPLY (GET('BASE,FIRST(EX1)), ADJOIN(EX2,ARGEX(EX1))) EXIT,
    LIST ('^, EX1, EX2) EXIT,
  WHEN ATOM (EX1),
    WHEN EX1 EQ 1, 1 EXIT,
    WHEN ZERO (EX1),
      WHEN EX2 < 0, ? (LIST('^, EX1, EX2))  EXIT,
      WHEN EX2 > 0 OR ZEROBASE, 0,  EXIT,
      LIST ('^, EX1, EX2)  EXIT,
    WHEN ATOM (EX2),
      WHEN EX1 EQ #E  AND  EX2 EQ #I  AND  NEGMULT(TRGEXPD,7),
	COS(1) + #I*SIN(1)  EXIT,
      WHEN POSMULT(LOGEXPD,7) AND NOT(EX1=LOGBAS OR EX1<0),
        LOGBAS ^ (EX2*LOG(EX1,LOGBAS))  EXIT,
      LIST ('^, EX1, EX2)  EXIT,
    WHEN APPLY (GET('EXPON,FIRST(EX2)), ADJOIN(EX1,ARGEX(EX2)))  EXIT,
    WHEN POSMULT(LOGEXPD,7) AND NOT(EX1=LOGBAS OR NUMBER(EX2) OR EX1<0),
      LOGBAS ^ (EX2*LOG(EX1,LOGBAS))  EXIT,
    LIST ('^, EX1, EX2)  EXIT,
  WHEN APPLY (GET('EXPON,FIRST(EX2)), ADJOIN(EX1,ARGEX(EX2)))  EXIT,
  WHEN APPLY (GET('BASE,FIRST(EX1)), ADJOIN(EX2,ARGEX(EX1)))  EXIT,
  WHEN POSMULT(LOGEXPD,7) AND NOT(EX1=LOGBAS OR NUMBER(EX2) OR EX1<0),
    LOGBAS ^ (EX2*LOG(EX1,LOGBAS))  EXIT,
  LIST ('^, EX1, EX2),
ENDFUN $

------------------------------------------------------------

%************* optional fractional-power package ******************%


PRIMES: '(2, 3, 5, 7, 11, 13, 17, 19) $

FUNCTION ROOT (EX1, EX2, EX3, LEX1, EX4, EX5, EX6,
  % Local: %  EX7),
  LOOP
    BLOCK
      WHEN ZERO (REST (EX7: DIVIDE(EX6,FIRST(LEX1)))),
        EX6: FIRST(EX7),
        WHEN (EX5:EX5+1) EQ EX3,  EX4: EX4*FIRST(LEX1),  EX5: 0,  EXIT EXIT,
      EX5: 0,
      WHEN NOT (POP(LEX1) < FIRST(EX7)), EX6: 1  EXIT,
      WHEN ATOM(LEX1),
        EX7: EX3 - 1,
        LEX1: EX6,
        LOOP
          EX5: LEX1^EX7,
          WHEN NOT ((EX5:QUOTIENT(EX6+EX7*LEX1*EX5,EX3*EX5)) < LEX1) EXIT,
          LEX1: EX5
        ENDLOOP,
        WHEN LEX1^EX3 EQ EX6, EX4: EX4*LEX1,  EX6: 1  EXIT,
        EX6: 1  EXIT,
    ENDBLOCK,
    WHEN EX6 EQ 1,
      EX1: EX1/(EX4^EX3), EX4: EX4^EX2,
      WHEN EX1 EQ 1, EX4 EXIT,
      EX4 * LIST ('^, EX1, EX2/EX3)  EXIT
  ENDLOOP,
ENDFUN $

FUNCTION FREE (EX1, EX2),
  WHEN EX1 = EX2, FALSE  EXIT,
  WHEN ATOM(EX1)  EXIT,
  LOOP
    WHEN NOT FREE(POP(EX1),EX2), FALSE  EXIT,
    WHEN ATOM(EX1), EXIT
  ENDLOOP,
ENDFUN $

PION2: #PI/2 $

PROPERTY EXPON, *, FUNCTION (EX1, EX2, EX3),
  WHEN EX1 EQ #E,
    WHEN INTEGER(EX2: EX2*EX3/PION2/#I), #I^EX2 EXIT,
    WHEN NEGMULT(TRGEXPD,7),
      WHEN FREE (EX2: EX2*PION2, #I),
      COS(EX2) + #I*SIN(EX2)  EXIT EXIT EXIT,
  WHEN INTEGER(EX1),
    WHEN PBRCH AND INTEGER(EX2),
      WHEN INTEGER(EX3:1/EX3),
        WHEN EX1 > 0,
          ROOT(EX1, EX2, EX3, PRIMES, 1, 0, EX1)  EXIT,
        WHEN ZERO(MOD(EX3,2)),
          #I^(2*EX2/EX3)*ROOT(-EX1,EX2,EX3,PRIMES,1,0,-EX1) EXIT,
        (-1)^EX2 * ROOT(-EX1, EX2, EX3, PRIMES, 1, 0, -EX1)
        EXIT EXIT EXIT,
  WHEN EX1=#I OR EX1=-#I,
    WHEN PBRCH AND INTEGER(EX2),
      WHEN INTEGER(EX3:1/EX3),
        WHEN EX1=#I, #E^(#I*#PI*EX2/EX3/2)  EXIT,
        #E^(3*#I*#PI*EX2/EX3/2)  EXIT,
      EXIT EXIT,
ENDFUN $

PROPERTY EXPON, ^, FUNCTION (EX1, EX2, EX3),
  WHEN INTEGER(EX1),
    WHEN INTEGER(EX2),
      WHEN PBRCH AND EX3 EQ -1,
        WHEN EX1 > 0, ROOT (EX1, 1, EX2, PRIMES, 1, 0, EX1)  EXIT,
        WHEN ZERO(MOD(EX2,2)),
          #I^(2/EX2) * ROOT(-EX1, 1, EX2, PRIMES, 1, 0, -EX1)  EXIT,
        -ROOT(-EX1, 1, EX2, PRIMES, 1, 0, -EX1) EXIT EXIT EXIT,
  WHEN EX1=#I OR EX1=-#I,
    WHEN INTEGER(EX2),
      WHEN PBRCH AND EX3 EQ -1,
        WHEN EX1=#I, #E^(#PI*#I/EX2/2)  EXIT,
        #E^(3*#PI*#I/EX2/2)  EXIT
      EXIT EXIT,
ENDFUN $

%****************** optional factorial package********************%
