-- 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[];

}.