Changeset 4500 for trunk/compiler

Timestamp:

10/12/08 08:36:44 (3 months ago)

Author:

pmoura

Message:

Modified the database built-in methods to allow initialization of static predicates for dynamic objects when the predicates are declared in "this". These changes simplify the initialization of dynamic objects when writing constructors. The dynamic objects must be descendants of "this".

Files:

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

trunk/compiler/logtalk.pl

@@ -2217 +2217 @@
 
 '$lgt_asserta_rule_chk'(Obj, (Head:-Body), Sender, TestScope, DclScope) :-
-    '$lgt_current_object_'(Obj, Prefix, Dcl, Def, _, _, _, DDcl, DDef, _, _, _, _),
-    !,
-    '$lgt_assert_pred_dcl'(Dcl, DDcl, Head, Scope, Type, Meta, SCtn, DclScope),
-    (   Type == (dynamic) ->
+    '$lgt_current_object_'(Obj, Prefix, Dcl, Def, _, _, _, DDcl, DDef, _, ObjType, _, _),
+    !,
+    '$lgt_assert_pred_dcl'(Dcl, DDcl, Head, Scope, PredType, Meta, SCtn, DclScope),
+    (   (PredType == (dynamic); ObjType == (dynamic), Sender = SCtn) ->
         (   (\+ \+ Scope = TestScope; Sender = SCtn) ->
             '$lgt_assert_pred_def'(Obj, Def, DDef, Prefix, Head, GSender, GThis, GSelf, THead, _),
@@ -2251 +2251 @@
 
 '$lgt_asserta_fact_chk'(Obj, Head, Sender, TestScope, DclScope) :-
-    '$lgt_current_object_'(Obj, Prefix, Dcl, Def, _, _, _, DDcl, DDef, _, _, _, _),
-    !,
-    '$lgt_assert_pred_dcl'(Dcl, DDcl, Head, Scope, Type, _, SCtn, DclScope),
-    (   Type == (dynamic) ->
+    '$lgt_current_object_'(Obj, Prefix, Dcl, Def, _, _, _, DDcl, DDef, _, ObjType, _, _),
+    !,
+    '$lgt_assert_pred_dcl'(Dcl, DDcl, Head, Scope, PredType, _, SCtn, DclScope),
+    (   (PredType == (dynamic); ObjType == (dynamic), Sender = SCtn) ->
         (   (\+ \+ Scope = TestScope; Sender = SCtn)  ->
             '$lgt_assert_pred_def'(Obj, Def, DDef, Prefix, Head, GSender, GThis, GSelf, THead, Update),
@@ -2261 +2261 @@
                 '$lgt_ctx_dbg_ctx'(Ctx, DbgCtx),
                 asserta((THead :- '$lgt_dbg_fact'(Head, 0, DbgCtx)))
-            ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, SCtn, DclScope, Sender, THead, DDef, Update),
+            ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, SCtn, DclScope, PredType, Sender, THead, DDef, Update),
                 asserta(THead)
             )
@@ -2319 +2319 @@
 
 '$lgt_assertz_rule_chk'(Obj, (Head:-Body), Sender, TestScope, DclScope) :-
-    '$lgt_current_object_'(Obj, Prefix, Dcl, Def, _, _, _, DDcl, DDef, _, _, _, _),
-    !,
-    '$lgt_assert_pred_dcl'(Dcl, DDcl, Head, Scope, Type, Meta, SCtn, DclScope),
-    (   Type == (dynamic) ->
+    '$lgt_current_object_'(Obj, Prefix, Dcl, Def, _, _, _, DDcl, DDef, _, ObjType, _, _),
+    !,
+    '$lgt_assert_pred_dcl'(Dcl, DDcl, Head, Scope, PredType, Meta, SCtn, DclScope),
+    (   (PredType == (dynamic); ObjType == (dynamic), Sender = SCtn) ->
         (   (\+ \+ Scope = TestScope; Sender = SCtn)  ->
             '$lgt_assert_pred_def'(Obj, Def, DDef, Prefix, Head, GSender, GThis, GSelf, THead, _),
@@ -2353 +2353 @@
 
 '$lgt_assertz_fact_chk'(Obj, Head, Sender, TestScope, DclScope) :-
-    '$lgt_current_object_'(Obj, Prefix, Dcl, Def, _, _, _, DDcl, DDef, _, _, _, _),
-    !,
-    '$lgt_assert_pred_dcl'(Dcl, DDcl, Head, Scope, Type, _, SCtn, DclScope),
-    (   Type == (dynamic) ->
+    '$lgt_current_object_'(Obj, Prefix, Dcl, Def, _, _, _, DDcl, DDef, _, ObjType, _, _),
+    !,
+    '$lgt_assert_pred_dcl'(Dcl, DDcl, Head, Scope, PredType, _, SCtn, DclScope),
+    (   (PredType == (dynamic); ObjType == (dynamic), Sender = SCtn) ->
         (   (\+ \+ Scope = TestScope; Sender = SCtn)  ->
             '$lgt_assert_pred_def'(Obj, Def, DDef, Prefix, Head, GSender, GThis, GSelf, THead, Update),
@@ -2363 +2363 @@
                 '$lgt_ctx_dbg_ctx'(Ctx, DbgCtx),
                 assertz((THead :- '$lgt_dbg_fact'(Head, 0, DbgCtx)))
-            ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, SCtn, DclScope, Sender, THead, DDef, Update),
+            ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, SCtn, DclScope, PredType, Sender, THead, DDef, Update),
                 assertz(THead)
             )
@@ -2451 +2451 @@
 
 '$lgt_clause_chk'(Obj, Head, Body, Sender, Scope) :-
-    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, _, _, _),
-    !,
-    (   call_with_args(Dcl, Head, PScope, Type, _, _, _, SCtn, _) ->
-        (   Type == (dynamic) ->
+    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, ObjType, _, _),
+    !,
+    (   call_with_args(Dcl, Head, PScope, PredType, _, _, _, SCtn, _) ->
+        (   (PredType == (dynamic); ObjType == (dynamic), Sender = SCtn) ->
             (   (\+ \+ PScope = Scope; Sender = SCtn) ->
                 (   (call_with_args(DDef, Head, _, _, _, Call); call_with_args(Def, Head, _, _, _, Call)) ->
@@ -2524 +2524 @@
 
 '$lgt_retract_var_body_chk'(Obj, (Head:-Body), Sender, Scope) :-
-    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, _, _, _),
-    !,
-    (   call_with_args(Dcl, Head, PScope, Type, _, _, _, SCtn, _) ->
-        (   Type == (dynamic) ->
+    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, ObjType, _, _),
+    !,
+    (   call_with_args(Dcl, Head, PScope, PredType, _, _, _, SCtn, _) ->
+        (   (PredType == (dynamic); ObjType == (dynamic), Sender = SCtn) ->
             (   (\+ \+ PScope = Scope; Sender = SCtn) ->
                 (   call_with_args(DDef, Head, _, _, _, Call) ->
@@ -2575 +2575 @@
 
 '$lgt_retract_rule_chk'(Obj, (Head:-Body), Sender, Scope) :-
-    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, _, _, _),
-    !,
-    (   call_with_args(Dcl, Head, PScope, Type, _, _, _, SCtn, _) ->
-        (   Type == (dynamic) ->
+    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, ObjType, _, _),
+    !,
+    (   call_with_args(Dcl, Head, PScope, PredType, _, _, _, SCtn, _) ->
+        (   (PredType == (dynamic); ObjType == (dynamic), Sender = SCtn) ->
             (   (\+ \+ PScope = Scope; Sender = SCtn) ->
                 (   call_with_args(DDef, Head, _, _, _, Call) ->
@@ -2614 +2614 @@
 
 '$lgt_retract_fact_chk'(Obj, Head, Sender, Scope) :-
-    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, _, _, _),
-    !,
-    (   call_with_args(Dcl, Head, PScope, Type, _, _, _, SCtn, _) ->
-        (   Type == (dynamic) ->
+    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, ObjType, _, _),
+    !,
+    (   call_with_args(Dcl, Head, PScope, PredType, _, _, _, SCtn, _) ->
+        (   (PredType == (dynamic); ObjType == (dynamic), Sender = SCtn) ->
             (   (\+ \+ PScope = Scope; Sender = SCtn) ->
                 (   call_with_args(DDef, Head, _, _, _, Call) ->
                     (   '$lgt_debugging_'(Obj) ->
                         retract((Call :- '$lgt_dbg_fact'(_, _, _)))
-                    ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, SCtn, PScope, Sender, Call, DDef, true),
+                    ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, SCtn, PScope, PredType, Sender, Call, DDef, true),
                         retract(Call)
                     ),
@@ -2629 +2629 @@
                     (   '$lgt_debugging_'(Obj) ->
                         retract((Call :- '$lgt_dbg_fact'(_, _, _)))
-                    ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, PScope, Sender, Call),
+                    ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, PScope, PredType, Sender, Call),
                         retract(Call)
                     )
@@ -2646 +2646 @@
             (   '$lgt_debugging_'(Obj) ->
                 retract((Call :- '$lgt_dbg_fact'(_, _, _)))
-            ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, p, Sender, Call),
+            ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, p, PredType, Sender, Call),
                 retract(Call)
             )
@@ -2679 +2679 @@
 
 '$lgt_retractall_chk'(Obj, Head, Sender, Scope) :-
-    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, _, _, _),
-    !,
-    (   call_with_args(Dcl, Head, PScope, Type, _, _, _, SCtn, _) ->
-        (   Type == (dynamic) ->
+    '$lgt_current_object_'(Obj, _, Dcl, Def, _, _, _, _, DDef, _, ObjType, _, _),
+    !,
+    (   call_with_args(Dcl, Head, PScope, PredType, _, _, _, SCtn, _) ->
+        (   (PredType == (dynamic); ObjType == (dynamic), Sender = SCtn) ->
             (   (\+ \+ PScope = Scope; Sender = SCtn) ->
                 (   call_with_args(DDef, Head, _, _, _, Call) ->
@@ -2690 +2690 @@
                     (   '$lgt_debugging_'(Obj) ->
                         true
-                    ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, PScope, Sender, Call)
+                    ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, PScope, PredType, Sender, Call)
                     ),
                     retractall(Call)
@@ -2709 +2709 @@
             (   '$lgt_debugging_'(Obj) ->
                 true
-            ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, p, Sender, Call)
+            ;   '$lgt_add_db_lookup_cache_entry'(Obj, Head, p, PredType, Sender, Call)
             ),
             retractall(Call)
@@ -2730 +2730 @@
 
 
-% '$lgt_add_db_lookup_cache_entry'(@object_identifier, @callable, @callable, @object_identifier, @callable)
+% '$lgt_add_db_lookup_cache_entry'(@object_identifier, @callable, @callable, +atom, @object_identifier, @callable)
 %
 % adds a new database lookup cache entry (when an update goal is not needed)
 
-'$lgt_add_db_lookup_cache_entry'(Obj, Head, Scope, Sender, Call) :-
+'$lgt_add_db_lookup_cache_entry'(Obj, Head, Scope, Type, Sender, Call) :-
     functor(Obj, OFunctor, OArity),
     functor(GObj, OFunctor, OArity),
@@ -2744 +2744 @@
     GCall =.. [_| ExtArgs],
     '$lgt_unify_args'(Args, ExtArgs), 
-    (   Scope = p(p(p)) ->
+    (   (Scope = p(p(p)), Type == (dynamic)) ->
         asserta('$lgt_db_lookup_cache_'(GObj, GHead, _, GCall, true))
     ;   functor(Sender, SFunctor, SArity),
@@ -2752 +2752 @@
 
 
-% '$lgt_add_db_lookup_cache_entry'(@object_identifier, @callable, @callable, @callable, @object_identifier, @callable, +atom, +atom)
+% '$lgt_add_db_lookup_cache_entry'(@object_identifier, @callable, @callable, @callable, +atom, @object_identifier, @callable, +atom, +atom)
 %
 % adds a new database lookup cache entry
 
-'$lgt_add_db_lookup_cache_entry'(Obj, Head, SCtn, Scope, Sender, Call, DDef, NeedsUpdate) :-
+'$lgt_add_db_lookup_cache_entry'(Obj, Head, SCtn, Scope, Type, Sender, Call, DDef, NeedsUpdate) :-
     functor(Obj, OFunctor, OArity),
     functor(GObj, OFunctor, OArity),
@@ -2770 +2770 @@
         functor(UCall, CFunctor, CArity),
         UClause =.. [DDef, UHead, _, _, _, _],
-        (   Scope = p(p(p)) ->
+        (   (Scope = p(p(p)), Type == (dynamic)) ->
             asserta('$lgt_db_lookup_cache_'(GObj, GHead, _, GCall, '$lgt_update_ddef_table_opt'(UHead, UCall, UClause)))
         ;   functor(Sender, SFunctor, SArity),
@@ -2776 +2776 @@
             asserta('$lgt_db_lookup_cache_'(GObj, GHead, GSender, GCall, '$lgt_update_ddef_table_opt'(UHead, UCall, UClause)))
         )
-    ;   (   Scope = p(p(p)) ->
+    ;   (   (Scope = p(p(p)), Type == (dynamic)) ->
             asserta('$lgt_db_lookup_cache_'(GObj, GHead, _, GCall, true))
         ;   functor(Sender, SFunctor, SArity),