Logtalk 2.17.2 files.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1075 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

library/logtalk/logtalk.pl

@@ -2,7 +2,7 @@
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %
 %  Logtalk - Object oriented extension to Prolog
-%  Release 2.17.1
+%  Release 2.17.2
 %
 %  Copyright (c) 1998-2004 Paulo Moura.  All Rights Reserved.
 %
@@ -1105,7 +1105,7 @@ current_logtalk_flag(Flag, Value) :-
 	'$lgt_default_flag'(Flag, Value),
 	\+ '$lgt_flag_'(Flag, _).
 
-current_logtalk_flag(version, version(2, 17, 1)).
+current_logtalk_flag(version, version(2, 17, 2)).
 
 
 
@@ -1591,7 +1591,10 @@ current_logtalk_flag(version, version(2, 17, 1)).
 			;
 			throw(error(permission_error(modify, static_predicate, Head), Obj::retract((Head:-Body)), Sender)))
 		;
-		throw(error(existence_error(predicate_declaration, Head), Obj::retract((Head:-Body)), Sender))).
+		('$lgt_once'(DDef, Head, _, _, _, Call) ->	% local dynamic predicate with no scope declaration
+			retract((Call :- ('$lgt_nop'(Body), _)))
+			;
+			throw(error(existence_error(predicate_declaration, Head), Obj::retract((Head:-Body)), Sender)))).
 
 '$lgt_retract'(Obj, Head, Sender, Scope) :-
 	'$lgt_current_object_'(Obj, Prefix, _, _, _, _),
@@ -1621,7 +1624,13 @@ current_logtalk_flag(version, version(2, 17, 1)).
 			;
 			throw(error(permission_error(modify, static_predicate, Head), Obj::retract(Head), Sender)))
 		;
-		throw(error(existence_error(predicate_declaration, Head), Obj::retract(Head), Sender))).
+		('$lgt_once'(DDef, Head, _, _, _, Call) ->	% local dynamic predicate with no scope declaration
+			('$lgt_debugging_'(Obj) ->
+				retract((Call :- '$lgt_dbg_fact'(_, _)))
+				;
+				retract(Call))
+			;
+			throw(error(existence_error(predicate_declaration, Head), Obj::retract(Head), Sender)))).
 
 
 
@@ -1661,7 +1670,10 @@ current_logtalk_flag(version, version(2, 17, 1)).
 			;
 			throw(error(permission_error(modify, static_predicate, Head), Obj::retractall(Head), Sender)))
 		;
-		throw(error(existence_error(predicate_declaration, Head), Obj::retractall(Head), Sender))).
+		('$lgt_once'(DDef, Head, _, _, _, Call) ->	% local dynamic predicate with no scope declaration
+			retractall(Call)
+			;
+			throw(error(existence_error(predicate_declaration, Head), Obj::retractall(Head), Sender)))).
 
 
 
@@ -2120,7 +2132,7 @@ current_logtalk_flag(version, version(2, 17, 1)).
 
 
 '$lgt_dbg_pretty_print_spypoint'(Sender, This, Self, Goal) :-
-	current_ouput(Output),
+	current_output(Output),
 	(var(Sender) -> write('_, '); '$lgt_pretty_print_vars_quoted'(Output, Sender), write(', ')),
 	(var(This) -> write('_, '); '$lgt_pretty_print_vars_quoted'(Output, This), write(', ')),
 	(var(Self) -> write('_, '); '$lgt_pretty_print_vars_quoted'(Output, Self), write(', ')),
@@ -2712,11 +2724,17 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		Error,
 		'$lgt_compiler_error_handler'(Stream, Error)),
 	catch(
-		('$lgt_write_directives'(Stream),
+		'$lgt_write_directives'(Stream),
-		 '$lgt_write_clauses'(Stream),
-		 '$lgt_write_init_call'(Stream)),
 		Error,
 		'$lgt_compiler_error_handler'(Stream, Error)),
+	('$lgt_entity_'(_, _, _, _) ->
+		catch(
+			('$lgt_write_clauses'(Stream),
+			 '$lgt_write_init_call'(Stream)),
+			Error,
+			'$lgt_compiler_error_handler'(Stream, Error))
+		;
+		true),
 	close(Stream).
 
 
@@ -2726,7 +2744,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 % writes to disk the entity documentation in XML format
 
 '$lgt_write_entity_doc'(Entity) :-
-	'$lgt_compiler_option'(xml, on) ->
+	'$lgt_entity_'(_, _, _, _) ->
+		('$lgt_compiler_option'(xml, on) ->
 			'$lgt_file_name'(xml, Entity, File),
 			catch(
 				open(File, write, Stream),
@@ -2738,6 +2757,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 				'$lgt_compiler_error_handler'(Stream, Error)),
 			close(Stream)
 			;
+			true)
+		;
 		true.
 
 
@@ -2774,9 +2795,11 @@ current_logtalk_flag(version, version(2, 17, 1)).
 	close(Stream),
 	'$lgt_fix_redef_built_ins',
 	'$lgt_find_misspelt_calls',
-	'$lgt_entity_'(Type, _, _, _),
+	('$lgt_entity_'(Type, _, _, _) ->
 		'$lgt_gen_clauses'(Type),
-	'$lgt_gen_directives'(Type).
+		'$lgt_gen_directives'(Type)
+		;
+		true).	% source file containing no entity definition
 
 
 
