1:- module(fnotation,[op(900,fx,$>),fnotation_ops/2]). 2
3:- use_module(library(apply)). 4
5:- dynamic in_op/1, out_op/1, mpred_memo/2 .
10fnotation_ops(I, O) :-
11 retractall(in_op(_)), retractall(out_op(_)),
12 assertz(in_op(I)), assertz(out_op(O)) .
13
14expand_notation(_, _, Var, Var, Gs, Gs) :- var(Var), ! .
15expand_notation(Var, y, Term, Var, Gs, Gs) :- out_op(Term), ! .
16expand_notation(Var, HasOut, Term, ResTerm, GsH, GsT) :-
17 compound(Term),!,
18 compound_name_arguments(Term, Ftr, Args),
19 (predicate_property(Term, meta_predicate(_))
20 *->
21 maplist(expand_notation_term, Args, ResArgs),
22 compound_name_arguments(ResTerm, Ftr, ResArgs),
23 GsH = GsT
24 ; in_op(Ftr), [Arg] = Args
25 *->
26 expand_notation(ResTerm, SubHasOut, Arg, ResArg, GsH, (SubTerm, GsT)),
27 (var(SubHasOut), compound(ResArg)
28 *->
29 compound_name_arguments(ResArg, RFtr, RArgs),
30 append(RArgs, [ResTerm], NRArgs),
31 compound_name_arguments(SubTerm, RFtr, NRArgs)
32 ; SubTerm = ResArg)
33 ; foldl(expand_notation(Var, HasOut), Args, ArgsRes, GsH, GsT),
34 compound_name_arguments(ResTerm, Ftr, ArgsRes)
35 )
36.
37expand_notation(_, _, Term, Term, Gs, Gs).
38
39expand_notation_term(Term, Res) :-
40 expand_notation(_, _, Term, Tmp, Res, Tmp) .
41
42:- fnotation_ops($>, $<) . 43
44fn_expand(H :- B, RH :- NB) :-
45 expand_notation(_, _, B, RB, Gs, RB),
46 expand_notation(_, _, H, RH, NB, Gs),
47 (H :- B) \= (RH :- NB), ! .
48fn_expand(H, R) :-
49 not(functor(H,:-,2)), fn_expand(H :- true,R) .
50
51:- begin_tests(fn_expand). 52
53test(fn_expand1, [true(Ret = (h1 :- (p3(V1, A), p2(V1, V2), p1(A, V2))))]) :-
54 fn_expand((h1 :- p1(A, $> p2($> p3($<, A)))), Ret) .
55
56test(fn_expand2, [true(Ret = (h1(A, R) :- p2(V1, A), p1(V1, R)))]) :-
57 fn_expand((h1(A, R) :- p1($> p2($<, A), R)), Ret).
58
59test(fn_expand_fails, [fail]) :-
60 fn_expand((h1(A, R) :- p1(p2(A), R)), _).
61
62test(fn_expand_metapreds,
63 [true(Ret = (h1(A, B) :- p1, ((p3(V1, B), p2(V1))->(p5(A, V2), p4(V2));(p7(V3), p6(V3)))))]) :-
64 fn_expand((h1(A,B) :- p1, (p2($> p3($<,B)) -> p4($>p5(A));p6($>p7()))), Ret).
65
66test(fn_expand_head1, [true(Ret = (h1(V1) :- b(V1), p1))]) :-
67 fn_expand((h1($> b()) :- p1), Ret).
68
69test(fn_expand_head2, [true(Ret = (h1(V1) :- c(A, V2), b(V2, V1), p1(A)))]) :-
70 fn_expand((h1($> b($> c(A,$<))) :- p1(A)), Ret).
71
72test(fn_expand_head_with_body, [true(Ret = (h1(V1) :- h2(V1), p2(V2), p1(V2)))]) :-
73 fn_expand((h1($> h2()) :- p1($> p2())), Ret).
74
75test(fn_expand_head_with_body2,
76 [true(Ret = (h1(V1, V2, C) :- h2(V1, A), h3(B, V2), p2(p3(V3, B)), p4(C, V4), p1(A, V3, V4)))]) :-
77 fn_expand((h1($> h2($<, A), $> h3(B), C) :- p1(A, $> p2(p3($<, B)), $>p4(C))), Ret).
78
79:- op(900, fx, $$).
80
81test(fn_expand_custom, [
82 setup(fnotation_ops($$,$$)),
83 cleanup(fnotation_ops($>,$<)),
84 true(Ret = (h1(A, R):-p2(V1, A), p1(V1, R)))]) :-
85 fn_expand((h1(A,R) :- p1($$ p2($$, A), R)), Ret).
86
87:- end_tests(fn_expand). 88
89:- multifile user:term_expansion/2. 90:- dynamic user:term_expansion/2. 91
92user:term_expansion(F, R) :- fn_expand(F, R) .
93
94:- begin_tests(fnotation). 95
96pred1(A,s(A)) .
97pred2 :- pred1(a, $> pred1(a)) .
98pred3($> pred1(a)).
99
100test(run_pred1) :- pred2 .
101test(run_pred2) :- pred3(s(a)) .
102
103:- op(900, fx, $$).
104
105test(fn_expand_custom, [
106 setup(fnotation_ops($$,$$)),
107 cleanup(fnotation_ops($>,$<)),
108 true(Ret = (h1(A, R):-p2(V1, A), p1(V1, R)))]) :-
109 fn_expand((h1(A,R) :- p1($$ p2($$, A), R)), Ret).
110
111:- end_tests(fnotation).