<> <> <> DIRECTORY BasicTime USING [Pulses, GetClockPulses, PulsesToSeconds], IO USING [PutF], ViewerIO USING [CreateViewerStreams, STREAM]; -- Rope USING [ROPE, Equal], -- DFN: -- CEDAR -- PROGRAM IMPORTS IO, ViewerIO, BasicTime --, Rope-- = { nlType: TYPE = -- a node (an entry in the namelist) RECORD[ name: INT, <> children: arcTypeRef _ NIL, <> cyclehead: nlTypeRef _ NIL, <> cnext: nlTypeRef _ NIL, <> nlnext: nlTypeRef _ NIL, <> toporder: dfnNumber _ DFNNaN <> ]; nlTypeRef: TYPE = LONG POINTER TO nlType; arcType: TYPE = -- an arc RECORD[ arcChildp: nlTypeRef _ NIL, <> arcChildlist: arcTypeRef _ NIL <> ]; arcTypeRef: TYPE = LONG POINTER TO arcType; dfnNumber: TYPE = INT _ DFNNaN; DFNNaN: dfnNumber = 0; << used to mark depth first numbers that aren't set yet.>> DFNBusy: dfnNumber = -1; <> dfnstruct: TYPE = RECORD[ <> nlentryp: nlTypeRef, cycletop: INT]; dfntype: TYPE = dfnstruct; <> <> DFNMaxDepth: INT = 100; <> dfnStack: ARRAY [0 .. DFNMaxDepth) OF dfntype; dfnDepth: INT _ 0; dfnCounter: dfnNumber _ DFNNaN; DFNDEBUG: BOOL = FALSE; <> <<>> nlMax: INT = 101; nlAvail: INT [0 .. nlMax) _ 0; nlZone: ARRAY [0 .. nlMax) OF nlType; arcMax: INT = 600; arcAvail: INT [0 .. arcMax) _ 0; arcZone: ARRAY [0 .. arcMax) OF arcType; <<>> out: ViewerIO.STREAM _ NIL; DepthFirstNumber: PUBLIC PROCEDURE [parentp: nlTypeRef] RETURNS [BOOL] = { <> IF DFNDEBUG THEN { IO.PutF[out, "[dfn] dfn[%g]\n", [integer[printname[parentp]]]]; }; IF dfnNumbered[childp: parentp] THEN { <> RETURN [TRUE]; }; IF dfnBusy[childp: parentp] THEN { <> RETURN [dfnFindcycle[parentp]]; }; <<>> <> IF NOT dfnPreVisit[parentp: parentp] THEN { RETURN [FALSE]; }; <<>> <> FOR arcp: arcTypeRef _ parentp^.children, arcp^.arcChildlist WHILE arcp # NIL DO IF NOT DepthFirstNumber[parentp: arcp^.arcChildp] THEN { RETURN [FALSE]; }; ENDLOOP; <<>> <> IF NOT dfnPostVisit[parentp: parentp] THEN { RETURN [FALSE]; }; RETURN [TRUE]; }; dfnPreVisit: PROCEDURE [parentp: nlTypeRef] RETURNS [BOOL] = { <> dfnDepth _ dfnDepth + 1; IF dfnDepth >= DFNMaxDepth THEN { IO.PutF[out, "[dfn] out of my depth [dfnStack overflow]\n"]; RETURN [FALSE]; }; dfnStack[dfnDepth].nlentryp _ parentp; dfnStack[dfnDepth].cycletop _ dfnDepth; parentp^.toporder _ DFNBusy; IF DFNDEBUG THEN { IO.PutF[out, "[dfnPreVisit]\t\t%g: %g\n" , [integer[dfnDepth]], [integer[printname[parentp]]]]; }; RETURN [TRUE]; }; dfnNumbered: PROCEDURE [childp: nlTypeRef] RETURNS [BOOL] = { <> RETURN [childp^.toporder # DFNNaN AND childp^.toporder # DFNBusy]; }; dfnBusy: PROCEDURE [childp: nlTypeRef] RETURNS [BOOL] = { <> RETURN [childp^.toporder # DFNNaN]; }; dfnFindcycle: PROCEDURE [childp: nlTypeRef] RETURNS [result: BOOL] = { <> cycletop: INT; cycleheadp: nlTypeRef; tailp: nlTypeRef; FOR cycletop DECREASING IN (0 .. dfnDepth] DO cycleheadp _ dfnStack[cycletop].nlentryp; IF childp = cycleheadp THEN { EXIT; }; IF childp^.cyclehead # childp AND childp^.cyclehead = cycleheadp THEN { EXIT; }; ENDLOOP; IF cycletop <= 0 THEN { IO.PutF[out, "[dfnFindcycle] couldn't find head of cycle\n"]; RETURN [FALSE]; }; IF DFNDEBUG THEN { IO.PutF[out, "[dfnFindcycle] dfnDepth %g cycletop %g %g\n", [integer[dfnDepth]], [integer[cycletop]], [integer[printname[cycleheadp]]]]; }; IF cycletop = dfnDepth THEN { <> result _ dfnSelfCycle[childp]; } ELSE { <> <> FOR tailp _ cycleheadp, tailp^.cnext WHILE tailp^.cnext # NIL DO NULL; IF DFNDEBUG THEN { IO.PutF[out, "[dfnFindcycle] tail %g\n", [integer[printname[tailp]]]]; }; ENDLOOP; <> IF cycleheadp^.cyclehead # cycleheadp THEN { cycleheadp _ cycleheadp^.cyclehead; IF DFNDEBUG THEN { IO.PutF[out, "[dfnFindcycle] new cyclehead %g\n", [integer[printname[cycleheadp]]]]; }; }; FOR index: INT IN [cycletop + 1 .. dfnDepth] DO childp _ dfnStack[index].nlentryp; IF childp^.cyclehead = childp THEN { <> <> tailp^.cnext _ childp; childp^.cyclehead _ cycleheadp; IF DFNDEBUG THEN { IO.PutF[out, "[dfnFindcycle] glomming %g onto %g\n", [integer[printname[childp]]], [integer[printname[cycleheadp]]]]; }; FOR tailp _ childp, tailp^.cnext WHILE tailp^.cnext # NIL DO tailp^.cnext^.cyclehead _ cycleheadp; IF DFNDEBUG THEN { IO.PutF[out, "[dfnFindcycle] and its tail %g onto %g\n", [integer[printname[tailp^.cnext]]], [integer[printname[cycleheadp]]]]; }; ENDLOOP; } ELSE { IF childp^.cyclehead # cycleheadp -- firewall -- THEN { IO.PutF[out, "[dfnBusy] glommed, but not to cyclehead\n"]; }; }; ENDLOOP; result _ TRUE; }; }; dfnSelfCycle: PROCEDURE [parentp: nlTypeRef] RETURNS [BOOL] = { <> <> NULL; IF DFNDEBUG THEN { IO.PutF[out, "[dfnSelfCycle] %g \n", [integer[printname[parentp]]]]; }; RETURN [TRUE]; }; dfnPostVisit: PROCEDURE [parentp: nlTypeRef] RETURNS [BOOL] = { <> <<[MISSING: an explanation]>> IF DFNDEBUG THEN { IO.PutF[out, "[dfnPostVisit]\t%g: %g\n" , [integer[dfnDepth]], [integer[printname[parentp]]]]; }; <> IF parentp^.cyclehead = parentp THEN { dfnCounter _ dfnCounter + 1; FOR memberp: nlTypeRef _ parentp, memberp^.cnext WHILE memberp # NIL DO memberp^.toporder _ dfnCounter; IF DFNDEBUG THEN { IO.PutF[out, "[dfnPostVisit]\t\tmember %g^.toporder _ %g\n", [integer[printname[memberp]]], [integer[dfnCounter]]]; }; ENDLOOP; } ELSE { IF DFNDEBUG THEN { IO.PutF[out, "[dfnPostVisit]\t\tis part of a cycle\n"]; }; }; dfnDepth _ dfnDepth - 1; RETURN [TRUE]; }; printname: PROCEDURE [nlentryp: nlTypeRef] RETURNS [INT] = { RETURN [nlentryp^.name]; }; <<*** stuff for using the interpreter to run this ***>> nodeWorld: nlTypeRef _ NIL; AddNode: PROCEDURE [name: INT] RETURNS [nlTypeRef] = { node: nlTypeRef _ @nlZone[nlAvail]; nlAvail _ nlAvail + 1; node^.name _ name; node^.nlnext _ nodeWorld; node^.cyclehead _ node; nodeWorld _ node; RETURN [node]; }; NodeLookup: PROCEDURE [name: INT] RETURNS [nlTypeRef] = { FOR nodep: nlTypeRef _ nodeWorld, nodep^.nlnext WHILE nodep # NIL DO IF name = nodep^.name THEN RETURN [nodep]; ENDLOOP; RETURN [NIL]; }; AddArc: PROCEDURE [from: INT, to: INT] RETURNS [arcTypeRef] = { fromNode: nlTypeRef _ NodeLookup[from]; toNode: nlTypeRef _ NodeLookup[to]; IF fromNode # NIL AND toNode # NIL THEN { arcp: arcTypeRef _ @arcZone[arcAvail]; arcAvail _ arcAvail + 1; arcp^.arcChildp _ toNode; arcp^.arcChildlist _ fromNode^.children; fromNode^.children _ arcp; RETURN [arcp]; }; RETURN [NIL]; }; PrintNode: PROCEDURE [nodep: nlTypeRef] RETURNS [] = { IO.PutF[out, "%g: %g\n", [integer[nodep^.name]], [integer[nodep^.toporder]]]; }; PrintNodeWorld: PROCEDURE [] RETURNS [] = { FOR nodep: nlTypeRef _ nodeWorld, nodep^.nlnext WHILE nodep # NIL DO PrintNode[nodep]; ENDLOOP; }; DoIt: PROCEDURE [] RETURNS [result: BOOL] = { startPulses: BasicTime.Pulses; <> BuildWorld: PROC = { [] _ AddNode[1]; [] _ AddNode[2]; [] _ AddNode[3]; [] _ AddNode[4]; [] _ AddNode[5]; [] _ AddNode[6]; [] _ AddNode[7]; [] _ AddNode[8]; [] _ AddNode[9]; [] _ AddNode[10]; [] _ AddNode[11]; [] _ AddNode[12]; [] _ AddNode[13]; [] _ AddNode[14]; [] _ AddNode[15]; [] _ AddNode[16]; [] _ AddNode[17]; [] _ AddNode[18]; [] _ AddNode[19]; [] _ AddNode[20]; [] _ AddNode[21]; [] _ AddNode[22]; [] _ AddNode[23]; [] _ AddNode[24]; [] _ AddNode[25]; [] _ AddNode[26]; [] _ AddNode[27]; [] _ AddNode[28]; [] _ AddNode[29]; [] _ AddNode[30]; [] _ AddNode[31]; [] _ AddNode[32]; [] _ AddNode[33]; [] _ AddNode[34]; [] _ AddNode[35]; [] _ AddNode[36]; [] _ AddNode[37]; [] _ AddNode[38]; [] _ AddNode[39]; [] _ AddNode[40]; [] _ AddNode[41]; [] _ AddNode[42]; [] _ AddNode[43]; [] _ AddNode[44]; [] _ AddNode[45]; [] _ AddNode[46]; [] _ AddNode[47]; [] _ AddNode[48]; [] _ AddNode[49]; [] _ AddNode[50]; [] _ AddNode[51]; [] _ AddNode[52]; [] _ AddNode[53]; [] _ AddNode[54]; [] _ AddNode[55]; [] _ AddNode[56]; [] _ AddNode[57]; [] _ AddNode[58]; [] _ AddNode[59]; [] _ AddNode[60]; [] _ AddNode[61]; [] _ AddNode[62]; [] _ AddNode[63]; [] _ AddNode[64]; [] _ AddNode[65]; [] _ AddNode[66]; [] _ AddNode[67]; [] _ AddNode[68]; [] _ AddNode[69]; [] _ AddNode[70]; [] _ AddNode[71]; [] _ AddNode[72]; [] _ AddNode[73]; [] _ AddNode[74]; [] _ AddNode[75]; [] _ AddNode[76]; [] _ AddNode[77]; [] _ AddNode[78]; [] _ AddNode[79]; [] _ AddNode[80]; [] _ AddNode[81]; [] _ AddNode[82]; [] _ AddNode[83]; [] _ AddNode[84]; [] _ AddNode[85]; [] _ AddNode[86]; [] _ AddNode[87]; [] _ AddNode[88]; [] _ AddNode[89]; [] _ AddNode[90]; [] _ AddNode[91]; [] _ AddNode[92]; [] _ AddNode[93]; [] _ AddNode[94]; [] _ AddNode[95]; [] _ AddNode[96]; [] _ AddNode[97]; [] _ AddNode[98]; [] _ AddNode[99]; [] _ AddNode[100]; }; <> ConnectWorld: PROC = { [] _ AddArc[ 1, 2]; [] _ AddArc[ 1, 3]; [] _ AddArc[ 1, 4]; [] _ AddArc[ 1, 5]; [] _ AddArc[ 2, 6]; [] _ AddArc[ 2, 7]; [] _ AddArc[ 4, 8]; [] _ AddArc[ 4, 9]; [] _ AddArc[ 4, 10]; [] _ AddArc[ 4, 11]; [] _ AddArc[ 5, 12]; [] _ AddArc[ 5, 12]; [] _ AddArc[ 5, 13]; [] _ AddArc[ 5, 14]; [] _ AddArc[ 5, 15]; [] _ AddArc[ 6, 16]; [] _ AddArc[ 6, 17]; [] _ AddArc[ 7, 18]; [] _ AddArc[ 7, 4]; [] _ AddArc[ 8, 19]; [] _ AddArc[ 8, 20]; [] _ AddArc[ 8, 13]; [] _ AddArc[ 8, 21]; [] _ AddArc[ 8, 22]; [] _ AddArc[ 9, 23]; [] _ AddArc[ 9, 6]; [] _ AddArc[ 10, 24]; [] _ AddArc[ 10, 25]; [] _ AddArc[ 10, 26]; [] _ AddArc[ 10, 27]; [] _ AddArc[ 10, 4]; [] _ AddArc[ 11, 21]; [] _ AddArc[ 11, 27]; [] _ AddArc[ 11, 9]; [] _ AddArc[ 12, 28]; [] _ AddArc[ 12, 29]; [] _ AddArc[ 12, 30]; [] _ AddArc[ 12, 31]; [] _ AddArc[ 13, 32]; [] _ AddArc[ 13, 33]; [] _ AddArc[ 13, 34]; [] _ AddArc[ 13, 35]; [] _ AddArc[ 13, 36]; [] _ AddArc[ 15, 7]; [] _ AddArc[ 16, 37]; [] _ AddArc[ 16, 33]; [] _ AddArc[ 16, 38]; [] _ AddArc[ 16, 39]; [] _ AddArc[ 17, 40]; [] _ AddArc[ 17, 41]; [] _ AddArc[ 18, 24]; [] _ AddArc[ 18, 42]; [] _ AddArc[ 19, 43]; [] _ AddArc[ 19, 20]; [] _ AddArc[ 19, 25]; [] _ AddArc[ 19, 44]; [] _ AddArc[ 20, 45]; [] _ AddArc[ 20, 46]; [] _ AddArc[ 20, 26]; [] _ AddArc[ 22, 40]; [] _ AddArc[ 22, 47]; [] _ AddArc[ 22, 34]; [] _ AddArc[ 22, 48]; [] _ AddArc[ 22, 49]; [] _ AddArc[ 22, 12]; [] _ AddArc[ 23, 33]; [] _ AddArc[ 23, 50]; [] _ AddArc[ 23, 41]; [] _ AddArc[ 24, 51]; [] _ AddArc[ 24, 52]; [] _ AddArc[ 24, 53]; [] _ AddArc[ 24, 11]; [] _ AddArc[ 25, 4]; [] _ AddArc[ 26, 29]; [] _ AddArc[ 26, 54]; [] _ AddArc[ 26, 12]; [] _ AddArc[ 27, 55]; [] _ AddArc[ 27, 56]; [] _ AddArc[ 27, 57]; [] _ AddArc[ 28, 58]; [] _ AddArc[ 28, 38]; [] _ AddArc[ 28, 59]; [] _ AddArc[ 28, 52]; [] _ AddArc[ 29, 32]; [] _ AddArc[ 29, 60]; [] _ AddArc[ 29, 47]; [] _ AddArc[ 29, 61]; [] _ AddArc[ 29, 50]; [] _ AddArc[ 29, 21]; [] _ AddArc[ 30, 62]; [] _ AddArc[ 30, 63]; [] _ AddArc[ 30, 64]; [] _ AddArc[ 31, 33]; [] _ AddArc[ 31, 65]; [] _ AddArc[ 31, 46]; [] _ AddArc[ 31, 63]; [] _ AddArc[ 31, 40]; [] _ AddArc[ 31, 8]; [] _ AddArc[ 32, 45]; [] _ AddArc[ 32, 66]; [] _ AddArc[ 32, 20]; [] _ AddArc[ 33, 53]; [] _ AddArc[ 33, 67]; [] _ AddArc[ 33, 28]; [] _ AddArc[ 34, 47]; [] _ AddArc[ 34, 39]; [] _ AddArc[ 34, 38]; [] _ AddArc[ 34, 57]; [] _ AddArc[ 34, 68]; [] _ AddArc[ 35, 69]; [] _ AddArc[ 35, 45]; [] _ AddArc[ 35, 40]; [] _ AddArc[ 35, 70]; [] _ AddArc[ 35, 71]; [] _ AddArc[ 36, 42]; [] _ AddArc[ 36, 64]; [] _ AddArc[ 36, 61]; [] _ AddArc[ 36, 48]; [] _ AddArc[ 36, 63]; [] _ AddArc[ 36, 13]; [] _ AddArc[ 37, 72]; [] _ AddArc[ 37, 45]; [] _ AddArc[ 37, 16]; [] _ AddArc[ 38, 23]; [] _ AddArc[ 39, 73]; [] _ AddArc[ 39, 74]; [] _ AddArc[ 39, 75]; [] _ AddArc[ 39, 76]; [] _ AddArc[ 40, 44]; [] _ AddArc[ 40, 53]; [] _ AddArc[ 40, 63]; [] _ AddArc[ 40, 77]; [] _ AddArc[ 42, 78]; [] _ AddArc[ 42, 79]; [] _ AddArc[ 42, 80]; [] _ AddArc[ 43, 81]; [] _ AddArc[ 43, 50]; [] _ AddArc[ 43, 66]; [] _ AddArc[ 43, 50]; [] _ AddArc[ 43, 82]; [] _ AddArc[ 44, 49]; [] _ AddArc[ 44, 73]; [] _ AddArc[ 44, 57]; [] _ AddArc[ 44, 76]; [] _ AddArc[ 44, 81]; [] _ AddArc[ 44, 10]; [] _ AddArc[ 45, 11]; [] _ AddArc[ 46, 83]; [] _ AddArc[ 46, 2]; [] _ AddArc[ 47, 79]; [] _ AddArc[ 47, 84]; [] _ AddArc[ 47, 73]; [] _ AddArc[ 48, 61]; [] _ AddArc[ 48, 85]; [] _ AddArc[ 48, 69]; [] _ AddArc[ 48, 35]; [] _ AddArc[ 49, 44]; [] _ AddArc[ 50, 21]; [] _ AddArc[ 52, 71]; [] _ AddArc[ 52, 86]; [] _ AddArc[ 54, 87]; [] _ AddArc[ 54, 84]; [] _ AddArc[ 54, 68]; [] _ AddArc[ 54, 83]; [] _ AddArc[ 54, 71]; [] _ AddArc[ 55, 63]; [] _ AddArc[ 55, 88]; [] _ AddArc[ 55, 69]; [] _ AddArc[ 56, 82]; [] _ AddArc[ 56, 89]; [] _ AddArc[ 56, 38]; [] _ AddArc[ 57, 78]; [] _ AddArc[ 57, 84]; [] _ AddArc[ 57, 20]; [] _ AddArc[ 59, 90]; [] _ AddArc[ 59, 91]; [] _ AddArc[ 60, 92]; [] _ AddArc[ 61, 86]; [] _ AddArc[ 62, 65]; [] _ AddArc[ 62, 86]; [] _ AddArc[ 62, 20]; [] _ AddArc[ 63, 80]; [] _ AddArc[ 63, 22]; [] _ AddArc[ 64, 88]; [] _ AddArc[ 65, 93]; [] _ AddArc[ 65, 75]; [] _ AddArc[ 65, 69]; [] _ AddArc[ 65, 67]; [] _ AddArc[ 65, 85]; [] _ AddArc[ 65, 13]; [] _ AddArc[ 66, 72]; [] _ AddArc[ 66, 49]; [] _ AddArc[ 67, 83]; [] _ AddArc[ 67, 90]; [] _ AddArc[ 67, 94]; [] _ AddArc[ 67, 91]; [] _ AddArc[ 67, 20]; [] _ AddArc[ 68, 92]; [] _ AddArc[ 68, 79]; [] _ AddArc[ 68, 69]; [] _ AddArc[ 68, 73]; [] _ AddArc[ 68, 95]; [] _ AddArc[ 68, 19]; [] _ AddArc[ 69, 79]; [] _ AddArc[ 70, 88]; [] _ AddArc[ 70, 61]; [] _ AddArc[ 71, 95]; [] _ AddArc[ 71, 2]; [] _ AddArc[ 72, 61]; [] _ AddArc[ 73, 75]; [] _ AddArc[ 73, 67]; [] _ AddArc[ 74, 93]; [] _ AddArc[ 74, 88]; [] _ AddArc[ 74, 90]; [] _ AddArc[ 75, 85]; [] _ AddArc[ 75, 96]; [] _ AddArc[ 75, 96]; [] _ AddArc[ 75, 29]; [] _ AddArc[ 76, 49]; [] _ AddArc[ 77, 97]; [] _ AddArc[ 77, 95]; [] _ AddArc[ 77, 94]; [] _ AddArc[ 77, 83]; [] _ AddArc[ 77, 76]; [] _ AddArc[ 78, 95]; [] _ AddArc[ 78, 92]; [] _ AddArc[ 78, 85]; [] _ AddArc[ 78, 93]; [] _ AddArc[ 79, 89]; [] _ AddArc[ 79, 80]; [] _ AddArc[ 80, 91]; [] _ AddArc[ 80, 83]; [] _ AddArc[ 83, 98]; [] _ AddArc[ 83, 93]; [] _ AddArc[ 84, 91]; [] _ AddArc[ 84, 87]; [] _ AddArc[ 84, 97]; [] _ AddArc[ 84, 94]; [] _ AddArc[ 85, 96]; [] _ AddArc[ 86, 91]; [] _ AddArc[ 86, 96]; [] _ AddArc[ 86, 88]; [] _ AddArc[ 86, 97]; [] _ AddArc[ 86, 92]; [] _ AddArc[ 87, 98]; [] _ AddArc[ 87, 95]; [] _ AddArc[ 87, 99]; [] _ AddArc[ 87, 95]; [] _ AddArc[ 87, 22]; [] _ AddArc[ 88, 22]; [] _ AddArc[ 89, 99]; [] _ AddArc[ 89, 90]; [] _ AddArc[ 89, 96]; [] _ AddArc[ 89, 92]; [] _ AddArc[ 89, 93]; [] _ AddArc[ 90, 92]; [] _ AddArc[ 91, 2]; [] _ AddArc[ 92, 32]; [] _ AddArc[ 93, 96]; [] _ AddArc[ 93, 96]; [] _ AddArc[ 93, 97]; [] _ AddArc[ 93, 97]; [] _ AddArc[ 93, 95]; [] _ AddArc[ 94, 99]; [] _ AddArc[ 94, 97]; [] _ AddArc[ 94, 100]; [] _ AddArc[ 94, 95]; [] _ AddArc[ 94, 98]; [] _ AddArc[ 95, 96]; [] _ AddArc[ 95, 97]; [] _ AddArc[ 95, 98]; [] _ AddArc[ 95, 8]; [] _ AddArc[ 96, 99]; [] _ AddArc[ 96, 97]; [] _ AddArc[ 96, 33]; [] _ AddArc[ 97, 99]; [] _ AddArc[ 97, 53]; [] _ AddArc[ 98, 99]; [] _ AddArc[ 99, 86]; [] _ AddArc[100, 37]; }; out _ ViewerIO.CreateViewerStreams[name: "DFN.log"].out; BuildWorld[]; ConnectWorld[]; <> startPulses _ BasicTime.GetClockPulses[]; result _ DepthFirstNumber[NodeLookup[1 -- foo --]]; IO.PutF[out, "elapsed user time: %g secs\n", [real[BasicTime.PulsesToSeconds[BasicTime.GetClockPulses[] - startPulses]]]]; <> PrintNodeWorld; }; }.