--- In classiccommodore@yahoogroups.com, willynwv <no_reply@y...>
wrote:
> --- In classiccommodore@y..., "mjsayers" <mjsayers@y...> wrote:
> > I am checking one last time for information on the DEFG/DEFL
> > device/prog.defl in the 64 and 128 models. Any information would
be
> > greatly appreciated.
> >
> >
> > Michael Sayers
>
>
> Is this part of a program directory or a error message you sre
> getting?
>
> WillynWV

Greetings,

Of much research I finally located the information. Here it is for
the benefit of fellow Commodore 64 users:

The predicate groups/3 takes a segment structure `DefL', and scans
for groups on the outer level. The group definitions are
returned in the list `GrpL'. The segment structure where all
group structures have been replaced by their group names is
returned in `DefG'.

A group is built from a structure of segments which has one of
the following forms:

(1) opt(S1, S2, ...)
(2) rep(S1, S2, ...)
(3) rep(opt(S1, S2, ...))
(4) opt(rep(S1, S2, ...))

The group is [S1, S2, ...] while the functors `opt' and `rep'
remain on the outer level. Thus the apropriate groups for the
paradigma above are:

(1') opt(grp(S1)) grp(S1) -> [S1, S2, ...]
(2') rep(grp(S1)) grp(S1) -> [S1, S2, ...]
(3') rep(opt(grp(S1))) grp(S1) -> [S1, S2, ...]
(4') opt(rep(grp(S1))) grp(S1) -> [S1, S2, ...]

GrpL would be a list of the form

[S1grp, [S1, S2, ...]]

while DefG would be set to what is found in the left column of
the above table.

This is used in order to inline group declarations into
messages
or group classes. It worked well, however, a bug in GCC-2.7.0
forces me to quickly implement a new method where groups are
declared and defined in extra files. This allows to collect
groups
that are structurally equal into one, thus saving code size.
See below.
*/

groups([],[],[]).
groups([Dh|Dt], [Gh|Gt], [DGh|DGt]) :-
Dh =.. Dhl,
is_a_group(Dhl,Gh,DGh),
groups(Dt,Gt,DGt).
groups([Dh|Dt], Gt, [Dh|DGt]) :-
groups(Dt,Gt,DGt).

is_a_group([rep, S1, S2 | ST], [Grp, [S1, S2 | ST]], rep(Grp)) :-
group([S1, S2 | ST],Grp).
is_a_group([opt, S1, S2 | ST], [Grp, [S1, S2 | ST]], opt(Grp)) :-
group([S1, S2 | ST],Grp).
is_a_group([rep |[S]], Gh, rep(DGh)) :-
S =.. Dhl,
is_a_group(Dhl, Gh, DGh).
is_a_group([opt |[S]], Gh, opt(DGh)) :-
S =.. Dhl,
is_a_group(Dhl, Gh, DGh).

/*
* Can these rules ever apply?

is_a_group(rep(H), S1, [rep(ST)]) :-
format(user_error, " ZACK! rep(~w)~n", [H]),
H =.. HL,
is_a_group(HL,S1,ST),
format(user_error, " YUPP! ~n").
is_a_group(opt(H), S1, ST) :-
format(user_error, " ZACK! opt(~w)~n", [H]),
H =.. HL,
is_a_group(HL,S1,ST),
format(user_error, " YUPP! ~n").

*/

/*
* Give a name to a group
*/

group([S|_],grp(S)) :- atom(S). % the leading required segment
group([rep(S)|_],grp(S)) :- atom(S). % even if it is repeated
group([_|R], G) :- group(R, G). % or the first
required/repeated segment
group([opt(S)|_],grp(S)) :- atom(S). % or the first optional segment
group([opt(rep(S))|_],grp(S)) :- atom(S). % or the first optional
segment
group([rep(opt(S))|_],grp(S)) :- atom(S). % or the first optional
segment
group([S|_],grp(any)) :- S =.. [any|_]. % which can also be an ANYseg
group([rep(S)|_],grp(any)) :- S =.. [any|_]. % which can also be an
ANYseg
group([opt(S)|_],grp(any)) :- S =.. [any|_].
group([opt(rep(S))|_],grp(any)) :- S =.. [any|_].
group([rep(opt(S))|_],grp(any)) :- S =.. [any|_].
group(_,grp(grp)) :- % last resort!
% fformat(user_error,"w: group `~p' can not be named~n", [X]),
true.

/*
NAME
mkc_grps_fr/1, mkc_grps_h/2, mkc_grps_cc/2
-- make code for groups

SYNOPSIS
mkc_grps_h(+GrpL, +Prefix).

mkc_grps_cc(+GrpL, +Prefix).

DESCRIPTION
The predicate mkc_grps_h/2 outputs interface code for the list
of groups ind GrpL (see groups/3 for a description of the
groups list format). Usually the output goes into the .h file
for the class of which the group is part of. Every group has
its own class with nested class for their nested groups.

The predicate mkc_grps_cc/2 outputs the implementation for the
classes of the groups in GrpL. The Prefix argument holds the
scope reference to the class to which the group classes
belong.
*/

mkc_grps_h([],_).
mkc_grps_h([[S1,DefL]|T],Prefix) :-
mkc_grp_h(S1,DefL,Prefix),
mkc_grps_h(T,Prefix).

mkc_grp_h(S1,DefL,Prefix) :-
grptname(S1,Gn),
concat_atom([Prefix,'::',Gn],NewPrefix),
groups(DefL,GrpL,DefLG),

build_vdecl(DefLG,DecL),
memo_repstruc(NewPrefix,DecL),

comment('GROUP',Gn,Prefix,'a group'),

class_begin(Gn, 'Group'),

( length(GrpL,0)
-> true;
(
ppublic,
mkc_grps_h(GrpL,NewPrefix),
format("/*~n * Resume ~w~n */", Gn),
pprivate
)
),

print_vdecl(DecL),
itemtab_h(DecL),

ppublic,

/* ctor */

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

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

mkc_grps_cc([],_).
mkc_grps_cc([[S1,DefL]|T],Prefix) :-
mkc_grp_cc(S1,DefL,Prefix),
mkc_grps_cc(T,Prefix).

mkc_grp_cc(S1,DefL,Prefix) :-
grptname(S1,Gn),
concat_atom([Prefix,'::',Gn],PrefName),
groups(DefL,GrpL,DefLG),
build_vdecl(DefLG,DecL),

comment('GROUP',Gn,Prefix,'a group'),

/* itemtab */

length(DecL, NOItems),
itemtab_cc(PrefName, DecL, DefLG, GrpL),

/* ctor */

format("~n~n~w::~w() : Group(~w, itemtab)",
[PrefName, Gn, NOItems]),

init(DecL),
nl,

mkc_grps_cc(GrpL, PrefName).

mkc_grps_icc([],_).
mkc_grps_icc([[S1,DefL]|T],Prefix) :-
mkc_grp_icc(S1,DefL,Prefix),
mkc_grps_icc(T,Prefix).

mkc_grp_icc(S1,DefL,Prefix) :-
grptname(S1,Gn),
concat_atom([Prefix,'::',Gn],PrefName),
groups(DefL,GrpL,DefLG),
build_vdecl(DefLG,DecL),

comment('GROUP',Gn,Prefix,'a group'),

/* get */

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

/* set */

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

mkc_grps_icc(GrpL, PrefName).

/*
NAME
groups/2 -- find groups in segment structures
mkc-groups/0 -- make code for all groups previously found

SYNOPSIS
groups(+DefL, ?DefG).
...
mkc_groups.

DESCRIPTION

A bug in GCC-2.7.0 forces me to quickly implement a new
method where groups are declared and defined in extra
files. This even has an advantage allowing me to collect
groups that are structurally equal into one, thus saving code
size.

The predicate groups/2 takes a segment structure `DefL', and
scans for groups on any level. The group definitions are
remembered in a database, that is later used to produce code.
The segment structure where all group structures have been
replaced by their group names is returned in `DefG'.

A group is built from a structure of segments which has one of
the following forms:

(1) opt(S1, S2, ...)
(2) rep(S1, S2, ...)
(3) rep(opt(S1, S2, ...))
(4) opt(rep(S1, S2, ...))

The group is [S1, S2, ...] while the functors `opt' and `rep'
remain on the outer level. Thus the apropriate groups for the
paradigma above are:

(1') opt(grp(S1)) grp(S1) -> [S1, S2, ...]
(2') rep(grp(S1)) grp(S1) -> [S1, S2, ...]
(3') rep(opt(grp(S1))) grp(S1) -> [S1, S2, ...]
(4') opt(rep(grp(S1))) grp(S1) -> [S1, S2, ...]
*/

groups(X,Y) :- groupsl(X,Y,0).

groupsl([],[],_).
groupsl([Dh|Dt], [DGh|DGt], Level) :-
Dh =.. Dhl,
groupsl1(Dhl, DGh, Level),
groupsl(Dt, DGt, Level).
groupsl([Dh|Dt], [Dh|DGt], Level) :-
groupsl(Dt, DGt, Level).

groupsl1([rep, S1, S2 | ST], rep(Grp), Level) :-
NLevel is Level + 1,
groupsl([S1, S2 | ST], ThisGrp, NLevel),
memo_group(ThisGrp, Grp, Level).
groupsl1([opt, S1, S2 | ST], opt(Grp), Level) :-
NLevel is Level + 1,
groupsl([S1, S2 | ST], ThisGrp, NLevel),
memo_group(ThisGrp, Grp, Level).
groupsl1([rep |[S]], rep(DGh), Level) :-
S =.. Dhl,
groupsl1(Dhl, DGh, Level).
groupsl1([opt |[S]], opt(DGh), Level) :-
S =.. Dhl,
groupsl1(Dhl, DGh, Level).

memo_group_memory(_,_,_) :- fail.

memo_group(Def, Name, _) :-
memo_group_memory(Name, Def, _).

memo_group(Def, Name1, Level) :-
group(Def, grp(Name)),
(
memo_group_memory(grp(Name), _, _) ->
memo_group1(Def, Name, 1, Name1, Level);
(
asserta(memo_group_memory(grp(Name), Def, Level)),
Name1 = grp(Name)
)
).

memo_group1(Def, Name, I, Name1, Level) :-
memo_group_memory(grp(Name,I), _, _),
J is I + 1,
memo_group1(Def, Name, J, Name1, Level).

memo_group1(Def, Name, I, grp(Name, I), Level) :-
asserta(memo_group_memory(grp(Name,I), Def, Level)).

mkc_groups :-
format("Groups:~n"),
retract(memo_group_memory(_,_,_) :- fail),
forall(memo_group_memory(G,Def,Level),
(
(
G = grp(N,I) ->
format("[~w~w(~w)", [N,I,Level]);
(
G = grp(N),
format("[~w(~w)", [N,Level])
)
), flush,
mkc_group(G,Def,Level),
format("]", [G])
)).

group_lookup(Name, Def) :-
memo_group_memory(Name, Def, _).

mkc_group(G,DefLG,Level) :-
file(group,G,Fnh),
grptname(G,Gn),
memo_incl(DefLG, []),
build_vdecl(DefLG,DecL),
memo_repstruc(Gn,DecL),

htell(Fnh,Def,group),

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

comment('GROUP',Gn,'',"a group"),

print_incl,

class_begin(Gn, 'Group'),

typedef_groups(DefLG),

print_vdecl(DecL),

/* itemtab */
length(DecL, NOItems),
itemtab_h(DecL),

ppublic,

/* ctor */

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

/* 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, group),

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

comment('GROUP',Gn,'',"a group"),

/* itemtab */

itemtab_cc(Gn, DecL, DefLG, []),

/* ctor */
format("~n~n~w::~w() : Group(~w, itemtab)",
[Gn, Gn, NOItems]),

init(DecL),
nl,

cctold,
icctell(Fnh, group),

/* get */

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

/* set */

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

nl,
icctold,

vcgtell,

% node

format("node: {~>~ntitle: ~'~w~'~n", [Gn]),
format("label: ~'~w~'~n", [Gn]),
format("color: green~n"),
TheLevel is Level + 2,
format("level: ~w~<~n}~n", [TheLevel]),

% edges

forall(member([Type,_,_,_,Name], DecL),
(
format("edge: {~>~n"),
uppercase(Name,UName),
( ( concat("repstruc<",Tp0,Type), concat(Tp1,">",Tp0) )
-> format("label: ~'~w(r)~'~n", [UName]);
( Type = 'repANYseg'
-> ( Tp1 = 'ANYseg',
format("label: ~'~w(r)~'~n", [UName]) );
( format("label: ~'~w~'~n", [UName]),
Tp1 = Type ) ) ),
format("sourcename: ~'~w~'~n", [Gn]),
format("targetname: ~'~w~'~<~n}~n", [Tp1])
)),

vcgtold.


typedef_groups(L) :-
ppublic, nl,
typedef_groups1(L).

typedef_groups1([]).
typedef_groups1([G|T]) :-
G =.. [grp,N|_],
grptname(G,C),
grplname(grp(N),D),
format("typedef ::~w ~w;~n", [C,D]),
typedef_groups1(T).
typedef_groups1([rep(G)|T]) :-
G =.. [grp,N|_],
grptname(G,C),
grplname(grp(N),D),
format("typedef ::~w ~w;~n", [C,D]),
typedef_groups1(T).
typedef_groups1([opt(G)|T]) :-
G =.. [grp,N|_],
grptname(G,C),
grplname(grp(N),D),
format("typedef ::~w ~w;~n", [C,D]),
typedef_groups1(T).
typedef_groups1([rep(opt(G))|T]) :-
G =.. [grp,N|_],
grptname(G,C),
grplname(grp(N),D),
format("typedef ::~w ~w;~n", [C,D]),
typedef_groups1(T).
typedef_groups1([opt(rep(G))|T]) :-
G =.. [grp,N|_],
grptname(G,C),
grplname(grp(N),D),
format("typedef ::~w ~w;~n", [C,D]),
typedef_groups1(T).
typedef_groups1([_|T]) :-
typedef_groups1(T).