/* * Make c++ code for groups * * Copyright (c) 1994, 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(mkc_grp,[groups/3, mkc_grps_h/2, mkc_grps_cc/2, mkc_grps_icc/2, groups/2, mkc_groups/0, group_lookup/2, typedef_groups/1]). :- style_check(+string). :- use_module(desc-files). :- use_module(desc-names). :- use_module(db-inter). :- use_module(mkc-print). :- use_module(mkc-msg). /* NAME groups/3 -- find groups in segment structures SYNOPSIS groups(+DefL, ?GrpL, ?DefG). DESCRIPTION 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 ~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).