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