Integrate arithmetic expansion into loader.pl

Author: hurufu

src/loader.pl

@@ -35,6 +35,61 @@
     ),
     write('.').
 
+trace(on).
+
+writeln(X) :-
+    trace(on), write(X), nl.
+x(G_0) :-
+    catch(loader:G_0, E, (loader:writeln(exception:E:G_0),throw(E))).
+w(G_0) :-
+    writeln(call:G_0), x(G_0), writeln(exit:G_0).
+w(_) :-
+    writeln(done).
+
+%% arithmetic_relation_expanded(?Term, ListDifference).
+%
+% Recursively traverse Term and assemble a list of replacements that make a
+% valid aruthmetic relation.
+%
+% Hand-expanded DCG, because library(dcgs) isn't available during goal expansion.
+arithmetic_relation_expanded(T, L1-L2) :-
+    maplist(loader:elaborate(F/2), [T,R], [Ts,Rs]),
+    memberchk(F, [is,>,<,>=,=<,=:=,=\=]),
+    next(ok(Ts,Rs), L1-[R|L2]).
+
+%% next(+Marker, ListDifference).
+%
+% Describes needed replacements according to `Marker`.
+next(nok(T,R), [T=R|L]-L).
+next(ok([],[]), L-L).
+next(ok([T0|Ts],[R0|Rs]), L1-L3) :-
+    arithmetic_function_expanded(T0, R0, L1-L2), next(ok(Ts,Rs), L2-L3).
+
+%% arithmetic_function_expanded(?Term, -ExpandedTerm, ListDifference).
+arithmetic_function_expanded(T, R, LD) :-
+    check(T, R, C), next(C, LD).
+
+%% check(?Term, -ExpandedTerm, -Marker).
+%
+% `Marker` describes what is `Term` in regards to arithmetical function, it is
+% `ok/2` if `Term` is Ok to be a part of arithmetical function and it is `nok/2`
+% if it isn't.
+%
+% NOTE: Order of `check/3` clauses is important for correctness.
+check(T, T, ok([],[])) :- (var(T); number(T)), !.
+check(T, R, ok(Ts,Rs)) :-
+    maplist(loader:elaborate(F/A), [T,R], [Ts,Rs]),
+    arithmetic_functions(A, Fs),
+    member(F, Fs), !.
+check(T, R, nok(T,R)) :- !.
+
+elaborate(Functor/Arity, Term, Args) :-
+    functor(Term, Functor, Arity),
+    Term =.. [Functor|Args].
+
+arithmetic_functions(0, [e,pi,epsilon]).
+arithmetic_functions(1, [+,-,\,sqrt,exp,log,sin,cos,tan,asin,acos,atan,sign,abs,round,ceiling,floor,truncate,float,float_integer_part,float_fractional_part]).
+arithmetic_functions(2, [+,-,/,*,**,^,/\,\/,xor,div,//,rdiv,<<,>>,mod,rem,max,min,gcd,atan2]).
 
 :- non_counted_backtracking '$print_message_and_fail'/1.
 
@@ -43,6 +98,7 @@
     nl,
     '$fail'.
 
+
 expand_term(Term, ExpandedTerm) :-
     (  '$predicate_defined'(user, term_expansion, 2),
        catch(user:term_expansion(Term, ExpandedTerm0),
@@ -69,16 +125,13 @@
        term_expansion_list(Terms, ExpandedTerms0Tail, ExpandedTermsTail)
     ).
 
-
 :- non_counted_backtracking goal_expansion/3.
 
-goal_expansion(G, user, (Y = Rhs, X is Y)) :-
+goal_expansion(G, _, Gx) :-
     % Additional rule just to replace invalid arithmetic expression with
     % runtime exception
     nonvar(G),
-    G = (X is Rhs),
-    nonvar(Rhs),
-    (Rhs == []; Rhs = [_|_]).
+    arithmetic_relation_expanded(G, Gx-[]).
 goal_expansion(Goal, Module, ExpandedGoal) :-
     (  atom(Module),
        '$predicate_defined'(Module, goal_expansion, 2),

tests/scryer/cli/issues/incorrect_arithmetics.in/hoist-expr.pl

@@ -4,37 +4,54 @@
 :- use_module(library(iso_ext)).
 :- use_module(library(format)).
 :- use_module(library(debug)).
+:- use_module(library(time)).
+
+:- dynamic(rznvivy/0).
 
 % Asserting and consulting of erroneous arithmetic relation shall succeed,
 % but then it must fail at runtime.
 main :-
-    template_relation("tttftt", R),
-    findall(T, test(R, T), [assert,consult]).
+    template_relation("tttf", R),
+    ignore_exception(test(R, consult)),
+    ignore_exception(test(R, assert)),
+    true.
 
 test(Relation, TestVariant) :-
-    load_and_call(TestVariant, (rznvivy :- false, Relation), \+rznvivy).
+    load_and_call(TestVariant, rznvivy/0, (rznvivy :- false, Relation), \+rznvivy).
 
-load_and_call(assert, Clause, Query) :-
+load_and_call(assert, PI, Clause, Query) :-
     setup_call_cleanup(
         ignore_exception(assertz(Clause)),
-        $-Query,
-        retract(Clause)
+        callf(PI, Query),
+        $abolish(PI)
     ).
-load_and_call(consult, Clause, Query) :-
+load_and_call(consult, PI, Clause, Query) :-
     T = 'chnytjl.pl',
     setup_call_cleanup(
         open(T, write, S),
         portray_clause(S, Clause),
         close(S)
     ),
-    ignore_exception(consult(T)),
-    $-Query.
+    setup_call_cleanup(
+        ignore_exception(consult(T)),
+        callf(PI, Query),
+        $abolish(PI)
+    ).
+
+callf(PI, G_0) :-
+    clause(rznvivy, I),
+    I \= true,
+    always(ignore_exception(listing(PI))),
+    $G_0.
+
+always(G_0) :- call(G_0).
+always(_).
 
 template_relation(Template, R) :-
-    setof(E, phrase(arith_relation(E), Template), Es),
+    time(setof(E, phrase(arith_relation(E), Template), Es)),
     length(Es, L),
     random_integer(0, L, I),
-    format("% Info: Selected ~dth out of ~d found aritmetic relations that satisfy ~s template:~n\t", [I,L,Template]),
+    format("   % Info: Selected ~d/~d aritmetic terms that satisfy ~s template:~n\t", [I,L,Template]),
     nth0(I, Es, R),
     portray_clause(R).
 
@@ -57,7 +74,7 @@
 func(Expr) --> {fn(T, Expr)}, [T].
 rel(Expr)  --> {rl(T, Expr)}, [T].
 
-%rl(t, expr(F,A,B)) :- member(F, [A<B,A=:=B]).
+rl(t, expr(F,A,B)) :- member(F, [A<B,A=:=B]).
 rl(t, expr(F,A))   :- member(F, [_ is A]).
 
 fn(t, expr(A))     :- rnd(A).
@@ -66,7 +83,7 @@
 fn(t, expr(F,A,B)) :- member(F, [A+B,A-B,A*B,A/B,A^B,max(A,B)]).
 fn(f, expr(F))     :- member(F, [[],phi,[_|_]]).
 fn(f, expr(F,A))   :- member(F, [zeta(A)]).
-fn(f, expr(F,A,B)) :- member(F, [[A,B]]).
+fn(f, expr(F,A,B)) :- member(F, [[A,B],[A|B]]).
 
 %% rnd(N).
 %