SaffronInstanceImpl.Mesa
Copyright Ó 1988 by Xerox Corporation. All rights reserved.
James Rauen, June 20, 1988 4:34:50 pm PDT
Last edited by: James Rauen July 12, 1988 11:26:47 am PDT
This file implements the Instance abstraction, which Saffron uses to represent an arbitrary Cedar object. The abstraction is implemented with an opaque type. The constructors enforce the various invariants of the representation; they also raise numerous type-checking errors.
DIRECTORY
Basics USING [Comparison],
BigCardinals USING [BigAdd, BigCARD, BigCompare, BigDivMod, BigFromBinaryRope, BigFromDecimalRope, BigFromSmall, BigMultiply, BigSubtract, BigToDecimalRope, BigZero, FirstOneBit, Zero],
IO USING [bool, int, PutFR, PutR, rope],
Rope USING [ActionType, Cat, Fetch, ROPE, Substr],
SaffronBaseDef USING [LocalContextNode, ProgramGraphNode],
SaffronContextPrivateTypes USING [BaseTypeTGNBody, TypeGraphNodeListNodeBody, TypeGraphNodeNodeBody],
SaffronErrorHandling USING [Error, InternalError, Message],
SaffronInstance,
SaffronTargetArchitecture USING [TargetArchitecture];
SaffronInstanceImpl: CEDAR PROGRAM
IMPORTS BigCardinals, IO, Rope, SaffronErrorHandling
EXPORTS SaffronBaseDef, SaffronInstance
~ BEGIN
Nicknames
ROPE: TYPE ~ Rope.ROPE;
LocalContextNode: TYPE ~ SaffronBaseDef.LocalContextNode;
ProgramGraphNode: TYPE ~ SaffronBaseDef.ProgramGraphNode;
TypeGraphNodeNode: TYPE ~ REF TypeGraphNodeNodeBody;
TypeGraphNodeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.TypeGraphNodeNodeBody;
TypeGraphNodeListNode: TYPE ~ REF TypeGraphNodeListNodeBody;
TypeGraphNodeListNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.TypeGraphNodeListNodeBody;
TargetArchitecture: TYPE ~ SaffronTargetArchitecture.TargetArchitecture;
Representation
InstanceNode: TYPE ~ REF InstanceNodeBody;
InstanceNodeBody: PUBLIC TYPE ~ RECORD [
type: TypeGraphNodeNode,
code: ProgramGraphNode,
value: SELECT instanceKind: * FROM
static => [concreteRepresentation: REF ANY],
runtime => [],
trash => [],
ENDCASE
];
Generic Operations
Static: PUBLIC PROC [i: InstanceNode] RETURNS [BOOLEAN] ~ BEGIN
RETURN [i.instanceKind = static];
END;
RuntimeValue: PUBLIC PROC [i: InstanceNode] RETURNS [BOOLEAN] ~ BEGIN
RETURN [i.instanceKind = runtime];
END;
Trash: PUBLIC PROC [i: InstanceNode] RETURNS [BOOLEAN] ~ BEGIN
RETURN [i.instanceKind = trash];
END;
Type: PUBLIC PROC [i: InstanceNode] RETURNS [TypeGraphNodeNode] ~ BEGIN
RETURN [i.type];
END;
ChangeType: PUBLIC PROC [i: InstanceNode, newType: TypeGraphNodeNode] RETURNS [InstanceNode] ~ BEGIN
IF newType = NIL THEN ERROR SaffronErrorHandling.InternalError["Tried to change type to NIL"];
RETURN [NEW[InstanceNodeBody ←
WITH i SELECT FROM
ii: REF static InstanceNodeBody => [newType, i.code, static[ii.concreteRepresentation]],
ii: REF runtime InstanceNodeBody => [newType, i.code, runtime[]],
ii: REF trash InstanceNodeBody => [newType, i.code, trash[]],
ENDCASE => ERROR
]];
END;
Code: PUBLIC PROC [i: InstanceNode] RETURNS [ProgramGraphNode] ~ BEGIN
RETURN[i.code];
END;
GetConcreteRepresentation: PROC [i: InstanceNode] RETURNS [REF ANY] ~ BEGIN
WITH i SELECT FROM
ii: REF static InstanceNodeBody =>
RETURN[ii.concreteRepresentation];
ii: REF runtime InstanceNodeBody =>
ERROR SaffronErrorHandling.InternalError[ "SaffronInstanceImpl.GetConcreteRepresentation called with runtime instance."];
ii: REF trash InstanceNodeBody =>
ERROR SaffronErrorHandling.InternalError[ "SaffronInstanceImpl.GetConcreteRepresentation called with trash instance."];
ENDCASE;
RETURN[NIL]; -- to make the compiler happy
END;
RopeFromInstance: PUBLIC PROC [i: InstanceNode] RETURNS [ROPE] ~ BEGIN
RETURN [WITH i SELECT FROM
ii: REF static InstanceNodeBody => RopeFromStaticInstance[ii],
ii: REF runtime InstanceNodeBody => "[RUNTIME VALUE]",
ii: REF trash InstanceNodeBody => "TRASH"
ENDCASE   => ERROR
];
END;
RopeFromStaticInstance: PROC [i: REF static InstanceNodeBody] RETURNS [ROPE] ~ BEGIN
concreteRep: REF ANY = i.concreteRepresentation;
r: ROPE ← WITH concreteRep SELECT FROM
v: IntegerValue => UnparseIntegerValue[v, 10],
v: REF BOOLEAN => IO.PutR[IO.bool[v^]],
ENDCASE  => "can't print it";
RETURN[Rope.Cat["STATIC[", r, "]"]];
END;
Dummies Until Everything's Implemented
MakeDummy: PUBLIC PROC [msg: ROPE] RETURNS [InstanceNode] ~ BEGIN
SIGNAL SaffronErrorHandling.Message[IO.PutFR["Creating dummy (%g) instance.", IO.rope[msg]]];
RETURN [NEW[InstanceNodeBody ← [NIL, NIL, trash[]]]];
END;
Trash
MakeTrash: PUBLIC PROC [type: TypeGraphNodeNode] RETURNS [InstanceNode] ~ BEGIN
RETURN [NEW[InstanceNodeBody ← [type, NIL, trash[]]]];
END;
Runtime Values
MakeRuntime: PUBLIC PROC [type: TypeGraphNodeNode, code: ProgramGraphNode] RETURNS [InstanceNode] ~ BEGIN
RETURN [NEW[InstanceNodeBody ← [type, code, runtime[]]]];
END;
Numeric Types
Generic Definitions
Sign: TYPE = SaffronInstance.Sign;
Integers
IntegerValue: TYPE = REF IntegerValueBody;
IntegerValueBody: PUBLIC TYPE = RECORD [
sign: Sign,
absoluteValue: BigCardinals.BigCARD
];
MakeIntegerValue: PUBLIC PROC [j: INT] RETURNS [intValue: IntegerValue] ~ BEGIN
RETURN[NEW[IntegerValueBody ← [
sign: IF j >= 0 THEN plus ELSE minus,
absoluteValue: BigCardinals.BigFromSmall[ABS[j]]
]]];
END;
ParseIntegerLiteral: PUBLIC PROC [text: ROPE, base: [2..36] ← 10] RETURNS [IntegerValue] ~ BEGIN
sign: Sign ← plus;
absoluteValue: BigCardinals.BigCARD;
SELECT text.Fetch[0] FROM
'+   => {text ← text.Substr[1]};
'-   => {text ← text.Substr[1]; sign ← minus};
ENDCASE => NULL;
SELECT base FROM
2   => {absoluteValue ← BigCardinals.BigFromBinaryRope[text]};
10   => {absoluteValue ← BigCardinals.BigFromDecimalRope[text]};
ENDCASE => {
ERROR SaffronErrorHandling.InternalError[IO.PutFR["Can't parse base %g", IO.int[base]]] };
RETURN[NEW[IntegerValueBody ← [sign, absoluteValue]]];
END;
UnparseIntegerValue: PUBLIC PROC [value: IntegerValue, base: [2..36] ← 10] RETURNS [ROPE] ~ BEGIN
RETURN[Rope.Cat[
IF value.sign = minus THEN "-" ELSE "",
SELECT base FROM
10   => BigCardinals.BigToDecimalRope[value.absoluteValue],
ENDCASE =>
ERROR SaffronErrorHandling.InternalError[IO.PutFR["Can't parse base %g", IO.int[base]]]
]];
END;
DigitFromChar: PROC [literal: CHARACTER, base: [2..36]] RETURNS [digit: INT] ~ BEGIN
SELECT literal FROM
IN ['0..'9]  => digit ← literal - '0;
IN ['a..'z]  => digit ← literal - 'a + 10;
IN ['A..'Z] => digit ← literal - 'A + 10;
ENDCASE => ERROR SaffronErrorHandling.InternalError[IO.PutFR["Bad argument (%g) to DigitFromChar", IO.char[literal]]];
IF digit >= base THEN ERROR SaffronErrorHandling.InternalError[IO.PutFR["Argument (%g) to DigitFromChar too large for base %g", IO.char[literal], IO.int[base]]];
RETURN[digit];
END;
CastIntegerValue: PUBLIC PROC [value: IntegerValue, types: TypeGraphNodeListNode] RETURNS [InstanceNode] ~ BEGIN
typeList: LIST OF TypeGraphNodeNode ← types^;
WHILE (typeList # NIL) DO
IF CanCastIntegerValue[value, typeList.first]
THEN {
SIGNAL SaffronErrorHandling.Message[IO.PutFR["Casting an integer value of %g", IO.rope[UnparseIntegerValue[value]]]];
RETURN [NEW[InstanceNodeBody ← [
type: typeList.first,
code: NIL,
value: static[value]
]]];
};
ENDLOOP;
SIGNAL SaffronErrorHandling.Error[0, IO.PutFR["Integer value %g exceeds the capacity of all integer types.", IO.rope[UnparseIntegerValue[value]]]];
RETURN [NEW[InstanceNodeBody ← [
type: types^.first,
code: NIL,
value: static[MakeIntegerValue[0]]
]]];
END;
CanCastIntegerValue: PUBLIC PROC [value: IntegerValue, type: TypeGraphNodeNode] RETURNS [BOOLEAN] ~ BEGIN
IntegerBaseType: TYPE = REF integer SaffronContextPrivateTypes.BaseTypeTGNBody;
baseType: IntegerBaseType ← IF ISTYPE[type.body, IntegerBaseType]
THEN NARROW[type.body]
ELSE ERROR SaffronErrorHandling.InternalError["Tried to cast an integer value into a non integer base type."];
IF baseType.signed
THEN {
nValueBits: INT ← BigCardinals.FirstOneBit[BigCardinals.BigSubtract[
value.absoluteValue, BigCardinals.BigFromSmall[IF value.sign = minus THEN 1 ELSE 0]]] + 1;
IF (nValueBits + 1) > baseType.nBits THEN RETURN[FALSE];
}
ELSE {
nValueBits: INT ← BigCardinals.FirstOneBit[value.absoluteValue] + 1;
IF value.sign = minus THEN RETURN[FALSE];
IF nValueBits > baseType.nBits THEN RETURN[FALSE];
};
RETURN[TRUE];
END;
RetrieveIntegerValue: PUBLIC PROC [i: InstanceNode] RETURNS [IntegerValue] ~ BEGIN
RETURN [NARROW[GetConcreteRepresentation[i]]];
END;
AddIntegers: PUBLIC PROC [i1, i2: IntegerValue] RETURNS [IntegerValue] ~ BEGIN
abs1: BigCardinals.BigCARD = i1.absoluteValue;
abs2: BigCardinals.BigCARD = i2.absoluteValue;
RETURN[NEW[IntegerValueBody ←
IF i1.sign = i2.sign
THEN [i1.sign, BigCardinals.BigAdd[abs1, abs2]]
ELSE SELECT BigCardinals.BigCompare[abs1, abs2] FROM
less  => [i2.sign, BigCardinals.BigSubtract[abs2, abs1]],
equal  => [plus, BigCardinals.Zero],
greater => [i1.sign, BigCardinals.BigSubtract[abs1, abs2]]
ENDCASE => ERROR
]];
END;
SubtractIntegers: PUBLIC PROC [i1, i2: IntegerValue] RETURNS [IntegerValue] ~ BEGIN
abs1: BigCardinals.BigCARD = i1.absoluteValue;
abs2: BigCardinals.BigCARD = i2.absoluteValue;
RETURN[NEW[IntegerValueBody ←
IF i1.sign # i2.sign
THEN [i1.sign, BigCardinals.BigAdd[abs1, abs2]]
ELSE SELECT BigCardinals.BigCompare[abs1, abs2] FROM
less  => [FlipSign[i1.sign], BigCardinals.BigSubtract[abs2, abs1]],
equal  => [plus, BigCardinals.Zero],
greater => [i1.sign, BigCardinals.BigSubtract[abs1, abs2]]
ENDCASE => ERROR
]];
END;
MultiplyIntegers: PUBLIC PROC [i1, i2: IntegerValue] RETURNS [IntegerValue] ~ BEGIN
RETURN[NEW[IntegerValueBody ← [
sign: IF i1.sign = i2.sign THEN plus ELSE minus,
absoluteValue: BigCardinals.BigMultiply[i1.absoluteValue, i2.absoluteValue]
]]];
END;
DivideIntegers: PUBLIC PROC [i1, i2: IntegerValue] RETURNS [IntegerValue] ~ BEGIN
do a divide by zero check!
RETURN[NEW[IntegerValueBody ← [
sign: IF i1.sign = i2.sign THEN plus ELSE minus,
absoluteValue: BigCardinals.BigDivMod[i1.absoluteValue, i2.absoluteValue].quo
]]];
END;
ModIntegers: PUBLIC PROC [i1, i2: IntegerValue] RETURNS [IntegerValue] ~ BEGIN
do a divide by zero check!
RETURN[NEW[IntegerValueBody ← [
sign: IF i1.sign = i2.sign THEN plus ELSE minus,
absoluteValue: BigCardinals.BigDivMod[i1.absoluteValue, i2.absoluteValue].rem
]]];
END;
NegateInteger: PUBLIC PROC [i: IntegerValue] RETURNS [IntegerValue] ~ BEGIN
RETURN[IF BigCardinals.BigZero[i.absoluteValue]
THEN i
ELSE NEW[IntegerValueBody ← [
sign: FlipSign[i.sign],
absoluteValue: i.absoluteValue
]]];
END;
FlipSign: PROC [sign: Sign] RETURNS [Sign] = INLINE {
RETURN[IF sign = plus THEN minus ELSE plus]; };
MultiplySigns: PROC [sign1, sign2: Sign] RETURNS[Sign] = INLINE {
RETURN[IF sign1 = sign2 THEN plus ELSE minus]; };
Reals
RealValue: TYPE = REF RealValueBody;
RealValueBody: PUBLIC TYPE = RECORD [
sign: Sign,
mantissa: Mantissa,
exponent: Exponent
];
Mantissa: TYPE = REF MantissaBody;
MantissaBody: TYPE = RECORD [
mantissa: SEQUENCE nMantissaBytes: CARDINAL OF BYTE
];
Exponent: TYPE = REF ExponentBody;
ExponentBody: TYPE = RECORD [
exponent: SEQUENCE nExponentBytes: CARDINAL OF BYTE
];
ParseLiteralReal: PROC [text: ROPE, architecture: TargetArchitecture, rootContext: LocalContextNode] RETURNS [InstanceNode];
IsReal: PROC [i: InstanceNode] RETURNS [BOOLEAN];
Return TRUE if i is a real instance, FALSE otherwise.
AddReals: PROC [i1, i2: InstanceNode] RETURNS [InstanceNode];
SubtractReals: PROC [i1, i2: InstanceNode] RETURNS [InstanceNode];
MultiplyReals: PROC [i1, i2: InstanceNode] RETURNS [InstanceNode];
DivideReals: PROC [i1, i2: InstanceNode] RETURNS [InstanceNode];
Generic Operations
IsNumeric: PROC [i: InstanceNode] RETURNS [BOOLEAN];
Return TRUE if i is an integer or real instance, FALSE otherwise.
CoerceIntegerToReal: PROC [i: InstanceNode] RETURNS [InstanceNode];
Foo.
Operations on Numeric Instances
Operations
InstanceAdd: PUBLIC PROC [i1, i2: InstanceNode, targetType: TypeGraphNodeNode] RETURNS [InstanceNode] ~ BEGIN
RETURN [MakeDummy["add"]];
END;
InstanceSubtract: PUBLIC PROC [i1, i2: InstanceNode, targetType: TypeGraphNodeNode] RETURNS [InstanceNode] ~ BEGIN
RETURN [MakeDummy["subtract"]];
END;
InstanceMultiply: PUBLIC PROC [i1, i2: InstanceNode, targetType: TypeGraphNodeNode] RETURNS [InstanceNode] ~ BEGIN
RETURN [MakeDummy["multiply"]];
END;
InstanceDivide: PUBLIC PROC [i1, i2: InstanceNode, targetType: TypeGraphNodeNode] RETURNS [InstanceNode] ~ BEGIN
RETURN [MakeDummy["divide"]];
END;
Other Basic Types
Atom
MakeStaticAtom: PROC [value: ATOM, rootContext: LocalContextNode] RETURNS [InstanceNode];
MakeUnknownAtom: PROC [code: ProgramGraphNode, rootContext: LocalContextNode] RETURNS [InstanceNode];
IsAtom: PROC [i: InstanceNode] RETURNS [BOOLEAN];
Return TRUE if i is an atom instance, FALSE otherwise.
AtomValue: PROC [i: InstanceNode] RETURNS [ATOM];
i must be a static atom instance. Return its value.
Boolean
MakeStaticBoolean: PUBLIC PROC [value: BOOLEAN, type: TypeGraphNodeNode] RETURNS [InstanceNode] ~ BEGIN
SIGNAL SaffronErrorHandling.Message[IO.PutFR["Creating a static boolean value of %g", IO.bool[value]]];
RETURN[NEW[InstanceNodeBody ← [type, NIL, static[NEW[BOOLEAN ← value]]]]];
END;
needs code!
MakeUnknownBoolean: PROC [code: ProgramGraphNode, rootContext: LocalContextNode] RETURNS [InstanceNode];
BooleanValue: PUBLIC PROC [i: InstanceNode] RETURNS [BOOLEAN] ~ BEGIN
IF Static[i] AND TRUE
THEN RETURN[NARROW[GetConcreteRepresentation[i], REF BOOLEAN]^]
also test to see if its type is boolean
ELSE ERROR SaffronErrorHandling.InternalError["not a boolean instance"];
END;
Character
MakeStaticChar: PROC [value: CHARACTER, rootContext: LocalContextNode] RETURNS [InstanceNode];
MakeUnknownChar: PROC [code: ProgramGraphNode, rootContext: LocalContextNode] RETURNS [InstanceNode];
IsCharacter: PROC [i: InstanceNode] RETURNS [BOOLEAN];
Return TRUE if i is a character instance, FALSE otherwise.
CharacterValue: PROC [i: InstanceNode] RETURNS [CHARACTER];
i must be a static character instance. Return its value.
Rope
MakeStaticRope: PROC [value: ROPE, rootContext: LocalContextNode] RETURNS [InstanceNode];
MakeUnknownRope: PROC [code: ProgramGraphNode, rootContext: LocalContextNode] RETURNS [InstanceNode];
IsRope: PROC [i: InstanceNode] RETURNS [BOOLEAN];
Return TRUE if i is a rope instance, FALSE otherwise.
RopeValue: PROC [i: InstanceNode] RETURNS [ROPE];
i must be a static rope instance. Return its value.
Constructed Types
MakeSubRange: PUBLIC PROC [low, high: InstanceNode, subRangeType: TypeGraphNodeNode] RETURNS [i: InstanceNode] ~ BEGIN
i ← NEW[InstanceNodeBody ← [TRUE, subRangeType, elements]];
MakeList: PUBLIC PROC [elements: LIST OF InstanceNode, listType: TypeGraphNodeNode] RETURNS [i: InstanceNode] ~ BEGIN
-- i ← NEW[InstanceNodeBody ← [listType, NIL, elements]];
-- FOR e: LIST OF InstanceNode ← elements, e.rest WHILE (e.first # NIL) DO
-- IF e.first.Static = FALSE THEN i.Static ← FALSE;
-- IF Incompatible[element.type, listType.elementType] THEN error...
-- ENDLOOP;
-- if this winds up being a not-compile-time-constant, then we need to return consing code.
RETURN [NEW[InstanceNodeBody ← [NIL, NIL, trash[]]]];
END;
Procedure Frame
MakeList: PROC [elements: LIST OF InstanceNode, listType: TypeGraphNodeNode] RETURNS [i: InstanceNode];
END.