This commit is contained in:
Vitor Santos Costa 2010-09-27 22:31:06 +01:00
parent c50ed643f9
commit bf40154ff1
2 changed files with 75 additions and 60 deletions

View File

@ -222,8 +222,8 @@ system_message(error(permission_error(modify,dynamic_procedure,_), Where)) -->
[ 'PERMISSION ERROR- ~w: modifying a dynamic procedure' - [Where] ].
system_message(error(permission_error(modify,flag,W), _)) -->
[ 'PERMISSION ERROR- cannot modify flag ~w' - [W] ].
system_message(error(permission_error(modify,operator,W), _)) -->
[ 'PERMISSION ERROR- T cannot declare ~w an operator' - [W] ].
system_message(error(permission_error(modify,operator,W), Q)) -->
[ 'PERMISSION ERROR- ~w: cannot modify operator ~q' - [Q,W] ].
system_message(error(permission_error(modify,dynamic_procedure,F), Where)) -->
[ 'PERMISSION ERROR- ~w: modifying dynamic procedure ~w' - [Where,F] ].
system_message(error(permission_error(modify,static_procedure,F), Where)) -->

View File

@ -1,65 +1,80 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: utils.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: Some utility predicates available in yap *
* *
*************************************************************************/
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: utils.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: Some utility predicates available in yap *
* *
*************************************************************************/
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,op(P,T,V)),
'$op'(P, T, V).
'$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(operator_priority,P),G)
;
P > 1200 ->
'$do_error'(domain_error(operator_priority,P),G)
;
\+ '$associativity'(T) ->
'$do_error'(domain_error(operator_specifier,T),G)
;
'$check_op_name'(V,G)
).
'$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(operator_priority,P),G)
;
P > 1200 ->
'$do_error'(domain_error(operator_priority,P),G)
;
\+ '$associativity'(T) ->
'$do_error'(domain_error(operator_specifier,T),G)
;
'$check_op_name'(V,G)
).
'$associativity'(xfx).
'$associativity'(xfy).
'$associativity'(yfx).
'$associativity'(yfy).
'$associativity'(xf).
'$associativity'(yf).
'$associativity'(fx).
'$associativity'(fy).
'$associativity'(xfx).
'$associativity'(xfy).
'$associativity'(yfx).
'$associativity'(yfy).
'$associativity'(xf).
'$associativity'(yf).
'$associativity'(fx).
'$associativity'(fy).
'$check_op_name'(V,G) :-
var(V), !,
'$do_error'(instantiation_error,G).
'$check_op_name'(V,G) :-
var(V), !,
'$do_error'(instantiation_error,G).
'$check_op_name'(',',G) :- !,
'$do_error'(permission_error(modify,operator,','),G).
'$check_op_name'('[]',G) :- !,
'$do_error'(permission_error(create,operator,'[]'),G).
'$check_op_name'('{}',G) :- !,
'$do_error'(permission_error(create,operator,'{}'),G).
'$check_op_name'('|',G) :- !,
G = op(P, T, _),
(
integer(P),
P < 1001
;
Fix \== xfx, Fix \== xfy, Fix \== yfx, Fix \== yfy
),
'$do_error'(permission_error(create,operator,'|'),G).
'$check_op_name'(V,_) :-
atom(V), !.
'$check_op_name'(M:A, G) :-