/* -*-Macsyma-*- */
EVAL_WHEN(BATCH,TTYOFF:TRUE)$
/*ASB;STOPEX 15
2:48pm  Wednesday, 4 November 1981
7:55pm  Saturday, 29 May 1982
  Added a DIAGEVAL_VERSION for this file.
1:48pm  Saturday, 12 June 1982
  Changed loadflags to getversions, DEFINE_VARIABLE:'MODE.
*/

EVAL_WHEN(TRANSLATE,
	  TRANSCOMPILE:TRUE,
	  DEFINE_VARIABLE:'MODE,
	  MODEDECLARE(FUNCTION(FREEOFL),BOOLEAN))$

PUT('STOPEX,15,'DIAGEVAL_VERSION)$

EVAL_WHEN([BATCH,LOADFILE],
	  IF GET('GNAUTO,'DIAGEVAL_VERSION)=FALSE
	  THEN LOAD('[GNAUTO,FASL,DSK,DGVAL]))$

/* Switches  */
DEFINE_VARIABLE(IFORP,FALSE,BOOLEAN)$
DEFINE_VARIABLE(EXPANDWRT_DENOM,FALSE,BOOLEAN)$
DEFINE_VARIABLE(EXPANDWRT_NONRAT,TRUE,BOOLEAN)$

STOPEXPAND(EXP,[VARLIST]):=
  IF ATOM(EXP) OR MAPATOM(EXP)
  THEN EXP
  ELSE BLOCK([PARTSWITCH:TRUE,INFLAG:TRUE,PIECE],
	     STOPEXPANDL(EXP,VARLIST))$

EXPANDWRT(EXP,[VARLIST]):=
  IF ATOM(EXP) OR MAPATOM(EXP)
  THEN EXP
  ELSE BLOCK([PARTSWITCH:TRUE,INFLAG:TRUE,PIECE],
	     STOPEXPANDL(EXP,VARLIST))$

EXPANDWRTL(EXP,VARLIST):=STOPEXPANDL(EXP,VARLIST)$

STOPEXPANDL(EXP,VARLIST):=  
  IF ATOM(EXP) OR MAPATOM(EXP)
  THEN EXP
  ELSE BLOCK([INFLAG:TRUE,PARTSWITCH:TRUE,PIECE,IP0DUM],
	     IF (IP0DUM:INPART(EXP,0))="+"
	     THEN MAP(LAMBDA([TERMDUM],STOPEXPANDL(TERMDUM,VARLIST)),EXP)
	     ELSE BLOCK(
  [NONRATDUM,IFORP:TRUE,DENDUM],
  IF EXPANDWRT_NONRAT
  THEN (NONRATDUM:
	LDELETE(VARLIST,LAST(ORPARTITIONL(SHOWRATVARS(EXP),"[",VARLIST))),
	FOR IDUM IN NONRATDUM DO
	    IF NOT ATOM(IDUM)
	    THEN EXP:SUBST(MAP(LAMBDA([DUM],STOPEXPANDL(DUM,VARLIST)),IDUM),
			   IDUM,EXP)),
  IF EXPANDWRT_DENOM AND (DENDUM:DENOM(EXP))#1
  THEN EXP:NUM(EXP)/STOPEXPANDL(DENDUM,VARLIST),
  STOPEXPANDL1(EXP,VARLIST)))$

STOPEXPANDL1(EXP,VARLIST):=
  IF ATOM(EXP) OR MAPATOM(EXP)
  THEN EXP
  ELSE BLOCK([IP0DUM:INPART(EXP,0),DUM:1,VARFOUND:FALSE],
  MODEDECLARE(VARFOUND,BOOLEAN),
	     IF FREEOFL(VARLIST,EXP)
	     THEN EXP
	     ELSE IF FREEOF("+",EXP) THEN RETURN(EXP),
	     IF IP0DUM="+"
	     THEN RETURN(MAP(LAMBDA([TERMDUM],
				    STOPEXPANDL1(TERMDUM,VARLIST)),EXP))
	     ELSE IF IP0DUM="^"
		  THEN IF INPART(EXP,1,0)="+"
	               THEN EXWRT_POWER(EXP,VARLIST)
		       ELSE EXP
		  ELSE IF IP0DUM="*"
		       THEN (FOR IDUM IN EXP DO
			         IF NOT FREEOFL(VARLIST,IDUM)
			         THEN (IDUM:STOPEXPANDL1(IDUM,VARLIST),
				       IF VARFOUND
				       THEN DUM:DISTRIBUTE(DUM,IDUM,VARLIST)
				       ELSE (VARFOUND:TRUE,
					     DUM:VARMULT(DUM,IDUM,VARLIST)))
			         ELSE IF VARFOUND
				      THEN DUM:VARMULT(IDUM,DUM,VARLIST)
				      ELSE DUM:DUM*IDUM,
		             DUM)
		       ELSE IF MATRIXP(EXP) OR LISTP(EXP)
		            THEN MATRIXMAP(LAMBDA([DUMM],
						  STOPEXPANDL1(DUMM,VARLIST)),
				           EXP)
		            ELSE IF IP0DUM="." AND EXPANDWRT_NONRAT
		                 THEN REMOVE_NESTED_DOTS0L(MAP(LAMBDA([DUM],
							      STOPEXPANDL1(DUM,
								     VARLIST)),
							       EXP),
							   VARLIST)
			         ELSE EXP)$

EXWRT_POWER(EXP,VARLIST):=BLOCK(
  [IP1DUM,IP2DUM1,EXWRTLIST,SPLITDUM,FSPLITDUM],
  DECLARE(EXWRTLIST,SPECIAL),
  IF INPART(EXP,0)#"^" THEN RETURN(EXP),
  IF NOT FREEOFL(VARLIST,IP1DUM:INPART(EXP,1))
     AND INTEGERP(IP2DUM1:INPART(EXP,2))
     AND (MODE_IDENTITY(FIXNUM,IP2DUM1))>1
     AND INPART(IP1DUM,0)="+"
  THEN (SPLITDUM:ORPARTITIONL(IP1DUM,"+",VARLIST),
	IF (FSPLITDUM:FIRST(SPLITDUM))#0
	THEN (EXWRTLIST:CONS(1,EXWRT_POWER1(LAST(SPLITDUM),IP2DUM1,VARLIST)),
	      SUM(VARMULT(FSPLITDUM^KDUM*IP2DUM1!/(KDUM!*(IP2DUM1-KDUM)!),
			  FIRST(EXWRTLIST:REST(EXWRTLIST)),
			  VARLIST),
		  KDUM,0,IP2DUM1))
	ELSE FIRST(EXWRT_POWER1(LAST(SPLITDUM),IP2DUM1,VARLIST)))
  ELSE EXP)$

EXWRT_POWER1(EXP,POWERDUM,VARLIST):=(
  MODEDECLARE(POWERDUM,FIXNUM),
 BLOCK(
  [DUM:[EXP,1],FIRSTDUM:STOPEXPANDL1(EXP,VARLIST)],
  IF POWERDUM=1 THEN RETURN(DUM),
  IF INPART(EXP,0)#"+"
  THEN FOR IDUM:2 THRU POWERDUM DO
	   DUM:CONS(EXP^IDUM,DUM)
  ELSE FOR IDUM:2 THRU POWERDUM DO
	   DUM:CONS(FIRSTDUM:
		    MAP(LAMBDA([DUM],MULTTHRU(DUM,FIRSTDUM)),EXP),DUM),
  DUM))$

VARMULT(FACT,EXP,VARLIST):=BLOCK(
  [SPLITDUM:ORPARTITIONL(EXP,"+",VARLIST)],
  FACT*FIRST(SPLITDUM)+MULTTHRU(FACT,LAST(SPLITDUM)))$

DISTRIBUTE(EXP1,EXP2,VARLIST):=BLOCK(
  [SPLITEXP1:ORPARTITIONL(EXP1,"+",VARLIST),
   SPLITEXP2:ORPARTITIONL(EXP2,"+",VARLIST),
   FSPLEXP1,FSPLEXP2,LSPLEXP1,LSPLEXP2],
  LSPLEXP1:LAST(SPLITEXP1),
  LSPLEXP2:LAST(SPLITEXP2),
  (FSPLEXP1:FIRST(SPLITEXP1))*(FSPLEXP2:FIRST(SPLITEXP2))
  +(IF FSPLEXP1#0
    THEN VARMULT(FSPLEXP1,STOPEXPANDL1(LSPLEXP2,VARLIST),VARLIST)
    ELSE 0)
  +(IF FSPLEXP2#0
    THEN VARMULT(FSPLEXP2,STOPEXPANDL1(LSPLEXP1,VARLIST),VARLIST)
    ELSE 0)
  +(IF INPART(LSPLEXP1,0)="+"
    THEN MAP(LAMBDA([TERM],STOPEXPANDL1(TERM*LSPLEXP2,VARLIST)),LSPLEXP1)
    ELSE IF INPART(LSPLEXP2,0)="+"
	 THEN MAP(LAMBDA([TERM],STOPEXPANDL1(TERM*LSPLEXP1,VARLIST)),LSPLEXP2)
	 ELSE LSPLEXP1*LSPLEXP2))$

EXPANDWRT_FACTORED(EXP,[VARLIST]):=
  IF LISTP(EXP) OR MATRIXP(EXP)
  THEN MATRIXMAP(LAMBDA([DUM],APPLY('EXPANDWRT_FACTORED,CONS(DUM,VARLIST))),
		 EXP)
  ELSE BLOCK([IFORP:TRUE,PIECE,PARTSWITCH:TRUE,INFLAG:TRUE,DUM],
	     DUM:ORPARTITIONL(EXP,"*",VARLIST),
	     FIRST(DUM)*STOPEXPANDL(LAST(DUM),VARLIST))$

EVAL_WHEN(BATCH,TTYOFF:FALSE)$
