EnumTypesImpl.Mesa
Last Edited by: Spreitzer, March 10, 1984 1:26:35 pm PST
Last Edited by: McCreight, March 8, 1984 7:02:23 pm PST
DIRECTORY AMBridge, AMMiniModel, AMTypes, Atom, FS, Basics, BasicTime, IO, EnumTypes, Rope, RoseTranslateTypes, RoseTypes, RuntimeError, SignalTypeRegistration, VFonts;
EnumTypesImpl:
CEDAR
PROGRAM
IMPORTS AMBridge, AMMiniModel, AMTypes, Atom, FS, Basics, BasicTime, IO, Rope, RoseTranslateTypes, RuntimeError, SignalTypeRegistration, VFonts
EXPORTS EnumTypes =
BEGIN
ROPE: TYPE = Rope.ROPE;
WordPtr: TYPE = RoseTypes.WordPtr;
NodeType: TYPE = RoseTypes.NodeType;
NodeTypeRep: TYPE = RoseTypes.NodeTypeRep;
Format: TYPE = RoseTypes.Format;
Node: TYPE = RoseTypes.Node;
NodeTestProc: TYPE = RoseTypes.NodeTestProc;
NodeTestData: TYPE = RoseTypes.NodeTestData;
ETData: TYPE = REF ETDataRep;
ETDataRep:
TYPE =
RECORD [
fileSinceEpoch: LONG CARDINAL,
interface, type: ROPE,
amType: AMTypes.Type,
bits: CARDINAL
];
enumTypeProcs: RoseTypes.NodeProcs ←
NEW [RoseTypes.NodeProcsRep ← [
Bits: EnumTypeBits,
MesaUse: EnumTypeMesaUse,
MesaDefinition: EnumTypeMesaDefinition,
UserDescription: EnumTypeUserDescription,
MesaDescription: EnumTypeMesaDescription,
ListFormats: EnumTypeListFormats,
GetFormat: EnumTypeGetFormat]];
ConstructEnumType: RoseTranslateTypes.NodeTypeConstructor
--PROC [parms: REF ANY - -UNION [BindingList, Args]- -] RETURNS [type: NodeType]-- =
BEGIN
name: RoseTranslateTypes.Quoted ← NARROW[RoseTranslateTypes.GetParm[n: 1, name: "name", parms: parms]];
type ← EnumType[name.rope];
END;
EnumType:
PUBLIC
PROC [etName:
ROPE]
RETURNS [nt: NodeType] =
BEGIN
interface, type: ROPE;
atom: ATOM;
md: ETData;
fileTime: BasicTime.GMT;
fileSinceEpoch: LONG CARDINAL;
fileExists: BOOLEAN ← TRUE;
periodPos: INT;
iType, enumType: AMTypes.Type;
nComponents: NAT;
maxValue: CARDINAL ← 0;
bits: CARDINAL ← 0;
powBits: INT;
atom ← Atom.MakeAtom[etName];
nt ← NARROW[Atom.GetProp[atom: atom, prop: $enumTypeRoseImpl]];
periodPos ← etName.Find["."];
WHILE periodPos<0
DO
etName ← Rope.Concat["Dragon.", etName];
periodPos ← etName.Find["."];
ENDLOOP;
interface ← etName.Substr[0, periodPos];
type ← etName.Substr[periodPos+1, etName.Length[]-(periodPos+1)];
IF interface.Length=0 OR type.Length=0 THEN ERROR;
fileTime ← FS.FileInfo[interface.Concat[".bcd"]
! FS.Error => {fileExists ← FALSE; CONTINUE}].created;
IF NOT fileExists THEN ERROR;
fileSinceEpoch ← BasicTime.Period[from: BasicTime.earliestGMT, to: fileTime];
IF nt #
NIL
THEN
BEGIN
et: ETData ← NARROW[nt.typeData];
IF fileSinceEpoch = et.fileSinceEpoch THEN RETURN; -- it's still good
END;
iType ← AMMiniModel.AcquireIRType[defsName: interface.Concat[".bcd"]];
nComponents ← AMTypes.NComponents[iType];
FOR i:
NAT
IN [1..nComponents]
DO
BEGIN ENABLE RuntimeError.UNCAUGHT => LOOP;
compType: AMTypes.Type = AMTypes.IndexToType[iType, i];
SELECT AMTypes.UnderClass[compType]
FROM
type =>
IF Rope.Equal[AMTypes.IndexToName[iType, i], type]
THEN
BEGIN
enumType ← AMTypes.UnderType[AMTypes.TVToType[AMTypes.IndexToDefaultInitialValue[iType, i]]];
IF AMTypes.TypeClass[enumType]#enumerated THEN LOOP;
maxValue ← AMTypes.NValues[enumType]-1;
EXIT; -- we found our type
END;
ENDCASE => NULL;
END; -- of ENABLE block
REPEAT
FINISHED => ERROR; -- couldn't find that type
ENDLOOP;
powBits ← 2;
FOR bits ← 1, bits+1
DO
IF maxValue<powBits
THEN
EXIT;
powBits ← 2*powBits;
ENDLOOP;
md ←
NEW [ETDataRep ← [
fileSinceEpoch: fileSinceEpoch,
interface: interface,
type: type,
amType: enumType,
bits: bits]];
nt ←
NEW [NodeTypeRep ← [
procs: enumTypeProcs,
typeData: md,
structure: atom[] ]];
Atom.PutProp[atom: atom, prop: $enumTypeRoseImpl, val: nt];
END;
EnumTypeBits:
PROC [nt: NodeType]
RETURNS [bits:
INTEGER] =
{md: ETData ← NARROW[nt.typeData]; bits ← md.bits};
EnumTypeMesaUse:
PROC [nt: NodeType]
RETURNS [m: RoseTypes.Mesa] =
{md: ETData ← NARROW[nt.typeData]; m ← [md.type]};
EnumTypeMesaDefinition:
PROC [nt: NodeType]
RETURNS [m: RoseTypes.Mesa] = {
md: ETData ← NARROW[nt.typeData];
m ← [
mesa: md.type.Cat[": TYPE = ", md.interface, ".", md.type],
directory: LIST[md.interface]]};
EnumTypeUserDescription:
PROC [nt: NodeType]
RETURNS [ud:
ROPE] =
{md: ETData ← NARROW[nt.typeData];
ud ← Rope.Cat["EnumType[\"", md.interface.Cat[".", md.type], "\"]"]};
EnumTypeMesaDescription:
PROC [nt: NodeType]
RETURNS [m: RoseTypes.Mesa] =
{md: ETData ← NARROW[nt.typeData];
m ← [
mesa: Rope.Cat["EnumTypes.EnumType[\"", md.interface.Cat[".", md.type], "\"]"],
imports: LIST["EnumTypes"]]};
EnumTypeListFormats:
PROC [NodeType]
RETURNS [rl: RoseTypes.RopeList] =
{rl ← LIST["et"]};
EnumTypeGetFormat:
PROC [NodeType,
ROPE]
RETURNS [Format] =
{RETURN [enumTypeFormat]};
enumTypeFormat: RoseTypes.Format ←
NEW [RoseTypes.FormatRep ← [
FormatValue: EnumTypeFormatValue,
ParseValue: EnumTypeParseValue,
FormatTest: EnumTypeFormatTest,
ParseTest: EnumTypeParseTest,
MaxWidth: EnumTypeMaxWidth,
formatData: NIL,
key: "et"]];
EnumTypeFormatValue:
PROC [node: Node, format: Format, where: WordPtr]
RETURNS [rope:
ROPE] =
BEGIN
md: ETData ← NARROW[node.type.typeData];
index: CARDINAL;
TRUSTED {index ← Basics.
BITAND[where^, masks[md.bits]]};
BEGIN ENABLE AMTypes.Error => IF reason=badIndex THEN GOTO NoName ELSE REJECT;
RETURN[AMTypes.TVToName[AMTypes.Value[md.amType, index+1]]];
EXITS NoName => NULL;
END;
RETURN ["??"];
END;
masks: ARRAY [0..16] OF CARDINAL = [0, 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, 4095, 8191, 16383, 32767, 65535];
EnumTypeParseValue:
PROC [node: Node, format: Format, where: WordPtr, from:
IO.
STREAM]
RETURNS [success:
BOOLEAN] =
BEGIN
md: ETData ← NARROW[node.type.typeData];
i: CARDINAL;
rope: ROPE ← from.GetTokenRope[].token;
[i, success] ← Lookup[md, rope];
IF success THEN TRUSTED {where^ ← i};
END;
Lookup:
PROC [md: ETData, rope:
ROPE]
RETURNS [index:
CARDINAL, success:
BOOLEAN] =
BEGIN
FOR tv: AMTypes.
TV ← AMTypes.First[md.amType], AMTypes.Next[tv]
WHILE tv#
NIL
DO
BEGIN
IF Rope.Equal[rope, AMTypes.TVToName[tv
! AMTypes.Error =>
IF reason=badIndex
THEN
GOTO NoName
ELSE
REJECT]]
THEN
TRUSTED BEGIN
value: CARDINAL = AMBridge.TVToCardinal[tv];
RETURN[value, TRUE];
END;
EXITS NoName => NULL;
END;
ENDLOOP;
success ← FALSE; index ← 0;
END;
EnumTypeMaxWidth:
PROC [nodeType: NodeType, format: Format, font: VFonts.Font]
RETURNS [
INT] =
BEGIN
md: ETData ← NARROW[nodeType.typeData];
mw: INT ← VFonts.StringWidth["??"];
FOR tv: AMTypes.
TV ← AMTypes.First[md.amType], AMTypes.Next[tv]
WHILE tv#
NIL
DO
mw ←
MAX[mw, VFonts.StringWidth[AMTypes.TVToName[tv
! AMTypes.Error => IF reason=badIndex THEN CONTINUE ELSE REJECT], font]];
ENDLOOP;
RETURN [mw];
END;
EnumTypeParseTest:
PROC [nodeType: NodeType, format: Format, from:
IO.
STREAM]
RETURNS [success:
BOOLEAN, testProc: NodeTestProc, testData: NodeTestData] =
BEGIN
md: ETData ← NARROW[nodeType.typeData];
i: CARDINAL;
rope: ROPE ← from.GetTokenRope[].token;
[i, success] ← Lookup[md, rope];
IF success THEN testData ← NEW [CARDINAL ← i] ELSE testData ← NIL;
testProc ← TestEnumType;
END;
EnumTypeFormatTest:
PROC [nodeType: NodeType, format: Format, testProc: NodeTestProc, testData: NodeTestData]
RETURNS [rope:
ROPE] =
BEGIN
md: ETData ← NARROW[nodeType.typeData];
rc: REF CARDINAL ← NARROW[testData];
IF rc #
NIL
THEN
BEGIN ENABLE AMTypes.Error => IF reason=badIndex THEN GOTO NoName ELSE REJECT;
RETURN[AMTypes.TVToName[AMTypes.Value[md.amType, rc^+1]]];
EXITS NoName => NULL;
END;
RETURN["??"];
END;
TestEnumType: RoseTypes.NodeTestProc
--PROC [where: WordPtr, testData: NodeTestData, nodeType: NodeType] RETURNS [passes: BOOLEAN]-- =
BEGIN
rc: REF CARDINAL ← NARROW[testData];
md: ETData ← NARROW[nodeType.typeData];
TRUSTED {passes ← rc^ = Basics.BITAND[where^, masks[md.bits]]};
END;
SignalTypeRegistration.RegisterNodeTypeConstructor["EnumType", ConstructEnumType];
END.