PACKET systembaumbearbeitungneuDEFINES loescheteilbaeume, teilbaeumeaussystembaum,uebersetze:LET dp=":",refinementende=".";LET grenze=6 ;LET fehldat="Übersetzungsfehler:";FILE VAR quelle;KNOTENMENGE VAR ang,nach; TEXT VAR newsymbol:="";INT VAR newkind;TEXT VAR aktzeile:="";INT VAR zeilenindex;ROW grenzeTEXT VAR at;FILE VAR f;INT CONST maxat:=6,tepos:=1,mpos :=2,vpos:=3,npos:=4,tpos:=5,ppos:=6;LET normkz="0",refkz="1";LET scanende=7, scanbold=2,scantext=4,scandel=6,scannumber=3,scanid=1;TEXT PROC attribute( KNOTEN CONST k):TEXT VAR attr;read(k,attr);attrEND PROC attribute;BOOL PROC isrefinement(KNOTEN CONST k):(subtext(attribute(k),1,1)=refkz)END PROC isrefinement;BOOL PROC isnormal(KNOTEN CONST k):(subtext(attribute(k),1,1)= normkz)END PROC isnormal;BOOL PROC isopen(KNOTEN CONST k):NOT (isrefinement(k )COR isnormal(k))END PROC isopen;PROC mengedernachfolger(KNOTEN CONST k, KNOTENMENGE VAR m):read(k,m)END PROC mengedernachfolger;PROC neuenachfolgermenge(KNOTEN CONST k,KNOTENMENGE CONST m):write(k,m)END PROC neuenachfolgermenge;PROC loescheteilbaeume(TEXT CONST datnam,BOOL VAR gefunden):bearbeiteteilbaeume(datnam,PROC (TEXT CONST ,BOOL VAR )loesche, gefunden)END PROC loescheteilbaeume;PROC teilbaeumeaussystembaum(TEXT CONST datnam,BOOL VAR gefunden):bearbeiteteilbaeume(datnam,PROC (TEXT CONST ,BOOL VAR )retranslate,gefunden)END PROC teilbaeumeaussystembaum;PROC bearbeiteteilbaeume(TEXT CONST datnam,PROC (TEXT CONST ,BOOL VAR )behandle, BOOL VAR gefunden):ersterteilbaum;WHILE weitereteilbaeumeREP behandleteilbaum ;naechsterteilbaumPER .behandleteilbaum:behandle(teilbaumname,gefunden);IF NOT gefundenTHEN line(f,2);putline(f,"(* Teilbaum "+teilbaumname+ " existiert nicht *)");FI ;nextsymbol(newsymbol,typ).ersterteilbaum:f:= sequentialfile(input,datnam);TEXT VAR liste;getline(f,liste);forget(datnam, quiet);f:=sequentialfile(output,datnam);scan(liste);naechsterteilbaum. naechsterteilbaum:TEXT VAR teilbaumname;INT VAR typ;nextsymbol(teilbaumname, typ).weitereteilbaeume:typ<>scanende.END PROC bearbeiteteilbaeume;PROC loesche(TEXT CONST teilbaumname,BOOL VAR gefunden):sucheteilbaum;IF gefunden THEN loeschediesenFI .sucheteilbaum:KNOTEN VAR teilbaumref;gefunden:= existiert(exporte,teilbaumref,teilbaumname).loeschediesen:#loescheunterbaum( teilbaumref);KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);KNOTEN VAR r :=erster(g);IF gueltig(r)THEN knotenloeschen(g,r)FI ;knotenloeschen(exporte, teilbaumref)#KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);KNOTEN VAR r :=erster(g);loescheunterbaum(teilbaumref);IF gueltig(r)THEN knotenloeschen(g, r)FI ;knotenloeschen(exporte,teilbaumref).END PROC loesche;PROC retranslate( TEXT CONST teilbaumname,BOOL VAR gefunden):sucheteilbaum;IF gefundenTHEN schreibeteilbaumname;durchlaufeteilbaum;schreibeteilbaumendeFI .sucheteilbaum :KNOTEN VAR teilbaumref;gefunden:=existiert(exporte,teilbaumref,teilbaumname) .schreibeteilbaumname:putline(f,attribute(teilbaumref)+dp). schreibeteilbaumende:putline(f,refinementende).durchlaufeteilbaum: KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);ausbaum(erster(g),1).END PROC retranslate;PROC ausbaum(KNOTEN CONST k,INT CONST stufe):stufennummer; IF istnochnichtdefiniertTHEN refinementnameschreiben; nochnichtdefiniertschreibenELIF istrefinementTHEN refinementsuchenundschreibenELSE notierediesen;durchlaufeallesoehneFI . istrefinement:(isrefinement(k))CAND (stufe>1).istnochnichtdefiniert:isopen(k) .notierediesen:elemente(k,vorschub,zeile).stufennummer:TEXT VAR vorschub:= stufe*" ";TEXT VAR zeile:=vorschub+text(stufe);vorschub:=vorschub+" ". refinementnameschreiben:KNOTEN VAR knoten:=k;refinementname.refinementname: put(f,zeile+" "+attribute(knoten));line(f).nochnichtdefiniertschreiben:put(f, vorschub+" (* ist noch nicht definiert *)");line(f). refinementsuchenundschreiben:read(k,knoten);refinementname. durchlaufeallesoehne:KNOTENMENGE VAR soehne;mengedernachfolger(k,soehne); KNOTEN VAR sohn:=erster(soehne);WHILE gueltig(sohn)REP ausbaum(sohn,stufe+1); naechster(sohn,soehne)PER .END PROC ausbaum;PROC elemente(KNOTEN CONST k, TEXT CONST vorschub,TEXT CONST zeil):TEXT VAR at,zeile:=zeil;tex;mask;vorproz ;nachproz;tast;prozess;absatz.tex:zeile:=zeile+" TEXT """+text(k)+"""";put(f, zeile).mask:at:=maske(k);IF at<>""THEN put(f,";");line(f);zeile:=vorschub+ "MASKE """+at+"""";put(f,zeile)FI .prozess:at:=task(k);IF at<>""THEN put(f, ";");line(f);zeile:=vorschub+"TASK """+at+"""";put(f,zeile)FI .vorproz:at:= vorprozedur(k);IF at<>""THEN put(f,";");line(f);zeile:=vorschub+"> "+at;put(f ,zeile)FI .nachproz:at:=nachprozedur(k);IF at<>""THEN put(f,";");line(f); zeile:=vorschub+"< "+at;put(f,zeile)FI .tast:at:=taste(k);IF at<>""THEN put(f ,";");line(f);zeile:=vorschub+"TASTE """+at+"""";put(f,zeile)FI .absatz:line( f).END PROC elemente;TEXT PROC maske(KNOTEN CONST k):attribut(k,mpos)END PROC maske;TEXT PROC task(KNOTEN CONST k):attribut(k,ppos)END PROC task;TEXT PROC vorprozedur(KNOTEN CONST k):attribut(k,vpos)END PROC vorprozedur;TEXT PROC nachprozedur(KNOTEN CONST k):attribut(k,npos)END PROC nachprozedur;TEXT PROC taste(KNOTEN CONST k):attribut(k,tpos)END PROC taste;TEXT PROC attribut( KNOTEN CONST k,INT CONST i):TEXT VAR attext;attext:=attribute(k);TEXT VAR amuster:="��",emuster:="��";replace(amuster,1,i);replace(emuster,1,i+1);INT VAR ende,anfang;anfang:=pos(attext,amuster)+2;IF i")OR is("<")OR is("MASKE")OR is("TASTE")OR is("TASK"))END PROC iskeybold;BOOL PROC istext:(newkind=scantext)END PROC istext;BOOL PROC isdelimiter:(newkind=scandel)END PROC isdelimiter;BOOL PROC isprocedure(TEXT VAR t):IF NOT isidTHEN FALSE ELSE t:=newsymbol;next;IF is("(")THEN INT VAR klammernzaehler:=0;REP IF is("(")THEN klammernzaehlerINCR 1ELIF is(")")THEN klammernzaehlerDECR 1FI ;IF istextTHEN t:=t+""""+newsymbol+""""ELSE t:=t+ newsymbolFI ;nextUNTIL (klammernzaehler=0)PER FI ;is(";")COR israndFI END PROC isprocedure;BOOL PROC isnumber:(newkind=scannumber)END PROC isnumber; BOOL PROC isid:(newkind=scanid)END PROC isid;PROC next:nextsymbol(newsymbol, newkind);WHILE (newkind=scanende)CAND (NOT eof(quelle))REP getline(quelle, aktzeile);continuescan(aktzeile);aktuellezeile;nextsymbol(newsymbol,newkind); PER ;END PROC next;PROC lies(TEXT CONST t):IF NOT (t=newsymbol)THEN fehler(t) ELSE nextFI END PROC lies;PROC fehler(TEXT CONST f):FILE VAR fd:= sequentialfile(output,fehldat);TEXT VAR t:="Fehler bei : """;t:=t+newsymbol+ """ in Zeile "+text(zeilenindex)+" , ";line(fd,5);putline(fd,t);t:= "denn erwartet wurde: """;t:=t+f;t:=t+""" ";putline(fd,t);close(fd);stop END PROC fehler;PROC initparser:initscanner;END PROC initparser;PROC initscanner:getline(quelle,aktzeile);scan(aktzeile);page;cursor(1,3);put( "Bearbeitet wird zur Zeit Zeile: ");zeilenindex:=1;aktuellezeile;END PROC initscanner;PROC aktuellezeile:cursor(33,3);put(zeilenindex);zeilenindexINCR 1;END PROC aktuellezeile;PROC systembaum:enablestop;initparser; initialisieretemporaeregruppen;next;REP benannterteilbaum;nextUNTIL dateiende PER ;meldesyntaxkorrekt;uebernehmeindenbestand.initialisieretemporaeregruppen :ang:=leereknotenmenge;nach:=leereknotenmenge.meldesyntaxkorrekt:line(5);put( " * * * E i n g a b e i s t k o r r e k t * * * ");line(5);put( " * * * Ü b e r n a h m e i n M e n ü b a u m * * * ").END PROC systembaum;PROC benannterteilbaum:IF NOT isidTHEN fehler("Teilbaumname")FI ; erzeugeangebotsundsystemknotenaunds;next;baum(s);sistnachfolgervona; aistbezugsknotenvons.erzeugeangebotsundsystemknotenaunds:KNOTEN VAR a:= neuerknoten(ang);aHAT newsymbol;KNOTEN VAR s:=neuerknoten(system). sistnachfolgervona:sNACH a.aistbezugsknotenvons:sBEZUG a.END PROC benannterteilbaum;PROC baum(KNOTEN VAR node):INT VAR i0;lies(":");IF NOT isnumberTHEN fehler("Stufennummer")FI ;i0:=int(newsymbol);next; knotenattribute(node);zeigerefinementan;unterbaum(i0,node).zeigerefinementan: TEXT VAR t:=attribute(node);replace(t,1,"1");nodeHAT t.END PROC baum;PROC unterbaum(INT CONST j,KNOTEN VAR node):INT CONST k:=int(newsymbol);IF NOT isnumberTHEN IF NOT schlussTHEN fehler("Stufennummer oder Ende")ELSE LEAVE unterbaumFI FI ;IF j>=kTHEN LEAVE unterbaumFI ;next;erzeugeneuensohns; dieseristinsystemnachfolgervonnode;sohn(k,s,node);soehne(k,node). erzeugeneuensohns:KNOTEN VAR s:=neuerknoten(system). dieseristinsystemnachfolgervonnode:sNACH node.END PROC unterbaum;PROC soehne( INT CONST j,KNOTEN VAR node):INT CONST k:=int(newsymbol);IF NOT isnumberTHEN IF NOT schlussTHEN fehler("Stufennummer oder Ende")ELSE LEAVE soehneFI FI ; IF j>kTHEN LEAVE soehneFI ;IF NOT (j=k)THEN fehler("gleiche Stufennummer")FI ;next;erzeugeneuensohns;dieseristinsystemnachfolgervonnode;sohn(j,s,node); soehne(j,node).erzeugeneuensohns:KNOTEN VAR s:=neuerknoten(system). dieseristinsystemnachfolgervonnode:sNACH node.END PROC soehne;PROC sohn(INT CONST k,KNOTEN VAR node,vater):IF iskeyboldTHEN knotenattribute(node); unterbaum(k,node)ELSE IF NOT isidTHEN fehler( "ein Teilbaumname oder Schlüsselwort")ELSE erzeugeneuenachfrageninnach; setzevateralsnachfolgervonn;next;FI FI .erzeugeneuenachfrageninnach:KNOTEN VAR n:=neuerknoten(nach,newsymbol).setzevateralsnachfolgervonn:IF sohnvon(n, vater)THEN fehler(newsymbol+" nur einmal als Sohn auf Level "+text(k))FI ; vaterNACH n;nodeHAT newsymbol.END PROC sohn;PROC knotenattribute(KNOTEN VAR node):initialisierehilfsvariablen;TEXT VAR t;attribut;WHILE iskeyboldREP attributPER ;IF ((NOT isnumber)CAND (NOT schluss))THEN fehler( "Attribut oder Stufennummer")ELSE abschliessendebehandlungFI . initialisierehilfsvariablen:INT VAR i:=0;t:="0";FOR iFROM 1UPTO maxatREP at(i ):=""PER .abschliessendebehandlung:merke(t);nodeHAT t.END PROC knotenattribute;PROC attribut:TEXT VAR procname;IF is("TEXT")THEN next;IF NOT istextTHEN fehler("ein Menuetext")FI ;setze(newsymbol,tepos);next;IF NOT israndTHEN lies(";")FI ELSE IF is(">")THEN next;IF NOT isprocedure(procname) THEN fehler("ein Vor-Prozedur-Aufruf")FI ;setze(procname,vpos);IF NOT isrand THEN nextFI ELSE IF is("<")THEN next;IF NOT isprocedure(procname)THEN fehler( "ein Nach-Prozedur-Aufruf")FI ;setze(procname,npos);IF NOT israndTHEN nextFI ELSE IF is("MASKE")THEN next;IF NOT istextTHEN fehler("ein Maskenname")FI ; setze(newsymbol,mpos);next;IF NOT israndTHEN lies(";")FI ELSE IF is("TASTE") THEN next;IF NOT istextTHEN fehler("ein Funktionstastenname")FI ;setze( newsymbol,tpos);next;IF NOT israndTHEN lies(";")FI ELSE IF is("TASK")THEN next;IF NOT istextTHEN fehler("ein Taskname")FI ;setze(newsymbol,ppos);next; IF NOT israndTHEN lies(";")FI ELSE fehler("ein Schlüsselwort")FI FI FI FI FI FI END PROC attribut;PROC setze(TEXT CONST t,INT CONST i):at(i):=tEND PROC setze;PROC merke(TEXT VAR t):INT VAR i;TEXT VAR muster:="��";FOR iFROM 1UPTO maxatREP replace(muster,1,i);tCAT muster;tCAT at(i)PER END PROC merke;PROC uebersetze(TEXT CONST t,BOOL VAR fehler):quelle:=sequentialfile(input,t);INT CONST azahl:=zahlderelemente(exporte),szahl:=zahlderelemente(system),nzahl:= zahlderelemente(importe);clearerror;disablestop;kopieresystembaum;systembaum; IF iserrorTHEN fehler:=TRUE ;setzesystembaumzurueck;LEAVE uebersetzeFI ; fehler:=FALSE ;line(3);put( " * * * Ü b e r n a h m e i s t b e e n d e t * * * ");line(2); statistik(azahl,szahl,nzahl);line(2);put( " * * * D a t e n b a n k b e r e i n i g u n g * * * ");loesche; ueberschreibesystembaumEND PROC uebersetze;PROC statistik(INT CONST az,sz,nz) :INT CONST agesz:=zahlderelemente(exporte),sgesz:=zahlderelemente(system), ngesz:=zahlderelemente(importe);put("Zahl der Systembaumknoten insgesamt: "); put(sgesz);INT CONST sdif:=sgesz-sz,ndif:=ngesz-nz;line;IF sdif<0THEN put( "Entfernte Systemknoten: "+text(-sdif));ELSE put( "Neu erzeugte Systemknoten: "+text(sdif));FI ;line;put( "Neu definierte Teilbäume: "+text(agesz-az));line;IF ndif<0THEN put( "Abgedeckte Teilbaumreferenzen: "+text(-ndif))ELSE put( "Zusätzliche offene Teilbaumreferenzen: "+text(ndif))FI END PROC statistik; PROC loesche:knotenmengeloeschen(ang);knotenmengeloeschen(nach)END PROC loesche;OP VEREINIGT (KNOTENMENGE VAR a,KNOTENMENGE CONST b):KNOTEN VAR k:= erster(b);WHILE gueltig(k)REP a+k;naechster(k,b)PER ;END OP VEREINIGT ;OP +( KNOTENMENGE VAR a,KNOTEN CONST b):inknotenmenge(a,b);END OP +;PROC uebernehmeindenbestand:startepruefungmitneu;WHILE gueltig(neu)REP pruefenderexporte;IF schondaTHEN aenderungELSE neuanlegenFI PER ; abgleichenvonexportenundimporten.startepruefungmitneu:KNOTEN VAR neu:=erster( ang);KNOTEN VAR alt;BOOL VAR gleich.pruefenderexporte:gleich:=existiert( exporte,alt,attribute(neu)).schonda:gleich.aenderung: loeschealleknotendesaltenrefinements;neuanlegenbisaufdenursprung. loeschealleknotendesaltenrefinements:rettebisherigenursprung; gehevomursprungausundloescheallesausserrefinements.rettebisherigenursprung: KNOTENMENGE VAR u;mengedernachfolger(alt,u);KNOTEN VAR ursprung:=erster(u). gehevomursprungausundloescheallesausserrefinements:loescheunterbaum(ursprung) .neuanlegenbisaufdenursprung:raufnachfolgervonneusetzen; derursprungwirdueberschrieben.raufnachfolgervonneusetzen:KNOTENMENGE VAR root ;KNOTEN VAR r;mengedernachfolger(neu,root);r:=erster(root). derursprungwirdueberschrieben:move(r,ursprung);knotenloeschen(root,r); knotenloeschen(ang,neu).neuanlegen:inknotenmenge(exporte,neu,alt); ausknotenmenge(ang,neu).abgleichenvonexportenundimporten:KNOTENMENGE VAR abzudeckendenachfragen;KNOTENMENGE VAR nachfragesoehne;BOOL VAR gibtes;TEXT VAR importname;KNOTEN VAR importeinordner,importbezug;festimport:=erster( importe);WHILE gueltig(festimport)REP importname:=attribute(festimport); abgleichmitimporten;abgleichabschlussPER ;KNOTEN VAR aktimport:=erster(nach); WHILE gueltig(aktimport)REP importname:=attribute(aktimport); versucheabgleichmitexporten;IF gelungenTHEN importbezug:=aktimport; fuehreabgleichmitexportendurch;knotenloeschen(nach,aktimport)ELSE gibtes:= existiert(importe,importeinordner,importname);inknotenmenge(importe,aktimport ,importeinordner);ausknotenmenge(nach,aktimport)FI ;PER .abgleichabschluss: versucheabgleichmitexporten;IF gelungenTHEN importbezug:=festimport; fuehreabgleichmitexportendurch;knotenloeschen(importe,festimport)ELSE naechster(festimport,importe)FI .versucheabgleichmitexporten:KNOTEN VAR aktexport;BOOL VAR gelungen;gelungen:=existiert(exporte,aktexport,importname) .abgleichmitimporten:KNOTEN VAR festimport;gelungen:=existiert(nach,aktimport ,importname);IF gelungenTHEN verschmelzung;knotenloeschen(nach,aktimport)FI . verschmelzung:KNOTENMENGE VAR nfa;mengedernachfolger(aktimport,nfa); KNOTENMENGE VAR nfn;mengedernachfolger(festimport,nfn);nfnVEREINIGT nfa. fuehreabgleichmitexportendurch:finderefinementwurzel; markiererefinementalsbenutzt;sammlenachfragen;WHILE nochimbereichREP deckenachfrageabPER .finderefinementwurzel:KNOTEN VAR refinementwurzel; KNOTENMENGE VAR exportiertesrefinement;mengedernachfolger(aktexport, exportiertesrefinement);refinementwurzel:=erster(exportiertesrefinement). markiererefinementalsbenutzt:write(aktexport,markierungsknoten). sammlenachfragen:mengedernachfolger(importbezug,abzudeckendenachfragen); KNOTEN VAR behandelterimport:=erster(abzudeckendenachfragen).nochimbereich: gueltig(behandelterimport).naechsterimport:naechster(behandelterimport, abzudeckendenachfragen).deckenachfrageab:findeungesaettigtensohn;IF gueltig( zuersetzendersohn)THEN ersetzediesendurchrefinement;naechsterimportELSE ausknotenmenge(abzudeckendenachfragen,behandelterimport)FI . findeungesaettigtensohn:KNOTEN VAR zuersetzendersohn;mengedernachfolger( behandelterimport,nachfragesoehne);zuersetzendersohn:=erster(nachfragesoehne) ;WHILE gueltig(zuersetzendersohn)CAND nochnichtgefundenREP naechster( zuersetzendersohn,nachfragesoehne)PER .nochnichtgefunden:(NOT isopen( zuersetzendersohn))COR (NOT (attribute(zuersetzendersohn)=attribute( importbezug))).ersetzediesendurchrefinement:knotenloeschen(nachfragesoehne, zuersetzendersohn);inknotenmenge(nachfragesoehne,refinementwurzel, zuersetzendersohn).END PROC uebernehmeindenbestand;PROC loescheunterbaum( KNOTEN CONST node):KNOTENMENGE VAR m;mengedernachfolger(node,m);KNOTEN VAR k :=erster(m);WHILE gueltig(k)REP IF NOT isrefinement(k)THEN loescheunterbaum(k );knotenloeschen(m,k)ELSE ausknotenmenge(m,k);FI PER END PROC loescheunterbaum;END PACKET systembaumbearbeitungneu;