diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix operator error checking (Ulrich #192)

Browse Source
This commit is contained in:
Vitor Santos Costa 2010-10-08 10:44:51 +01:00
parent ff6bd1dda0
commit da0aee0f57
1 changed files with 69 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
pl/utils.yap
View File

@ -19,34 +19,37 @@
'$check_op'(P,T,V,op(P,T,V)), '$check_op'(P,T,V,op(P,T,V)),
'$op'(P, T, V). '$op'(P, T, V).
'$check_op'(P,T,V,G) :- % just check the operator declarations for correctness.
( '$check_op'(P,T,Op,G) :-
var(P) -> ( var(P) ; var(T); var(Op)), !,
'$do_error'(instantiation_error,G) '$do_error'(instantiation_error,G).
; '$check_op'(P,_,_,G) :-
var(T) -> \+ integer(P), !,
'$do_error'(instantiation_error,G) '$do_error'(type_error(integer,P),G).
; '$check_op'(P,_,_,G) :-
var(V) -> P < 0, !,
'$do_error'(instantiation_error,G) '$do_error'(domain_error(operator_priority,P),G).
; '$check_op'(P,_,_,G) :-
\+ integer(P) -> P > 1200, !,
'$do_error'(type_error(integer,P),G) '$do_error'(domain_error(operator_priority,P),G).
; '$check_op'(_,T,_,G) :-
\+ atom(T) -> \+ atom(T), !,
'$do_error'(type_error(atom,T),G) '$do_error'(type_error(atom,P),G).
; '$check_op'(_,T,_,G) :-
P < 0 -> \+ '$associativity'(T), !,
'$do_error'(domain_error(operator_priority,P),G) '$do_error'(domain_error(operator_specifier,T),G).
; '$check_op'(P,T,V,G) :-
P > 1200 -> '$check_module_for_op'(V, G, NV),
'$do_error'(domain_error(operator_priority,P),G) '$check_top_op'(P, T, NV, G).
;
\+ '$associativity'(T) -> '$check_top_op'(_, _, [], _).
'$do_error'(domain_error(operator_specifier,T),G) '$check_top_op'(P, T, Op.NV, G) :- !,
; '$check_ops'(P, T, Op.NV, G).
'$check_op_name'(V,G) '$check_top_op'(P, T, V, G) :-
). atom(V), !,
'$check_op_name'(P, T, V, G).
'$check_top_op'(P, T, V, G) :-
'$do_error'(type_error(atom,V),G).
'$associativity'(xfx). '$associativity'(xfx).
'$associativity'(xfy). '$associativity'(xfy).
@ -57,17 +60,43 @@
'$associativity'(fx). '$associativity'(fx).
'$associativity'(fy). '$associativity'(fy).
'$check_op_name'(V,G) :- '$check_module_for_op'(MOp, G, _) :-
var(MOp), !,
'$do_error'(instantiation_error,G).
'$check_module_for_op'(M:V, G, _) :-
var(M), !,
'$do_error'(instantiation_error,G).
'$check_module_for_op'(M:V, G, NV) :-
atom(M), !,
'$check_module_for_op'(V, G, NV).
'$check_module_for_op'(M:V, G, _) :- !,
'$do_error'(type_error(atom,P),G).
'$check_module_for_op'(V, G, V).
'$check_ops'(P, T, [], G) :- !.
'$check_ops'(P, T, Op.NV, G) :- !,
(
var(NV)
->
'$do_error'(instantiation_error,G)
;
'$check_module_for_op'(Op, G, NOp),
'$check_op_name'(P, T, NOp, G),
'$check_ops'(P, T, NV, G)
).
'$check_ops'(P, T, Ops, G) :-
'$do_error'(type_error(list,Ops),G).
'$check_op_name'(_,_,V,G) :-
var(V), !, var(V), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_op_name'(',',G) :- !, '$check_op_name'(_,_,',',G) :- !,
'$do_error'(permission_error(modify,operator,','),G). '$do_error'(permission_error(modify,operator,','),G).
'$check_op_name'('[]',G) :- !, '$check_op_name'(_,_,'[]',G) :- !,
'$do_error'(permission_error(create,operator,'[]'),G). '$do_error'(permispsion_error(create,operator,'[]'),G).
'$check_op_name'('{}',G) :- !, '$check_op_name'(_,_,'{}',G) :- !,
'$do_error'(permission_error(create,operator,'{}'),G). '$do_error'(permission_error(create,operator,'{}'),G).
'$check_op_name'('|',G) :- !, '$check_op_name'(P,T,'|',G) :- !,
G = op(P, T, _),
( (
integer(P), integer(P),
P < 1001 P < 1001
@ -75,35 +104,13 @@
Fix \== xfx, Fix \== xfy, Fix \== yfx, Fix \== yfy Fix \== xfx, Fix \== xfy, Fix \== yfx, Fix \== yfy
), ),
'$do_error'(permission_error(create,operator,'|'),G). '$do_error'(permission_error(create,operator,'|'),G).
'$check_op_name'(V,_) :- '$check_op_name'(_,_,V,_) :-
atom(V), !. atom(V), !.
'$check_op_name'(M:A, G) :- '$check_op_name'(_,_,A,G) :-
( '$do_error'(type_error(atom,A),G).
var(M) ->
'$do_error'(instantiation_error,G)
;
var(A) ->
'$do_error'(instantiation_error,G)
;
atom(M) ->
'$check_op_name'(A, G)
;
'$do_error'(instantiation_error,G)
).
'$check_op_name'([A|As], G) :-
'$check_op_name'(A, G),
'$check_op_names'(As, G).
'$check_op_names'([], _). '$op'(P, T, ML) :-
'$check_op_names'([A|As], G) :- strip_module(ML, M, [A|As]), !,
'$check_op_name'(A, G),
'$check_op_names'(As, G).
'$op'(P, T, M:[A|As]) :- !,
'$current_module'(M),
'$opl'(P, T, M, [A|As]).
'$op'(P, T, [A|As]) :- !,
'$opl'(P, T, M, [A|As]). '$opl'(P, T, M, [A|As]).
'$op'(P, T, A) :- '$op'(P, T, A) :-
'$op2'(P,T,A). '$op2'(P,T,A).