/*
 * 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.
 */

/*
 *  Make header files for segments
 *
 */
:- module(mkc_seg,[mkc/0]).

:- style_check(+string).

:- use_module(desc-files).
:- use_module(desc-names).
:- use_module(db-inter).
:- use_module(mkc-print).

mkc :- format("Making code for segments:~n"),
       vcgnew,
	forall(implemented(_:segment(S,_,_)),
	(
	    file(segment,S,Fnh),
	    format("[~w", [S]), flush,
	    class(S,Fnh),
	    format("]")
	)), nl,
        format("Writing repfield.conf"),
	print_repfield,
        format(".~n").

/* 
 * Make a segment class
 */
class(S,Fnh) :-
	segment(S, D, FA), 
	segname(S,Sn),

	build_incl(S,DepL),
	build_vdecl(S,DecL),
	memo_repfield(DecL),
	build_cdef(S,DefL),

	htell(Fnh,Def,segment),

	nl,
	format("#include <Segment.h>~n"),

	comment('SEGMENT',S,FA,D),
	print_incl(DepL),
	class_begin(Sn,'Segment'),
	print_cdef(DefL),
	print_vdecl(DecL),
	length(DecL, NOFields),
	
	/* fieldtab */

	format("~nstatic fielddesc fieldtab[~w];~n", NOFields),

	ppublic,

	/* ctor */

	format("~n~w();~n", Sn),

	/* get */

	forall(
	(
	    member([Type,_,Name,_,_], DecL),
	    Type \= '// void'
	),
	format("~nconst ~w& get~w() const;", [Type, Name])),

	/* set */
    
        nl,
	forall(
	(
	    member([Type,_,Name,_,_], DecL),
	    Type \= '// void'
	), 
	format("~nvoid set~w(const ~w &x);", [Name, Type])),
	class_end,

	iccinclude(Fnh),

	htold(Def),

	cctell(Fnh,segment),

	nl,
	format("#include ~'Segment.h~'~n"),
	format("#include ~'SegTypeCode.h~'~n"),

	comment('SEGMENT',S,FA,D),
	print_incl(DepL),

	/* fieldtab */

	format("Segment::fielddesc ~w::fieldtab[~w] = {~>", [Sn, NOFields]),
	forall(
	(
	    member([Type,Rq,Name,_,Cmt], DecL)
	),
	(
	    Type \= '// void' ->
	    (
		required_field(Rq, Rq1),
		format("~n{ (::Type (::Segment::*))&~w::~w, ~w, ~'~w~' },",
                       [Sn, Name, Rq1, Cmt])
	    ) ;
	    format("~n{ NULL, optional, ~'unused~' },")
	)),
	format("~<~n};"),

	/* ctor */

	valname(S,Sv),
	format("~n~n~w::~w() : Segment(SegTypeCode::~w, ~w, fieldtab) {}",
	[Sn, Sn, Sv, NOFields]),

	cctold,
        icctell(Fnh, segment),

	/* get */

        nl,
        forall(
	(
	    member([Type,_,Name,_,_], DecL),
	    Type \= '// void'
	),
	(
	    format("~ninline~n"),
	    format("const ~w& ~w::get~w() const~n", [Type, Sn, Name]),
	    format("{~n"),	    
	    format("  return ~w;~n", Name),
	    format("}~n")
	)),

	/* set */
    
	nl,
        forall(
	(
	    member([Type,_,Name,_,_], DecL),
	    Type \= '// void'
	),
	(
	    format("inline~n"),
	    format("void ~w::set~w(const ~w &x)~n", [Sn,Name,Type]),
	    format("{~n"),	    
	    format("  ~w = x;~n", [Name]),
	    format("  set();~n"),
	    format("}~n")
	)),

	nl,
	icctold,

        vcgtell,

% node

        format("node: {~>~ntitle: ~'~w~'~n", [Sn]),
        uppercase(S,US), 
        format("label: ~'~w~'~n", [US]),
        format("color: red~n"),
        format("level: 10~<~n}~n"),

% edges
  
        forall(
	(
	    member([Type,_,_,_,Name], DecL),
	    Type \= '// void'
	),
        (
          format("edge: {~>~n"),
          uppercase(Name,UName), 
          ( ( concat("repfield<",Tp0,Type), concat(Tp1,">",Tp0) )
            -> format("label: ~'~w(r)~'~n", [UName]);
               ( format("label: ~'~w~'~n", [UName]),
                 Tp1 = Type ) ),
          ( concat(_,"Code",Tp1) -> Tp2 = 'IDtyp' ; Tp2 = Tp1 ),
          format("sourcename: ~'~w~'~n", [Sn]),
          format("targetname: ~'~w~'~<~n}~n", [Tp2])          
        )),

        vcgtold.


