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
    9% ---------------------------------------------------------------------------
   10% translation and loading
   11% When loading a PHA program using load/1, the result is a set of clauses
   12% for the predicates pha_user:rv/2, pha_user:rule/3. The rule represention
   13% is a head term with a difference list of conjunctive subgoals. Disjunction
   14% is represented by the special subgoal =|or(List1,List2,Tail)|=, which is
   15% two difference lists sharing the same tail.

 glist(+G:goal)// is det

Translates a PHA goal into a difference list representation.

   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).

 load +FileSpec is semidet

Clears the current program and loads a new one from the given file spec. The current program is not cleared if the given file cannot be read.

   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]).

 edit// is det

Edit loaded program.

   58edit --> {current_program(File), edit(File), load(File)}.
   59
   60% intention is to switch to term_expansion based program loading eventually.
   61
   62% clause_expansion(H:-B,pha_user:rule(H,GS,GT)) :- glist(B,GS,GT).
   63
   64% check_rv(Name,Vals) :-
   65%    (  \+ (numbervars(Name,0,_), \+ground(Vals)) -> true
   66%    ;  format('WARNING: rv ~w has non-ground values - ignoring it.\n',[Name])
   67%    ).
   68
   69% user:term_expansion(\H, EXP) :- findall(X, clause_expansion(H:-true, X), EXP).
   70% user:term_expansion(\H:-B, EXP) :- findall(X, clause_expansion(H:-B, X), EXP).
   71% user:term_expansion(rv(Name,Vals),pha_user:rv(Name,Vals)) :- check_rv(Name,Vals).