share/simplification/disol.mac

   1 /* -*-Macsyma-*- */
   2 eval_when(batch,ttyoff:true)$
   3 /*ASB;DISOL 7
   4 2:37pm  Wednesday, 4 November 1981
   5 7:53pm  Saturday, 29 May 1982
   6   Added a DIAGEVAL_VERSION for this file.
   7 1:44pm  Saturday, 12 June 1982
   8   Changed loadflags to getversions, DEFINE_VARIABLE:'MODE.
   9 10:23am  Sunday, 1 May 1983
  10 ASB;DISOL
  11   Multics compatibility.
  12 */
  13
  14 eval_when(translate,
  15           define_variable:'mode,
  16           mode_declare(function(freeofl),boolean))$
  17
  18 put('disol,8,'version)$
  19
  20 define_variable(iforp,false,boolean)$
  21
  22 /*
  23 IF STATUS(FEATURE,ITS)=TRUE
  24 THEN SETUP_AUTOLOAD([GENUT,FASL,DSK,DGVAL],
  25                     'ORPARTITIONL,'FREEOFL)$
  26 */
  27
  28 /* GNU Maxima */
  29
  30 eval_when([batch,loadfile],
  31   if get('gnauto,'diageval_version)=false
  32   then load("genut"))$
  33
  34 eval_when(translate,
  35           declare_translated(orpartitionl,elabel,disolate2,freeofl,
  36                              not_atom_elabel,disolate1))$
  37
  38 disolate(exp,[orig_iso_list]):=block(
  39   [partswitch:true,iforp:true,piece,inflag:true],
  40   disolate1(exp,orig_iso_list))$
  41
  42 disolate1(exp,varlist):=block(
  43   [ip0dum:inpart(exp,0)],
  44   if varlist=[] then return(exp),
  45   if freeofl(varlist,exp) then return(not_atom_elabel(exp)),
  46   if member(exp,varlist) or member(ip0dum,varlist) then return(exp),
  47   if ip0dum="*"
  48   then if isolate_wrt_times
  49        then disolate2("*",exp,varlist)
  50        else map(lambda([dum],disolate1(dum,varlist)),exp)
  51   else if ip0dum="+"
  52        then disolate2("+",exp,varlist)
  53        else map(lambda([dum],disolate1(dum,varlist)),exp))$
  54
  55 not_atom_elabel(exp):=if not atom(exp) then elabel(exp) else exp$
  56
  57 disolate2(op,exp,varlist):=block(
  58   [splitdum:orpartitionl(exp,op,varlist),lsplitdum],
  59   apply(op,[not_atom_elabel(first(splitdum)),
  60             if inpart(lsplitdum:last(splitdum),0)=op
  61             then map(lambda([dum],disolate1(dum,varlist)),lsplitdum)
  62             else disolate1(lsplitdum,varlist)]))$
  63
  64 elabel(exp):=block(
  65   [e_labels:apply('labels,[linechar]),olddum:false],
  66   for idum in e_labels do
  67       if exp=apply('ev,[idum])
  68       then return(olddum:idum),
  69   if olddum=false
  70   then if dispflag
  71        then first(ldisp(exp))
  72        else ?elabel(exp)
  73   else  olddum)$
  74 eval_when(batch,ttyoff:false)$