/*
NAME
	build_incl/2  --  build list of dependencies

SYNOPSIS
	build_incl(+S, ?DepL).

DESCRIPTION 

	The predicate build_include/2 takes the segment `S' and builds
    	a list of dependencies i.e. of those data types which have to
	be included from other files before they can be referenced.
	Beside the normal data types, there is a class, which may have
	to be included as well: the `repfield' template class.

	A list of dependencies (`DepL') is a flat list of atoms each
	designating an interface file to load. The list does however
	not contain filenames. These have to be translated from the
	symbols later in the process.
*/

build_incl(S,DepL) :-
	findall(Type,
	(
	    field(S,_,_,Typ,TabNr,_,_,_,_),
	    nonnil(Typ),
	    (
		(
		    Typ = id, nonnil(TabNr), table(TabNr, _, _)
		) ->
		Type = code(TabNr);
		Type = Typ
	    )
	), DepL1),
	sort(DepL1,DepL2),
	(
	    Rp^(field(S,_,_,_,_,_,Rp,_,_),
	        repeat_field(Rp,X,_,_,_,_),
		X\=n)
	    -> DepL=[repfield|DepL2] ; DepL=DepL2 
	).

/*
 * Build list of variable/parameter declarations
 */
build_vdecl(S,DecLt) :-
	findall(Decl,
	  ( between(1,60,I),  /* CAVE: Maximum # of fields per segment = 60 */
	    (
		( special_segment(S) -> I > 2 ; true ),
		(
		    field(S,I,Ds,Dt,TabNr,Rq,Rp,_,_) ->
		    build_vdecl1(Dt,TabNr,Ds,Rp,Rq,Decl) ;
		    (
			concat('unused ',I,Ds),
			build_vdecl1('',_,Ds,_,o,Decl)
		    )
		)
	    )),
	  DecL),
	  reverse(DecL,DecLr),
	  trunc_unused(DecLr,DecLrt),
	  reverse(DecLrt,DecLt).

trunc_unused([],[]).
trunc_unused([['// void'|_]|R], Rt) :- trunc_unused(R,Rt).
trunc_unused(R,R).

build_vdecl1(X,_,Ds,_,Rq,['// void',Rq,Name,'',Ds]) :-
	nil(X), !,
	cname(Ds,Name).

build_vdecl1(id,TabNr,Ds,Rp,Rq,[Type,Rq,Name,Index,Ds]) :-
	nonnil(TabNr),
	cdetname(TabNr,Typ), !,
	cdevname(Ds,Name),
	repeat_field(Rp,_,Typ,Type,Name,Index).
	
build_vdecl1(Dt,_,Ds,Rp,Rq,[Type,Rq,Name,Index,Ds]) :- !,
	typname(Dt,Typ),
	cname(Ds,Name),
	repeat_field(Rp,_,Typ,Type,Name,Index).

/*
 * Build list of definitions, which have to be made public before
 * anything else is declared.
 */
build_cdef(S,DefL) :-
	findall(Def,
	   (between(1,100,I),
	    field(S,I,Ds,_,_,_,Rp,_,_),
	    build_cdef1(Ds,Rp,Def)),
	  DefL).

build_cdef1(Ds,Rp,const(Name,Value)) :-
	repeat_field(Rp,Value,'',_,'',_),
	integer(Value),
	cname(Ds,Name).

/*
NAME
	memo_repfield/1, print_repfield
		--  repfield template configuration facility

SYNOPSIS
        memo_repfield(+DecL).

        print_repfield.

DESCRIPTION
	Works just like memo_incl/1 and print_incl/0. The predicate
	memo_repfield/2 memoizes the base type of each usage of a
	repfield template in the declaration list `DecL' while
        print_repfield/0 prints and forgets what was memoized since
        the last print_repfield was done.
*/

memo_repfield([]).
memo_repfield([H|T]) :-
	memo_repfield1(H),
	memo_repfield(T).

memo_repfield1([Type,_,_,_,_]) :-
	concat('repfield<',X,Type),
	concat(X1,'>',X),
	memo_repfield2(X1).
memo_repfield1(_).

memo_repfield2(X) :-
	predicate_property(memo_repfield_memory(_), _),
	memo_repfield_memory(X).
memo_repfield2(X) :-
	assert(memo_repfield_memory(X)).

print_repfield :-
	predicate_property(memo_repfield_memory(_), _),
	path(base,Path),
	concat(Path,'repfield.conf',File),
	tell(File),
	forall(memo_repfield_memory(X),
	    format("~w~n", X)),
	told,
	abolish(memo_repfield_memory, 1).
print_repfield :- 
        format("... no repeated fields."),
	path(base,Path),
	concat(Path,'repfield.conf',File),
	tell(File),
        told.