-- PLSupImpl.Mesa Last Modified by JHM
-- Schmidt August 22, 1982 1:47 pm
-- used to be Sup.Mesa
DIRECTORY
Inline: TYPE USING [LongCARDINAL],
PL: TYPE USING [BlessLST, BlessString, GetSpecialNodes, Insert, LengthList, LSTNode, LSTNodeRecord, Map, NewNail, Node, NodeRecord, RErr, rLST, rSTR, Z],
PString: TYPE USING [Item, NewStream, Stream],
Rope: TYPE USING [Equal, ROPE],
SafeStorage: TYPE USING [NewZone];
PLSupImpl: CEDAR PROGRAM IMPORTS P:PL, S: PString, SafeStorage, Rope EXPORTS PL = {
OPEN P, Rope;
--
N: ZONE = P.Z;
PrefixedZone: ZONE;
LSTNode: TYPE = PL.LSTNode;
LSTNodeRecord: TYPE = PL.LSTNodeRecord;
NodeRecord: TYPE = PL.NodeRecord;
Node: TYPE = PL.Node;
--
PBug: PUBLIC SIGNAL[ROPE] = CODE;
SErr: PUBLIC SIGNAL[est: ROPE] = CODE;
RErr: PUBLIC SIGNAL[est: ROPE] = CODE;
EndDisplay: PUBLIC SIGNAL = CODE;
Interrupt: PUBLIC SIGNAL = CODE;
--
ListRecord: TYPE = RECORD[old: Node, new: ROPE, pref: LONG INTEGER, number: BOOLEAN];
List: REF L;
L: TYPE = RECORD[e:SEQUENCE length: NAT OF ListRecord];
lin: CARDINAL;
ascii: BOOLEAN;
Nail: LSTNode;
SortRoutine: PROC[input: Node] RETURNS[Node] = {
ascii ← FALSE;
WITH input SELECT FROM
l: rLST => RETURN[sort[l]];
ENDCASE => ERROR P.RErr["sort requires a list"];
};
ASortRoutine: PROC[input: Node] RETURNS[Node] = {
ascii ← TRUE;
WITH input SELECT FROM
l: rLST => RETURN[sort[l]];
ENDCASE => ERROR P.RErr["asort requires a list"];
};
sort: PROC[input: LSTNode] RETURNS[j:LSTNode] = {
i,m: CARDINAL;
j ← NIL;
i ← P.LengthList[input];
IF i <= 1 THEN j ← input
ELSE {
List ← PrefixedZone.NEW[L[i]];
lin ← 0;
FOR m IN [0..i) DO
List[m].number ← FALSE;
ENDLOOP;
P.Map[input,SR];
-- setting up simple random number generaor
TreeSort[lin]; -- sort the list
j ← N.NEW[LSTNodeRecord←[TRUE,LST[List[lin-1].old,Nail]]];
IF lin > 1 THEN FOR i DECREASING IN [0.. (lin-2)] DO
j ← N.NEW[LSTNodeRecord←[TRUE,LST[List[i].old,j]]];
ENDLOOP;
};
RETURN[j];
};
SR: PROC[n: Node] = {
ns: PString.Stream;
List[lin].old ← n;
WITH n SELECT FROM
l: rLST => n ← l.listhead;
t: rSTR => List[lin].new ← t.str;
ENDCASE => P.RErr["sort expects a list of strings"];
ns ← S.NewStream[List[lin].new];
List[lin].number ← FALSE;
IF ~ascii THEN
{
c: CHARACTER;
neg: BOOLEAN ← FALSE;
n: LONG INTEGER ← 0;
[c,ns] ← S.Item[ns];
IF c = '- THEN { neg ← TRUE; [c, ns] ← S.Item[ns] };
IF c=0C THEN GOTO NotNum;
UNTIL c=0C DO
IF c NOT IN ['0..'9] THEN GOTO NotNum;
n ← n*10+ (c-'0);
[c, ns] ← S.Item[ns];
ENDLOOP;
IF neg THEN n ← -n;
List[lin].number ← TRUE;
List[lin].pref ← n
EXITS
NotNum => NULL;
};
IF ~List[lin].number THEN
{
-- this is just to get the first four characters into the long integer place so that they form a good hint
FunnyINT: TYPE = PACKED ARRAY [0..4) OF CHARACTER;
ns ← S.NewStream[List[lin].new];
[LOOPHOLE[List[lin].pref, FunnyINT][2], ns] ← S.Item[ns];
[LOOPHOLE[List[lin].pref, FunnyINT][3], ns] ← S.Item[ns];
[LOOPHOLE[List[lin].pref, FunnyINT][0], ns] ← S.Item[ns];
[LOOPHOLE[List[lin].pref, FunnyINT][1], ns] ← S.Item[ns];
};
lin ← lin + 1;
};
TreeSort: PROC[N: INTEGER] = {
t: ListRecord;
siftUp: PROC[low, high: INTEGER] =
{ k, son: INTEGER;
k ← low;
DO
IF 2*k>high THEN EXIT;
IF 2*k+1>high OR LessThan[2*k+1-1, 2*k-1] THEN son ← 2*k ELSE son ← 2*k+1;
IF LessThan[son-1, k-1] THEN EXIT;
t ← List[son-1]; List[son-1] ← List[k-1]; List[k-1] ← t;
k ← son;
ENDLOOP;
};
i: INTEGER;
FOR i DECREASING IN [1..N/2] DO siftUp[i,N] ENDLOOP;
FOR i DECREASING IN [1..N) DO
t ← List[1-1]; List[1-1] ← List[i+1-1]; List[i+1-1] ← t;
siftUp[1,i]
ENDLOOP;
};
LessThan: PROC[i,j: INTEGER] RETURNS[BOOLEAN] = {
res: INTEGER;
n1, n2: PString.Stream;
c1,c2: CHARACTER;
IF List[i].number AND List[j].number THEN {
IF List[i].pref < List[j].pref THEN RETURN[TRUE]
ELSE RETURN[FALSE];
};
IF ~List[i].number AND ~List[j].number THEN {
res ← USC[List[i].pref,List[j].pref];
IF res ~= 0 THEN RETURN[res=-1];
};
n1 ← S.NewStream[List[i].new];
n2 ← S.NewStream[List[j].new];
DO
[c1, n1] ← S.Item[n1];
[c2, n2] ← S.Item[n2];
IF c1 > c2 THEN {
res ← 1;
EXIT;
};
IF c1 < c2 THEN {
res ← -1;
EXIT;
};
IF c1 = 0C THEN {
res ← 0;
EXIT;
};
ENDLOOP;
RETURN[res=-1];
};
USC: PROC[a,b: LONG INTEGER] RETURNS[INTEGER] = {
-- unsigned compare, treat a and b as LONG CARDINALS
-- return -1 if a<b, 0 if a=b, 1 if a>b
i: Inline.LongCARDINAL ← LOOPHOLE[a];
j: Inline.LongCARDINAL ← LOOPHOLE[b];
IF i>j THEN RETURN[1];
IF i<j THEN RETURN[-1];
RETURN[0];
};
USortRoutine: PROC[input: Node] RETURNS[ans:Node] =
-- unary
{n: LSTNode ← P.BlessLST[ASortRoutine[input]];
ans ← n;
IF n.listhead#NIL THEN
WHILE n.listtail.listhead # NIL DO
IF Equal[P.BlessString[n.listhead],P.BlessString[n.listtail.listhead]] THEN
{ --n.listhead ← n.listtail.listhead;
--n.listtail ← n.listtail.listtail;
n↑ ← n.listtail↑
}
ELSE n ← n.listtail
ENDLOOP;
};
FactorRoutine: PROC[ninput: Node] RETURNS[ans:Node] = {
-- unary
input: LSTNode = P.BlessLST[ninput];
Ch: PROC[n: Node] =
{WITH n SELECT FROM l: rLST =>
WITH l.listhead SELECT FROM s: rSTR => RETURN;
ENDCASE => P.RErr["Illegal input to factor"];
ENDCASE => P.RErr["Illegal input to factor"]};
ans ← NIL;
P.Map[input,Ch];
{n: LSTNode ← sort[input];
m: LSTNode ← P.NewNail[];
ans ← m;
UNTIL n.listhead=NIL DO
key: Node ← P.BlessLST[n.listhead].listhead;
target: LSTNode ← P.NewNail[];
m↑ ← [TRUE, LST[
N.NEW[NodeRecord←[TRUE,LST[key,target]]],
P.NewNail[]]];
m ← m.listtail;
WHILE n.listhead#NIL
AND Equal[P.BlessString[key],P.BlessString[P.BlessLST[n.listhead].listhead]] DO
target↑ ← [TRUE,LST[
P.BlessLST[n.listhead].listtail,
P.NewNail[]]];
target ← target.listtail;
n ← n.listtail
ENDLOOP;
ENDLOOP;
}};
SupSetup: PUBLIC PROC = {
[] ← P.Insert["sort",[,,ZARY[SortRoutine]]];
[] ← P.Insert["usort",[,,ZARY[USortRoutine]]];
[] ← P.Insert["asort",[,,ZARY[ASortRoutine]]];
[] ← P.Insert["factor",[,,ZARY[FactorRoutine]]];
};
PrefixedZone ← SafeStorage.NewZone[];
[,,Nail] ← P.GetSpecialNodes[];
}.