--FILE: RandomCodeTypesImpl.mesa
--Last Edited by: Sturgis, October 4, 1984 4:55:12 pm PDT
DIRECTORY
IO USING[PutF, rope, STREAM],
RandomCodeTypes USING[WordType, WordTypeBody],
Rope USING[ROPE];
RandomCodeTypesImpl: CEDAR PROGRAM IMPORTS IO EXPORTS RandomCodeTypes =
BEGIN
OPEN RandomCodeTypes;
TypeSet: TYPE = REF TypeSetBody;
TypeSetBody: PUBLIC TYPE = RECORD[
ordinaryWordType: WordType,
uninitializedWordType: WordType,
nWordTypes: CARDINAL,
wordTypes: SEQUENCE MaxWordTypes: CARDINAL OF WordType];
ProcedureType: TYPE = REF ProcedureTypeBody;
ProcedureTypeBody: PUBLIC TYPE = RECORD[printName: Rope.ROPE, typeOfAllowedArgs: SeqType, typeOfPossibleResults: SeqType];
SeqType: TYPE = REF SeqTypeBody;
SeqTypeBody: PUBLIC TYPE = RECORD[printName: Rope.ROPE, typeSet: TypeSet, localInfo: SeqTypeLocalInfoTable, remoteInfo: SeqTypeRemoteInfoTable, types: SEQUENCE nWords: CARDINAL OF WordType];
-- Type creation operations
CreateTypeSet: PUBLIC PROCEDURE[maxNTypes: CARDINAL] RETURNS[TypeSet] =
BEGIN
typeSet: TypeSet ← NEW[TypeSetBody[maxNTypes]];
typeSet.ordinaryWordType ← NEW[WordTypeBody ← [ordinary, 0, NIL]];
typeSet.uninitializedWordType ← NEW[WordTypeBody ← [uninitialized, 1, NIL]];
typeSet.nWordTypes ← 2;
typeSet.wordTypes[0] ← typeSet.ordinaryWordType;
typeSet.wordTypes[1] ← typeSet.uninitializedWordType;
RETURN[typeSet];
END;
GetSizeOfTypeSet: PUBLIC PROCEDURE[typeSet: TypeSet] RETURNS[CARDINAL] =
{RETURN[typeSet.nWordTypes]};
GetUninitializedWordType: PUBLIC PROCEDURE[typeSet: TypeSet] RETURNS[WordType] =
{RETURN[typeSet.uninitializedWordType]};
GetOrdinaryWordType: PUBLIC PROCEDURE[typeSet: TypeSet] RETURNS[WordType] =
{RETURN[typeSet.ordinaryWordType]};
GetWordTypeFromIndex: PUBLIC PROCEDURE[typeSet: TypeSet, x: CARDINAL] RETURNS[WordType] =
{RETURN[typeSet.wordTypes[x]]};
CreatePointerType: PUBLIC PROCEDURE[typeSet: TypeSet, seq: SeqType] RETURNS[WordType] =
BEGIN
pointer: WordType ← NEW[WordTypeBody ← [pointer, typeSet.nWordTypes, seq]];
IF typeSet.nWordTypes = typeSet.MaxWordTypes THEN ERROR;
typeSet.wordTypes[typeSet.nWordTypes] ← pointer;
typeSet.nWordTypes ← typeSet.nWordTypes + 1;
RETURN[pointer];
END;
CreateProcedureType: PUBLIC PROCEDURE[typeSet: TypeSet, printName: Rope.ROPE, allowedArgs: SeqType, possibleResults: SeqType] RETURNS[WordType] =
BEGIN
procedureType: ProcedureType ← NEW[ProcedureTypeBody ← [printName, allowedArgs, possibleResults]];
wordProcedureType: WordType ← NEW[WordTypeBody ← [procedure, typeSet.nWordTypes, procedureType]];
IF typeSet.nWordTypes = typeSet.MaxWordTypes THEN ERROR;
typeSet.wordTypes[typeSet.nWordTypes] ← wordProcedureType;
typeSet.nWordTypes ← typeSet.nWordTypes + 1;
RETURN[wordProcedureType];
END;
CreateSeqType: PUBLIC PROCEDURE[typeSet: TypeSet, printName: Rope.ROPE, nWords: CARDINAL] RETURNS[SeqType] =
BEGIN
seq: SeqType ← NEW[SeqTypeBody[nWords]];
seq.printName ← printName;
seq.typeSet ← typeSet;
RETURN[seq];
END;
-- type inspection routines
GetIndex: PUBLIC PROCEDURE[wordType: WordType] RETURNS[CARDINAL] =
{RETURN[wordType.index]};
GetSeqTypeOfPointerType: PUBLIC PROCEDURE[wordType: WordType] RETURNS[SeqType] =
{RETURN[NARROW[wordType.body]]};
GetArgsResultsOfProcedureType: PUBLIC PROCEDURE[wordType: WordType] RETURNS[args, results: SeqType] =
BEGIN
body: REF ProcedureTypeBody ← NARROW[wordType.body];
RETURN[body.typeOfAllowedArgs, body.typeOfPossibleResults];
END;
GetTypeSetOfSeq: PUBLIC PROCEDURE[seq: SeqType] RETURNS[TypeSet] =
{RETURN[seq.typeSet]};
GetLength: PUBLIC PROCEDURE[seq: SeqType] RETURNS[CARDINAL] =
{RETURN[IF seq = NIL THEN 0 ELSE seq.nWords]};
TopOfSeq: PUBLIC PROCEDURE[s: SeqType, baseSize: CARDINAL] RETURNS[SeqType] =
BEGIN
new: SeqType ← NEW[SeqTypeBody[IF s = NIL THEN 0 ELSE s.nWords-baseSize]];
IF s = NIL THEN
{IF baseSize = 0 THEN RETURN[NIL] ELSE ERROR};
new.typeSet ← s.typeSet;
FOR I: CARDINAL IN [0..new.nWords) DO
new.types[I] ← s.types[baseSize+I];
ENDLOOP;
RETURN[new];
END;
TopTwoOfSeq: PUBLIC PROCEDURE[s: SeqType] RETURNS[s0, s1: WordType] =
BEGIN
IF s.nWords = 0 THEN RETURN[NIL, NIL];
IF s.nWords = 1 THEN RETURN[s[0], NIL];
RETURN[s[s.nWords-1], s[s.nWords-2]];
END;
GetWordTypeFromOffset: PUBLIC PROCEDURE[s: SeqType, offset: CARDINAL] RETURNS[WordType] =
{RETURN[s.types[offset]]};
FindFirstDiff: PUBLIC PROCEDURE[a, b: SeqType] RETURNS[CARDINAL] =
BEGIN
x: CARDINAL ← MIN[IF a = NIL THEN 0 ELSE a.nWords, IF b = NIL THEN 0 ELSE b.nWords];
FOR I: CARDINAL IN [0..x) DO
IF a.types[I] # b.types[I] THEN RETURN[I];
ENDLOOP;
RETURN[x];
END;
-- type manipulation routines
FillSeqType: PUBLIC PROCEDURE[seq: SeqType, genWordTypes: PROCEDURE[CARDINAL] RETURNS[WordType]] =
{FOR I: CARDINAL IN [0..seq.nWords) DO seq.types[I] ← genWordTypes[I] ENDLOOP};
MergeTypes: PUBLIC PROCEDURE[a, b: SeqType] RETURNS[SeqType] =
BEGIN -- returns a type t such that a is an initial seq of t, and b is a final seq of t
y: CARDINAL ← FindBestMerge[a,b];
bSize: CARDINAL ← IF b = NIL THEN 0 ELSE b.nWords;
newType: SeqType ← NEW[SeqTypeBody[y+bSize]];
IF a = NIL AND b = NIL THEN RETURN[NIL];
IF a # NIL AND b # NIL AND a.typeSet # b.typeSet THEN ERROR;
newType.typeSet ← IF b = NIL THEN a.typeSet ELSE b.typeSet;
FOR I: CARDINAL IN [0..y) DO newType.types[I] ← a.types[I] ENDLOOP;
FOR I: CARDINAL IN [0..bSize) DO newType.types[y+I] ← b.types[I] ENDLOOP;
RETURN[newType];
END;
SubtractAddTypes: PUBLIC PROCEDURE[first, minus, plus: SeqType] RETURNS[SeqType] =
BEGIN
minusNWords: INT ← IF minus = NIL THEN 0 ELSE minus.nWords;
plusNWords: INT ← IF plus = NIL THEN 0 ELSE plus.nWords;
y: CARDINAL = first.nWords - minusNWords;
newType: SeqType ← NEW[SeqTypeBody[y+plusNWords]];
IF minus # NIL AND first.typeSet # minus.typeSet THEN ERROR;
IF plus # NIL AND first.typeSet # plus.typeSet THEN ERROR;
newType.typeSet ← first.typeSet;
FOR I: CARDINAL IN [0..y) DO newType.types[I] ← first.types[I] ENDLOOP;
FOR I: INT IN [0..plusNWords) DO newType.types[y+I] ← plus.types[I] ENDLOOP;
RETURN[newType];
END;
PopSomeTypes: PUBLIC PROCEDURE[model: SeqType, nPop: CARDINAL] RETURNS[SeqType] =
BEGIN
newSize: CARDINAL;
newType: SeqType;
IF nPop = 0 THEN RETURN[model];
newSize ← model.nWords-nPop;
newType ← NEW[SeqTypeBody[newSize]];
newType.typeSet ← model.typeSet;
FOR I: CARDINAL IN [0..newSize) DO newType.types[I] ← model.types[I] ENDLOOP;
RETURN[newType];
END;
PushOneType: PUBLIC PROCEDURE[model: SeqType, type: WordType] RETURNS[SeqType] =
BEGIN
newSize: CARDINAL ← model.nWords+1;
newType: SeqType ← NEW[SeqTypeBody[newSize]];
newType.typeSet ← model.typeSet;
FOR I: CARDINAL IN [0..model.nWords) DO newType.types[I] ← model.types[I] ENDLOOP;
newType.types[newSize-1] ← type;
RETURN[newType];
END;
CopySeqType: PUBLIC PROCEDURE[in: SeqType] RETURNS[SeqType] =
BEGIN
--out: SeqType ← NEW[SeqTypeBody[in.nWords]];
--FOR I: CARDINAL IN [0..in.nWords) DO
--out.types[I] ← in.types[I];
--ENDLOOP;
--RETURN[out];
RETURN[in];
END;
CopyWithOneTypeChanged: PUBLIC PROCEDURE[in: SeqType, at: CARDINAL, new: WordType] RETURNS[SeqType] =
BEGIN
out: SeqType ← NEW[SeqTypeBody[in.nWords]];
out.typeSet ← in.typeSet;
FOR I: CARDINAL IN [0..in.nWords) DO
IF I # at THEN out.types[I] ← in.types[I]
ELSE out.types[I] ← new;
ENDLOOP;
RETURN[out];
END;
CreateTypeExtendingPartOfType: PUBLIC PROCEDURE[in: SeqType, baseCount: CARDINAL, extension: SeqType] RETURNS[SeqType] =
BEGIN
extensionSize: CARDINAL ← IF extension = NIL THEN 0 ELSE extension.nWords;
out: SeqType ← NEW[SeqTypeBody[baseCount+extensionSize]];
IF in # NIL AND extension # NIL AND in.typeSet # extension.typeSet THEN ERROR;
IF in = NIL AND extension = NIL THEN RETURN[NIL];
out.typeSet ← IF in # NIL THEN in.typeSet ELSE extension.typeSet;
FOR I: CARDINAL IN [0..baseCount) DO
out.types[I] ← in.types[I];
ENDLOOP;
FOR I: CARDINAL IN [0..extensionSize) DO
out.types[baseCount+I] ← extension[I];
ENDLOOP;
RETURN[out];
END;
-- type checking operations
WordStorableAs: PUBLIC PROCEDURE[arg1, arg2: WordType] RETURNS[--yes-- BOOLEAN] =
BEGIN
-- select on the case of arg1
SELECT arg1.type FROM
uninitialized => RETURN[FALSE];
ordinary => {RETURN[arg2.type = ordinary]};
pointer => {RETURN[arg2.type = pointer AND arg1.body = arg2.body]};
procedure => IF arg2.type # procedure THEN RETURN[FALSE] ELSE
BEGIN
procedure1: ProcedureType ← NARROW[arg1.body];
procedure2: ProcedureType ← NARROW[arg2.body];
-- following is not Cedar, since the comparison of type of allowed args etc will just be eauality tests? If not that, then might get into loops. I don't want to learn how this should be done just yet, but soon.
IF NOT SeqStorableAs[procedure2.typeOfAllowedArgs, procedure1.typeOfAllowedArgs]
THEN RETURN[FALSE];
IF NOT SeqStorableAs[procedure1.typeOfPossibleResults, procedure2.typeOfPossibleResults]
THEN RETURN[FALSE];
RETURN[TRUE];
END;
ENDCASE => ERROR;
END;
LoadIndirectTypeCheck: PUBLIC PROCEDURE[pointer: WordType, offset: CARDINAL, stackType: SeqType] =
BEGIN
baseSize: INTEGER ← stackType.nWords - 1;
seq: SeqType;
IF baseSize < 0 THEN ERROR;
IF pointer.type # pointer THEN ERROR;
seq ← NARROW[pointer.body];
IF NOT WordStorableAs[seq.types[offset], stackType.types[baseSize-1]] THEN ERROR;
END;
StoreIndirectTypeCheck: PUBLIC PROCEDURE[stackType: SeqType, pointer: WordType, offset: CARDINAL] =
BEGIN
baseSize: INTEGER ← stackType.nWords - 1;
seq: SeqType;
IF baseSize < 0 THEN ERROR;
IF pointer.type # pointer THEN ERROR;
seq ← NARROW[pointer.body];
IF NOT WordStorableAs[stackType.types[baseSize], seq.types[offset]] THEN ERROR;
END;
StackBaseCheck: PUBLIC PROCEDURE[source, target: SeqType, nArgs, nResults: CARDINAL] =
BEGIN
sourceSize: CARDINAL ← IF source = NIL THEN 0 ELSE source.nWords;
targetSize: CARDINAL ← IF target = NIL THEN 0 ELSE target.nWords;
baseSize: CARDINAL ← sourceSize - nArgs;
IF sourceSize < nArgs THEN ERROR;
IF baseSize # (targetSize - nResults) THEN ERROR;
FOR I: CARDINAL IN [0..baseSize) DO
IF source.types[I] # target.types[I] THEN ERROR;
ENDLOOP;
END;
FrameVarsCheck: PUBLIC PROCEDURE[source, target: SeqType, skip: CARDINAL] =
BEGIN
IF source.nWords # target.nWords AND (target.nWords # source.nWords+1 OR skip # source.nWords) THEN ERROR;-- allow for special case of pushing onto local variables
FOR I: INT IN [0..source.nWords) DO
IF I # skip AND source.types[I] # target.types[I] THEN ERROR;
ENDLOOP;
END;
ArgPairTypeCheck: PUBLIC PROCEDURE[stackType: SeqType, a0, a1: WordType] =
BEGIN
stackNWords: CARDINAL ← stackType.nWords;
nArgs: CARDINAL ← IF a1 # NIL THEN 2 ELSE IF a0 # NIL THEN 1 ELSE 0;
IF stackNWords < nArgs THEN ERROR;
IF a1 # NIL AND NOT WordStorableAs[stackType.types[stackNWords-2], a1] THEN ERROR;
IF a0 # NIL AND NOT WordStorableAs[stackType.types[stackNWords-1], a0] THEN ERROR;
END;
ArgSeqTypeCheck: PUBLIC PROCEDURE[stackType, allowedArgs: SeqType, skipOne: BOOLEAN ← FALSE] =
BEGIN
skip: CARDINAL ← IF skipOne THEN 1 ELSE 0;
stackSize: CARDINAL ← IF stackType = NIL THEN 0 ELSE stackType.nWords;
argSize: CARDINAL ← IF allowedArgs= NIL THEN 0 ELSE allowedArgs.nWords;
baseSize: INTEGER ← stackSize - argSize - skip;
IF baseSize < 0 THEN ERROR;
FOR I: CARDINAL IN [0..argSize) DO
IF NOT WordStorableAs[stackType.types[baseSize+I], allowedArgs[I]] THEN ERROR;
ENDLOOP;
END;
ResultWordTypeCheck: PUBLIC PROCEDURE[r0: WordType, stackType: SeqType] =
BEGIN
nResults: CARDINAL ← IF r0 # NIL THEN 1 ELSE 0;
stackNWords: CARDINAL ← stackType.nWords;
IF stackNWords < nResults THEN ERROR;
IF r0 # NIL AND NOT WordStorableAs[r0, stackType.types[stackNWords-1]] THEN ERROR;
END;
ResultSeqTypeCheck: PUBLIC PROCEDURE[possibleResults, stackType: SeqType] =
BEGIN
resultSize: CARDINAL ← IF possibleResults = NIL THEN 0 ELSE possibleResults.nWords;
stackSize: CARDINAL ← IF stackType = NIL THEN 0 ELSE stackType.nWords;
baseSize: INTEGER ← stackSize - resultSize;
IF baseSize < 0 THEN ERROR;
FOR I: CARDINAL IN [0..resultSize) DO
IF NOT WordStorableAs[possibleResults[I], stackType.types[baseSize+I]] THEN ERROR;
ENDLOOP;
END;
-- used during random construction of procedures
GetLocalOffset: PUBLIC PROCEDURE[s: SeqType, t: WordType, random: CARDINAL] RETURNS[CARDINAL] = -- returns LAST[CARDINAL] if fails
BEGIN
index: CARDINAL ← GetIndex[t];
IF s.localInfo = NIL THEN BuildSeqInfoTables[s];
IF s.localInfo[index].n = 0 THEN RETURN[LAST[CARDINAL]];
RETURN[s.localInfo[index][random MOD s.localInfo[index].n]];
END;
GetRemoteOffset: PUBLIC PROCEDURE[s: SeqType, t: WordType, random: CARDINAL] RETURNS[l,r: CARDINAL] = -- returns l = LAST[CARDINAL] if fails
BEGIN
index: CARDINAL ← GetIndex[t];
IF s.remoteInfo = NIL THEN BuildSeqInfoTables[s];
IF s.remoteInfo[index].n = 0 THEN RETURN[LAST[CARDINAL], 0];
[l,r] ← s.remoteInfo[index][random MOD s.remoteInfo[index].n];
RETURN[l,r];
END;
-- print routines
PrintWordType: PUBLIC PROCEDURE[w: WordType, on: IO.STREAM] =
BEGIN
SELECT w.type FROM
uninitialized => {on.PutF["u"]};
ordinary => {on.PutF["w"]};
pointer => {seq: SeqType ← NARROW[w.body]; on.PutF["@%g", IO.rope[seq.printName]]};
procedure =>
BEGIN
proc: ProcedureType ← NARROW[w.body];
on.PutF["%g", IO.rope[proc.printName]]
END;
ENDCASE => ERROR;
END;
PrintSeqType: PUBLIC PROCEDURE[t: SeqType, on: IO.STREAM] =
BEGIN
IF t = NIL THEN
{on.PutF["<>"]; RETURN};
on.PutF["%g", IO.rope[t.printName]];
on.PutF["<"];
IF t.nWords > 0 THEN PrintWordType[t.types[0], on];
FOR i: CARDINAL IN (0..t.nWords) DO
on.PutF[" "];
PrintWordType[t.types[i], on];
ENDLOOP;
on.PutF[">"];
END;
-- support code
SeqStorableAs: PROCEDURE[arg1, arg2: SeqType] RETURNS[--yes-- BOOLEAN] =
BEGIN
IF arg1 = NIL AND arg2 = NIL THEN RETURN[TRUE];
IF arg1.nWords # arg2.nWords THEN RETURN[FALSE];
FOR i: CARDINAL IN [0..arg1.nWords) DO
IF NOT WordStorableAs[arg1.types[i], arg2.types[i]] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
END;
FindBestMerge: PROCEDURE[a, b: SeqType] RETURNS[CARDINAL] =
BEGIN
aSize: CARDINAL ← IF a = NIL THEN 0 ELSE a.nWords;
bSize: CARDINAL ← IF b = NIL THEN 0 ELSE b.nWords;
x: CARDINAL ← IF aSize <= bSize THEN 0 ELSE aSize - bSize;
IF a # NIL AND b # NIL AND a.typeSet # b.typeSet THEN ERROR;
FOR I: CARDINAL IN [x..aSize) DO
BEGIN
FOR J: CARDINAL IN [0..aSize-I) DO
IF NOT WordStorableAs[a.types[I+J], b.types[J]] THEN GOTO failMatch;
ENDLOOP;
RETURN[I];
EXITS
failMatch => LOOP;
END;
ENDLOOP;
RETURN[aSize];
END;
SeqTypeLocalInfoTable: TYPE = REF SeqTypeLocalInfoTableBody;
SeqTypeLocalInfoTableBody: TYPE = RECORD[SEQUENCE n: CARDINAL OF LocalOffsetInfoTable];
LocalOffsetInfoTable: TYPE = REF LocalOffsetInfoTableBody;
LocalOffsetInfoTableBody: TYPE = RECORD[SEQUENCE n: CARDINAL OF CARDINAL];
SeqTypeRemoteInfoTable: TYPE = REF SeqTypeRemoteInfoTableBody;
SeqTypeRemoteInfoTableBody: TYPE = RECORD[SEQUENCE n: CARDINAL OF RemoteOffsetInfoTable];
RemoteOffsetInfoTable: TYPE = REF RemoteOffsetInfoTableBody;
RemoteOffsetInfoTableBody: TYPE = RECORD[SEQUENCE n: CARDINAL OF RECORD[l, r: CARDINAL]];
BuildSeqInfoTables: PROCEDURE[s: SeqType] =
BEGIN
Counts: TYPE = REF CountsBody;
CountsBody: TYPE = RECORD[SEQUENCE nCounts: CARDINAL OF CARDINAL];
typeSet: TypeSet ← s.typeSet;
size: CARDINAL ← GetSizeOfTypeSet[typeSet];
localTable: SeqTypeLocalInfoTable ← NEW[SeqTypeLocalInfoTableBody[size]];
remoteTable: SeqTypeRemoteInfoTable ← NEW[SeqTypeRemoteInfoTableBody[size]];
counts: Counts ← NEW[CountsBody[size]];
-- build local table
FOR I: CARDINAL IN [0..size) DO counts[I] ← 0 ENDLOOP;
FOR J: CARDINAL IN [0..s.nWords) DO
index: CARDINAL ← GetIndex[s.types[J]];
counts[index] ← counts[index]+1;
ENDLOOP;
FOR I: CARDINAL IN [0..size) DO
localTable[I] ← NEW[LocalOffsetInfoTableBody[counts[I]]]
ENDLOOP;
FOR I: CARDINAL IN [0..size) DO counts[I] ← 0 ENDLOOP;
FOR J: CARDINAL IN [0..s.nWords) DO
index: CARDINAL ← GetIndex[s.types[J]];
localTable[index][counts[index]] ← J;
counts[index] ← counts[index]+1;
ENDLOOP;
-- build remote table
FOR I: CARDINAL IN [0..size) DO counts[I] ← 0 ENDLOOP;
FOR J: CARDINAL IN [0..s.nWords) DO
IF s.types[J].type = pointer THEN
BEGIN
remoteSeq: SeqType ← NARROW[s.types[J].body];
FOR K: CARDINAL IN [0..remoteSeq.nWords) DO
index: CARDINAL ← GetIndex[remoteSeq.types[K]];
counts[index] ← counts[index]+1;
ENDLOOP;
END;
ENDLOOP;
FOR I: CARDINAL IN [0..size) DO
remoteTable[I] ← NEW[RemoteOffsetInfoTableBody[counts[I]]]
ENDLOOP;
FOR I: CARDINAL IN [0..size) DO counts[I] ← 0 ENDLOOP;
FOR J: CARDINAL IN [0..s.nWords) DO
IF s.types[J].type = pointer THEN
BEGIN
remoteSeq: SeqType ← NARROW[s.types[J].body];
FOR K: CARDINAL IN [0..remoteSeq.nWords) DO
index: CARDINAL ← GetIndex[remoteSeq.types[K]];
remoteTable[index][counts[index]] ← [J,K];
counts[index] ← counts[index]+1;
ENDLOOP;
END;
ENDLOOP;
s.localInfo ← localTable;
s.remoteInfo ← remoteTable
END;
END.
MODULE HISTORY
Initial by: Sturgis, May 2, 1984 9:07:08 am PDT: edited from RandomCodeGraphImpl