/*================================================================================= =================================================================================== ======== File: pwe_compiler.pl ======== Purpose: Compilation of Prolog Word Expert specifications ======== Author: Torbjörn Lager (Torbjorn.Lager@ling.uu.se) ======== Dev. under: SICStus Prolog v. 3.8 ======== Updated: 991103 =================================================================================== =================================================================================*/ :- use_module(library(lists)). /*================================================================================= ======== Operators =================================================================================*/ :- op(1100,xfy,o). :- op(1050,xfy,<-). :- op(500,xfx,>). %NB! :- op(600,xfy,@). :- op(700,xfy,&). :- op(400,fx,add). :- op(1150,xfx,:=). :- op(400,fx,word_expert). /*================================================================================= ======== Settings =================================================================================*/ % Default setting of trace facility :- bb_put(pwe_trace,off). /*================================================================================= ======== Rule compiler =================================================================================*/ compile_PWE((word_expert F := Rules),Clauses) :- atom_conc(F,'_lemma',F2), ( bb_get(pwe_trace,on) -> compile_PWE(Rules,F,trace,1,N,Clauses0), atom_conc(F,N,F1), Head0 =.. [F,P,V], Head =.. [F,P,V,T], Body1 =.. [F1,P,V,T0], Body = (Body1, reverse(T0,T)), functor(UnknownGoal,F2,4), format("Compiled PWE ~w/2 from ~w rules. Trace mode.~n",[F,N]), Clauses = [(Head0 :- Body),(Head :- Body), unknown_predicate_handler(UnknownGoal,_,fail)| Clauses0] ; compile_PWE(Rules,F,notrace,1,N,Clauses0), atom_conc(F,N,F1), Head =.. [F,P,V], Body =.. [F1,P,V], functor(UnknownGoal,F2,3), format("Compiled PWE ~w/2 from ~w rules.~n",[F,N]), Clauses = [(Head :- Body), unknown_predicate_handler(UnknownGoal,_,fail)| Clauses0] ). compile_PWE(end,_F,_Trace,N,N,[]). compile_PWE((Rule o Rules),F,Trace,N0,N,[Clause|Clauses]) :- compile_PWE(Rule,F,Trace,N0,N1,Clause), compile_PWE(Rules,F,Trace,N1,N,Clauses). compile_PWE((_:add A <- Cs),F,notrace,N,N,Clause) :- atom_conc(F,N,F1), Head =.. [F1,P,A], compile_conditions(Cs,P,F,notrace,N,BodyList,[]), list2goal(BodyList,Body), % construct literal for the memo-functions atom_conc(F,'_lemma',F3), Head2 =.. [F3,P,N,B], Head3 =.. [F3,P,_,A], Clause = (Head :- ( var(P) -> Body ; Head2 -> A = B ; Body, asserta(Head3) )). compile_PWE((F0:add A <- Cs),F,trace,N,N,Clause) :- atom_conc(F,N,F1), Head =.. [F1,P,A,T], compile_conditions(Cs,P,F,trace,N,BodyList,[]), list2goal(BodyList,Body), % construct literal for the memo-functions atom_conc(F,'_lemma',F3), Head2 =.. [F3,P,N,B,T], Head3 =.. [F3,P,_,A,T], Clause = (Head :- ( var(P) -> Body, T = [(F0:add A <- Cs)] ; Head2 -> A = B ; Body, T = [(F0:add A <- Cs)], asserta(Head3) )). compile_PWE((F0:A>B <- Cs),F,notrace,N1,N2,Clause) :- N2 is N1+1, atom_conc(F,N1,F1), atom_conc(F,N2,F2), BodyPart1 =.. [F1,P,V0], Head =.. [F2,P,V], % construct literals for the memo-functions atom_conc(F,'_lemma',F3), Head2 =.. [F3,P,N2,V0], Head3 =.. [F3,P,M,B], compile_conditions(Cs,P,F,notrace,N1,BodyList,[]), list2goal(BodyList,BodyPart2), Clause = ( Head :- ( var(P) -> BodyPart1, ( V0 = A, constraint(F0,A,B,P), BodyPart2 -> V = B ; V = V0 ) ; Head2 -> V = V0 ; BodyPart1, ( V0 = A, constraint(F0,A,B,P), BodyPart2 -> V = B, asserta((Head3 :- M >= N2,!)) ; V = V0 ) )). compile_PWE((F0:A>B <- Cs),F,trace,N1,N2,Clause) :- N2 is N1+1, atom_conc(F,N1,F1), atom_conc(F,N2,F2), BodyPart1 =.. [F1,P,V0,T0], Head =.. [F2,P,V,T], % construct literals for the memo-functions atom_conc(F,'_lemma',F3), Head2 =.. [F3,P,N2,V0,T0], Head3 =.. [F3,P,M,B,T], compile_conditions(Cs,P,F,trace,N1,BodyList,[]), list2goal(BodyList,BodyPart2), Clause = ( Head :- ( var(P) -> BodyPart1, ( V0 = A, constraint(F0,A,B,P), BodyPart2 -> V = B, T = [(F0:A>B <- Cs)|T0] ; V = V0, T = T0 ) ; Head2 -> V = V0, T = T0 ; BodyPart1, ( V0 = A, constraint(F0,A,B,P), BodyPart2 -> V = B, T = [(F0:A>B <- Cs)|T0], asserta((Head3 :- M >= N2,!)) ; V = V0, T = T0 ) )). compile_conditions((C&Cs),P,F,Trace,N) --> compile_conditions(C,P,F,Trace,N), compile_conditions(Cs,P,F,Trace,N). compile_conditions(FV@Positions,P0,F,Trace,N) --> compile_position(Positions,P0,P), compile_feature(FV,P,F,Trace,N). compile_conditions({PrologGoal},_P0,_F,_Trace,_N) --> [PrologGoal]. compile_position([0],P,P) --> !, []. compile_position([Offset],P0,P) --> !, [P is P0+Offset]. compile_position(Positions,P0,P) --> [member(Offset,Positions), P is P0+Offset]. compile_feature(F:A,P,F,notrace,N) --> !, {atom_conc(F,N,F1), Goal =.. [F1,P,A]},[Goal]. compile_feature(F:A,P,F,trace,N) --> !, {atom_conc(F,N,F1), Goal =.. [F1,P,A,_]},[Goal]. compile_feature(F:A,P,_F,_Trace,_N) --> {Goal =.. [F,P,A]},[Goal]. term_expansion(Rules,Clauses) :- compile_PWE(Rules,Clauses). /*================================================================================= ======== Text loading =================================================================================*/ load_text(File) :- seeing(OldFile), see(File), read_text(WordList), seen, see(OldFile), retractall(wd(_,_)), assert_words(WordList). read_text(Words) :- get0(C), read_text(C,Words). read_text(-1,[]) :- !. read_text(C,[Word|Words]) :- punctuation(C,Word), !, read_text(Words). read_text(C,[Word|Words]) :- letter(C), !, read_rest_letters(Chars,LeftOver), atom_chars(Word,[C|Chars]), read_text(LeftOver,Words). read_text(_C,Words) :- % C is not a letter or punctuation mark read_text(Words). read_rest_letters(Letters,LeftOver) :- get0(C), read_rest_letters(C,Letters,LeftOver). read_rest_letters(-1,[],-1). read_rest_letters(C,[C|Chars],LeftOver) :- letter(C), !, read_rest_letters(Chars,LeftOver). read_rest_letters(C,[],C). % C is not a letter letter(C) :- ( C >= 192 -> C \== 215, C \== 247 ; C >= "a" -> C =< "z" ; C >= "A" -> C =< "Z" ; C >= "0", C =< "9" ; C is "-" ). punctuation(0'.,'.'). punctuation(0'?,'?'). punctuation(0'!,'!'). punctuation(0'",'"'). punctuation(0',,','). punctuation(0';,';'). punctuation(0':,':'). punctuation(0'/,'/'). %punctuation(0'-,'-'). punctuation(0'\','\''). assert_words(Words) :- assert_words(Words,0,N), format("~w words loaded.~n",[N]). assert_words([],N,N). assert_words([Word|Words],N0,N) :- N1 is N0+1, assert(wd(N0,Word)), assert_words(Words,N1,N). /*================================================================================= ======== Concordance tool =================================================================================*/ conc(P,Size) :- format("~w: ",[P]), print_left_context(P,Size), print_target(P), print_right_context(P,Size), nl. print_target(P) :- wd(P,W), format("[~w] ",[W]). print_left_context(P,Size) :- Pn is P-Size, P2 is P-1, ( between(Pn,P2,Pi), wd(Pi,W), write(W), write(' '), fail ; true ). print_right_context(P,Size) :- Pn is P+Size, P2 is P+1, ( between(P2,Pn,Pi), wd(Pi,W), write(W), write(' '), fail ; true ). /*================================================================================= ======== Utilities =================================================================================*/ :- op(800,fx,set). set A=B :- bb_put(A,B). atom_conc(Atom1,Atom2,Atom) :- name(Atom1,L1), name(Atom2,L2), append(L1,L2,L3), name(Atom,L3). list2goal([X],X) :- !. list2goal([X|Xs],(X,Ys)) :- list2goal(Xs,Ys). between(L,U,L) :- L =< U. between(L,U,N) :- L < U, M is L+1, between(M,U,N). print_rules([]). print_rules([Rule|Rules]) :- write(Rule),nl, print_rules(Rules). /*=================================================================================*/