Changeset 4412 for trunk/compiler

Timestamp:

07/31/08 02:54:42 (5 months ago)

Author:

pmoura

Message:

Added support for using Prolog use_module/2 directives in objects and categories. This allows module predicates to be called using implicit qualification, improving readability.

Files:

• trunk/compiler/logtalk.pl (modified) (12 diffs)

trunk/compiler/logtalk.pl

@@ -201 +201 @@
 :- dynamic('$lgt_pp_uses_'/1).                  % '$lgt_pp_uses_'(Obj)
 :- dynamic('$lgt_pp_uses_'/3).                  % '$lgt_pp_uses_'(Obj, Predicate, Alias)
+:- dynamic('$lgt_pp_use_module_'/3).            % '$lgt_pp_use_module_'(Module, Predicate, Alias)
 :- dynamic('$lgt_pp_calls_'/1).                 % '$lgt_pp_calls_'(Entity)
 :- dynamic('$lgt_pp_info_'/1).                  % '$lgt_pp_info_'(List)
@@ -1826 +1827 @@
     \+ '$lgt_current_flag_'(Flag, _).
 
-current_logtalk_flag(version, version(2, 32, 2)).
+current_logtalk_flag(version, version(2, 33, 0)).
 
 
@@ -4833 +4834 @@
     retractall('$lgt_pp_uses_'(_)),
     retractall('$lgt_pp_uses_'(_, _, _)),
+    retractall('$lgt_pp_use_module_'(_, _, _)),
     retractall('$lgt_pp_calls_'(_)),
     retractall('$lgt_pp_info_'(_)),
@@ -5445 +5447 @@
 
 
+'$lgt_tr_directive'(use_module, [Module, _], _, _) :-
+    var(Module),
+    throw(instantiation_error).
+
+'$lgt_tr_directive'(uses, [Module, _], _, _) :-
+    \+ callable(Module),
+    throw(type_error(module_identifier, Module)).
+
 '$lgt_tr_directive'(use_module, [Module, Preds], Input, Output) :-  % module directive
     (   atom(Module) ->
@@ -5450 +5460 @@
     ;   arg(1, Module, Name)
     ),
-    '$lgt_tr_directive'(uses, [Name, Preds], Input, Output).
+    (   '$lgt_pp_module_'(_) ->                                     % we're compiling a module
+        '$lgt_tr_directive'(uses, [Name, Preds], Input, Output)     % as an object
+    ;   '$lgt_tr_use_module_preds'(Preds, Name)
+    ).
 
 
@@ -5896 +5909 @@
     ;   throw(domain_error(arity_mismatch(Original, Alias)))
     ),
-    (   \+ '$lgt_pp_uses_'(_, _, TAlias) ->
+    (   \+ '$lgt_pp_uses_'(_, _, TAlias),
+        \+ '$lgt_pp_use_module_'(_, _, TAlias) ->
         TOriginal =.. [_| Args], TAlias =.. [_| Args],  % unify args of TOriginal and TAlias
         assertz('$lgt_pp_uses_'(Obj, TOriginal, TAlias))
@@ -5903 +5917 @@
     ),
     '$lgt_tr_uses_preds'(Preds, Obj).
+
+
+
+% '$lgt_tr_use_module_preds'(+list, +module_identifier)
+%
+% auxiliary predicate for translating use_module/2 directives in objects or categories
+
+'$lgt_tr_use_module_preds'([], _).
+
+'$lgt_tr_use_module_preds'([Pred| Preds], Module) :-
+    (   nonvar(Pred) ->
+        true
+    ;   throw(instantiation_error)
+    ),
+    (   Pred = (Original::Alias) ->
+        true
+    ;   (Original, Alias) = (Pred, Pred)
+    ),
+    (   (nonvar(Original), nonvar(Alias)) ->
+        true
+    ;   throw(instantiation_error)
+    ),
+    (   '$lgt_valid_pred_ind'(Original, OFunctor, OArity) ->
+        functor(TOriginal, OFunctor, OArity)
+    ;   throw(type_error(predicate_indicator, Original))
+    ),
+    (   '$lgt_valid_pred_ind'(Alias, AFunctor, AArity) ->
+        functor(TAlias, AFunctor, AArity)
+    ;   throw(type_error(predicate_indicator, Alias))
+    ),
+    (   OArity =:= AArity ->
+        true
+    ;   throw(domain_error(arity_mismatch(Original, Alias)))
+    ),
+    (   \+ '$lgt_pp_uses_'(_, _, TAlias),
+        \+ '$lgt_pp_use_module_'(_, _, TAlias) ->
+        TOriginal =.. [_| Args], TAlias =.. [_| Args],  % unify args of TOriginal and TAlias
+        assertz('$lgt_pp_use_module_'(Module, TOriginal, TAlias))
+    ;   functor(TAlias, Functor, Arity),
+        throw(permission_error(modify, uses_module_predicate, Functor/Arity))
+    ),
+    '$lgt_tr_use_module_preds'(Preds, Module).
 
 
@@ -6423 +6479 @@
     functor(Alias, Functor, Arity),
     throw(permission_error(modify, uses_object_predicate, Functor/Arity)).
+
+
+% conflict with a predicate specified in a use_module/2 directive
+
+'$lgt_tr_head'(Alias, _, _, _) :-
+    '$lgt_pp_use_module_'(_, _, Alias),
+    functor(Alias, Functor, Arity),
+    throw(permission_error(modify, uses_module_predicate, Functor/Arity)).
 
 
@@ -7313 +7377 @@
     !,
     '$lgt_tr_body'(Obj::Pred, TPred, DPred, Ctx).
+
+
+% predicates specified in use_module/2 directives
+
+'$lgt_tr_body'(Alias, ':'(Module, Pred), ':'(Module, Pred), _) :-
+    '$lgt_pp_use_module_'(Module, Pred, Alias),
+    !.
 
 
@@ -7346 +7417 @@
 
 
-% Logtalk and Prolog built-in (meta-)predicates
+% remember non-portable predicate calls
 
 '$lgt_tr_body'(Pred, _, _, _) :-
@@ -7358 +7429 @@
     assertz('$lgt_non_portable_call_'(Functor, Arity)),
     fail.
+
+
+% Logtalk and Prolog built-in (meta-)predicates
 
 '$lgt_tr_body'(Pred, TPred, DPred, Ctx) :-
@@ -10396 +10470 @@
     functor(Pred, Functor, Arity),
     \+ '$lgt_pp_redefined_built_in_'(Pred, _, _, _, _).
+
+'$lgt_non_portable_call'(':'(Module, Functor/Arity)) :-
+    '$lgt_pp_use_module_'(Module, Pred, _),
+    functor(Pred, Functor, Arity).