1 % b_arithmetic_expressions.pl
2 % returns for arithmetic expressions a symbolic value that can be called in CLP(FD)
3
4 % :- use_module(kernel_waitflags,[add_error_wf/5]). included in b_interpreter
5
6 b_compute_arith_expression(b(Expr,Type,Info),LS,S,R,WF) :- !,
7 (ground(Type), Type == integer -> true
8 ; add_error_wf(b_compute_arith_expression,'Arithmetic expression has illegal type: ',b(Expr,Type,Info),Info,WF)
9 ),
10 ? b_compute_arith_expression2(Expr,Info,LS,S,R,WF).
11
12 b_compute_arith_expression(Expr,LS,S,R,WF) :-
13 add_error_wf(b_compute_arith_expression,'Expression not properly wrapped: ',Expr,Expr,WF),
14 b_compute_arith_expression2(Expr,unknown,LS,S,R,WF).
15
16
17 b_compute_arith_expression2(unary_minus(Arg1),_I,LocalState,State,Value,WF) :- !,
18 b_compute_arith_expression(Arg1,LocalState,State,SV1,WF),
19 Value = '-'(SV1).
20 b_compute_arith_expression2(add(Arg1,Arg2),_I,LocalState,State,Value,WF) :- !,
21 ? b_compute_arith_expression(Arg1,LocalState,State,SV1,WF),
22 ? b_compute_arith_expression(Arg2,LocalState,State,SV2,WF),
23 Value = '+'(SV1,SV2).
24 b_compute_arith_expression2(minus(Arg1,Arg2),_I,LocalState,State,Value,WF) :- !,
25 ? b_compute_arith_expression(Arg1,LocalState,State,SV1,WF),
26 ? b_compute_arith_expression(Arg2,LocalState,State,SV2,WF),
27 Value = '-'(SV1,SV2).
28 b_compute_arith_expression2(multiplication(Arg1,Arg2),_I,LocalState,State,Value,WF) :- !,
29 ? b_compute_arith_expression(Arg1,LocalState,State,SV1,WF),
30 ? b_compute_arith_expression(Arg2,LocalState,State,SV2,WF),
31 Value = '*'(SV1,SV2).
32 b_compute_arith_expression2(external_function_call(XFUN,[Arg1]),_Info,LocalState,State,Value,WF) :-
33 unary_external_function_to_clpfd(XFUN,SV1,ClpfdExpr),!,
34 b_compute_arith_expression(Arg1,LocalState,State,SV1,WF),
35 Value = ClpfdExpr.
36 b_compute_arith_expression2(Expr,Info,LocalState,State,Value,WF) :-
37 ? b_compute_expression2(Expr,integer,Info,LocalState,State,int(Value),WF).
38 %b_compute_expression2(Expr,integer,Info,LocalState,State,R,WF), R=int(Value). % this version does not seem faster
39 % kernel_objects:basic_type2(integer,int(Value)).
40
41 unary_external_function_to_clpfd('ABS',Arg1,abs(Arg1)).
42 % TO DO: floor/ceiling/...
43
44
45 % Note: calling b_compute_arith_expression will also instantiate a variable to at least the int(_) skeleton; thereby enabling propagation
46 % this is potentially better than calling the default versions of the predicates, which may wait until the int(_) skeleton is set up before propagation
47
48
49 :- use_module(clpfd_interface,[clpfd_eq_expr_optimized/2]).
50
51 b_test_arith_equal_boolean_expression(Arg1,Arg2,LocalState,State,WF) :-
52 ? b_compute_arith_expression(Arg1,LocalState,State,CLPFD_Expr1,WF),
53 ? b_compute_arith_expression(Arg2,LocalState,State,CLPFD_Expr2,WF),
54 clpfd_eq_expr_optimized(CLPFD_Expr1,CLPFD_Expr2).
55
56 %(preferences:preference(use_smt_mode,true)-> clpfd_eq_expr_optimized(CLPFD_Expr1,CLPFD_Expr2)
57 % ; clpfd_eq_expr(CLPFD_Expr1,CLPFD_Expr2)).
58 % maybe we should call clpfd_eq_expr_optimized only in SMT mode and call clpfd_eq_expr otherwise ??
59 % initially test 1077 ran considerably slower with clpfd_eq_expr_optimized
60
61 % ------------------------------------
62 % Now similar code for reals
63 % ------------------------------------
64
65 % should only be used when kernel_reals:use_clpfd_real_solver is true
66 % and when kernel_reals:do_not_double_check_solution is true
67 % Note: we could add double checking to the code below,
68 % but SICStus Prolog itself leaves uninstantiated intermediate variables (see SPRM-21557)
69
70 b_compute_real_arith_expression(b(Expr,Type,Info),LS,S,R,WF) :- !,
71 (ground(Type), Type == real -> true
72 ; add_error_wf(b_compute_arith_expression,'Arithmetic expression has illegal type: ',b(Expr,Type,Info),Info,WF)
73 ),
74 b_compute_real_arith_expression2(Expr,Info,LS,S,R,WF).
75
76 b_compute_real_arith_expression2(unary_minus_real(Arg1),_I,LocalState,State,Value,WF) :- !,
77 b_compute_real_arith_expression(Arg1,LocalState,State,SV1,WF),
78 Value = '-'(SV1).
79 b_compute_real_arith_expression2(add_real(Arg1,Arg2),_I,LocalState,State,Value,WF) :- !,
80 b_compute_real_arith_expression(Arg1,LocalState,State,SV1,WF),
81 b_compute_real_arith_expression(Arg2,LocalState,State,SV2,WF),
82 Value = '+'(SV1,SV2).
83 b_compute_real_arith_expression2(minus_real(Arg1,Arg2),_I,LocalState,State,Value,WF) :- !,
84 b_compute_real_arith_expression(Arg1,LocalState,State,SV1,WF),
85 b_compute_real_arith_expression(Arg2,LocalState,State,SV2,WF),
86 Value = '-'(SV1,SV2).
87 b_compute_real_arith_expression2(multiplication_real(Arg1,Arg2),_I,LocalState,State,Value,WF) :- !,
88 b_compute_real_arith_expression(Arg1,LocalState,State,SV1,WF),
89 b_compute_real_arith_expression(Arg2,LocalState,State,SV2,WF),
90 Value = '*'(SV1,SV2).
91 b_compute_real_arith_expression2(power_of_real(Arg1,Arg2),_I,LocalState,State,Value,WF) :- !,
92 b_compute_real_arith_expression(Arg1,LocalState,State,SV1,WF),
93 b_compute_real_arith_expression(Arg2,LocalState,State,SV2,WF), % integer value but converted to real
94 Value = '^'(SV1,SV2).
95 b_compute_real_arith_expression2(external_function_call(XFUN,[Arg1]),_Info,LocalState,State,Value,WF) :-
96 unary_external_function_to_clpfd_real(XFUN,SV1,ClpfdExpr),!,
97 b_compute_real_arith_expression(Arg1,LocalState,State,SV1,WF),
98 Value = ClpfdExpr.
99 b_compute_real_arith_expression2(Expr,Info,LocalState,State,Value,WF) :- write(comp(Expr)),nl,
100 b_compute_expression2(Expr,real,Info,LocalState,State,BValue,WF),
101 is_real(BValue,Value).
102
103 unary_external_function_to_clpfd_real('RABS',Arg1,abs(Arg1)).
104 % TODO: convert_real(.)
105
106 :- use_module(kernel_reals,[post_real_equal_expr_wf/4]).
107 b_test_real_arith_equal_boolean_expression(Arg1,Arg2,Info,LocalState,State,WF) :-
108 b_compute_real_arith_expression(Arg1,LocalState,State,CLPFD_Expr1,WF),
109 b_compute_real_arith_expression(Arg2,LocalState,State,CLPFD_Expr2,WF),
110 %write(post_eq(CLPFD_Expr1,CLPFD_Expr2)),nl,
111 post_real_equal_expr_wf(CLPFD_Expr1,CLPFD_Expr2,Info,WF).
112