@@ -3100,7 +3123,7 @@ current_logtalk_flag(version, version(2, 17, 1)).
 	functor(Dir, Functor, Arity),
 	\+ '$lgt_lgt_opening_directive'(Functor/Arity),
 	!,
-	assertz('$lgt_directive_'(Dir)).
+	assertz('$lgt_directive_'(Dir)).	% directive will be copied to the generated Prolog file
 
 '$lgt_tr_directive'(Dir) :-
 	functor(Dir, Functor, Arity),
@@ -4301,7 +4324,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 read_term(Stream, Term, Options),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4316,7 +4340,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 read_term(Term, Options),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4331,7 +4356,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 read(Stream, Term),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4346,7 +4372,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 read(Term),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4361,7 +4388,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 write_term(Stream, Term, Options),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4376,7 +4404,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 write_term(Term, Options),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4391,7 +4420,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 write(Stream, Term),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4406,7 +4436,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 write(Term),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4421,7 +4452,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 writeq(Stream, Term),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4436,7 +4468,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 		('$lgt_save_operators'(Ops, Saved),
 		 '$lgt_add_operators'(Ops),
 		 writeq(Term),
-		 '$lgt_remove_operators'(Ops)),
+		 '$lgt_remove_operators'(Ops),
+		 '$lgt_add_operators'(Saved)),
 		Error,
 		'$lgt_iso_read_error_handler'(Ops, Saved, Error)).
 
@@ -4450,8 +4483,7 @@ current_logtalk_flag(version, version(2, 17, 1)).
 '$lgt_save_operators'(Ops, Saved) :-
 	findall(
 		op(Pr, Spec, Op),
-		('$lgt_member'(op(_, _, Op), Ops),
+		('$lgt_member'(op(_, _, Op), Ops), current_op(Pr, Spec, Op)),
-		 current_op(Pr, Spec, Op)),
 		Saved).
 
 
@@ -4908,6 +4940,8 @@ current_logtalk_flag(version, version(2, 17, 1)).
 %
 % retracts a dynamic "ddef clause" (used to translate a predicate call)
 % if there are no more clauses for the predicate otherwise does nothing
+%
+% this is needed in order to allow definitions in ancestors to be found
 
 '$lgt_update_ddef_table'(DDef, Call) :-
 	functor(Call, Functor, Arity),
@@ -5013,14 +5047,12 @@ current_logtalk_flag(version, version(2, 17, 1)).
 
 
 '$lgt_gen_static_object_dynamic_directives' :-
-	'$lgt_object_'(_, _, _, Def, _, _, _, DDcl, DDef),
+	'$lgt_object_'(_, Prefix, _, _, _, _, _, DDcl, DDef),
 	assertz('$lgt_directive_'(dynamic(DDcl/2))),
 	assertz('$lgt_directive_'(dynamic(DDef/5))),
 	'$lgt_dynamic_'(Functor/Arity),
-	functor(Pred, Functor, Arity),
+	'$lgt_construct_predicate_functor'(Prefix, Functor, Arity, TFunctor),
-	Clause =.. [Def, Pred, _, _, _, TPred],
+	TArity is Arity + 3,
-	'$lgt_def_'(Clause),
-	functor(TPred, TFunctor, TArity),
 	assertz('$lgt_directive_'(dynamic(TFunctor/TArity))),
 	fail.
 
@@ -5029,12 +5061,10 @@ current_logtalk_flag(version, version(2, 17, 1)).
 
 
 '$lgt_gen_object_discontiguous_directives' :-
-	'$lgt_object_'(_, _, _, Def, _, _, _, _, _),
+	'$lgt_object_'(_, Prefix, _, _, _, _, _, _, _),
 	'$lgt_discontiguous_'(Functor/Arity),
-	functor(Pred, Functor, Arity),
+	'$lgt_construct_predicate_functor'(Prefix, Functor, Arity, TFunctor),
-	Clause =.. [Def, Pred, _, _, _, TPred],
+	TArity is Arity + 3,
-	'$lgt_def_'(Clause),
-	functor(TPred, TFunctor, TArity),
 	assertz('$lgt_directive_'(discontiguous(TFunctor/TArity))),
 	fail.
 
@@ -5059,12 +5089,10 @@ current_logtalk_flag(version, version(2, 17, 1)).
 
 
 '$lgt_gen_category_discontiguous_directives' :-
-	'$lgt_category_'(_, _, _, Def),
+	'$lgt_category_'(_, Prefix, _, _),
 	'$lgt_discontiguous_'(Functor/Arity),
-	functor(Pred, Functor, Arity),
+	'$lgt_construct_predicate_functor'(Prefix, Functor, Arity, TFunctor),
-	Clause =.. [Def, Pred, _, _, _, TPred],
+	TArity is Arity + 3,
-	'$lgt_def_'(Clause),
-	functor(TPred, TFunctor, TArity),
 	assertz('$lgt_directive_'(discontiguous(TFunctor/TArity))),
 	fail.
 

library/logtalk/yap.config

@@ -1,7 +1,7 @@
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %
 %  Logtalk - Object oriented extension to Prolog
-%  Release 2.17.1
+%  Release 2.17.2
 %
 %  configuration file for YAP Prolog 4.3.23 and later versions
 %