/
alt10a.pl
120 lines (97 loc) · 3 KB
/
alt10a.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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
:- dynamic test_data/1.
:- dynamic saved_output/1.
:- dynamic my_trace_on/0.
:- use_module('predicate_streams.pl').
my_trace :-
assert(my_trace_on).
my_notrace :-
retractall(my_trace_on).
:- assert(my_trace_on).
squelch(_) :-
true.
my_member(_,[]) :-
fail.
my_member(A,[H|R]) :-
A = H ;
my_member(A,R).
should_be_wrapped(Goal) :-
Goal =.. [P|R],
( P = ',' ->
maplist([A]>>(error([a,A]),aop_advice(A)),R) ;
(
not(my_member(P,[consult,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,open])),
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,write_data_to_file,writeq_data_to_file])),
not(my_member(P,[nl,write_term,write_data_to_file,writeq_data_to_file]))
)).
wot(X,A) :-
with_output_to(atom(A),write_term(X,[quoted(true)])).
errorq(Item) :-
with_output_to(user_error,write_term(Item,[quoted(true)])).
error(Item,Options) :-
with_output_to(user_error,write_term(Item,Options)).
error(Item) :-
with_output_to(user_error,write_term(Item,[])).
error_nl :-
with_output_to(user_error,nl).
aop_advice(Goal) :-
do_aop_code_before(Goal),
with_output_to_predicate([X]>>(
%% error([x,X]),
assert(saved_output(X))
),
( call(Goal) *-> (Result = true; (do_aop_code_redo(Goal),fail) ) ; Result = fail )),
do_aop_code_after(Goal,Result),
Result \== fail.
do_aop_code_before(Goal) :-
( my_trace_on ->
(
wot(Goal,GoalAtom),
atomic_list_concat([' Call: (8) ',GoalAtom,' ?'],'',Output),
error(Output), error_nl
) ;
(
true
)
).
do_aop_code_after(Goal,Result) :-
( my_trace_on ->
(
wot(Goal,GoalAtom),
atomic_list_concat([' ',Result,': (8) ',GoalAtom,' ?'],'',Output),
error(Output), error_nl
) ;
(
Goal =.. [P|A],
length(A,Arity),
atomic_list_concat([P,Arity],'__',Predicate),
( Result \== fail -> TestGoal = Goal ; TestGoal = not(Goal)),
error(test(Predicate) :- TestGoal,[quoted(true)]),
error('.'), error_nl, error_nl
)
).
do_aop_code_redo(Goal) :-
( my_trace_on ->
(
wot(Goal,GoalAtom),
atomic_list_concat([' Redo: (8) ',GoalAtom,' ?'],'',Output),
error(Output), error_nl
) ;
(
true
)
).
write_data_to_file(Data,Filename) :-
open(Filename, write, S),
write(S,Data),
close(S).
writeq_data_to_file(Data,Filename) :-
open(Filename, write, S),
writeq(S,Data),
close(S).
goal_expansion(Goal,aop_advice(Goal)) :-
should_be_wrapped(Goal).
:- consult('test.pl').
%% :- begin_tests(util2).
%% test(my_view_1):-my_view(b).
%% test(tsScry_1) :-
%% wot(tsScry(X = 1),A),