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