/*  $Id: pce_global.pl,v 1.6 2001/02/06 12:46:00 jan Exp $

    Part of XPCE

    Author:  Jan Wielemaker and Anjo Anjewierden
    E-mail:  jan@swi.psy.uva.nl
    WWW:     http://www.swi.psy.uva.nl/projects/xpce/
    Copying: GPL-2.  See the file COPYING or http://www.gnu.org

    Copyright (C) 1990-2001 SWI, University of Amsterdam. All rights reserved.
*/

:- module(pce_global,
	[ pce_global/2				  % Ref x Goal
	]).

:- meta_predicate
      pce_global(+, :).

:- use_module(pce_boot(pce_principal), [send/2, object/1, new/2]).

:- require([strip_module/3, gensym/2, append/3]).

:- dynamic
	'pce global goal'/3,			  % Ref, Module, Goal
	'pce catcher'/2.			  % Module, Goal


		/********************************
		*            USER PART		*
		********************************/

%	pce_global(+@Reference, +Goal)
%	Register `Goal' to be a goal that creates `@Reference'

pce_global(@Ref, MGoal) :-
	strip_module(MGoal, Module, Goal),
	global(Ref, Module, Goal).

global(Ref, Module, Goal) :-
	var(Ref), !,
	retractall('pce catcher'(Module, Goal)),
	asserta('pce catcher'(Module, Goal)).
global(Ref, Module, Goal) :-			  % just reconsult
	'pce global goal'(Ref, Module, Goal), !.
global(Ref, Module, Goal) :-
	'pce global goal'(Ref, Module, _G2), !,	  % definition changed
	(   object(@Ref)
	->  gensym(Ref, NewRef),
	    send(@Ref, name_reference, NewRef),
	    format(user_error, ':- pce_global: Renamed @~w into @~w~n',
		   [Ref, NewRef])
	;   true
	),
	retractall('pce global goal'(Ref, Module, _G2)),
	asserta('pce global goal'(Ref, Module, Goal)).
global(Ref, _M1, new(Term)) :-			  % same definition
	'pce global goal'(Ref, _M2, new(Term)), !.
global(Ref, M1, G1) :-
	'pce global goal'(Ref, M2, G2), !,
	format(user_error,
	       '[WARNING: Global object @~w already defined in module ~w]~n',
	       [Ref, M2]),
	retractall('pce global goal'(Ref, M2, G2)),
	asserta('pce global goal'(Ref, M1, G1)).
global(Ref, Module, Goal) :-
	asserta('pce global goal'(Ref, Module, Goal)).


		/********************************
		*            SYSTEM		*
		********************************/

register_handler :-
   send(@pce?exception_handlers,
	append(attribute(undefined_assoc,
			 message(@prolog, call, trap_ref, @arg1)))).

:- initialization
	register_handler.

trap(@Ref) :-
	trap_ref(Ref).

trap_ref(Ref) :-
	'pce global goal'(Ref, Module, Goal), !,
	(   Goal = new(Term)
	->  (   new(@Ref, Module:Term)
	    ->  true
	    ;   format(user_error,
		       '[WARNING: pce_global/2: Create failed: ~w]~n',
		       [Term]),
		trace,
	        fail
	    )
	;   Goal =.. List,
	    append(List, [@Ref], GoalList),
	    GoalTerm =.. GoalList,
	    (	Module:GoalTerm
	    ->  true
	    ;   format(user_error,
		       '[WARNING: pce_global/2: Goal failed: ~w:~w]~n',
		       [Module, GoalTerm]),
		trace,
		fail
	    )
	).
trap_ref(Ref) :-
	'pce catcher'(Module, Goal),
	call(Module:Goal, Ref).
