1:- module(pha_load, [glist/3, load/1, edit//0]). 2
3:- dynamic current_program/1. 4
5:- op(400,fx,~). 6:- op(990,xfy,&). 7:- op(1200,xfx,<-). 8
19glist(true) --> !, [].
20glist((A,B)) --> !, glist(A), glist(B).
21glist(&(A,B)) --> !, glist(A), glist(B).
22glist((A;B)) --> !, [or(GA,GB,GT)], {glist(A,GA,GT), glist(B,GB,GT)}.
23glist(H) --> [H].
24
25clause_translation(rv(Name,D),pha_user:rv(Name,Vals)) :- !, eval_dist(D,Vals).
26clause_translation(rv(Name,D):-B, (pha_user:rv(Name,Vals):-B,eval_dist(D,Vals))) :- !.
27clause_translation(H:-B, pha_user:rule(H,G1,G2)) :- !, glist(B,G1,G2).
28clause_translation(H<-B, pha_user:rule(H,G1,G2)) :- !, glist(B,G1,G2).
29clause_translation(H-->B, Rule) :- !,
30 dcg_translate_rule(H-->B,Cl),
31 clause_translation(Cl, Rule).
32clause_translation(H, pha_user:rule(H,G1,G2)) :- glist(true,G1,G2).
33
34eval_dist(\Dist1,Dist) :- !, maplist(flip_weighted,Dist1,Dist).
35eval_dist(flip(P1),[P0:false, P1:true]) :- !, P0 is 1-P1.
36eval_dist([X|XS],[X|XS]).
37
38flip_weighted(V:P,P:V).
43load(FileSpec) :-
44 absolute_file_name(FileSpec, [extensions([pha,'']), access(read)], File),
45 read_file_to_terms(File, Terms, [module(pha)]),
46 retractall(current_program(_)),
47 catch(abolish(pha_user:rule/3),_,true),
48 catch(abolish(pha_user:rv/2),_,true),
49 forall(member(Term,Terms), (clause_translation(Term,Clause), assertz(Clause))),
50 assert(current_program(File)),
51 compile_predicates([pha_user:rule/3, pha_user:rv/2]),
52 (predicate_property(pha_user:rule(_,_,_),number_of_clauses(NC)) -> true; NC=0),
53 (predicate_property(pha_user:rv(_,_),number_of_clauses(NR)) -> true; NR=0),
54 format('% pha> ~w compiled: ~d random variables, ~d clauses.\n',[File,NR,NC]).
58edit --> {current_program(File), edit(File), load(File)}.
59
61
63
68