Changeset 4213 for trunk/compiler/logtalk.pl

Timestamp:

04/21/08 09:25:05 (6 months ago)

Author:

pmoura

Message:

Added support for checking arithmetic expressions for calls to non-portable function calls when using the "portability" compiler flag.

Files:

• trunk/compiler/logtalk.pl (modified) (7 diffs)

trunk/compiler/logtalk.pl

@@ -205 +205 @@
 :- dynamic('$lgt_pp_calls_pred_'/4).            % '$lgt_pp_calls_pred_'(Functor, Arity, TFunctor, TArity)
 :- dynamic('$lgt_non_portable_call_'/2).        % '$lgt_non_portable_call_'(Functor, Arity)
+:- dynamic('$lgt_non_portable_function_'/2).    % '$lgt_non_portable_function_'(Functor, Arity)
 
 :- dynamic('$lgt_pp_defs_nt_'/2).               % '$lgt_pp_defs_nt_'(Functor, Arity)
@@ -4752 +4753 @@
     retractall('$lgt_pp_calls_pred_'(_, _, _, _)),
     retractall('$lgt_non_portable_call_'(_, _)),
+    retractall('$lgt_non_portable_function_'(_, _)),
     retractall('$lgt_pp_defs_nt_'(_, _)),
     retractall('$lgt_pp_calls_nt_'(_, _)),
@@ -7198 +7200 @@
 
 
+% arithmetic predicates (portability checks)
+
+'$lgt_tr_body'(_ is Exp, _, _, _) :-
+    '$lgt_check_non_portable_functions'(Exp),
+    fail.
+'$lgt_tr_body'(Exp1 =:= Exp2, _, _, _) :-
+    '$lgt_check_non_portable_functions'(Exp1),
+    '$lgt_check_non_portable_functions'(Exp2),
+    fail.
+'$lgt_tr_body'(Exp1 =\= Exp2, _, _, _) :-
+    '$lgt_check_non_portable_functions'(Exp1),
+    '$lgt_check_non_portable_functions'(Exp2),
+    fail.
+'$lgt_tr_body'(Exp1 < Exp2, _, _, _) :-
+    '$lgt_check_non_portable_functions'(Exp1),
+    '$lgt_check_non_portable_functions'(Exp2),
+    fail.
+'$lgt_tr_body'(Exp1 =< Exp2, _, _, _) :-
+    '$lgt_check_non_portable_functions'(Exp1),
+    '$lgt_check_non_portable_functions'(Exp2),
+    fail.
+'$lgt_tr_body'(Exp1 > Exp2, _, _, _) :-
+    '$lgt_check_non_portable_functions'(Exp1),
+    '$lgt_check_non_portable_functions'(Exp2),
+    fail.
+'$lgt_tr_body'(Exp1 >= Exp2, _, _, _) :-
+    '$lgt_check_non_portable_functions'(Exp1),
+    '$lgt_check_non_portable_functions'(Exp2),
+    fail.
+
+
 % Logtalk and Prolog built-in (meta-)predicates
 
@@ -7553 +7586 @@
 
 '$lgt_compiler_db_pred_ind_chk'(_).
+
+
+
+% '$lgt_check_non_portable_functions'(@term)
+%
+% checks an arithmetic expression for calls to non-standard Prolog functions
+
+
+'$lgt_check_non_portable_functions'(Exp) :-
+    var(Exp),
+    !.
+
+'$lgt_check_non_portable_functions'(Exp) :-
+    number(Exp),
+    !.
+
+'$lgt_check_non_portable_functions'(Exp) :-
+    '$lgt_iso_spec_function'(Exp),
+    !,
+    Exp =.. [_| Exps],
+    '$lgt_check_non_portable_function_args'(Exps).
+
+'$lgt_check_non_portable_functions'(Exp) :-
+    functor(Exp, Functor, Arity),
+    (   '$lgt_non_portable_function_'(Functor, Arity) ->
+        true
+    ;   assertz('$lgt_non_portable_function_'(Functor, Arity))
+    ),
+    Exp =.. [_| Exps],
+    '$lgt_check_non_portable_function_args'(Exps).
+
+
+'$lgt_check_non_portable_function_args'([]).
+
+'$lgt_check_non_portable_function_args'([Exp| Exps]) :-
+    '$lgt_check_non_portable_functions'(Exp),
+    '$lgt_check_non_portable_function_args'(Exps).
 
 
@@ -8609 +8679 @@
         '$lgt_report_misspelt_calls',
         '$lgt_report_non_portable_calls',
+        '$lgt_report_non_portable_functions',
         '$lgt_report_unknown_entities'
     ;   true
@@ -10153 +10224 @@
     functor(Pred, Functor, Arity),
     \+ '$lgt_pp_redefined_built_in_'(Pred, _, _, _, _).
+
+
+
+% report non-portable arithmetic function calls in the body of object and category predicates
+
+'$lgt_report_non_portable_functions' :-
+    '$lgt_compiler_flag'(portability, warning),
+    setof(Functor/Arity, '$lgt_non_portable_function_'(Functor, Arity), Functions),
+    '$lgt_inc_compile_warnings_counter',
+    nl,
+    (   Functions = [_] ->
+        write('  WARNING!  Call to non-standard Prolog built-in arithmetic function: ')
+    ;   write('  WARNING!  Calls to non-standard Prolog built-in arithmetic functions: ')
+    ),
+    '$lgt_writeq_list'(Functions),
+    !.
+
+'$lgt_report_non_portable_functions'.
 
 
@@ -12706 +12795 @@
 '$lgt_iso_spec_pred'(halt).
 '$lgt_iso_spec_pred'(halt(_)).
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+%  table of ISO specified arithmetic functions
+%
+%  (used for portability checking)
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+'$lgt_iso_spec_function'('-'(_)).
+'$lgt_iso_spec_function'('+'(_, _)).
+'$lgt_iso_spec_function'('-'(_, _)).
+'$lgt_iso_spec_function'('*'(_, _)).
+'$lgt_iso_spec_function'('/'(_, _)).
+'$lgt_iso_spec_function'('//'(_, _)).
+'$lgt_iso_spec_function'(rem(_, _)).
+'$lgt_iso_spec_function'(mod(_, _)).
+'$lgt_iso_spec_function'('/\\'(_, _)).
+'$lgt_iso_spec_function'('\\/'(_, _)).
+'$lgt_iso_spec_function'('\\'(_, _)).
+'$lgt_iso_spec_function'('<<'(_, _)).
+'$lgt_iso_spec_function'('>>'(_, _)).
+'$lgt_iso_spec_function'('**'(_, _)).
+
+'$lgt_iso_spec_function'(abs(_)).
+'$lgt_iso_spec_function'(sign(_)).
+'$lgt_iso_spec_function'(sqrt(_)).
+'$lgt_iso_spec_function'(atan(_)).
+'$lgt_iso_spec_function'(cos(_)).
+'$lgt_iso_spec_function'(sin(_)).
+'$lgt_iso_spec_function'(exp(_)).
+'$lgt_iso_spec_function'(log(_)).
+'$lgt_iso_spec_function'(float(_)).
+'$lgt_iso_spec_function'(ceiling(_)).
+'$lgt_iso_spec_function'(floor(_)).
+'$lgt_iso_spec_function'(round(_)).
+'$lgt_iso_spec_function'(truncate(_)).
+'$lgt_iso_spec_function'(float_fractional_part(_)).
+'$lgt_iso_spec_function'(float_integer_part(_)).