lgamma broke arithmetic optimisation
integer_y has type y pass original source to checker (and maybe even use option in parser) use warning mechanism for checker messages. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1231 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
c9307a5987
commit
cd4fd05d45
@ -10,8 +10,12 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2004-12-28 22:20:34 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-01-13 05:47:25 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.155 2004/12/28 22:20:34 vsc
|
||||
* some extra bug fixes for trail overflows: some cannot be recovered that easily,
|
||||
* some can.
|
||||
*
|
||||
* Revision 1.154 2004/12/05 05:01:21 vsc
|
||||
* try to reduce overheads when running with goal expansion enabled.
|
||||
* CLPBN fixes
|
||||
@ -8099,7 +8103,7 @@ Yap_absmi(int inp)
|
||||
integer_y_nvar:
|
||||
/* non variable */
|
||||
if (IsIntTerm(d0)) {
|
||||
PREG = NEXTOP(PREG, xF);
|
||||
PREG = NEXTOP(PREG, yF);
|
||||
GONext();
|
||||
}
|
||||
if (IsApplTerm(d0)) {
|
||||
|
||||
13
C/arith1.c
13
C/arith1.c
@ -1086,7 +1086,7 @@ p_lgamma(Term t E_ARGS)
|
||||
Functor f = AritFunctorOfTerm(t);
|
||||
union arith_ret v;
|
||||
blob_type bt;
|
||||
Float dbl, out;
|
||||
Float dbl;
|
||||
|
||||
switch (BlobOfFunctor(f)) {
|
||||
case long_int_e:
|
||||
@ -1123,8 +1123,11 @@ p_lgamma(Term t E_ARGS)
|
||||
}
|
||||
|
||||
#if HAVE_LGAMMA
|
||||
out = lgamma(dbl);
|
||||
RFLOAT(out);
|
||||
{
|
||||
Float out;
|
||||
out = lgamma(dbl);
|
||||
RFLOAT(out);
|
||||
}
|
||||
#else
|
||||
RERROR();
|
||||
#endif
|
||||
@ -2014,7 +2017,6 @@ static InitUnEntry InitUnTab[] = {
|
||||
{"asin", p_asin},
|
||||
{"acos", p_acos},
|
||||
{"atan", p_atan},
|
||||
{"lgamma", p_lgamma},
|
||||
{"asinh", p_asinh},
|
||||
{"acosh", p_acosh},
|
||||
{"atanh", p_atanh},
|
||||
@ -2028,7 +2030,8 @@ static InitUnEntry InitUnTab[] = {
|
||||
{"msb", p_msb},
|
||||
{"float_fractional_part", p_ffracp},
|
||||
{"float_integer_part", p_fintp},
|
||||
{"sign", p_sign}
|
||||
{"sign", p_sign},
|
||||
{"lgamma", p_lgamma},
|
||||
};
|
||||
|
||||
static Int
|
||||
|
||||
@ -322,6 +322,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
|
||||
'$unary_op_as_integer'(float_fractional_part,27).
|
||||
'$unary_op_as_integer'(float_integer_part,28).
|
||||
'$unary_op_as_integer'(sign,29).
|
||||
'$unary_op_as_integer'(lgamma,30).
|
||||
|
||||
'$binary_op_as_integer'(+,0).
|
||||
'$binary_op_as_integer'(-,1).
|
||||
|
||||
81
pl/boot.yap
81
pl/boot.yap
@ -203,48 +203,49 @@ repeat :- '$repeat'.
|
||||
|
||||
'$command'(C,VL,Con) :-
|
||||
'$access_yap_flags'(9,1), !,
|
||||
'$execute_command'(C,VL,Con).
|
||||
'$execute_command'(C,VL,Con,C).
|
||||
'$command'(C,VL,Con) :-
|
||||
( (Con = top ; var(C) ; C = [_|_]) ->
|
||||
'$execute_command'(C,VL,Con), ! ;
|
||||
'$execute_command'(C,VL,Con,C), ! ;
|
||||
expand_term(C, EC),
|
||||
'$execute_commands'(EC,VL,Con)
|
||||
'$execute_commands'(EC,VL,Con,C)
|
||||
).
|
||||
|
||||
%
|
||||
% Hack in case expand_term has created a list of commands.
|
||||
%
|
||||
'$execute_commands'(V,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,meta_call(V)).
|
||||
'$execute_commands'([],_,_) :- !, fail.
|
||||
'$execute_commands'([C|Cs],VL,Con) :- !,
|
||||
'$execute_commands'(V,_,_,Source) :- var(V), !,
|
||||
'$do_error'(instantiation_error,meta_call(Source)).
|
||||
'$execute_commands'([],_,_,_) :- !, fail.
|
||||
'$execute_commands'([C|Cs],VL,Con,Source) :- !,
|
||||
(
|
||||
'$execute_command'(C,VL,Con)
|
||||
'$execute_command'(C,VL,Con,Source)
|
||||
;
|
||||
'$execute_commands'(Cs,VL,Con)
|
||||
'$execute_commands'(Cs,VL,Con,Source)
|
||||
),
|
||||
fail.
|
||||
'$execute_commands'(C,VL,Con) :-
|
||||
'$execute_command'(C,VL,Con).
|
||||
'$execute_commands'(C,VL,Con,Source) :-
|
||||
'$execute_command'(C,VL,Con,Source).
|
||||
|
||||
%
|
||||
%
|
||||
%
|
||||
|
||||
'$execute_command'(C,_,top) :- var(C), !,
|
||||
'$do_error'(instantiation_error,meta_call(C)).
|
||||
'$execute_command'(C,_,top) :- number(C), !,
|
||||
'$do_error'(type_error(callable,C),meta_call(C)).
|
||||
'$execute_command'(R,_,top) :- db_reference(R), !,
|
||||
'$do_error'(type_error(callable,R),meta_call(R)).
|
||||
'$execute_command'(end_of_file,_,_) :- !.
|
||||
'$execute_command'((:-G),_,Option) :- !,
|
||||
'$execute_command'(C,_,top,Source) :- var(C), !,
|
||||
'$do_error'(instantiation_error,meta_call(Source)).
|
||||
'$execute_command'(C,_,top,Source) :- number(C), !,
|
||||
'$do_error'(type_error(callable,C),meta_call(Source)).
|
||||
'$execute_command'(R,_,top,Source) :- db_reference(R), !,
|
||||
'$do_error'(type_error(callable,R),meta_call(Source)).
|
||||
'$execute_command'(end_of_file,_,_,_) :- !.
|
||||
'$execute_command'((:-G),_,Option,_) :- !,
|
||||
'$current_module'(M),
|
||||
'$process_directive'(G, Option, M),
|
||||
fail.
|
||||
'$execute_command'((?-G),V,_) :- !,
|
||||
'$execute_command'(G,V,top).
|
||||
'$execute_command'(G,V,Option) :- '$continue_with_command'(Option,V,G).
|
||||
'$execute_command'((?-G),V,_,Source) :- !,
|
||||
'$execute_command'(G,V,top,Source).
|
||||
'$execute_command'(G,V,Option,Source) :-
|
||||
'$continue_with_command'(Option,V,G,Source).
|
||||
|
||||
%
|
||||
% This command is very different depending on the language mode we are in.
|
||||
@ -297,40 +298,40 @@ repeat :- '$repeat'.
|
||||
'$all_directives'(G) :- !,
|
||||
'$directive'(G).
|
||||
|
||||
'$continue_with_command'(reconsult,V,G) :-
|
||||
'$go_compile_clause'(G,V,5),
|
||||
'$continue_with_command'(reconsult,V,G,Source) :-
|
||||
'$go_compile_clause'(G,V,5,Source),
|
||||
fail.
|
||||
'$continue_with_command'(consult,V,G) :-
|
||||
'$go_compile_clause'(G,V,13),
|
||||
'$continue_with_command'(consult,V,G,Source) :-
|
||||
'$go_compile_clause'(G,V,13,Source),
|
||||
fail.
|
||||
'$continue_with_command'(top,V,G) :-
|
||||
'$continue_with_command'(top,V,G,_) :-
|
||||
'$query'(G,V).
|
||||
|
||||
%
|
||||
% not 100% compatible with SICStus Prolog, as SICStus Prolog would put
|
||||
% module prefixes all over the place, although unnecessarily so.
|
||||
%
|
||||
'$go_compile_clause'(Mod:G,V,N) :- !,
|
||||
'$go_compile_clause'(G,V,N,Mod).
|
||||
'$go_compile_clause'((M:G :- B),V,N) :- !,
|
||||
'$go_compile_clause'(Mod:G,V,N,Source) :- !,
|
||||
'$go_compile_clause'(G,V,N,Mod,Source).
|
||||
'$go_compile_clause'((M:G :- B),V,N,Source) :- !,
|
||||
'$current_module'(M1),
|
||||
(M1 = M ->
|
||||
NG = (G :- B)
|
||||
;
|
||||
'$preprocess_clause_before_mod_change'((G:-B),M1,M,NG)
|
||||
),
|
||||
'$go_compile_clause'(NG,V,N,M).
|
||||
'$go_compile_clause'(G,V,N) :-
|
||||
'$go_compile_clause'(NG,V,N,M,Source).
|
||||
'$go_compile_clause'(G,V,N,Source) :-
|
||||
'$current_module'(Mod),
|
||||
'$go_compile_clause'(G,V,N,Mod).
|
||||
'$go_compile_clause'(G,V,N,Mod,Source).
|
||||
|
||||
'$go_compile_clause'(G, V, N, Mod) :-
|
||||
'$prepare_term'(G, V, G0, G1, Mod),
|
||||
'$go_compile_clause'(G, V, N, Mod, Source) :-
|
||||
'$prepare_term'(G, V, G0, G1, Mod, Source),
|
||||
'$$compile'(G1, G0, N, Mod).
|
||||
|
||||
'$prepare_term'(G,V,G0,G1, Mod) :-
|
||||
'$prepare_term'(G, V, G0, G1, Mod, Source) :-
|
||||
( get_value('$syntaxcheckflag',on) ->
|
||||
'$check_term'(G,V,Mod) ; true ),
|
||||
'$check_term'(Source, V, Mod) ; true ),
|
||||
'$precompile_term'(G, G0, G1, Mod).
|
||||
|
||||
% process an input clause
|
||||
@ -753,12 +754,10 @@ not(G) :- \+ '$execute'(G).
|
||||
'$do_undefp'(G,M) :-
|
||||
\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
|
||||
'$system_catch'(unknown_predicate_handler(G,M,NG), user, _, fail), !,
|
||||
'$execute'(user:NG),
|
||||
'$exit_undefp'.
|
||||
( once('$execute'(user:NG)) -> '$exit_undefp' ; '$exit_undefp', fail).
|
||||
'$do_undefp'(G,M) :-
|
||||
recorded('$unknown','$unknown'(M:G,US),_), !,
|
||||
'$execute'(user:US),
|
||||
'$exit_undefp'.
|
||||
( once('$execute'(user:US)) -> '$exit_undefp' ; '$exit_undefp', fail).
|
||||
'$do_undefp'(_,_) :-
|
||||
'$exit_undefp',
|
||||
fail.
|
||||
|
||||
@ -11,8 +11,11 @@
|
||||
* File: checker.yap *
|
||||
* comments: style checker for Prolog *
|
||||
* *
|
||||
* Last rev: $Date: 2004-06-29 19:12:01 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-01-13 05:47:27 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.15 2004/06/29 19:12:01 vsc
|
||||
* fix checker messages
|
||||
*
|
||||
* Revision 1.14 2004/06/29 19:04:46 vsc
|
||||
* fix multithreaded version
|
||||
* include new version of Ricardo's profiler
|
||||
@ -122,22 +125,14 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
|
||||
'$sv_warning'(SVs,T) :-
|
||||
'$current_module'(OM),
|
||||
'$xtract_head'(T,OM,M,H,Name,Arity),
|
||||
write(user_error,'% Warning: singleton variable'),
|
||||
'$write_svs'(SVs),
|
||||
write(user_error,' in '),
|
||||
write(user_error,Name/Arity),
|
||||
write(user_error,' (line '),
|
||||
'$start_line'(LN), write(user_error,LN),
|
||||
write(user_error,', clause '),
|
||||
'$start_line'(LN),
|
||||
( get_value('$consulting',false),
|
||||
'$first_clause_in_file'(Name,Arity, OM) ->
|
||||
ClN = 1 ;
|
||||
'$number_of_clauses'(H,M,ClN0),
|
||||
ClN is ClN0+1
|
||||
),
|
||||
write(user_error,ClN),
|
||||
write(user_error,')'),
|
||||
nl(user_error).
|
||||
print_message(warning,singletons(SVs,(M:Name/Arity),LN,ClN)).
|
||||
|
||||
'$xtract_head'(V,M,M,V,call,1) :- var(V), !.
|
||||
'$xtract_head'((H:-_),OM,M,NH,Name,Arity) :- !,
|
||||
@ -153,31 +148,12 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
|
||||
'$xtract_head'(H,M,M,H,Name,Arity) :-
|
||||
functor(H,Name,Arity).
|
||||
|
||||
'$write_svs'([H]) :- !, write(user_error,' '), '$write_svs1'([H]).
|
||||
'$write_svs'(SVs) :- write(user_error,'s '), '$write_svs1'(SVs).
|
||||
|
||||
'$write_svs1'([H]) :- !,
|
||||
'$write_str_in_stderr'(H).
|
||||
'$write_svs1'([H|T]) :-
|
||||
'$write_str_in_stderr'(H),
|
||||
write(user_error,','),
|
||||
'$write_svs1'(T).
|
||||
|
||||
'$write_str_in_stderr'([]).
|
||||
'$write_str_in_stderr'([C|T]) :-
|
||||
put(user_error,C),
|
||||
'$write_str_in_stderr'(T).
|
||||
|
||||
|
||||
'$handle_discontiguous'(F,A,M) :-
|
||||
recorded('$discontiguous_defs','$df'(F,A,M),_), !.
|
||||
'$handle_discontiguous'(F,A,M) :-
|
||||
'$in_this_file_before'(F,A,M),
|
||||
write(user_error,'% Warning: discontiguous definition of '),
|
||||
write(user_error,F/A), write(user_error,' (line '),
|
||||
'$start_line'(LN), write(user_error,LN),
|
||||
write(user_error,')'),
|
||||
nl(user_error).
|
||||
'$start_line'(LN),
|
||||
print_message(warning,clauses_not_together((M:Name/Arity),LN)).
|
||||
|
||||
'$handle_multiple'(F,A,M) :-
|
||||
\+ '$first_clause_in_file'(F,A,M), !.
|
||||
@ -199,12 +175,8 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
|
||||
|
||||
'$test_if_well_reconsulting'(F,F,_) :- !.
|
||||
'$test_if_well_reconsulting'(_,Fil,P) :-
|
||||
write(user_error,'% Warning: predicate '),
|
||||
write(user_error,P), write(user_error,' already defined in '),
|
||||
write(user_error,Fil), write(user_error,' (line '),
|
||||
'$start_line'(LN), write(user_error,LN),
|
||||
write(user_error,')'),
|
||||
nl(user_error).
|
||||
'$start_line'(LN),
|
||||
print_message(warning,defined_elsewhere((M:Name/Arity),Fil,LN)).
|
||||
|
||||
'$multifile'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,multifile(V)).
|
||||
|
||||
@ -11,8 +11,11 @@
|
||||
* File: errors.yap *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2004-11-19 21:32:53 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-01-13 05:47:27 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.58 2004/11/19 21:32:53 vsc
|
||||
* change abort so that it won't be caught by handlers.
|
||||
*
|
||||
* Revision 1.57 2004/10/27 15:56:34 vsc
|
||||
* bug fixes on memory overflows and on clauses :- fail being ignored by clause.
|
||||
*
|
||||
@ -156,12 +159,16 @@ print_message(Level, Mss) :-
|
||||
'$do_print_message'(breakpoints(L)) :- !,
|
||||
format(user_error,'Spy-points set on:', []),
|
||||
'$print_list_of_preds'(L).
|
||||
'$do_print_message'(clauses_not_together(P,LN)) :- !,
|
||||
format(user_error, 'Discontiguous definition of ~q, at line ~d.',[P,LN]).
|
||||
'$do_print_message'(debug(debug)) :- !,
|
||||
format(user_error,'Debug mode on.',[]).
|
||||
'$do_print_message'(debug(off)) :- !,
|
||||
format(user_error,'Debug mode off.',[]).
|
||||
'$do_print_message'(debug(trace)) :- !,
|
||||
format(user_error,'Trace mode on.',[]).
|
||||
'$do_print_message'(defined_elsewhere(P,F,LN)) :- !,
|
||||
format(user_error, 'predicate ~q, at line ~d, previously defined in file ~a.',[P,LN,F]).
|
||||
'$do_print_message'(import(Pred,To,From,private)) :- !,
|
||||
format(user_error,'Importing private predicate ~w:~w to ~w.',
|
||||
[From,Pred,To]).
|
||||
@ -176,10 +183,15 @@ print_message(Level, Mss) :-
|
||||
'$do_print_message'(no_match(P)) :- !,
|
||||
format(user_error,'No matching predicate for ~w.',
|
||||
[P]).
|
||||
'$do_print_message'(trace_command(C)) :- !,
|
||||
format(user_error,'Invalid trace command: ~c', [C]).
|
||||
'$do_print_message'(leash([A|B])) :- !,
|
||||
format(user_error,'Leashing set to ~w.',
|
||||
[[A|B]]).
|
||||
'$do_print_message'(singletons(SVs,P,LN,CLN)) :- !,
|
||||
format(user_error, 'Singleton variable',[]),
|
||||
'$write_svs'(SVs),
|
||||
format(user_error, ' in ~q at line ~d, clause ~d.',[P,LN,CLN]).
|
||||
'$do_print_message'(trace_help) :- !,
|
||||
format(user_error,' Please enter a valid debugger command (h for help).', []).
|
||||
yap_flag(user_error,' Please enter a valid debugger command (h for help).', []).
|
||||
'$do_print_message'(version(Version)) :- !,
|
||||
format(user_error,'YAP version ~a', [Version]).
|
||||
'$do_print_message'(yes) :- !,
|
||||
@ -187,6 +199,22 @@ print_message(Level, Mss) :-
|
||||
'$do_print_message'(Messg) :-
|
||||
format(user_error,'~q',Messg).
|
||||
|
||||
'$write_svs'([H]) :- !, write(user_error,' '), '$write_svs1'([H]).
|
||||
'$write_svs'(SVs) :- write(user_error,'s '), '$write_svs1'(SVs).
|
||||
|
||||
'$write_svs1'([H]) :- !,
|
||||
'$write_str_in_stderr'(H).
|
||||
'$write_svs1'([H|T]) :-
|
||||
'$write_str_in_stderr'(H),
|
||||
write(user_error,','),
|
||||
'$write_svs1'(T).
|
||||
|
||||
'$write_str_in_stderr'([]).
|
||||
'$write_str_in_stderr'([C|T]) :-
|
||||
put(user_error,C),
|
||||
'$write_str_in_stderr'(T).
|
||||
|
||||
|
||||
'$print_list_of_preds'([]).
|
||||
'$print_list_of_preds'([P|L]) :-
|
||||
format(user_error,'~n ~w',[P]),
|
||||
|
||||
Reference in New Issue
Block a user