Changeset 4517 for trunk/compiler

Timestamp:

10/18/08 17:56:42 (3 months ago)

Author:

pmoura

Message:

Improved reporting of line numbers for syntax errors when using YAP or SWI-Prolog as the back-end compilers.

Added entity property lines(Start, End) for entities compiled and loaded from source files. This property is only available when using SWI-Prolog or YAP as the back-end compilers.

Added a customized version of the read_term/2 predicate to all config files that returns the line where a term starts for back-end Prolog compilers whose implementation of the read_term/2 predicate supports this information.

Files:

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

trunk/compiler/logtalk.pl

@@ -4568 +4568 @@
         '$lgt_compiler_error_handler'(OpenError)),
     catch(
-        read_term(Input, Term, [singletons(Singletons)]),
+        '$lgt_read_term'(Input, Term, [singletons(Singletons)], Line),
         InputError,
         '$lgt_compiler_error_handler'(Input, InputError)),
@@ -4578 +4578 @@
         '$lgt_compiler_error_handler'(NewInput, Output, OpenError)),
     catch(
-        '$lgt_tr_file'(Term, Singletons, NewInput, Output),
+        '$lgt_tr_file'(Term, Singletons, Line, NewInput, Output),
         Error,
         '$lgt_compiler_error_handler'(NewInput, Output, Error)),
@@ -4625 +4625 @@
 
 
-% '$lgt_tr_file'(+term, +list, @stream, @stream)
-
-'$lgt_tr_file'(end_of_file, _, _, Output) :-                    % module definitions start with an opening
+% '$lgt_tr_file'(+term, +list, +integer, @stream, @stream)
+
+'$lgt_tr_file'(end_of_file, _, _, _, Output) :-                 % module definitions start with an opening
     '$lgt_pp_module_'(Module),                                  % module/1-2 directive and are assumed to
     '$lgt_pp_object_'(Module, _, _, _, _, _, _, _, _, _, _),    % end at the end of a source file; there is
@@ -4634 +4634 @@
     !.
 
-'$lgt_tr_file'(end_of_file, _, _, _) :-
+'$lgt_tr_file'(end_of_file, _, _, _, _) :-
     '$lgt_pp_object_'(Obj, _, _, _, _, _, _, _, _, _, _),
     throw(entity_ending_directive_missing(object, Obj)).
 
-'$lgt_tr_file'(end_of_file, _, _, _) :-
+'$lgt_tr_file'(end_of_file, _, _, _, _) :-
     '$lgt_pp_protocol_'(Ptc, _, _, _, _),
     throw(entity_ending_directive_missing(protocol, Ptc)).
 
-'$lgt_tr_file'(end_of_file, _, _, _) :-
+'$lgt_tr_file'(end_of_file, _, _, _, _) :-
     '$lgt_pp_category_'(Ctg, _, _, _, _, _),
     throw(entity_ending_directive_missing(category, Ctg)).
 
-'$lgt_tr_file'(end_of_file, _, _, _) :-
+'$lgt_tr_file'(end_of_file, _, _, _, _) :-
     !.
 
-'$lgt_tr_file'(Term, Singletons, Input, Output) :-
-    '$lgt_report_singletons'(Singletons, Term, Input),
-    '$lgt_tr_term'(Term, Input, Output),
-    read_term(Input, Next, [singletons(NextSingletons)]),
-    '$lgt_tr_file'(Next, NextSingletons, Input, Output).
-
-
-
-% '$lgt_add_entity_file_properties'(@entity_identifier, @stream)
+'$lgt_tr_file'(Term, Singletons, Line, Input, Output) :-
+    '$lgt_report_singletons'(Singletons, Term, Line, Input),
+    '$lgt_tr_term'(Term, Line, Input, Output),
+    '$lgt_read_term'(Input, Next, [singletons(NextSingletons)], NextLine),
+    '$lgt_tr_file'(Next, NextSingletons, NextLine, Input, Output).
+
+
+
+% '$lgt_add_entity_file_properties'(@nonvar, @entity_identifier)
 %
 % adds entity properties related to the entity source file
 
