SaffronValueImpl.Mesa
Copyright Ó 1988 by Xerox Corporation. All rights reserved.
James Rauen, July 28, 1988 1:36:41 pm PDT
Last edited by: James Rauen August 23, 1988 5:36:09 pm PDT
DIRECTORY
BigIntegers USING [BigINT, BigFromRope, BigFromSmall, RopeFromBig],
IO USING [int, PutF, PutFR, rope, STREAM],
Rope USING [ROPE],
SaffronBaseDef USING [CanCastIntegerValue, ProgramFragmentNode],
SaffronContext USING [],
SaffronContextPrivateTypes,
SaffronErrorHandling USING [Error, InternalError],
SaffronPGDef USING [MakePGPushConstant],
SaffronProgramGraphPrivateTypes USING [ProcedureGraphNodeBody];
SaffronValueImpl:
CEDAR
PROGRAM
IMPORTS BigIntegers, IO, SaffronBaseDef, SaffronErrorHandling, SaffronPGDef
EXPORTS SaffronBaseDef, SaffronContext
= BEGIN
OPEN
BD: SaffronBaseDef,
EH: SaffronErrorHandling,
PG: SaffronPGDef,
PT: SaffronContextPrivateTypes;
TypeGraphNodeNode: TYPE = REF TypeGraphNodeNodeBody;
TypeGraphNodeNodeBody: PUBLIC TYPE = PT.TypeGraphNodeNodeBody;
TypeGraphNodeListNode: TYPE = REF TypeGraphNodeListNodeBody;
TypeGraphNodeListNodeBody: PUBLIC TYPE = PT.TypeGraphNodeListNodeBody;
ValueNode: TYPE = REF ValueNodeBody;
ValueNodeBody: PUBLIC TYPE = PT.ValueNodeBody;
ProcedureGraphNode: TYPE = REF ProcedureGraphNodeBody;
ProcedureGraphNodeBody: PUBLIC TYPE = SaffronProgramGraphPrivateTypes.ProcedureGraphNodeBody;
BigINT: TYPE = BigIntegers.BigINT;
RetrieveIntegerValue:
PUBLIC
PROC [v: ValueNode]
RETURNS [BigINT] =
BEGIN
elementVal: PT.ElementVal ← NARROW[NARROW[v, REF static ValueNodeBody].body];
RETURN[NARROW[elementVal, REF integer base PT.ElementValBody].val];
END;
Static:
PUBLIC
PROC [v: ValueNode]
RETURNS [
BOOLEAN] =
BEGIN
RETURN[ISTYPE[v, REF static ValueNodeBody]];
END;
IsTrash:
PUBLIC
PROC [v: ValueNode]
RETURNS [
BOOLEAN] =
BEGIN
RETURN[ISTYPE[v, REF trash ValueNodeBody]];
END;
ChangeType:
PUBLIC
PROC [v: ValueNode, newType: TypeGraphNodeNode]
RETURNS [ValueNode] =
BEGIN
WITH v
SELECT
FROM
vv:
REF dummy ValueNodeBody =>
ERROR SaffronErrorHandling.InternalError["Tried to change type of dummy value"];
vv:
REF unparsed ValueNodeBody =>
ERROR SaffronErrorHandling.InternalError["Tried to change type of unparsed value"];
vv:
REF static ValueNodeBody => {
vv.type ← newType; RETURN[vv] };
vv:
REF trash ValueNodeBody =>
ERROR SaffronErrorHandling.InternalError["Tried to change type of trash value"];
vv:
REF runtime ValueNodeBody =>
ERROR SaffronErrorHandling.InternalError["Tried to change type of runtime value"];
actually, this should insert code & succeed.
ENDCASE => ERROR;
END;
MakeTrash:
PUBLIC
PROC [tgn: TypeGraphNodeNode]
RETURNS [ValueNode] =
BEGIN
v: REF trash ValueNodeBody ← NEW[trash ValueNodeBody ← [trash[code: NIL, type: tgn]]];
v.code ← PG.MakePGPushConstant[v];
RETURN [v];
END;
MakeDefaultMeValue:
PUBLIC
PROC
RETURNS [ValueNode] =
BEGIN
RETURN [NEW[ValueNodeBody ← [defaultMe[]]]];
END;
MakeRuntimeValue:
PUBLIC
PROC [code:
BD.ProgramFragmentNode, tgn: TypeGraphNodeNode]
RETURNS [ValueNode] =
BEGIN
RETURN [NEW[ValueNodeBody ← [runtime[code, tgn]]]];
END;
Type:
PUBLIC
PROC [v: ValueNode]
RETURNS [TypeGraphNodeNode] =
BEGIN
WITH v
SELECT
FROM
vv:
REF dummy ValueNodeBody =>
ERROR SaffronErrorHandling.InternalError["Tried to find type of dummy value"];
vv:
REF unparsed ValueNodeBody =>
ERROR SaffronErrorHandling.InternalError["Tried to find type of unparsed value"];
vv:
REF static ValueNodeBody =>
RETURN [vv.type];
vv:
REF trash ValueNodeBody =>
RETURN [vv.type];
vv:
REF runtime ValueNodeBody =>
RETURN [vv.type];
actually, this should insert code & succeed.
ENDCASE => ERROR;
END;
Code:
PUBLIC
PROC [v: ValueNode]
RETURNS [
BD.ProgramFragmentNode] =
BEGIN
WITH v
SELECT
FROM
vv:
REF dummy ValueNodeBody =>
ERROR SaffronErrorHandling.InternalError["Tried to find code for dummy value"];
vv:
REF unparsed ValueNodeBody =>
ERROR SaffronErrorHandling.InternalError["Tried to find code for unparsed value"];
vv:
REF static ValueNodeBody =>
RETURN [vv.code];
vv:
REF trash ValueNodeBody =>
RETURN [vv.code];
vv:
REF runtime ValueNodeBody =>
RETURN [vv.code];
actually, this should insert code & succeed.
ENDCASE => ERROR;
END;
ShowValue:
PUBLIC PROC [on:
IO.
STREAM, nest:
INT, value: ValueNode] =
BEGIN
Show just the value, not the type.
WITH value
SELECT
FROM
v: REF dummy ValueNodeBody => on.PutF["Dummy (%g)", IO.rope[v.info]];
v: REF unparsed ValueNodeBody => on.PutF["Unparsed value"];
v: REF defaultMe ValueNodeBody => on.PutF["DEFAULT ME"];
v: REF static ValueNodeBody => ShowStaticValue[on, nest, v];
v: REF trash ValueNodeBody => on.PutF["TRASH"];
v: REF runtime ValueNodeBody => SaffronContext.ShowProgramGraph[on, nest, v.code];
ENDCASE => ERROR;
END;
ShowStaticValue:
PROC [on:
IO.
STREAM, nest:
INT, v:
REF static ValueNodeBody] =
BEGIN
WITH v.body
SELECT
FROM
u: PT.ElementVal => ShowElementVal[on, nest, v];
u: PT.TransferVal => ShowTransferVal[on, nest, v];
ENDCASE => on.PutF["(Static value)"];
END;
Element
ShowElementVal:
PROC [on:
IO.
STREAM, nest:
INT, v:
REF static ValueNodeBody] =
BEGIN
val: PT.ElementVal ← NARROW[v.body];
WITH val
SELECT
FROM
vv:
REF boolean base
PT.ElementValBody =>
on.PutF[IF vv.val THEN "TRUE" ELSE "FALSE"];
vv:
REF character base
PT.ElementValBody =>
on.PutF["(character)"]; -- this could be nicer...
vv:
REF enumerated base
PT.ElementValBody =>
on.PutF["(enumerated value)"];
vv:
REF integer base
PT.ElementValBody =>
on.PutF[BigIntegers.RopeFromBig[vv.val]];
vv:
REF subrange
PT.ElementValBody =>
on.PutF["(subrange value)"];
ENDCASE;
END;
Succ:
PUBLIC
PROC [v: ValueNode]
RETURNS [ValueNode] =
BEGIN
WITH v
SELECT
FROM
vv:
REF static ValueNodeBody => {
val: PT.ElementVal ← NARROW[vv.body];
RETURN [v];
};
vv:
REF runtime ValueNodeBody => {
RETURN [v];
};
ENDCASE => ERROR EH.InternalError["Succ of something bad"];
Pred:
PUBLIC
PROC [v: ValueNode]
RETURNS [ValueNode] =
BEGIN
WITH v
SELECT
FROM
vv:
REF static ValueNodeBody => {
val: PT.ElementVal ← NARROW[vv.body];
RETURN [v];
};
vv:
REF runtime ValueNodeBody => {
RETURN [v];
};
ENDCASE => ERROR EH.InternalError["Pred of something bad"];
CastIntegerValue:
PUBLIC
PROC [value: BigINT, types: TypeGraphNodeListNode]
RETURNS [ValueNode] ~
BEGIN
result: REF static ValueNodeBody ← NIL;
FOR typeList:
LIST
OF TypeGraphNodeNode ← types^, typeList.rest
WHILE ((typeList #
NIL)
AND (result =
NIL)
) DO
IF
BD.CanCastIntegerValue[value, typeList.first]
THEN {
result ← NEW [static ValueNodeBody ← [static[
code: NIL,
type: typeList.first,
body: NEW[PT.ElementValBody ← [base[integer[value]]]]
]]];
result.code ← PG.MakePGPushConstant[result];
};
ENDLOOP;
IF result = NIL THEN {
SIGNAL SaffronErrorHandling.Error[0, IO.PutFR["Integer value %g exceeds the capacity of all integer types.", IO.rope[BigIntegers.RopeFromBig[value]]]];
result ← NEW [static ValueNodeBody ← [static[
code: NIL,
type: types^.first,
body: NEW[PT.ElementValBody ← [base[integer[BigIntegers.BigFromSmall[0]]]]]
]]];
};
result.code ← SaffronPGDef.MakePGPushConstant[result];
RETURN [result];
END;
ParseIntegerLiteral:
PUBLIC
PROC [text: Rope.
ROPE, radix:
INT]
RETURNS [BigINT] =
BEGIN
RETURN [BigIntegers.BigFromRope[text, radix]];
END;
MakeStaticBoolean:
PUBLIC
PROC [value:
BOOLEAN, type: TypeGraphNodeNode]
RETURNS [ValueNode] =
BEGIN
result:
REF static ValueNodeBody ← NEW [static ValueNodeBody ← [static[
code: NIL,
type: type,
body: NEW[PT.ElementValBody ← [base[boolean[value]]]]
]]];
result.code ← SaffronPGDef.MakePGPushConstant[result];
RETURN [result];
END;
BooleanValue:
PUBLIC
PROC [v: ValueNode]
RETURNS [
BOOLEAN] =
BEGIN
elementVal: PT.ElementVal ← NARROW[NARROW[v, REF static ValueNodeBody].body];
RETURN[NARROW[elementVal, REF boolean base PT.ElementValBody].val];
END;
MakeStaticCharacter:
PUBLIC
PROC [value:
CHARACTER, type: TypeGraphNodeNode]
RETURNS [ValueNode] =
BEGIN
result: REF static ValueNodeBody ← NEW [static ValueNodeBody ← [static[
code:
NIL,
type: type,
body: NEW[PT.ElementValBody ← [base[character[value]]]]
]]];
result.code ← SaffronPGDef.MakePGPushConstant[result];
RETURN [result];
END;
CharacterValue:
PUBLIC
PROC [v: ValueNode]
RETURNS [
CHARACTER] =
BEGIN
elementVal: PT.ElementVal ← NARROW[NARROW[v, REF static ValueNodeBody].body];
RETURN[NARROW[elementVal, REF character base PT.ElementValBody].val];
END;
Transfer
MakeTransferValue:
PUBLIC
PROC [type: TypeGraphNodeNode, code: ProcedureGraphNode]
RETURNS [ValueNode] =
BEGIN
result: REF static ValueNodeBody ← NEW [static ValueNodeBody ← [static[
code:
NIL,
type: type,
body: NEW[PT.TransferValBody ← [code]]
]]];
result.code ← SaffronPGDef.MakePGPushConstant[result];
RETURN [result];
END;
ShowTransferVal:
PROC [on:
IO.
STREAM, nest:
INT, v:
REF static ValueNodeBody] =
BEGIN
val: PT.TransferVal ← NARROW[v.body];
on.PutF[
SELECT
NARROW[v.type.body,
REF
PT.TransferTGNBody].mode
FROM
proc => "PROCEDURE",
port => "PORT",
signal => "SIGNAL",
error => "ERROR",
process => "PROCESS",
program => "PROGRAM"
ENDCASE => ERROR
];
on.PutF[" descriptor %g", IO.int[LOOPHOLE[val.code.code]]];
show an address & lc, maybe?
END;