;--------------------------------------------------------------------- ; COMPARATOR & MODIFIER : Intermediate Prototype DLL core Specification ;--------------------------------------------------------------------- ; Copyright by SSS - 1993 ; Wp2c of Contract 2 with INESC and SYSTENA ; ; Author: JNO di/inesc (2361) ; Revisions: 24.8.93 Rev: 8.10.93 ; Rev: 9.11.93 ; Rev:18.11.93 (including cts simulation) ; Rev:11.12.93 (current) ; ;--------------------------------------------------------------------- ; ; Comments: ; ; (a) Global state objects: cts,era, cmod, ui ; (b) ui (user interface) is accessed by the VB front-end ; (c) Warnings or error messages to be ommitted in the DLL version ; TYPE ;--------------------------------------------------------------------- ; cts Cts = CTSPair -> INT; CTSEdge = SYM; CTSArc :: source: CTSEdge sink: CTSEdge weight: INT; ; inv-CTSArc(a) = weight(a) in [1..100] CTSEdges = CTSEdge-set; CTSPair :: source: CTSEdge sink: CTSEdge; CTSRel = CTSPair-set; ; inv-Cts(db) = nb: TUTTO no longer exists ; acyclic(db) /\ ; ~redundant(db) /\ ; leavesAreTerms(db); ;--------------------------------------------------------------------- ; era Era :: AOB: AOBase; ; inv-Era(aob) = ..... AOBase = AOID -> AObject; AObject :: A: Attributes F: Facets; AOID = INT; AOIDs = AOID-set; AOIDpair :: Speci:AOID Genera:AOID; Attributes = AttName -> Value; Facets = FacName -> CTSEdge; Value=SYM; AttName=SYM; FacName=SYM; ;--------------------------------------------------------------------- ; cmod CMod :: AOL: AOLattice AOE: AOEquiv; ; inv-CMod(aol,aoe) = ..... AOLattice = AOIDpair-set; AOEquiv = AOID -> AOID; ;------------------------------------------------------------------------------- ; ; UI (user interface) state ; Ui :: FLG: SYM SID: AOID-list IDC: AOID CAO: AObject; ; FLG: true if AOL has changed ; SID: selected AOIDs, always nonempty ; IDC: AOID count ; CAO: currently selected AObject ; ;------------------------------------------------------------------------------- ENDTYPE ;------------------------------------------------------------------------------- ; basic functions ; FUNC filter(a:X,l:Xlist):Xlist RETURN if l==<> then <> else let (h=head(l),t=tail(l)) in if h==a then filter(a,t) else cons(h,filter(a,t)); FUNC warn(m:STR):SYM ;RETURN let (x=princ(m)) in 'warning; RETURN let (x=m) in 'warning; FUNC error(m:STR):SYM ;RETURN let (x=princ(m)) in 'error; RETURN let (x=m) in 'error; ; polymorphic projection FUNC pr(c:INT,r:Rel):Set RETURN if c==1 then { first(x) | x <- r } else if c==2 then { second(x) | x <- r } ;else let (x=princ("\nError in projection")) in {}; else {}; ; polymorphic selection left FUNC sll(r:Rel,e:X):Rel RETURN { t | t <- r : first(t)==e }; ;FUNC mkf(r:CTSRel):FFun ;RETURN let (p=choice(r)) ; in [ first(p) -> second(p) ] + mkf(r - { p }); ;FUNC MIN(s:INTSet):INT ;RETURN MINloop(s,999); ;FUNC MINloop(s:INTSet,m:INT):INT ;RETURN if (s=={}) then m ; else let (x=choice(s)) ; in MINloop(s-{x}, if (x >= m) then m else x); FUNC MAX(s:INTSet):INT RETURN MAXloop(s,0); FUNC MAXloop(s:INTSet,m:INT):INT RETURN if (s=={}) then m else let (x=choice(s)) in MAXloop(s-{x}, if (x < m) then m else x); ;--------------------------------------------------------------------- ; cts functions FUNC proj1(r:CTSRel):CTSEdges RETURN { source(x) | x <- r }; FUNC proj2(r:CTSRel):CTSEdges RETURN { sink(x) | x <- r }; FUNC sell(r:CTSRel,e:CTSEdge):CTSRel RETURN { t | t <- r : source(t)==e }; FUNC selr(r:CTSRel,e:CTSEdge):CTSRel RETURN { t | t <- r : sink(t)==e }; FUNC getWei(e1:CTSEdge,e2:CTSEdge):INT RETURN if ~(CTSPair(e1,e2) in dom(cts)) then 0 else cts[CTSPair(e1,e2)]; FUNC sucs(s:CTSEdge):CTSEdge-set RETURN proj2(sell(dom(cts),s)); FUNC ants(s:CTSEdge):CTSEdge-set RETURN proj1(selr(dom(cts),s)); FUNC traSucs(s:CTSEdge):CTSEdge-set RETURN UNION({ {e} U traSucs(e) | e <- sucs(s) }); FUNC traAnts(s:CTSEdge):CTSEdge-set RETURN UNION({ {e} U traAnts(e) | e <- ants(s) }); FUNC cyclic(a:CTSArc):Bool RETURN let (d=sink(a), S={d} U traSucs(d)) in source(a) in S; FUNC redundant(a:CTSArc):Bool RETURN let (s=source(a), S={s} U traSucs(s)) in sink(a) in S; FUNC ctsINIT():SYM STATE cts <- []; FUNC ctsAllEdges(): RETURN let (r = dom(cts)) in proj1(r) U proj2(r); FUNC weiAdd(a:Weight,b:Weight):Weight RETURN div(mul(a,b),100); FUNC weightedSucs(e:CTSEdge):CTSwEdges RETURN weightedSucsAux(e,100); FUNC weightedSucsAux(e:CTSEdge,w:INT):CTSwEdges RETURN UNION({ let (z= weiAdd(w,cts[CTSPair(e,d)])) in {} U weightedSucsAux(d,z) | d <- sucs(e)}); FUNC ctsCreateEdge(e:CTSEdge):ErrorMess STATE ctsCreateArc(CTSArc(e,'Tutto,100)); FUNC ctsCreateArc(a:CTSArc):SYM STATE cts <- cts + [ CTSPair(source(a),sink(a))->weight(a) ] RETURN 'ola; FUNC ctsCREATEARC(a:CTSArc):SYM ; Warning: should source(a) be a kernel term, ; check future LTS per verificare l'esistenza di source(a) PRE x > 0 STATE if redundant(a) then error("\nRedundant arc!\n") else ctsCreateArc(a) RETURN x; FUNC ctsCREATEARC(a:CTSArc):SYM ; Warning: should source(a) be a kernel term, ; check future LTS per verificare l'esistenza di source(a) PRE x > 0 RETURN x; FUNC ctsGetConcept(e:CTSEdge,d:INT0):CTSEdgesXdist RETURN if (d==0) then < { e }, 0 > else let (r ={ p | p <- weightedSucs(e) : second(p)<=d }, M = MAX(proj2(r)), x = selr(r,M)) in < proj1(x), M >; FUNC ctsConLub(e1:CTSEdge,e2:CTSEdge):CTSEdge ; pre-ctsConLub(e1,e2)=pre-ctsConcDist(e1,e2); RETURN first(ctsConcDist(e1,e2)); FUNC ctsConcDist(e1:CTSEdge,e2:CTSEdge):CTSEdgeAndINT RETURN let (r1={} U weightedSucs(e1), r2={} U weightedSucs(e2), X = pr(1,r1) * pr(1,r2), f = [e -> div(add(MAX(pr(2,sll(r1,e))), MAX(pr(2,sll(r2,e)))), 2) | e <- X], g = [w -> {e | e<-X: w==f[e] } | w <- ran(f)], ;x=princ("\ng = ",g), w = MAX(dom(g)), e = choice(g[w]) ;z=princ("\nIs the choice of ",e," among = ",g[w]," really a good choice?") ) in < e,w >; ; Think about it: choice({a})=the({a}) in most cases, but this is not really it... ;--------------------------------------------------------------------- ; era functions FUNC eraINIT():SYM STATE era <- Era([1 -> AObject([],[])]); FUNC eraAllAOID():AOIDs RETURN dom(AOB(era)); FUNC eraAOInsert(ref:AOID,obj:AObject):SYM ;pre-eraAOInsert(ref,obj)= ~(ref in dom(AOB(era))); RETURN era <- Era(AOB(era) + [ref -> obj]); FUNC eraAOSelect(ref:AOID):AObject ;pre-eraAOSelect: ref in dom(AOB(era)); RETURN AOB(era)[ref]; FUNC eraAORemove(ref:AOID):SYM ;pre-eraAOSelect: ref in dom(AOB(era)); RETURN era <- Era(AOB(era)\{ref}); FUNC eraAOIDAlias(ref:AOID,k:AOID):SYM ;pre-eraAOIDAlias(ref,k)= ~(k in dom(Era(AOB(era))) RETURN let (db = AOB(era)) in era <- Era(db\{ref} + [k->db[ref]]); ;--------------------------------------------------------------------- ; cmod functions FUNC cmodINIT():SYM RETURN cmod <- CMod({} ,[]); FUNC cmodAOSelect(ref:AOID):AObject ;pre-cmodAOSelect: ref in dom(AOB(era)) U dom(AOL(cmod)); RETURN let (aoe=AOE(cmod), r= if ref in eraAllAOID() then ref else if ref in dom(aoe) then aoe[ref]) in eraAOSelect(r); FUNC cmodAOInsert(ref:AOID,obj:AObject):SYM ; returns Boolean value true if AOL is changed ;pre-cmodAOInsert(ref,obj) = ~(ref in dom(AOB(era)) || ref in dom(AOE(cmod))) RETURN let (aol=AOL(cmod), aoe=AOE(cmod), ;x=princ("\nNow inserting AOID= ",ref), aoln=cmodAOLink(ref,obj), flag = isAOID(aoln), dummy = cmod <- if flag ; *** equivalent object *** then let (aoen = aoe + [ ref -> aoln ], y = z<- aoen, x = warn("\nEquivalent object...\n")) in CMod(aol,aoen) else let (dummy = eraAOInsert(ref,obj)) in CMod(aoln,aoe)) in flag; FUNC isAOID(a:AOLatticeOrAOID):Bool RETURN atom(a); FUNC cmodAOUnion(i:AObject,j:AOBject):AObject RETURN let (ai= A(i), aj= A(j), fi= F(i), fj= F(j), facs= (fi\dom(fj)) + (fj\dom(fi)) + [ f -> fi[f] | f <- (dom(fi) * dom(fj)): fi[f] == fj[f] ], atts= (ai\dom(aj)) + (aj\dom(ai)) + [ a -> ai[a] | a <- (dom(ai) * dom(aj)): ai[a] == aj[a] ]) in AObject(atts,facs); FUNC cmodCompAO(i:AObject,j:AOBject):AObject RETURN let (ai= A(i), aj= A(j), fi= F(i), fj= F(j), facs= [ f -> ctsConLub(fi[f],fj[f]) | f <- (dom(fi) * dom(fj)) ], atts= [ a -> ai[a] | a <- (dom(ai) * dom(aj)): ai[a] == aj[a] ]) in AObject(atts,facs); FUNC cmodLeqAO(oi:AOBject,oj:AOBject):Bool RETURN let (b=equal(oj,cmodCompAO(oi,oj)) ; x=princ("\n***\nIt is ",b," that ",oi,"\n<= ",oj) ) in b; ;FUNC cmodLeqAO(oi:AOBject,oj:AOBject):Bool ;RETURN equal(A(oi),A(cmodCompAO(oi,oj))); FUNC cmodCompAOIDs(i:AOID,j:AOID):AObject ;pre-cmodCompAOIDs(i,j)= subset({i,j}, dom(AOB(era)) U dom(AOE(cmod))) RETURN let (eqt= AOE(cmod)) in if i in eraAllAOID() then cmodCompAO(eraAOSelect(i), if j in eraAllAOID() then eraAOSelect(j) else eraAOSelect(eqt[j])) else cmodCompAO(eraAOSelect(eqt[i]), if j in eraAllAOID() then eraAOSelect(j) else eraAOSelect(eqt[j])); FUNC cmodAOLink(k:AOID,ao:AObject):AOLatticeOrAOID ; AOID=1=TOP of ERA RETURN let (top=eraAOSelect(1)) in if equal(ao,top) then 1 else cmodAOLinkAux(k,ao,{1}); FUNC cmodAOLinkAux(k:AOID,ao:AObject,Maj:AOIDs):AOLatticeOrAOID RETURN let (aol=AOL(cmod), Min= {Speci(p)|p<-aol:Genera(p) in Maj}, Up= {k|k <- Min: cmodLeqAO(ao,eraAOSelect(k))}, Lo= {k|k <- Min: cmodLeqAO(eraAOSelect(k),ao)}, ;x= princ("\nMin=",Min," Up=",Up," Lo=",Lo,"\n"), I= Lo*Up ) in if (card(I) > 0) then the(I) else if (card(Up) > 0) then cmodAOLinkAux(k,ao,Up) else cmodAOReLink(k,Maj,Lo); FUNC cmodAOReLink(k:AOID,Maj:AOIDs,Min:AOIDs):AOLattice RETURN let (aol=AOL(cmod)) in if Min == {} then aol U { AOIDpair(k,i) | i <- Maj } else let (rem = { p|p<-aol:~(Speci(p) in Min && Genera(p) in Maj) }) in (rem U {AOIDpair(i,k)| i<-Min}) U {AOIDpair(k,i)| i<-Maj}; FUNC cmodApproxAO(ref:AOID):PairOfAOIDSets RETURN let (aol=AOL(cmod), aoe=AOE(cmod), r= if ref in eraAllAOID() then ref else if ref in dom(aoe) then aoe[ref], maj={Genera(p)|p<-aol:Speci(p)==r }, min={Speci(p)|p<-aol:Genera(p)==r }) in < maj U {k|k<-dom(aoe):aoe[k] in maj}, min U {k|k<-dom(aoe):aoe[k] in min} >; FUNC cmodAORemAOID(ref:AOID):SYM ;pre-cmodAORemAOID(ref) = ref in dom(AOE(cmod)) U ran(AOE(cmod)) RETURN let (aol=AOL(cmod), aoe=AOE(cmod), D =dom(aoe), f =[k->ref|k<-D:ref==aoe[k]], Df =dom(f)) in if ref in D then let (x=cmod <- CMod(aol,aoe\{ref})) in 'aoen else if f == [] then let (up ={p|p<-aol:Speci(p)==ref}) ; NB: not in aoe table in if up == {} then error("\nCannot remove maximal elements\n") else let (dn ={p|p<-aol:Genera(p)==ref}, maj={Genera(p)|p<-up}, min={Speci(p)|p<-dn}, aoln= aol-(up U dn) U {AOIDpair(x,y)|x<-min,y<-maj}, x = cmod <- CMod(aoln,aoe\{ref}), y = eraAORemove(ref)) in 'aoln else let (k=choice(Df), ; NB: in aoe table range aoen=(aoe\Df) + [kk->k|kk<-Df-{k}], aoln={let (s=Speci(p), g=Genera(p)) in if s==ref ; NB: aol is irreflexive! then AOIDpair(k,g) else if g==ref then AOIDpair(s,k) else p | p<-aol}, x = cmod <- CMod(aoln,aoen), y = eraAOIDAlias(ref,k)) in k ; ;--------------------------------------------------------------------- ; ui functions (API "Buttons") FUNC INIT():SYM RETURN if ('era==eraINIT() && 'cmod==cmodINIT() && 'cts==ctsINIT()) then ui<-Ui('true,<1>,1,eraAOSelect(1)) else error("Could'nt initialize ERA, CTS etc"); FUNC UPLOAD():SYM RETURN if atom(progn( INIT(), ;princ("\nLoading Default CTS...\n"), ctsCreateEdge('Medium), ctsCreateEdge('Function), ctsCreateArc(CTSArc('Binary,'Medium,100)), ctsCreateArc(CTSArc('Image,'Medium,100)), ctsCreateArc(CTSArc('Text,'Medium,100)), ctsCreateArc(CTSArc('Manipulation,'Function,100)), ctsCreateArc(CTSArc('LogicOperation,'Function,100)), ctsCreateArc(CTSArc('eps,'Image,80)), ctsCreateArc(CTSArc('eps,'Text,20)), ctsCreateArc(CTSArc('laTeX,'Text,100)), ctsCreateArc(CTSArc('bitmap,'Binary,10)), ctsCreateArc(CTSArc('bitmap,'Image,90)), ctsCreateArc(CTSArc('GraphicsOperation,'Manipulation,100)), ctsCreateArc(CTSArc('BitOperation,'Manipulation,100)), ctsCreateArc(CTSArc('Rotate,'GraphicsOperation,89)), ctsCreateArc(CTSArc('Rotate,'BitOperation,11)), ctsCreateArc(CTSArc('rotRight,'Rotate,100)), ctsCreateArc(CTSArc('rotLeft,'Rotate,100)), ctsCreateArc(CTSArc('negate,'LogicOperation,41)), ctsCreateArc(CTSArc('negate,'BitOperation,59)), ctsCreateArc(CTSArc('bitmapToEps,'Manipulation,100)), ; ;princ("\nLoading Default AObase...\n"), AOINSERT(AObject(['author->'RBrunialti,'source->'C], ['function->'rotRight,'object->'eps])), AOINSERT(AObject(['progEnv->'Windows3_1,'source->'C], ['function->'rotLeft,'medium->'eps])), AOINSERT(AObject(['progEnv->'XWindows], ['medium->'bitmap])), AOINSERT(AObject(['progEnv->'XWindows,'domain->'ElectPublishing], ['object->'laTeX])), AOINSERT(AObject(['progEnv->'XWindows,'domain->'ElectPublishing], ['object->'laTeX])), AOINSERT(AObject(['author->'RBrunialti,'progEnv->'Windows3_1,'source->'C,'system->'Sour], [])), AOINSERT(AObject(['source->'C], [])) )) then ui <- Ui(true,SID(ui),IDC(ui),CAO(ui)) else error("\nCouldn't finish loading! "); FUNC AOINSERT(obj:AObject):SYM RETURN if subset(ran(F(obj)),ctsAllEdges()) then let (n=add(IDC(ui),1), flag=cmodAOInsert(n,obj)) in ui<-Ui(flag,,n,obj) else error("\nUnknown CTSEdges! "); FUNC AOREMOVE():SYM RETURN let (l=SID(ui)) in if l==<> then error("No object selected for deletion\n") else let (i=head(l), ll=tail(l), x=cmodAORemAOID(i) ) ;yy=princ("\nx=",x,".\n")) in if x == 'error then error("cmodAORemAOID couldnt remove object\n") else ui<- let (b= if x == 'aoen then FLG(ui) else 'true, lll=if ~(x == 'aoen || x=='aoln) then cons(x,ll) else if ll==<> then <1> else ll) in Ui(b,lll, IDC(ui),eraAOSelect(head(lll))); FUNC AOAPPROX():PairOfAOIDSets RETURN let (l=SID(ui)) in cmodApproxAO(head(l)); FUNC AOSELECT(ref:AOID):SYM RETURN if ~(ref in dom(AOB(era)) || ref in dom(AOE(cmod))) then error("\nNonexisting AObject! ") else ui<-Ui(FLG(ui), cons(ref,filter(ref,SID(ui))),IDC(ui),cmodAOSelect(ref)); FUNC SHOWH():AOLattice RETURN let (x = ui<-Ui(false,SID(ui),IDC(ui),CAO(ui))) in AOL(cmod); FUNC COMPARE():SYM RETURN let (l=SID(ui)) in if length(l) <= 1 then error("Select two objects for comparison") else ui<-Ui(FLG(ui), l, IDC(ui), cmodCompAOIDs(head(l),head(tail(l)))); FUNC AOSAVE():SYM RETURN AOINSERT(CAO(ui)); ;--------------------------------------------------------------------- ; THE END