/*
 * Copyright (c) 1995, 1996 Gunther Schadow.  All rights reserved.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

:- module(packages,[package/1,package/2,use_package/1,use_package/2,
		    make_package/1, make_package/2,
		    sourced_package/1, used_package/1, main_package/1,
		    defined/1, implemented/1,
		    functional_area/3,
		    header_segment/1,
		    trailer_segment/1,
		    special_segment/1,
		    message_type/3,
		    message/4,
		    segment/3,
		    field/9,
		    data_type/3,
		    ctyp_imp/2,
		    table/3,
		    value/4]).

:- style_check(+string).

package(Name) :-
	package(Name, '').

package(Name, Version) :-
    ( discontiguous
	functional_area/3,
	header_segment/1,
        trailer_segment/1,
	special_segment/1,
	message_type/3,
	message/4,
	segment/3,
	field/9,
	data_type/3,
	ctyp_imp/2,
	table/3,
	value/4),
	style_check(+string),
     assert(Name:package(Name)),
     assert(Name:version(Version)),
     assertu(sourced_package_memo(Name)).

assertu(X) :-
    predicate_property(X,_), X.
assertu(X) :-
    assert(X).
known(X) :-
    predicate_property(X,_) -> X.

pgpred(functional_area(_,_,_)).
pgpred(header_segment(_) ).
pgpred(trailer_segment(_)).
pgpred(special_segment(_)).
pgpred(message_type(_,_,_)).
pgpred(message(_,_,_,_)).
pgpred(segment(_,_,_)).
pgpred(field(_,_,_,_,_,_,_,_,_)).
pgpred(data_type(_,_,_)).
pgpred(ctyp_imp(_,_)).
pgpred(table(_,_,_)).
pgpred(value(_,_,_,_)).

hide_others(M) :-
    forall((pgpred(P), \+defined(M:P)),
	   (
	    assert(M:P),
	    retractall(M:P)
	    )).

use_package(Name) :-
    use_package(Name, _).
use_package(Name, Version) :-
    package(Name, Version, _, _, File),
    topdir(TOPDIR),
    concat_atom([TOPDIR, '/', File], Path),
    use_module(Path),
    ( known(main_package_memo(Name)) ->
     true ;
     assertu(used_package_memo(Name))
     ),
    hide_others(Name).

make_package(Name) :-
    make_package(Name, _).
make_package(Name, Version) :-
    package(Name, Version, _, _, File),
    topdir(TOPDIR),
    concat_atom([TOPDIR, '/', File], Path),
    use_module(Path),
    ( known(main_package_memo(X)) ->
     (
      fformat(user_error, "double main package ~w (~w was first)~n",
	      [Name, X]), !, fail
      ) ;
     assert(main_package_memo(Name))
     ),
    hide_others(Name).

sourced_package(P) :-
    known(sourced_package_memo(P)).
used_package(P) :-
    known(used_package_memo(P)).
main_package(P) :-
    known(main_package_memo(P)).

defined(M:X) :-
    main_package(M),
    ( predicate_property(M:X,_),
      predicate_property(M:X,imported_from(_)) -> fail ; M:X ).
defined(M:X) :-
    used_package(M),
    ( predicate_property(M:X,_),
      predicate_property(M:X,imported_from(_)) -> fail ; M:X ).
implemented(M:X) :-
    main_package(M),
    ( predicate_property(M:X,_),
      predicate_property(M:X,imported_from(_)) -> fail ; M:X ).
    
functional_area(A,B,C) :- defined(_:functional_area(A,B,C)).
header_segment(A)  :- defined(_:header_segment(A)).
trailer_segment(A) :- defined(_:trailer_segment(A)).
special_segment(A) :- defined(_:special_segment(A)).
message_type(A,B,C) :- defined(_:message_type(A,B,C)).
message(A,B,C,D) :- defined(_:message(A,B,C,D)).
segment(A,B,C) :- defined(_:segment(A,B,C)).
field(A,B,C,D,E,F,G,H,I) :- defined(_:field(A,B,C,D,E,F,G,H,I)).
data_type(A,B,C) :- defined(_:data_type(A,B,C)).
ctyp_imp(A,B) :- defined(_:ctyp_imp(A,B)).
table(A,B,C) :- defined(_:table(A,B,C)).
value(A,B,C,D) :- defined(_:value(A,B,C,D)).