fix some bugs from yesterday plus improve support for modules in
operators. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2095 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
4fa75e361a
commit
a4a26478e0
2
C/init.c
2
C/init.c
@ -338,7 +338,7 @@ Yap_GetOp(OpEntry *pp, int *prio, int fix)
|
||||
else
|
||||
n = 4, *prio = p;
|
||||
}
|
||||
return (Yap_LookupAtom(optypes[n]));
|
||||
return Yap_LookupAtom(optypes[n]);
|
||||
}
|
||||
|
||||
typedef struct OPSTRUCT {
|
||||
|
||||
47
C/stdpreds.c
47
C/stdpreds.c
@ -11,8 +11,12 @@
|
||||
* File: stdpreds.c *
|
||||
* comments: General-purpose C implemented system predicates *
|
||||
* *
|
||||
* Last rev: $Date: 2008-02-07 23:09:13 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-02-13 10:15:35 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.126 2008/02/07 23:09:13 vsc
|
||||
* don't break ISO standard in current_predicate/1.
|
||||
* Include Nicos flag.
|
||||
*
|
||||
* Revision 1.125 2008/01/23 17:57:53 vsc
|
||||
* valgrind it!
|
||||
* enable atom garbage collection.
|
||||
@ -2749,9 +2753,10 @@ static Int
|
||||
cont_current_op(void)
|
||||
{
|
||||
int prio;
|
||||
Atom a = AtomOfTerm(EXTRA_CBACK_ARG(3,1));
|
||||
Int fix = IntOfTerm(EXTRA_CBACK_ARG(3,3));
|
||||
Atom a = AtomOfTerm(EXTRA_CBACK_ARG(4,1));
|
||||
Int fix = IntOfTerm(EXTRA_CBACK_ARG(4,3));
|
||||
Term TType;
|
||||
Term tmod;
|
||||
OpEntry *pp = NIL;
|
||||
/* fix hp gcc bug */
|
||||
AtomEntry *at = RepAtom(a);
|
||||
@ -2778,12 +2783,19 @@ cont_current_op(void)
|
||||
fix = 6;
|
||||
if (fix == 6 && pp->Infix == 0)
|
||||
fix = 7;
|
||||
if (pp->OpModule == PROLOG_MODULE)
|
||||
tmod = TermProlog;
|
||||
else
|
||||
tmod = pp->OpModule;
|
||||
READ_UNLOCK(pp->OpRWLock);
|
||||
EXTRA_CBACK_ARG(3,3) = (CELL) MkIntTerm(fix);
|
||||
EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(fix);
|
||||
if (fix < 7)
|
||||
return (Yap_unify_constant(ARG1, MkIntTerm(prio))
|
||||
&& Yap_unify_constant(ARG2, TType));
|
||||
if (Yap_unify_constant(ARG1, MkIntTerm(prio)) && Yap_unify_constant(ARG2, TType))
|
||||
&& Yap_unify_constant(ARG2, TType)
|
||||
&& Yap_unify_constant(ARG4, tmod));
|
||||
if (Yap_unify_constant(ARG1, MkIntTerm(prio))
|
||||
&& Yap_unify_constant(ARG2, TType)
|
||||
&& Yap_unify_constant(ARG4, tmod))
|
||||
cut_succeed();
|
||||
else
|
||||
cut_fail();
|
||||
@ -2796,7 +2808,7 @@ cont_current_op(void)
|
||||
cut_fail();
|
||||
}
|
||||
fix = 0;
|
||||
EXTRA_CBACK_ARG(3,1) = (CELL) MkAtomTerm(at=RepAtom(a=pp->OpName));
|
||||
EXTRA_CBACK_ARG(4,1) = (CELL) MkAtomTerm(at=RepAtom(a=pp->OpName));
|
||||
}
|
||||
READ_LOCK(pp->OpRWLock);
|
||||
if (fix == 0 && pp->Prefix == 0)
|
||||
@ -2809,11 +2821,16 @@ cont_current_op(void)
|
||||
fix = 2;
|
||||
if (fix == 2 && pp->Infix == 0)
|
||||
fix = 3;
|
||||
if (pp->OpModule == PROLOG_MODULE)
|
||||
tmod = TermProlog;
|
||||
else
|
||||
tmod = pp->OpModule;
|
||||
READ_UNLOCK(pp->OpRWLock);
|
||||
EXTRA_CBACK_ARG(3,3) = (CELL) MkIntTerm(fix);
|
||||
EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(fix);
|
||||
return (Yap_unify_constant(ARG1, MkIntTerm(prio)) &&
|
||||
Yap_unify_constant(ARG2, TType) &&
|
||||
Yap_unify_constant(ARG3, MkAtomTerm(a)));
|
||||
Yap_unify_constant(ARG3, MkAtomTerm(a)) &&
|
||||
Yap_unify_constant(ARG4, tmod));
|
||||
}
|
||||
|
||||
static Int
|
||||
@ -2861,15 +2878,15 @@ init_current_op(void)
|
||||
else
|
||||
cut_fail();
|
||||
}
|
||||
EXTRA_CBACK_ARG(3,1) = (CELL) MkAtomTerm(a);
|
||||
EXTRA_CBACK_ARG(3,2) = (CELL) MkIntTerm(i);
|
||||
EXTRA_CBACK_ARG(4,1) = (CELL) MkAtomTerm(a);
|
||||
EXTRA_CBACK_ARG(4,2) = (CELL) MkIntTerm(i);
|
||||
if (IsVarTerm(top))
|
||||
EXTRA_CBACK_ARG(3,3) = (CELL) MkIntTerm(3);
|
||||
EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(3);
|
||||
else if (IsAtomTerm(top))
|
||||
EXTRA_CBACK_ARG(3,3) = (CELL) MkIntTerm(4);
|
||||
EXTRA_CBACK_ARG(4,3) = (CELL) MkIntTerm(4);
|
||||
else
|
||||
cut_fail();
|
||||
return (cont_current_op());
|
||||
return cont_current_op();
|
||||
}
|
||||
|
||||
#ifdef DEBUG
|
||||
@ -3799,7 +3816,7 @@ Yap_InitBackCPreds(void)
|
||||
SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPredBack("$current_predicate_for_atom", 3, 1, init_current_predicate_for_atom, cont_current_predicate_for_atom,
|
||||
SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op,
|
||||
Yap_InitCPredBack("$current_op", 4, 3, init_current_op, cont_current_op,
|
||||
SafePredFlag|SyncPredFlag);
|
||||
#ifdef BEAM
|
||||
Yap_InitCPredBack("eam", 1, 0, start_eam, cont_eam,
|
||||
|
||||
@ -38,7 +38,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
|
||||
|
||||
'$do_c_built_in'(G, M, OUT, MT) :- var(G), !,
|
||||
(MT = on -> NG = G ; NG = M:G),
|
||||
'$do_c_built_in'(call(NG),M,OUT).
|
||||
'$do_c_built_in'(call(NG), M, OUT, MT).
|
||||
'$do_c_built_in'(Mod:G, _, GN, MT) :- !,
|
||||
'$do_c_built_in'(G, Mod, GN0, MT),
|
||||
(GN0 = (_,_) -> GN = GN0 ; GN = Mod:GN0).
|
||||
|
||||
@ -517,6 +517,7 @@ source_module(Mod) :-
|
||||
clause(:,?,?),
|
||||
compile(:),
|
||||
consult(:),
|
||||
current_op(?,?,:),
|
||||
current_predicate(:),
|
||||
current_predicate(?,:),
|
||||
depth_bound_call(:,+),
|
||||
|
||||
130
pl/utils.yap
130
pl/utils.yap
@ -226,43 +226,109 @@ call_cleanup(Goal, Catcher, Cleanup) :-
|
||||
'$execute'(Cleanup), !.
|
||||
'$clean_call'(_).
|
||||
|
||||
op(P,T,V) :- var(P), !,
|
||||
'$do_error'(instantiation_error,op(P,T,V)).
|
||||
op(P,T,V) :- \+integer(P), !,
|
||||
'$do_error'(type_error(integer,P),op(P,T,V)).
|
||||
op(P,T,V) :- (P < 0 ; P > 1200), !,
|
||||
'$do_error'(domain_error(operator_priority,P),op(P,T,V)).
|
||||
op(P,T,V) :- var(T), !,
|
||||
'$do_error'(instantiation_error,op(P,T,V)).
|
||||
op(P,T,V) :- \+atom(T), !,
|
||||
'$do_error'(type_error(atom,T),op(P,T,V)).
|
||||
op(P,T,V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,op(P,T,V)).
|
||||
op(P,T,V) :-
|
||||
\+ atom(V), \+ '$check_list_of_operators'(V, op(P,T,V)),
|
||||
'$do_error'(type_error(list,V),op(P,T,V)).
|
||||
op(P,T,V) :- '$op2'(P,T,V).
|
||||
'$check_op'(P,T,V,op(P,T,V)),
|
||||
'$op'(P, T, V).
|
||||
|
||||
'$check_list_of_operators'(V, T) :- var(V), !,
|
||||
'$do_error'(instantiation_error,T).
|
||||
'$check_list_of_operators'([], _).
|
||||
'$check_list_of_operators'([H|L], T) :-
|
||||
'$check_if_operator'(H,T),
|
||||
'$check_list_of_operators'(L, T).
|
||||
'$check_op'(P,T,V,G) :-
|
||||
(
|
||||
var(P) ->
|
||||
'$do_error'(instantiation_error,G)
|
||||
;
|
||||
var(T) ->
|
||||
'$do_error'(instantiation_error,G)
|
||||
;
|
||||
var(V) ->
|
||||
'$do_error'(instantiation_error,G)
|
||||
;
|
||||
\+ integer(P) ->
|
||||
'$do_error'(type_error(integer,P),G)
|
||||
;
|
||||
\+ atom(T) ->
|
||||
'$do_error'(type_error(atom,T),G)
|
||||
;
|
||||
P < 0 ->
|
||||
'$do_error'(domain_error(out_of_range,P),G)
|
||||
;
|
||||
P > 1200 ->
|
||||
'$do_error'(domain_error(out_of_range,P),G)
|
||||
;
|
||||
\+ '$associativity'(T) ->
|
||||
'$do_error'(domain_error(operator_specifier,P),G)
|
||||
;
|
||||
'$check_op_name'(V,G)
|
||||
).
|
||||
|
||||
'$check_if_operator'(H,T) :- var(H), !,
|
||||
'$do_error'(instantiation_error,T).
|
||||
'$check_if_operator'(H,_) :- atom(H), !.
|
||||
'$check_if_operator'(H,T) :-
|
||||
'$do_error'(type_error(atom,H),T).
|
||||
'$associativity'(xfx).
|
||||
'$associativity'(xfy).
|
||||
'$associativity'(yfy).
|
||||
'$associativity'(xf).
|
||||
'$associativity'(yf).
|
||||
'$associativity'(fx).
|
||||
'$associativity'(fy).
|
||||
|
||||
'$op2'(_,_,[]) :- !.
|
||||
'$op2'(P,T,[A|L]) :- !, '$op'(P,T,A), '$op2'(P,T,L).
|
||||
'$op2'(P,T,A) :- atom(A), '$op'(P,T,A).
|
||||
'$check_op_name'(V,_) :-
|
||||
atom(V), !.
|
||||
'$check_op_name'(M:A, G) :-
|
||||
(
|
||||
var(M) ->
|
||||
'$do_error'(instantiation_error,G)
|
||||
;
|
||||
var(A) ->
|
||||
'$do_error'(instantiation_error,G)
|
||||
;
|
||||
\+ atom(A) ->
|
||||
'$do_error'(instantiation_error,G)
|
||||
;
|
||||
\+ atom(M) ->
|
||||
'$do_error'(instantiation_error,G)
|
||||
;
|
||||
true
|
||||
).
|
||||
'$check_op_name'([A|As], G) :-
|
||||
'$check_op_name'(A, G),
|
||||
'$check_op_names'(As, G).
|
||||
|
||||
'$op'(P,T,',') :- !,
|
||||
'$do_error'(permission_error(modify,operator,','),op(P,T,',')).
|
||||
'$op'(P,T,A) :- '$opdec'(P,T,A,prolog).
|
||||
'$check_op_names'([], _).
|
||||
'$check_op_names'([A|As], G) :-
|
||||
'$check_op_name'(A, G),
|
||||
'$check_op_names'(As, G).
|
||||
|
||||
|
||||
'$op'(P, T, A) :-
|
||||
atom(A), !,
|
||||
'$opdec'(P,T,A,prolog).
|
||||
'$op'(P, T, user:A) :- !,
|
||||
'$opdec'(P,T,A,prolog).
|
||||
'$op'(P, T, M:A) :-
|
||||
'$opdec'(P,T,A,M).
|
||||
'$op'(_, _, []).
|
||||
'$op'(P, T, [A|As]) :-
|
||||
'$op'(P, T, A),
|
||||
'$op'(P, T, As).
|
||||
|
||||
current_op(X,Y,V) :- var(V), !,
|
||||
'$current_module'(M),
|
||||
V = M:Z,
|
||||
'$do_current_op'(X,Y,Z,M).
|
||||
current_op(X,Y,M:Z) :- !,
|
||||
'$current_opm'(X,Y,Z,M).
|
||||
current_op(X,Y,Z) :-
|
||||
'$current_module'(M),
|
||||
'$do_current_op'(X,Y,Z,M).
|
||||
|
||||
|
||||
'$current_opm'(X,Y,Z,M) :-
|
||||
var(Z), !,
|
||||
'$do_current_op'(X,Y,Z,M).
|
||||
'$current_opm'(X,Y,M:Z,_) :- !,
|
||||
'$current_opm'(X,Y,Z,M).
|
||||
'$current_opm'(X,Y,Z,M) :-
|
||||
'$do_current_op'(X,Y,Z,M).
|
||||
|
||||
'$do_current_op'(X,Y,Z,M) :-
|
||||
'$current_op'(X,Y,Z,M1),
|
||||
( M1 = prolog -> true ; M1 = M ).
|
||||
|
||||
%%% Operating System utilities
|
||||
|
||||
|
||||
Reference in New Issue
Block a user