/
alt7.pl
75 lines (60 loc) · 2.45 KB
/
alt7.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
:- use_module(library(predicate_streams)).
:- dynamic saved_output/1.
my_member(_,[]) :-
fail.
my_member(A,[H|R]) :-
A = H ;
member(A,R).
should_be_wrapped(Goal) :-
Goal =.. [P|R],
( P = ',' ->
maplist([A]>>(error([a,A]),aop_advice(A)),R) ;
(
not(my_member(P,[module,use_module,use_module,set_prolog_flag,member_,debug_print_hook,assertion_failed,pred_option,locate_clauses,pred_option,pred_option,pred_option,pop_compile_operators,push_compile_operators,push_compile_operators,quasi_quotation_syntax,alternate_syntax,quasi_quotation_syntax,xref_open_source,xref_close_source,xref_source_identifier,file_search_path,prolog_file_type,goal_expansion,prolog_predicate_name,prolog_clause_name,prolog_clause_name,with_output_to])),
not(my_member(P,[error,error_nl,wot,my_member,should_be_wrapped,do_aop_code_before,do_aop_code_after,goal_expansion,aop_advice])),
not(my_member(P,[nl,write_term]))
)).
wot(X,A) :-
with_output_to(atom(A),write_term(X,[quoted(true)])).
error(Item) :-
with_output_to(user_error,write_term(Item,[quoted(true)])).
error_nl :-
with_output_to(user_error,nl).
aop_advice(Goal) :-
do_aop_code_before(Goal),
with_output_to_predicate([X]>>assert(saved_output(X)),
( call(Goal) *-> Result = 'Exit' ; Result = 'Fail' )),
do_aop_code_after(Goal,Result),
Result \== 'Fail'.
do_aop_code_before(Goal) :-
wot(Goal,GoalAtom),
atomic_list_concat([' Call: (8) ',GoalAtom,' ?'],'',Output),
error(Output), error_nl.
do_aop_code_after(Goal,Result) :-
wot(Goal,GoalAtom),
atomic_list_concat([' ',Result,': (8) ',GoalAtom,' ?'],'',Output),
error(Output), error_nl.
goal_expansion(Goal,aop_advice(Goal)) :-
should_be_wrapped(Goal).
:- consult('test.pl').
%% /home/andrewdo/lib/swipl/pack/predicate_streams/prolog/predicate_streams.pl
%% quietly(Goal):-
%% tracing ->
%% each_call_cleanup(notrace,Goal,trace);
%% Goal.
%% % the SETUPO is called at each REDO
%% % oh i can write out the aop_redo
%% aop_advice(Goal) :-
%% do_aop_code_before(Goal),
%% ( Goal *-> (Result = true; (aop_redo_code(Goal),fail) ) ; Result = fail ),
%% do_aop_code_after(Goal,Result),
%% Result \== fail.
%% trusted_redo_call_cleanup(Setup,Goal,Cleanup):-
%% \+ \+ '$sig_atomic'(Setup),
%% catch(
%% ( ( Goal, deterministic(DET)),
%% '$sig_atomic'(Cleanup),
%% ( DET == true -> !
%% ; ( true;('$sig_atomic'(Setup),fail)))),
%% E,
%% ( '$sig_atomic'(Cleanup),throw(E))).