-'$lgt_add_entity_file_properties'(Entity, _Input) :-
-%   (   catch('$lgt_stream_current_line_number'(Input, Line), _, fail) ->
-%       assertz('$lgt_pp_file_rclause_'('$lgt_entity_property_'(Entity, line_count(Line))))
-%   ;   true
-%   ),
-    '$lgt_pp_file_path_'(File, Path) ->
-    assertz('$lgt_pp_rclause_'('$lgt_entity_property_'(Entity, file(File, Path)))).
-
-
-
-% '$lgt_report_singletons'(+list, +term, @stream)
+'$lgt_add_entity_file_properties'(start(Start), Entity) :-
+    (   Start =:= -1 ->
+        true
+    ;   assertz('$lgt_pp_file_rclause_'('$lgt_entity_property_'(Entity, lines(Start, _))))
+    ),
+    (   '$lgt_pp_file_path_'(File, Path) ->
+        assertz('$lgt_pp_rclause_'('$lgt_entity_property_'(Entity, file(File, Path))))
+    ;   true
+    ).
+
+'$lgt_add_entity_file_properties'(end(End), Entity) :-
+    (   End =:= -1 ->
+        true
+    ;   retract('$lgt_pp_file_rclause_'('$lgt_entity_property_'(Entity, lines(Start, _)))) ->
+        assertz('$lgt_pp_file_rclause_'('$lgt_entity_property_'(Entity, lines(Start, End))))
+    ).
+
+
+
+% '$lgt_report_singletons'(+list, +term, +integer, @stream)
 %
 % reports the singleton variables found while compiling an entity term
 
-'$lgt_report_singletons'(Singletons, Term, Input) :-
+'$lgt_report_singletons'(Singletons, Term, Line, Input) :-
     (   '$lgt_compiler_flag'(singletons, warning),
         '$lgt_compiler_flag'(report, on) ->
         '$lgt_filter_singletons'(Singletons, Names),
-        '$lgt_report_singleton_names'(Names, Term, Input)
+        '$lgt_report_singleton_names'(Names, Term, Line, Input)
     ;   true
     ).
 
 
-'$lgt_report_singleton_names'([], _, _) :-
+'$lgt_report_singleton_names'([], _, _, _) :-
     !.  % cut needed to prevent problems with compilers with broken read_term/3 implementations
 
