%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Version 6.1: writes starting and end time of the dmc to a file %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% dmc(File) :- use_module(library(ugraphs)), use_module(library(lists)), use_module(library(system),[datime/1]), retractall(lub_num(_)), assert(lub_num(0)), tell('dmc6_erg_stat.txt'), datime(Start), nl,write('datime Start= '),write(Start), dmc(_,_,_), datime(End), lub_num(LUBNUM), nl,write('datime End= '),write(End), nl,write('with LUB NUM= '),write(LUBNUM), told, datime(End), file_export(File). dmc(SortedSubIntros,SortedIntros,SortedExts) :- alec_announce('Compiling type unification...'), abolish((unify_type)/3), retractall(sub_rhstype(_)), retractall(ext_or_intro_rhstype(_)), retractall(type_num(_,_)), retractall(num_type(_,_)), retractall(stmatrix_num(_,_)), retractall(stmatrix_dim(_)), % PHASE 0: 1) Prolog hygiene, % 2) check that bot and a_/1 atoms are not abused, % 3) sort sub/intro/ext declarations, warn on RHS duplicates, % throw exception on LHS duplicates, % 4) tabulate types on RHSs of sub/intro/ext declarations ((ale(no_types_defined) new_if_warning_else_fail (\+current_predicate(sub,(_ sub _)), \+current_predicate(intro,(_ intro _)))) -> MarkedSortedSubs = [], SortedIntros = [] ; verify_sub_declarations(MarkedSortedSubs), verify_intro_declarations(SortedIntros) ), verify_ext_declaration(SortedExts), % PHASE 1: 1) collect default minimal types (RHS of intro or ext or any LHS % but not RHS of sub), % 2) collect default maximal types (LHS of intro or any RHS % but not LHS of sub), % 3) build subsumption adjacency graph from sorted sub declarations, % 4) warn on unary branches, % 5) remove bot from subsumption graph - can be handled specially. strip_subs(MarkedSortedSubs,SortedSubLHSs,SortedSubs,SortedSubIntros), strip_keys(SortedIntros,SortedIntroLHSs), ord_union(SortedIntroLHSs,SortedSubLHSs,SortedLHSDefMins), esetof(Min,(clause(ext_or_intro_rhstype(Min),true), \+ clause(sub_rhstype(Min),true)),SortedRHSDefMins), ord_union(SortedLHSDefMins,SortedRHSDefMins,SortedDefMins), ( select(bot-DeclaredMins,SortedSubs,SortedMinSubs) -> ord_subtract(SortedDefMins,DeclaredMins,ImplicitMins) ; SortedMinSubs = SortedSubs, ImplicitMins = SortedDefMins ), ale(implicit_mins(ImplicitMins)) new_if_warning (ImplicitMins \== []), esetof(Max,defmax(Max),SortedDefMaxs), add_vertices(SortedMinSubs,SortedDefMaxs,SubGraph), ale(implicit_maxs(SortedDefMaxs)) new_if_warning (SortedDefMaxs \== []), dmc_act(SubGraph). dmc_act(SubGraph) :- % PHASE 2: 1) topologically sort vertices of subsumption graph, % 2) translate graph to topologically ordered numerical indices % and reflexively close (resulting graph is an upper-triangular % Boolean matrix), % 3) transitively close graph, yielding subtype matrix, % 4) extract and assert rows of subtype matrix. ( top_sort(SubGraph,TopSortedTypes) -> assert(toposort(TopSortedTypes)) ; member(T-Neibs,SubGraph), member(S,Neibs), min_path(S,T,SubGraph,Path,_), raise_exception(ale(subtype_cycle(T,[T|Path]))) ), num_types(TopSortedTypes,1,DimPlus1), % bot is number 0 Dim is DimPlus1 - 1, seed_refl_close_zmatrix(SubGraph,Dim,SubMatrix), upper_tri_trans_close(Dim,SubMatrix,STMatrix), length(RowMatrix,Dim), rconvert_stm(STMatrix,RowMatrix,1,Dim,Dim), hash_stm_rows(RowMatrix,1), assert(stmatrix_dim(Dim)), % PHASE 3: compile unify_type/3 on_exception(ale(no_lub(T1,T2,Mins)),dmc_iterate,add_lub(T1,T2,Mins,SubGraph)). :-dynamic subgraph/1. add_lub(T1,T2,RMins,SubGraph) :- sort(RMins,Mins), %nl,write('in add lub'), %nl,write('T1='),write(T1), %nl,write('T2='),write(T2), %nl,write('Mins='),write(Mins), %nl,write('SubGraph='),write(SubGraph), %nl,write('Dim='),write(Dim), create_new_lub(NewLubType), add_vertices(SubGraph,[NewLubType], NG1), %nl,write('NG1='),write(NG1), create_min_edges(Mins,NewLubType,[],Es), %nl,write('Es='),write(Es), add_edges(NG1,Es,NG2), %nl,write('NG2='),write(NG2), add_edges(NG2,[T1-NewLubType],NG3), add_edges(NG3,[T2-NewLubType],NG4), %nl,write('NG4='),write(NG4), edges(SubGraph,AllEs), find_others(T1,T2,Mins,AllEs,[],Os), %nl,write('Os='),write(Os), filter_others(Os,Mins,SubGraph,[],FOs), %nl,write('FOs='),write(FOs), add_lub_to_others(FOs,NewLubType,NG4,NewSubGraph1), transitive_closure(NewSubGraph1,NewSubGraph), %nl,write('NewSubGraph='),write(NewSubGraph), %nl,write('NewDim='),write(NewDim), %nl,write('-----------------------'), reset, assert(subgraph(NewSubGraph)), dmc_act(NewSubGraph). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % add_lub helpers %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% create_min_edges([],_,Es,Es):-!. create_min_edges([M|RestOfMins],Lub,Acc,Es):- create_min_edges(RestOfMins,Lub,[Lub-M|Acc],Es). filter_others([],_,_,FOs,FOs):-!. filter_others([O|Rest],Mins,SubGraph,Acc,FOs):- neighbours(O,SubGraph,Niebs), ((sublist(Mins,Niebs))-> filter_others(Rest,Mins,SubGraph,[O|Acc],FOs) ;filter_others(Rest,Mins,SubGraph,Acc,FOs)). find_others(_,_,[],_,Acc,Os):- remove_duplicates(Acc,Os),!. find_others(T1,T2,[M|RestOfMins],AllEs,Acc,Os):- findall(X,(member(X-M,AllEs),X\==T1,X\==T2),MDaddies), append(MDaddies,Acc,NewAcc), find_others(T1,T2,RestOfMins,AllEs,NewAcc,Os). add_lub_to_others([],_,NewSubGraph,NewSubGraph):-!. add_lub_to_others([O|Os],NewLubType,SubGraph,NewSubGraph):- add_edges(SubGraph,[O-NewLubType],MidSubGraph), %transitive_closure(MidSubGraph,TCMidSubGraph), %RFD??? %add_lub_to_others(Os,NewLubType,TCMidSubGraph,NewSubGraph). add_lub_to_others(Os,NewLubType,MidSubGraph,NewSubGraph). create_new_lub(NewLubType):- get_lub_num(LubNum),name(LubNum,XXX), append([108,117,98],XXX,LUBXXX), %RFD-14Feb2008:[108,117,98]=[l,u,b] name(NewLubType,LUBXXX). :-dynamic lub_num/1. get_lub_num(NewLubNum):- retract(lub_num(OldLubNum)), NewLubNum is OldLubNum +1, assert(lub_num(NewLubNum)). reset :- retractall(stmatrix_num(_,_)), retractall(type_num(_,_)), retractall(num_type(_,_)), retractall(subgraph(_)), retractall(stmatrix_dim(_)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % dmc_iterate similar to unifytype/3 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% dmc_iterate:- dmc_iterate(_,_,_), fail. dmc_iterate. dmc_iterate(Arg1,Arg2,TypeLUB):- clause(stmatrix_dim(Dim),true), for_loop(1,N1,Dim), clause(stmatrix_num(N1,Row1),true), % for each row of the subtype matrix... clause(num_type(N1,Type1),true), (Arg1 = Type1, ( Arg2 = bot % bot case ; Arg2 = Type1 % reflexive case ) ; arg(2,Row1,Row1Rest), arg(1,Row1Rest,Next), % test for subtypes and joins N1Plus1 is N1 + 1, unify_type_range(N1Plus1,Next,Arg1,Arg2,TypeLUB,Type1,Row1Rest) ). %%%%%%%%%%%%%%%%% % EXPORT %%%%%%%%%%%%%%%%% file_export(File):- tell(File), write('%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'),nl, write('%This file was generated by ALE, (http://www.ale.cs.toronto.edu) '),nl, write('%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'),nl, nl,write('%%%Types'),nl, retractall((_ sub _)), subgraph(FSubs), gen_new_subs(FSubs), findall(X,(X sub _Y),Types), groundChk(Types,TypesChkd), ex_dmc(TypesChkd), told, !. gen_new_subs([]). gen_new_subs([S-Subs|Rest]):- assert((S sub Subs)), gen_new_subs(Rest). ex_dmc([]). ex_dmc([H|T]):- (H sub Subs), ( (Subs == []) ->( nl,write('\''),write(H),write('\''), write(' sub \[ \].'), ex_dmc(T) ) ;( nl,write('\''),write(H),write('\''),write(' sub \['), ex_dmc_subs(Subs), write('\].'), ex_dmc(T) ) ). ex_dmc_subs([S]):- write('\''),write(S),write('\''). ex_dmc_subs([S|ST]):- write('\''),write(S),write('\''),write(','), ex_dmc_subs(ST). groundChk(NonGrounded,Grounded) :- findall(X,(member(X,NonGrounded),ground(X)),Grounded).