Changeset 5270

Timestamp:

01/30/10 10:11:21 (6 weeks ago)

Author:

pmoura

Message:

Added a '$lgt_tr_predicate_heads'/3 hook predicate to the Logtalk compiler in order to simplify handling of proprietary directives in config files.

Location:

trunk

Files:

• compiler/logtalk.pl (modified) (3 diffs)
• configs/b.pl (modified) (1 diff)
• configs/swi.pl (modified) (1 diff)
• RELEASE_NOTES.txt (modified) (1 diff)

trunk/compiler/logtalk.pl

@@ -13368 +13368 @@
 
 
-% '$lgt_tr_predicate_heads'(@callable, -callable)
-%
-% translates a single predicate head, a conjunction of predicate heads, or a
-% list of predicate heads; used as a hook predicate in the config files
-    
-'$lgt_tr_predicate_heads'(Head, _) :-
+% '$lgt_tr_predicate_heads'(@callable, -callable, @term)
+%
+% translates a single predicate head, a conjunction of predicate heads, or
+% a list of predicate heads; used mainly as a hook predicate in the config
+% files for processing proprietary directives
+
+'$lgt_tr_predicate_heads'(Head, _, _) :-
     var(Head),
     throw(instantiation_error).
-'$lgt_tr_predicate_heads'([], []) :-
+'$lgt_tr_predicate_heads'([], [], _) :-
     !.
-'$lgt_tr_predicate_heads'([Head| Heads], [THead| THeads]) :-
-    !,
-    '$lgt_tr_predicate_heads'(Head, THead),
-    '$lgt_tr_predicate_heads'(Heads, THeads).
-'$lgt_tr_predicate_heads'((Head, Heads), (THead, THeads)) :-
-    !,
-    '$lgt_tr_predicate_heads'(Head, THead),
-    '$lgt_tr_predicate_heads'(Heads, THeads).
-'$lgt_tr_predicate_heads'(Head, THead) :-
+'$lgt_tr_predicate_heads'([Head| Heads], [THead| THeads], Context) :-
+    !,
+    '$lgt_tr_predicate_heads'(Head, THead, Context),
+    '$lgt_tr_predicate_heads'(Heads, THeads, Context).
+'$lgt_tr_predicate_heads'((Head, Heads), (THead, THeads), Context) :-
+    !,
+    '$lgt_tr_predicate_heads'(Head, THead, Context),
+    '$lgt_tr_predicate_heads'(Heads, THeads, Context).
+'$lgt_tr_predicate_heads'(Head, THead, Context) :-
     functor(Head, Functor, Arity),
     '$lgt_pp_entity'(_, _, Prefix, _, _),
@@ -13393 +13394 @@
     Head =.. [Functor| Args],
     THead =.. [TFunctor| Targs],
-    '$lgt_append'(Args, [_], Targs).
+    '$lgt_append'(Args, [Context], Targs).
+
+
+'$lgt_tr_predicate_heads'(Heads, THeads) :-
+    '$lgt_tr_predicate_heads'(Heads, THeads, _).
 
 
@@ -13400 +13405 @@
 % '$lgt_tr_predicate_indicators'(+predicate_indicator, -predicate_indicator)
 %
-% translates a single predicate indicator, a conjunction of predicate indicators, or a
-% list of predicate indicators; used as a hook predicate in the config files
+% translates a single predicate indicator, a conjunction of predicate indicators, or
+% a list of predicate indicators; used mainly as a hook predicate in the config files
+% for processing proprietary directives
 
 '$lgt_tr_predicate_indicators'(PI, _) :-

trunk/configs/b.pl

@@ -533 +533 @@
     '$lgt_tr_predicate_indicators'(PIs, CPIs).
 '$lgt_rewrite_and_copy_pl_directive'(table(':'(Head, N)), table(':'(THead, N))) :-
-    '$lgt_rewrite_and_copy_pl_directive_head'(Head, THead).
+    !,
+    '$lgt_tr_predicate_heads'(Head, THead, '-').
 '$lgt_rewrite_and_copy_pl_directive'(table(PIs), table(CPIs)) :-
     '$lgt_tr_predicate_indicators'(PIs, CPIs).
-'$lgt_rewrite_and_copy_pl_directive'(mode(Pred), mode(TPred)) :-
-    functor(Pred, Functor, Arity),
-    '$lgt_tr_predicate_indicators'(Functor/Arity, TFunctor/TArity),
-    functor(TPred, TFunctor, TArity),
-    Pred =.. [Functor| Args],
-    TPred =.. [TFunctor| TArgs],
-    append(Args, ['?'], TArgs).
-
-
-'$lgt_rewrite_and_copy_pl_directive_head'(Head, _) :-
-    var(Head),
-    throw(instantiation_error).
-'$lgt_rewrite_and_copy_pl_directive_head'(Head, THead) :-
-    functor(Head, Functor, Arity),
-    \+ (Functor == '/', Arity =:= 2),   % not a predicate indicator
-    '$lgt_tr_predicate_indicators'(Functor/Arity, TFunctor/TArity),
-    functor(THead, TFunctor, TArity),
-    Head =.. [_| Args],
-    THead =.. [_| TArgs],
-    append(Args, ['-'], TArgs).
+'$lgt_rewrite_and_copy_pl_directive'(mode(Head), mode(THead)) :-
+    '$lgt_tr_predicate_heads'(Head, THead, '?').
 
 

trunk/configs/swi.pl

@@ -583 +583 @@
     '$lgt_tr_predicate_indicators'(PIs, CPIs).
 '$lgt_rewrite_and_copy_pl_directive'(index(Head), index(THead)) :-
-    '$lgt_tr_predicate_heads'(Head, THead),
-    Head =..  [_|  Args],
-    THead =.. [_| TArgs],
-    '$lgt_append'(Args, [0], TArgs).
+    '$lgt_tr_predicate_heads'(Head, THead, 0).
 '$lgt_rewrite_and_copy_pl_directive'(hash(Head), hash(THead)) :-
     '$lgt_tr_predicate_heads'(Head, THead).

trunk/RELEASE_NOTES.txt

@@ -29 +29 @@
     all config files.
 
-    Added '$lgt_tr_predicate_heads'/2 and '$lgt_tr_predicate_indicators'/2
-    hook predicates to the Logtalk compiler in order to simplify handling
-    of proprietary directives in config files.
+    Added '$lgt_tr_predicate_indicators'/2, '$lgt_tr_predicate_heads'/2, and
+    '$lgt_tr_predicate_heads'/3 hook predicates to the Logtalk compiler in
+    order to simplify handling of proprietary directives in config files.
 
     Added support for the proprietary directive eager_consume/0 to the config