-'$lgt_report_singleton_names'([Name| Names], Term, Stream) :-
+'$lgt_report_singleton_names'([Name| Names], Term, Line, Input) :-
     '$lgt_inc_compile_warnings_counter',
     (   '$lgt_pp_entity'(_, _, _, _, _) ->
@@ -4699 +4708 @@
     'lgt_report_singletons_term'(Term),
     '$lgt_write_list'([Name| Names]),
-    nl, '$lgt_report_compiler_error_line_number'(Stream),
+    nl, '$lgt_report_compiler_error_line_number'(Line, Input),
     (   '$lgt_pp_entity'(_, _, _, _, _) ->
         true
@@ -4822 +4831 @@
 '$lgt_report_compiler_error'(Stream, Error) :-
     '$lgt_report_compiler_error_message'(Error),
-    '$lgt_report_compiler_error_line_number'(Stream),
+    (   catch('$lgt_stream_current_line_number'(Stream, Line), _, fail) ->
+        write('                  above line: '), write(Line)
+    ;   true
+    ),
     nl.
 
@@ -4861 +4873 @@
 
 
-'$lgt_report_compiler_error_line_number'(Stream) :-
-    (   catch('$lgt_stream_current_line_number'(Stream, Line), _, fail) ->
-        write('                  above line: '), write(Line)
-    ;   true
+'$lgt_report_compiler_error_line_number'(Line, Stream) :-
+    (   Line =:= -1 ->
+        (   catch('$lgt_stream_current_line_number'(Stream, Next), _, fail) ->
+            write('                  above line: '), write(Next)
+        ;   true
+        )
+    ;   write('                  in line: '), write(Line)
     ).
 
@@ -5128 +5143 @@
 
 
-% '$lgt_tr_term'(+term, @stream, @stream)
+% '$lgt_tr_term'(+term, +integer, @stream, @stream)
 %
 % translates a source file term (clauses, directives, and grammar rules)
 
-'$lgt_tr_term'(Term, Input, Output) :-
+'$lgt_tr_term'(Term, Line, Input, Output) :-
     (   % source-file specific compiler hook:
         '$lgt_pp_hook_term_expansion_'(Term, Terms) ->
-        '$lgt_tr_expanded_terms'(Terms, Input, Output)
+        '$lgt_tr_expanded_terms'(Terms, Line, Input, Output)
     ;   % default compiler hook:
         '$lgt_hook_term_expansion_'(Term, Terms) ->
-        '$lgt_tr_expanded_terms'(Terms, Input, Output)
+        '$lgt_tr_expanded_terms'(Terms, Line, Input, Output)
     ;   % no compiler hook defined:
-        '$lgt_tr_expanded_term'(Term, Input, Output)
-    ).
-
-
-
-% '$lgt_tr_expanded_terms'(+list, @stream, @stream)
+        '$lgt_tr_expanded_term'(Term, Line, Input, Output)
+    ).
+
+
+
+% '$lgt_tr_expanded_terms'(+list, +integer, @stream, @stream)
 %
 % translates a list of source file terms
 
-'$lgt_tr_expanded_terms'([], _, _).
-
-'$lgt_tr_expanded_terms'([Term| Terms], Input, Output) :-
-    '$lgt_tr_expanded_term'(Term, Input, Output),
-    '$lgt_tr_expanded_terms'(Terms, Input, Output).
-
-
-
-% '$lgt_tr_expanded_term'(+list, @stream, @stream)
+'$lgt_tr_expanded_terms'([], _, _, _).
+
+'$lgt_tr_expanded_terms'([Term| Terms], Line, Input, Output) :-
+    '$lgt_tr_expanded_term'(Term, Line, Input, Output),
+    '$lgt_tr_expanded_terms'(Terms, Line, Input, Output).
+
+
+
+% '$lgt_tr_expanded_term'(+term, +integer, @stream, @stream)
 %
 % translates a source file term (clauses, directives, and grammar rules)
 
-'$lgt_tr_expanded_term'((Head :- Body), Input, _) :-
-    !,
-    '$lgt_tr_clause'((Head :- Body), Input).
-
-'$lgt_tr_expanded_term'((:- Directive), Input, Output) :-
-    !,
-    '$lgt_tr_directive'(Directive, Input, Output).
-
-'$lgt_tr_expanded_term'((Head --> Body), Input, _) :-
+'$lgt_tr_expanded_term'((Head :- Body), Line, Input, _) :-
+    !,
+    '$lgt_tr_clause'((Head :- Body), Line, Input).
+
+'$lgt_tr_expanded_term'((:- Directive), Line, Input, Output) :-
+    !,
+    '$lgt_tr_directive'(Directive, Line, Input, Output).
+
+'$lgt_tr_expanded_term'((Head --> Body), Line, Input, _) :-
     !,
     '$lgt_dcgrule_to_clause'((Head --> Body), Clause),
-    '$lgt_tr_clause'(Clause, Input).
-
-'$lgt_tr_expanded_term'(Fact, Input, _) :-
-    '$lgt_tr_clause'(Fact, Input).
+    '$lgt_tr_clause'(Clause, Line, Input).
+
+'$lgt_tr_expanded_term'(Fact, Line, Input, _) :-
+    '$lgt_tr_clause'(Fact, Line, Input).
 
 
@@ -5186 +5201 @@
 
 '$lgt_tr_directives'([Dir| Dirs], Input, Output) :-
-    '$lgt_tr_directive'(Dir, Input, Output),
+    '$lgt_tr_directive'(Dir, -1, Input, Output),
     '$lgt_tr_directives'(Dirs, Input, Output).
 
 
 
-% '$lgt_tr_directive'(+term, @stream, @stream)
+% '$lgt_tr_directive'(+term, +integer, @stream, @stream)
 %
 % translates a directive
 
-'$lgt_tr_directive'(Dir, _, _) :-
+'$lgt_tr_directive'(Dir, _, _, _) :-
     var(Dir),
     throw(error(instantiantion_error, directive(Dir))).
 
-'$lgt_tr_directive'(Dir, _, _) :-               % closing entity directive occurs before the opening
+'$lgt_tr_directive'(Dir, _, _, _) :-            % closing entity directive occurs before the opening
     \+ '$lgt_pp_entity'(_, _, _, _, _),         % entity directive; the opening directive is probably
     functor(Dir, Functor, Arity),               % missing or misspelt
@@ -5205 +5220 @@
     throw(error(unmatched_directive, directive(Dir))).
 
-'$lgt_tr_directive'(Dir, _, _) :-
+'$lgt_tr_directive'(Dir, _, _, _) :-
     \+ '$lgt_pp_entity'(_, _, _, _, _),         % directive occurs before opening entity directive
     functor(Dir, Functor, Arity),
@@ -5212 +5227 @@
     '$lgt_tr_file_directive'(Dir).              % translate it as a source file-level directive
 
-'$lgt_tr_directive'(Dir, Input, Output) :-      % entity closing directive
+'$lgt_tr_directive'(Dir, Line, Input, Output) :-    % entity closing directive
     functor(Dir, Functor, Arity),
     '$lgt_lgt_closing_directive'(Functor, Arity),
     Dir =.. [Functor| Args],
     catch(
-        '$lgt_tr_directive'(Functor, Args, Input, Output),
+        '$lgt_tr_directive'(Functor, Args, Line, Input, Output),
         Error,
         (   '$lgt_pp_entity'(Type, Entity, _, _, _) ->
@@ -5225 +5240 @@
     !.
 
-'$lgt_tr_directive'(Dir, Input, Output) :-      % entity opening directive or entity directive
+'$lgt_tr_directive'(Dir, Line, Input, Output) :-    % entity opening directive or entity directive
     functor(Dir, Functor, Arity),
     '$lgt_lgt_directive'(Functor, Arity),
     Dir =.. [Functor| Args],
     catch(
-        '$lgt_tr_directive'(Functor, Args, Input, Output),
+        '$lgt_tr_directive'(Functor, Args, Line, Input, Output),
         Error,
         throw(error(Error, directive(Dir)))),
     !.
 
-'$lgt_tr_directive'(Dir, Input, _) :-
-    '$lgt_ignore_pl_directive'(Dir),                        % defined in the Prolog config files
+'$lgt_tr_directive'(Dir, Line, Input, _) :-
+    '$lgt_ignore_pl_directive'(Dir),                    % defined in the Prolog config files
     !,
     (   '$lgt_compiler_flag'(portability, warning) ->
         nl, write('        WARNING!  Ignoring Prolog directive: '), writeq(Dir),
-        nl, '$lgt_report_compiler_error_line_number'(Input)
+        nl, '$lgt_report_compiler_error_line_number'(Line, Input)
     ;   true
     ).
 
-'$lgt_tr_directive'(Dir, Input, _) :-
-    '$lgt_rewrite_and_copy_pl_directive'(Dir, RWDir),       % defined in the Prolog config files
+'$lgt_tr_directive'(Dir, Line, Input, _) :-
+    '$lgt_rewrite_and_copy_pl_directive'(Dir, RWDir),   % defined in the Prolog config files
     assertz('$lgt_pp_directive_'(RWDir)),
     !,
@@ -5251 +5266 @@
         nl, write('        WARNING!  Rewriting Prolog directive:         '), writeq(Dir),
         nl, write('                  Copying resulting Prolog directive: '), writeq(RWDir),
-        nl, '$lgt_report_compiler_error_line_number'(Input)
+        nl, '$lgt_report_compiler_error_line_number'(Line, Input)
     ;   true
     ).
 
-'$lgt_tr_directive'(Dir, Input, Output) :-
+'$lgt_tr_directive'(Dir, Line, Input, Output) :-
     '$lgt_rewrite_and_recompile_pl_directive'(Dir, RWDir),  % defined in the Prolog config files
     !,
@@ -5261 +5276 @@
         nl, write('        WARNING!  Rewriting Prolog directive:             '), writeq(Dir),
         nl, write('                  Recompiling resulting Prolog directive: '), writeq(RWDir),
-        nl, '$lgt_report_compiler_error_line_number'(Input)
+        nl, '$lgt_report_compiler_error_line_number'(Line, Input)
     ;   true
     ),
-    '$lgt_tr_directive'(RWDir, Input, Output).  % try to translate the rewritten directive
-
-'$lgt_tr_directive'(Dir, _, _) :-
+    '$lgt_tr_directive'(RWDir, Line, Input, Output).    % try to translate the rewritten directive
+
+'$lgt_tr_directive'(Dir, _, _, _) :-
     functor(Dir, Functor, Arity),
     throw(error(domain_error(directive, Functor/Arity), directive(Dir))).
@@ -5312 +5327 @@
 
 
-% '$lgt_tr_directive'(+atom, +list, @stream, @stream)
+% '$lgt_tr_directive'(+atom, +list, @nonvar, @stream, @stream)
 %
 % translates a directive and its (possibly empty) list of arguments
 
-'$lgt_tr_directive'(object, [Obj| _], _, _) :-
+'$lgt_tr_directive'(object, [Obj| _], _, _, _) :-
     var(Obj),
     throw(instantiation_error).
 
-'$lgt_tr_directive'(object, [Obj| _], _, _) :-
+'$lgt_tr_directive'(object, [Obj| _], _, _, _) :-
     \+ callable(Obj),
     throw(type_error(object_identifier, Obj)).
 
-'$lgt_tr_directive'(object, [Obj| _], _, _) :-
+'$lgt_tr_directive'(object, [Obj| _], _, _, _) :-
     (   '$lgt_built_in_object'(Obj) ->
         throw(permission_error(modify, object, Obj))
@@ -5333 +5348 @@
     ).
 
-'$lgt_tr_directive'(object, [Obj| Rels], Input, _) :-
+'$lgt_tr_directive'(object, [Obj| Rels], Line, _, _) :-
     '$lgt_report_compiling_entity'(object, Obj),
-    '$lgt_add_entity_file_properties'(Obj, Input),
+    '$lgt_add_entity_file_properties'(start(Line), Obj),
     '$lgt_save_file_op_table',
     '$lgt_tr_object_id'(Obj, static),                           % assume static object
     '$lgt_tr_object_relations'(Rels, Obj).
 
-'$lgt_tr_directive'(end_object, [], _, Output) :-
+'$lgt_tr_directive'(end_object, [], Line, _, Output) :-
     (   '$lgt_pp_object_'(Obj, _, _, _, _, _, _, _, _, _, _) ->
         '$lgt_tr_entity'(object, Obj, Output),
         '$lgt_restore_file_op_table',
-        '$lgt_report_compiled_entity'(object, Obj)
+        '$lgt_report_compiled_entity'(object, Obj),
+        '$lgt_add_entity_file_properties'(end(Line), Obj)
     ;   throw(closing_directive_mismatch)
     ).
 
-'$lgt_tr_directive'(protocol, [Ptc| _], _, _) :-
+'$lgt_tr_directive'(protocol, [Ptc| _], _, _, _) :-
     var(Ptc),
     throw(instantiation_error).
 
-'$lgt_tr_directive'(protocol, [Ptc| _], _, _) :-
+'$lgt_tr_directive'(protocol, [Ptc| _], _, _, _) :-
     \+ atom(Ptc),
     throw(type_error(protocol_identifier, Ptc)).
 
-'$lgt_tr_directive'(protocol, [Ptc| _], _, _) :-
+'$lgt_tr_directive'(protocol, [Ptc| _], _, _, _) :-
     (   '$lgt_built_in_object'(Ptc) ->
         throw(permission_error(modify, object, Ptc))
@@ -5365 +5381 @@
     ).
 
-'$lgt_tr_directive'(protocol, [Ptc| Rels], Input, _) :-
+'$lgt_tr_directive'(protocol, [Ptc| Rels], Line, _, _) :-
     '$lgt_report_compiling_entity'(protocol, Ptc),
-    '$lgt_add_entity_file_properties'(Ptc, Input),
+    '$lgt_add_entity_file_properties'(start(Line), Ptc),
     '$lgt_save_file_op_table',
     '$lgt_tr_protocol_id'(Ptc, static),                         % assume static protocol
     '$lgt_tr_protocol_relations'(Rels, Ptc).
 
-'$lgt_tr_directive'(end_protocol, [], _, Output) :-
+'$lgt_tr_directive'(end_protocol, [], Line, _, Output) :-
     (   '$lgt_pp_protocol_'(Ptc, _, _, _, _) ->
         '$lgt_tr_entity'(protocol, Ptc, Output),
         '$lgt_restore_file_op_table',
-        '$lgt_report_compiled_entity'(protocol, Ptc)
+        '$lgt_report_compiled_entity'(protocol, Ptc),
+        '$lgt_add_entity_file_properties'(end(Line), Ptc)
     ;   throw(closing_directive_mismatch)
     ).
 
 
-'$lgt_tr_directive'(category, [Ctg| _], _, _) :-
+'$lgt_tr_directive'(category, [Ctg| _], _, _, _) :-
     var(Ctg),
     throw(instantiation_error).
 
-'$lgt_tr_directive'(category, [Ctg| _], _, _) :-
+'$lgt_tr_directive'(category, [Ctg| _], _, _, _) :-
     \+ atom(Ctg),
     throw(type_error(category_identifier, Ctg)).
 
-'$lgt_tr_directive'(category, [Ctg| _], _, _) :-
+'$lgt_tr_directive'(category, [Ctg| _], _, _, _) :-
     (   '$lgt_built_in_object'(Ctg) ->
         throw(permission_error(modify, object, Ctg))
@@ -5398 +5415 @@
     ).
 
-'$lgt_tr_directive'(category, [Ctg| Rels], Input, _) :-
+'$lgt_tr_directive'(category, [Ctg| Rels], Line, _, _) :-
     '$lgt_report_compiling_entity'(category, Ctg),
-    '$lgt_add_entity_file_properties'(Ctg, Input),
+    '$lgt_add_entity_file_properties'(start(Line), Ctg),
     '$lgt_save_file_op_table',
     '$lgt_tr_category_id'(Ctg, static),                         % assume static category
     '$lgt_tr_category_relations'(Rels, Ctg).
 
-'$lgt_tr_directive'(end_category, [], _, Output) :-
+'$lgt_tr_directive'(end_category, [], Line, _, Output) :-
     (   '$lgt_pp_category_'(Ctg, _, _, _, _, _) ->
         '$lgt_tr_entity'(category, Ctg, Output),
         '$lgt_restore_file_op_table',
-        '$lgt_report_compiled_entity'(category, Ctg)
+        '$lgt_report_compiled_entity'(category, Ctg),
+        '$lgt_add_entity_file_properties'(end(Line), Ctg)
     ;   throw(closing_directive_mismatch)
     ).
@@ -5416 +5434 @@
 % compile modules as objects
 
-'$lgt_tr_directive'(module, [Module], Input, Output) :-
-    !,
-    '$lgt_tr_directive'(module, [Module, []], Input, Output).   % empty export list
-
-'$lgt_tr_directive'(module, [Module, ExportList], _, _) :-
+'$lgt_tr_directive'(module, [Module], Line, Input, Output) :-
+    !,
+    '$lgt_tr_directive'(module, [Module, []], Line, Input, Output). % empty export list
+
+'$lgt_tr_directive'(module, [Module, ExportList], _, _, _) :-
     (var(Module); var(ExportList)),
     throw(instantiation_error).
 
-'$lgt_tr_directive'(module, [Module, _], _, _) :-
+'$lgt_tr_directive'(module, [Module, _], _, _, _) :-
     \+ atom(Module),
     throw(type_error(module_identifier, Module)).
 
-'$lgt_tr_directive'(module, [Module, ExportList], Input, Output) :-
+'$lgt_tr_directive'(module, [Module, ExportList], Line, Input, Output) :-
     assertz('$lgt_pp_module_'(Module)),                         % remeber we are compiling a module
     '$lgt_report_compiling_entity'(module, Module),
     '$lgt_tr_object_id'(Module, static),                        % assume static module/object
-    '$lgt_tr_directive'((public), ExportList, Input, Output),   % make the export list public predicates
+    '$lgt_tr_directive'((public), ExportList, Line, Input, Output), % make the export list public predicates
     '$lgt_save_file_op_table'.
 
@@ -5438 +5456 @@
 % create a message queue at object initialization
 
-'$lgt_tr_directive'(threaded, [], _, _) :-
-    \+ '$lgt_pp_object_'(_, _, _, _, _, _, _, _, _, _, _),
-    throw(domain_error(object_directive, threaded/0)).
-
-'$lgt_tr_directive'(threaded, [], _, _) :-
+'$lgt_tr_directive'(threaded, [], _, _, _) :-
     \+ '$lgt_compiler_flag'(threads, on),
     throw(error(resource_error(threads), threaded/0)).
 
-'$lgt_tr_directive'(threaded, [], _, _) :-
-    !,
-    assertz('$lgt_pp_threaded_'),
-    '$lgt_pp_object_'(Obj, _, _, _, _, _, _, _, _, _, _),
-    assertz('$lgt_pp_rclause_'('$lgt_entity_property_'(Obj, threaded))).
+'$lgt_tr_directive'(threaded, [], _, _, _) :-
+    !,
+    (   '$lgt_pp_object_'(Obj, _, _, _, _, _, _, _, _, _, _) ->
+        assertz('$lgt_pp_threaded_'),
+        assertz('$lgt_pp_rclause_'('$lgt_entity_property_'(Obj, threaded)))
+    ;   throw(domain_error(object_directive, threaded/0))
+    ).
 
 
 % make all object (or category) predicates synchronized using the same mutex
 
-'$lgt_tr_directive'(synchronized, [], _, _) :-
+'$lgt_tr_directive'(synchronized, [], _, _, _) :-
     \+ '$lgt_pp_object_'(_, _, _, _, _, _, _, _, _, _, _),
     \+ '$lgt_pp_category_'(_, _, _, _, _, _),
     throw(domain_error(directive, synchronized/0)).
 
-'$lgt_tr_directive'(synchronized, [], _, _) :-
+'$lgt_tr_directive'(synchronized, [], _, _, _) :-
     !,
     (   '$lgt_default_flag'(threads, on) ->
@@ -5474 +5490 @@
 % dynamic entity directive
 
-'$lgt_tr_directive'((dynamic), [], _, _) :-
+'$lgt_tr_directive'((dynamic), [], _, _, _) :-
     !,
     '$lgt_update_entity_comp_mode'.
 
 
-'$lgt_tr_directive'(initialization, [Goal], _, _) :-
+'$lgt_tr_directive'(initialization, [Goal], _, _, _) :-
     var(Goal),
     throw(instantiation_error).
 
-'$lgt_tr_directive'(initialization, [Goal], _, _) :-
+'$lgt_tr_directive'(initialization, [Goal], _, _, _) :-
     \+ callable(Goal),
     throw(type_error(callable, Goal)).
 
-'$lgt_tr_directive'(initialization, [Goal], _, _) :-
+'$lgt_tr_directive'(initialization, [Goal], _, _, _) :-
     '$lgt_pp_entity'(_, Entity, Prefix, _, _),
     '$lgt_ctx_ctx'(Ctx, _, Entity, Entity, Entity, Prefix, [], _),
@@ -5494 +5510 @@
 
 
-'$lgt_tr_directive'(op, [Pr, Spec, Ops], _, _) :-
+'$lgt_tr_directive'(op, [Pr, Spec, Ops], _, _, _) :-
     (var(Pr); var(Spec); var(Ops)),
     throw(instantiation_error).
 
-'$lgt_tr_directive'(op, [Pr, _, _], _, _) :-
+'$lgt_tr_directive'(op, [Pr, _, _], _, _, _) :-
     \+ '$lgt_valid_op_priority'(Pr),
     throw(type_error(operator_priority, Pr)).
 
-'$lgt_tr_directive'(op, [_, Spec, _], _, _) :-
+'$lgt_tr_directive'(op, [_, Spec, _], _, _, _) :-
     \+ '$lgt_valid_op_specifier'(Spec),
     throw(type_error(operator_specifier, Spec)).
 
-'$lgt_tr_directive'(op, [_, _, Ops], _, _) :-
+'$lgt_tr_directive'(op, [_, _, Ops], _, _, _) :-
     \+ '$lgt_valid_op_names'(Ops),
     throw(type_error(operator_name, Ops)).
 
-'$lgt_tr_directive'(op, [Pr, Spec, Ops], _, _) :-
+'$lgt_tr_directive'(op, [Pr, Spec, Ops], _, _, _) :-
     op(Pr, Spec, Ops),
     '$lgt_assert_entity_ops'(Pr, Spec, Ops).
 
 
-'$lgt_tr_directive'(uses, [Obj, Preds], _, _) :-
+'$lgt_tr_directive'(uses, [Obj, Preds], _, _, _) :-
     (var(Obj); var(Preds)),
     throw(instantiation_error).
 
-'$lgt_tr_directive'(uses, [Obj, _], _, _) :-
+'$lgt_tr_directive'(uses, [Obj, _], _, _, _) :-
     \+ callable(Obj),
     throw(type_error(object_identifier, Obj)).
 
-'$lgt_tr_directive'(uses, [_, Preds], _, _) :-
+'$lgt_tr_directive'(uses, [_, Preds], _, _, _) :-
     \+ '$lgt_is_proper_list'(Preds),
     throw(type_error(list, Preds)).
 
-'$lgt_tr_directive'(uses, [Obj, Preds], _, _) :-
+'$lgt_tr_directive'(uses, [Obj, Preds], _, _, _) :-
     !,
     assertz('$lgt_pp_referenced_object_'(Obj)),
@@ -5534 +5550 @@
 
 
-'$lgt_tr_directive'(uses, [Obj], _, _) :-
+'$lgt_tr_directive'(uses, [Obj], _, _, _) :-
     var(Obj),
     throw(instantiation_error).
 
-'$lgt_tr_directive'(uses, [Obj], _, _) :-
+'$lgt_tr_directive'(uses, [Obj], _, _, _) :-
     \+ callable(Obj),
     throw(type_error(object_identifier, Obj)).
 
-'$lgt_tr_directive'(uses, [Obj], _, _) :-
+'$lgt_tr_directive'(uses, [Obj], _, _, _) :-
     assertz('$lgt_pp_referenced_object_'(Obj)),
     assertz('$lgt_pp_uses_'(Obj)).
 
 
-'$lgt_tr_directive'(use_module, [Module, _], _, _) :-
+'$lgt_tr_directive'(use_module, [Module, _], _, _, _) :-
     var(Module),
     throw(instantiation_error).