Semantic analysis
AnalyzeModule:
PUBLIC
PROC [context: Context, tree: Tree] = {
M:
PROC [directory, imports, exports, shares, locks, decl:
REF] = {
self: AttributedNode = NARROW[tree];
{
Action:
PROC [item: Tree] = {
AddDirectoryItem[context, item];
}; DoList[directory, Action]};
IF shares # NIL THEN ProcessSharesList[context, shares];
IF imports # NIL THEN ProcessModuleList[context, imports, TRUE];
IF exports # NIL THEN ProcessModuleList[context, exports, FALSE];
Assert[AnalyzeDecl[context, decl, self, 1]];
Assert[AnalyzeDecl[context, decl, self, 2]];
Assert[AnalyzeDecl[context, decl, self, 3]];
PropagateAttribute[self, $TYPECODE, NARROW[decl], $DECLTYPECODE];
};
Assert[With6[tree, module, M]];
};
AnalyzeDecl:
PUBLIC
PROC [context: Context, tree: Tree, parent: AttributedNode, pass: [1..3]]
RETURNS [
BOOL] = {
Pass 1 defines the name in the context, with a null type code.
Pass 2 assigns the type code, but with the type graph present only in skeleton form.
Pass 3 analyzes the value.
D:
PROC [idNode, typeNode, valueNode:
REF] = {
self: AttributedNode = NARROW[tree];
Each:
PROC [item: Tree] = {
id: ROPE = GetIdentifier[item];
SELECT pass
FROM
1 => {
ste: REF SymbolTableEntryRep.other ¬ NEW[SymbolTableEntryRep.other];
SELECT context.scopeKind
FROM
globalDefs => ste.qualifier ¬ context.moduleName;
globalImpl => {
publicType: TypeCode ¬ nullTypeCode;
IF GetAttribute[tree, $PUBLIC] # NIL THEN [ste.qualifier, publicType] ¬ FindExportee[context, id];
WITH UnderType[context.types, publicType]
SELECT
FROM
t: REF TypeRep.control => AddAttribute[NARROW[typeNode], $PARAMETERDEFAULTS, ParameterDefaults[context.types, t]];
ENDCASE => NULL;
IF publicType # nullTypeCode THEN AddTypeCodeAttribute[self, $PUBLICTYPECODE, publicType];
IF ste.qualifier = NIL THEN ste.qualifier ¬ context.moduleName;
};
ENDCASE => NULL;
QualifyIdentifierNode[item, ste.qualifier];
ste.typeCode ¬ nullTypeCode;
ste.readonly ¬ GetAttribute[self, $CONSTANT]=$TRUE;
AddSymbol[context, id, ste];
IF context.moduleName = NIL THEN context.moduleName ¬ id;
};
2 => {
ste: REF SymbolTableEntryRep.other ¬ NARROW[LookupSymbol[context, id]];
ste.typeCode ¬ GetTypeValueAttribute[context.types, typeNode];
IF context.fieldListLast #
NIL
THEN {
add: FieldList = LIST[[id, ste.typeCode]];
context.fieldListLast.rest ¬ add;
context.fieldListLast ¬ add;
};
};
ENDCASE => NULL;
};
IF pass = 2 THEN Assert[AnalyzeTypePass[context, typeNode, 1], "AnalyzeTypePass(%g)", [cardinal[pass]], typeNode];
DoList[idNode, Each];
IF pass >= 2 THEN Assert[AnalyzeTypePass[context, typeNode, pass],"AnalyzeTypePass(%g)", [cardinal[pass]], typeNode];
IF pass = 3
THEN {
typeCode: TypeCode = GetTypeValueAttribute[context.types, typeNode];
AddTypeCodeAttribute[self, $DECLTYPECODE, typeCode];
IF valueNode #
NIL
THEN {
PropagateAttribute[valueNode, $NEEDTYPECODE, self, $DECLTYPECODE];
WITH UnderType[context.types, typeCode]
SELECT
FROM
c:
REF TypeRep.control => {
IF c.class = $PROC
AND GetNodeName[typeNode] # $PROCTC
THEN {
Supply attributes telling the names of the arguments and results
AddAttribute[NARROW[typeNode], $PROCTYPE, ExternalProcType[context.types, c]];
};
};
ENDCASE => NULL;
CrankAnalyze.AnalyzeBodyOrExpression[context, valueNode, self, 1];
CrankAnalyze.AnalyzeBodyOrExpression[context, valueNode, self, 2];
CrankAnalyze.AnalyzeBodyOrExpression[context, valueNode, self, 3];
WITH TypeFromTypeCode[context.types, GetTypeCodeAttribute[self, $DECLTYPECODE]]
SELECT
FROM
d:
REF TypeRep.record => {
IF d.class = $DEFINITIONS
THEN {
remove the list head created by AnalyzeBodyOrExpression
IF d.fieldList =
NIL
OR d.fieldList.first # [
NIL, nullTypeCode]
THEN { Assert[FALSE, "Bug"] }
ELSE { d.fieldList ¬ d.fieldList.rest };
};
};
ENDCASE => NULL;
};
};
};
RETURN[With3[tree, decl, D]];
};
AnalyzeTypeDecl:
PUBLIC
PROC [context: Context, tree: Tree, parent: AttributedNode, pass: [1..3]]
RETURNS [
BOOL] = {
Pass 1 defines the name(s) in context, assigning a type code.
Pass 2 fills in the type.
Pass 3 analyzes the initial value.
D:
PROC [identifierNode, typeNode, initialValueNode:
REF] = {
self: AttributedNode = NARROW[tree];
Each:
PROC [item: Tree] = {
id: ROPE = GetIdentifier[item];
SELECT pass
FROM
1 => {
typeCode: TypeCode = NewDefinitionType[typeGraph: context.types, qualifier: context.moduleName, shortName: id, groundType: nullTypeCode];
typeTypeCode: TypeCode = NewTypeType[context.types, typeCode];
ste: REF SymbolTableEntryRep.other = NEW[SymbolTableEntryRep.other ¬ [other[typeCode: typeTypeCode, readonly: TRUE]]];
IF context.scopeKind = globalImpl
AND GetAttribute[tree, $PUBLIC] #
NIL
THEN {
ste.qualifier ¬ TryExportingType[context, id, typeCode];
};
AddSymbol[context, id, ste];
};
2 => {
ste: REF SymbolTableEntryRep.other = NARROW[LookupSymbol[context, id]];
typeType: REF TypeRep.type = NARROW[TypeFromTypeCode[context.types, ste.typeCode]];
type: REF TypeRep.definition = NARROW[TypeFromTypeCode[context.types, typeType.value]];
type.groundType ¬ GetTypeValueAttribute[context.types, typeNode];
IF initialValueNode #
NIL
THEN {
type.groundType ¬ NewInitialType[context.types, context.moduleName, initialValueNode, type.groundType];
};
IF ste.qualifier =
NIL
THEN {
ste.qualifier ¬ GetTypeQualifier[context, type.typeCode, id];
};
QualifyIdentifierNode[item, ste.qualifier];
IF context.fieldListLast #
NIL
THEN {
add: FieldList = LIST[[id, typeType.typeCode]];
context.fieldListLast.rest ¬ add;
context.fieldListLast ¬ add;
};
};
ENDCASE => NULL;
};
IF pass = 2 THEN Assert[AnalyzeTypePass[context, typeNode, 1]];
IF pass <= 2 THEN DoList[identifierNode, Each];
IF pass = 2 THEN Assert[AnalyzeTypePass[context, typeNode, 2]];
IF pass = 3 THEN AnalyzeInitialValue[context, typeNode, initialValueNode];
};
RETURN[With3[tree, typedecl, D]];
};
FieldListFromEnumeration:
PUBLIC
PROC [items:
LIST
OF EnumerationItem, rangeType: TypeCode]
RETURNS [FieldList] = {
RETURN [
IF items = NIL
THEN NIL ELSE
CONS[[name: items.first.name, rangeType: rangeType], FieldListFromEnumeration[items.rest, rangeType]]
]
};
AnalyzeFieldList:
PUBLIC
PROC [context: Context, fieldListNode: Tree]
RETURNS [FieldList] = {
fieldList: FieldList ¬ NIL;
last: FieldList ¬ NIL;
Append:
PROC [f: FieldListItem] = {
Ought to check for duplicates here.
IF last =
NIL
THEN last ¬ fieldList ¬ LIST[f]
ELSE {last.rest ¬ LIST[f]; last ¬ last.rest};
};
Each:
PROC [fieldListEntryNode: Tree] = {
FieldDecl:
PROC [idsNode, typeNode, valueNode: Tree] = {
EachId:
PROC [fieldNameNode: Tree] = {
id: ROPE ¬ NIL;
rangeType: TypeCode ¬ nullTypeCode;
Item:
PROC [idNode, constantNode: Tree] = {
This is for the machine-dependent case.
For now, we ignore constantNode, which may be a constant expression (the word offset) or an item whose first component is a word offset and whose second component is an item containing the first and last bit numbers.
id ¬ IF idNode # NIL THEN GetIdentifier[idNode] ELSE NIL;
};
IF NOT With2[fieldNameNode, item, Item] AND fieldNameNode # NIL THEN id ¬ GetIdentifier[fieldNameNode];
rangeType ¬ GetTypeValueAttribute[context.types, typeNode];
IF valueNode #
NIL
THEN {
rangeType ¬ NewInitialType[context.types, context.moduleName, valueNode, rangeType];
};
Append[[name: id, rangeType: rangeType]];
};
AnalyzeType2[context, typeNode];
AddTypeCodeAttribute[fieldListEntryNode, $DECLTYPECODE, GetTypeValueAttribute[context.types, typeNode]];
IF idsNode =
NIL
THEN Append[[name: NIL, rangeType: GetTypeValueAttribute[context.types, typeNode]]]
ELSE DoList[idsNode, EachId];
};
Assert[With3[fieldListEntryNode, decl, FieldDecl]];
};
DoList[fieldListNode, Each];
RETURN [fieldList]
};
AnalyzeFieldListValues:
PROC [context: Context, fieldListNode: Tree] = {
Each:
PROC [fieldListEntryNode: Tree] = {
FieldDecl:
PROC [idsNode, typeNode, valueNode: Tree] = {
AnalyzeInitialValue[context, typeNode, valueNode];
};
Assert[With3[fieldListEntryNode, decl, FieldDecl]];
};
DoList[fieldListNode, Each];
};
AnalyzeVariantList:
PUBLIC
PROC [context: Context, variantListNode: Tree]
RETURNS [VariantList] = {
variantList: VariantList ¬ NIL;
last: VariantList ¬ NIL;
Append:
PROC [f: VariantListItem] = {
Ought to check for duplicates here.
IF last =
NIL
THEN last ¬ variantList ¬ LIST[f]
ELSE {last.rest ¬ LIST[f]; last ¬ last.rest};
};
Each:
PROC [variantListEntryNode: Tree] = {
VariantDecl:
PROC [idsNode, typeNode, valueNode: Tree] = {
fieldList: FieldList ¬ NIL;
VariantTC:
PROC [fieldListNode: Tree] = {
fieldList ¬ AnalyzeFieldList[context, fieldListNode];
};
EachId:
PROC [idNode: Tree] = {
tagId: ROPE = GetIdentifier[idNode];
Append[[value: tagId, chooses: fieldList]];
};
Assert[With1[typeNode, variantTC, VariantTC]];
Assert[valueNode=NIL, "initial value on variant part ignored",,variantListEntryNode];
DoList[idsNode, EachId];
};
Assert[With3[variantListEntryNode, typedecl, VariantDecl]];
};
DoList[variantListNode, Each];
RETURN [variantList]
};
AnalyzeVariantListValues:
PUBLIC
PROC [context: Context, variantListNode: Tree] = {
Each:
PROC [variantListEntryNode: Tree] = {
VariantDecl:
PROC [idsNode, typeNode, valueNode: Tree] = {
VariantTC:
PROC [fieldListNode: Tree] = {
AnalyzeFieldListValues[context, fieldListNode];
};
Assert[With1[typeNode, variantTC, VariantTC]];
Assert[valueNode=NIL, "Initial value on variant part ignored",,variantListEntryNode];
};
Assert[With3[variantListEntryNode, typedecl, VariantDecl]];
};
DoList[variantListNode, Each];
};
AnalyzeInitialValue:
PROC [context: Context, typeNode, valueNode:
REF] = {
[] ¬ AnalyzeTypePass[context, typeNode, 3];
IF valueNode #
NIL
THEN {
typeCode: TypeCode = GetTypeValueAttribute[context.types, typeNode];
AddTypeCodeAttribute[valueNode, $NEEDTYPECODE, typeCode];
WITH UnderType[context.types, typeCode]
SELECT
FROM
c: REF TypeRep.control => NULL;
ENDCASE => {
Assert[CrankAnalyze.AnalyzeExpression[context, valueNode],"Expr expected",,valueNode];
};
};
};
GetLink:
SIGNAL
RETURNS [TypeCode] =
CODE;
-- for linkTC nested in listTC; sorry about this
AnalyzeType:
PUBLIC
PROC [context: Context, tree: Tree] = {
Assert[AnalyzeTypePass[context, tree, 1],"Need type",,tree];
[] ¬ AnalyzeTypePass[context, tree, 2];
[] ¬ AnalyzeTypePass[context, tree, 3];
};
AnalyzeType2:
PROC [context: Context, tree: Tree] = {
Assert[AnalyzeTypePass[context, tree, 1],"Need type",,tree];
[] ¬ AnalyzeTypePass[context, tree, 2];
};
AnalyzeTypePass:
PUBLIC
PROC [context: Context, tree: Tree, pass: [1..3]]
RETURNS [
BOOL] = {
Pass 1 assigns the $TYPECODE attribute and creates an entry in the type graph.
Pass 2 fills it in, assuming the other symbols in the context are at least partially defined
Pass 3 analyzes the initial value of component types, and fills in qualifiers
self: AttributedNode = NARROW[tree];
IndicateTypeCode:
PROC [typeCode: TypeCode] = {
AddTypeCodeAttribute[self, $TYPECODE, NewTypeType[context.types, typeCode]];
};
IndicateType:
PROC [type: Type] = {
IndicateTypeCode[NewType[context.types, type]];
};
ReferenceTypes:
PROC
RETURNS [
BOOL] = {
ReferenceTC:
PROC [referentTypeNode:
REF] = {
SELECT pass
FROM
1 => {
IndicateTypeCode[NewReferenceType[context.types, nullTypeCode, SELECT GetNodeName[self] FROM $REFTC => $REF, $POINTERTC => $POINTER, $LISTTC => $LIST, ENDCASE => NIL]];
};
2 => {
type: REF TypeRep.reference ¬ NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
AnalyzeType2[context, referentTypeNode
! GetLink => {RESUME[type.typeCode]} -- for linkTC nested in listTC; sorry about this
];
type.referentType ¬ GetTypeValueAttribute[context.types, referentTypeNode];
The following confused Dot interpretation, so we don't do it.
IF GetNodeName[self] = $LISTTC THEN {
WITH TypeFromTypeCode[context.types, type.referentType] SELECT FROM
r: REF TypeRep.record => {
-- Referents of LIST types are unpainted. It is OK to reach down and smash this, because the recordTC node was generated by the parser, and so nobody else can refer to it.
r.class ← $STRUCTURE;
};
ENDCASE => Assert[FALSE];
};
};
3 => { [] ¬ AnalyzeTypePass[context, referentTypeNode, 3] };
ENDCASE;
};
RelativeTC:
PROC [baseTypeNode, referentTypeNode:
REF] = {
SELECT pass
FROM
1 => {
IndicateTypeCode[NewReferenceType[context.types, nullTypeCode, $RELATIVEPOINTER]];
};
2 => {
type: REF TypeRep.reference ¬ NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
AnalyzeType2[context, baseTypeNode];
Should check for a base pointer.
AnalyzeType2[context, referentTypeNode];
type.referentType ¬ GetTypeValueAttribute[context.types, referentTypeNode];
};
3 => {
[] ¬ AnalyzeTypePass[context, baseTypeNode, 3];
[] ¬ AnalyzeTypePass[context, referentTypeNode, 3];
};
ENDCASE;
};
RETURN [With1[self, refTC, ReferenceTC] OR With1[self, pointerTC, ReferenceTC] OR With1[self, listTC, ReferenceTC] OR With2[self, relativeTC, RelativeTC]];
};
LinkTC:
PROC = {
SELECT pass
FROM
1 => {
IndicateTypeCode[SIGNAL GetLink]; -- sorry about this
};
ENDCASE;
};
ZoneTC:
PROC = {
IF pass = 1 THEN IndicateType[NEW[TypeRep.simple ¬ [class: $ZONE, v: simple[]]]];
};
ArraydescTC:
PROC [referentTypeNode:
REF] = {
IF pass = 1 THEN IndicateType[NEW[TypeRep.array ¬ [class: $ARRAYDESCRIPTOR, v: array[domainType: nullTypeCode, rangeType: nullTypeCode]]]];
};
LongTC:
PROC [referentTypeNode:
REF] = {
Assert[AnalyzeTypePass[context, referentTypeNode, pass]];
IF pass = 1
THEN {
referentTypeCode: TypeCode = GetTypeValueAttribute[context.types, referentTypeNode];
referentType: REF TypeRep = UnderType[context.types, referentTypeCode];
type: REF TypeRep ¬ NIL;
WITH referentType
SELECT
FROM
t:
REF TypeRep.array => {
IF GetNodeName[referentTypeNode] = $ARRAYDESCTC
THEN {
type ¬ t; type.class ¬ $LONGARRAYDESCRIPTOR
};
};
t:
REF TypeRep.reference => {
SELECT t.class
FROM
$POINTER => IF GetNodeName[referentTypeNode] = $POINTERTC THEN { type ¬ t; type.class ¬ $LONGPOINTER };
$REF, $LIST => { type ¬ referentType };
ENDCASE => NULL;
};
t:
REF TypeRep.scalar => {
SELECT t.class
FROM
$INT16 => {
type ¬ UnderType[context.types, LookupTypeCode[Root[context], "INT32"]]
};
$CARD16 => {
type ¬ UnderType[context.types, LookupTypeCode[Root[context], "CARD32"]]
};
ENDCASE => NULL;
};
ENDCASE => NULL;
Assert[type # NIL, "LONG unimplemented in this context",,self];
IF type = NIL THEN RETURN;
IF type = referentType
THEN IndicateTypeCode[referentTypeCode]
ELSE IndicateType[type];
};
};
ArrayTC:
PROC [domainTypeNode, rangeTypeNode:
REF] = {
SELECT pass
FROM
1 => {
type: REF TypeRep.array = NEW[TypeRep.array ¬ [class: $ARRAY, v: array[domainType: nullTypeCode, rangeType: nullTypeCode]]];
IndicateType[type];
};
2 => {
type: REF TypeRep.array = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
AnalyzeType2[context, domainTypeNode];
AnalyzeType2[context, rangeTypeNode];
type.domainType ¬ GetTypeValueAttribute[context.types, domainTypeNode];
type.rangeType ¬ GetTypeValueAttribute[context.types, rangeTypeNode];
AddTypeCodeAttribute[rangeTypeNode, $DECLTYPECODE, type.rangeType];
};
3 => {
[] ¬ AnalyzeTypePass[context, domainTypeNode, 3];
[] ¬ AnalyzeTypePass[context, rangeTypeNode, 3];
};
ENDCASE;
};
SubrangeTC:
PROC [groundTypeNode, intervalNode:
REF] = {
SELECT pass
FROM
1 => {
type: REF TypeRep.subrange = NEW[TypeRep.subrange];
type.class ¬ $SUBRANGE;
IndicateType[type];
};
2 => {
type: REF TypeRep.subrange = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
first: DINT ¬ DINT.FIRST;
last: DINT ¬ DINT.LAST;
groundTypeCode: TypeCode ¬ nullTypeCode;
Interval:
PROC [lowNode, highNode:
REF] = {
AddTypeCodeAttribute[lowNode, $NEEDTYPECODE, groundTypeCode];
PropagateAttribute[highNode, $NEEDTYPECODE, NARROW[lowNode], $NEEDTYPECODE];
Assert[CrankAnalyze.AnalyzeExpression[context, lowNode],"low not an expr",,self];
Assert[CrankAnalyze.AnalyzeExpression[context, highNode],"high not an expr",,self];
first ¬ GetSimpleConstant[context, lowNode ! Error => CONTINUE];
last ¬ GetSimpleConstant[context, highNode ! Error => CONTINUE];
};
RefFromInt:
PROC [int:
DINT]
RETURNS [
REF] ~ {
SELECT int
FROM
IN DINT[INT.FIRST..INT.LAST] => RETURN [NEW[INT ¬ int]];
IN DINT[CARD.FIRST..CARD.LAST] => RETURN [NEW[CARD ¬ int]];
ENDCASE => RETURN [NEW[DINT ¬ int]];
};
AnalyzeType2[context, groundTypeNode];
groundTypeCode ¬ GetTypeValueAttribute[context.types, groundTypeNode];
SELECT
TRUE
FROM
With2[intervalNode, intOO, Interval] => { first ¬ first+1; last ¬ last-1 };
With2[intervalNode, intCO, Interval] => { last ¬ last-1 };
With2[intervalNode, intOC, Interval] => { first ¬ first+1 };
With2[intervalNode, intCC, Interval] => NULL;
ENDCASE => Assert[FALSE];
type.groundType ¬ groundTypeCode;
type.first ¬ RefFromInt[first];
type.last ¬ RefFromInt[last];
};
3 => { [] ¬ AnalyzeTypePass[context, groundTypeNode, 3] };
ENDCASE;
};
DefinitionTC:
PROC = {
SELECT pass
FROM
1 => {
type: REF TypeRep.record = NEW[TypeRep.record ¬ [class: $DEFINITIONS, v: record[fieldList: NIL]]];
IndicateType[type];
};
ENDCASE;
};
ControlTC:
PROC [domainNode, rangeNode:
REF] = {
class: TypeClass ¬
SELECT GetNodeName[self]
FROM
$PROCTC => $PROC,
$SIGNALTC => $SIGNAL,
$ERRORTC => $ERROR,
$PROGRAMTC => $PROGRAM,
$PROCESSTC => $PROCESS,
ENDCASE => ERROR;
SELECT pass
FROM
1 => {
type: REF TypeRep.control = NEW[TypeRep.control ¬ [class: class, v: control[argumentType: nullTypeCode, returnType: nullTypeCode]]];
IndicateType[type];
Will need to insert the symbols into the context of the body
};
2 => {
type: REF TypeRep.control = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
TypeCodeOf:
PROC [listNode:
REF]
RETURNS [TypeCode] = {
type: Type =
IF listNode #
NIL
AND GetNodeName[listNode] = $ANYTC
THEN NEW[TypeRep.simple ¬ [class: $ANY, v: simple[]]]
ELSE NEW[TypeRep.record ¬ [class: $STRUCTURE, v: record[fieldList: AnalyzeFieldList[context, listNode]]]];
RETURN [NewType[context.types, type]]
};
type.argumentType ¬ TypeCodeOf[domainNode];
type.returnType ¬ TypeCodeOf[rangeNode];
};
3 => {
type: REF TypeRep.control = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
WITH UnderType[context.types, type.argumentType]
SELECT
FROM
s: REF TypeRep.record => {AnalyzeFieldListValues[context, domainNode]};
ENDCASE => NULL;
WITH UnderType[context.types, type.returnType]
SELECT
FROM
s: REF TypeRep.record => {AnalyzeFieldListValues[context, rangeNode]};
ENDCASE => NULL;
};
ENDCASE;
};
RecordTC:
PROC [fieldListNode:
REF] = {
SELECT pass
FROM
1 => {
type: REF TypeRep.record = NEW[TypeRep.record ¬ [class: $RECORD, v: record[fieldList: NIL]]];
IndicateType[type];
};
2 => {
type: REF TypeRep.record = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
type.fieldList ¬ AnalyzeFieldList[context, fieldListNode];
};
3 => {
AnalyzeFieldListValues[context, fieldListNode]
};
ENDCASE;
};
UnionTC:
PROC [tagDeclNode, variantsNode:
REF] = {
SELECT pass
FROM
1 => {
type: REF TypeRep.union = NEW[TypeRep.union];
type.class ¬ $UNION;
IndicateType[type];
};
2 => {
type: REF TypeRep.union = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
TagDecl:
PROC [tagIdNode, typeNode, valueNode: Tree] = {
ImplicitTC:
PROC = {
Need to cons up an enumerated type for type.tagType.
type.variantList has been contructed already.
Count: PROC [v: VariantList] RETURNS [i: INT ¬ 0] = INLINE {WHILE v # NIL DO i ¬ i + 1; v ¬ v.rest ENDLOOP};
n: INT = Count[type.variantList];
tagType: REF TypeRep.enumerated = NEW[TypeRep.enumerated ¬ [class: $ENUMERATION, v: enumerated[items: NIL]]];
last: LIST OF EnumerationItem ¬ NIL;
i: INT ¬ 0;
FOR each: VariantList ¬ type.variantList, each.rest
UNTIL each =
NIL
DO
new: LIST OF EnumerationItem ¬ LIST[[NARROW[each.first.value], i]];
IF last = NIL THEN tagType.items ¬ new ELSE last.rest ¬ new;
last ¬ new;
i ¬ i + 1;
ENDLOOP;
type.tagType ¬ NewType[context.types, tagType];
};
Item:
PROC [idNode, constantNode: Tree] = {
This is for the machine-dependent case.
For now, we ignore constantNode, which may be a constant expression (the word offset) or an item whose first component is a word offset and whose second component is an item containing the first and last bit numbers.
type.tagName ¬ IF idNode # NIL THEN GetIdentifier[idNode] ELSE NIL;
};
IF tagIdNode # NIL AND NOT With2[tagIdNode, item, Item] THEN type.tagName ¬ GetIdentifier[tagIdNode];
Assert[valueNode = NIL, "Initializer not allowed on tag decl",,tree];
IF
NOT With0[typeNode, implicitTC, ImplicitTC]
THEN {
AnalyzeType2[context, typeNode];
type.tagType ¬ GetTypeValueAttribute[context.types, typeNode];
};
};
type.variantList ¬ AnalyzeVariantList[context, variantsNode];
Assert[With3[tagDeclNode, decl, TagDecl]];
AddTypeCodeAttribute[tagDeclNode, $DECLTYPECODE, type.tagType];
Should check tags in type.variantList against type.tagType, and for duplicates.
};
3 => {
AnalyzeVariantListValues[context, variantsNode];
};
ENDCASE;
};
SequenceTC:
PROC [limitDeclNode, rangeTypeNode: Tree] = {
SELECT pass
FROM
1 => {
type: REF TypeRep.sequence = NEW[TypeRep.sequence];
type.class ¬ $SEQUENCE;
IndicateType[type];
};
2 => {
type: REF TypeRep.sequence = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
LimitDecl:
PROC [idNode, typeNode, valueNode: Tree] = {
id: ROPE = IF idNode # NIL THEN GetIdentifier[idNode] ELSE NIL;
AnalyzeType2[context, typeNode];
type.limitName ¬ id;
type.domainType ¬ GetTypeValueAttribute[context.types, typeNode];
type.rangeType ¬ GetTypeValueAttribute[context.types, rangeTypeNode];
Assert[valueNode=NIL, "initial value on sequence limit ignored",, self];
};
AnalyzeType2[context, rangeTypeNode];
Assert[With3[limitDeclNode, decl, LimitDecl]];
AddTypeCodeAttribute[limitDeclNode, $DECLTYPECODE, type.rangeType];
};
3 => { [] ¬ AnalyzeTypePass[context, rangeTypeNode, 3] };
ENDCASE;
};
EnumeratedTC:
PROC [idsNode: Tree] = {
SELECT pass
FROM
1 => {
val: CARD ¬ 0;
type: REF TypeRep.enumerated = NEW[TypeRep.enumerated];
last: LIST OF EnumerationItem ¬ NIL;
Each:
PROC [enumItem: Tree] = {
id: ROPE ¬ NIL;
new: LIST OF EnumerationItem ¬ NIL;
Item:
PROC [idNode, constantNode: Tree] = {
This is for the machine-dependent case
newVal: CARD = GetSimpleConstant[context, constantNode];
id ¬ IF idNode # NIL THEN GetIdentifier[idNode] ELSE NIL;
Assert[newVal >= val, "Enumeration out of order: %g", [cardinal[newVal]], idsNode];
val ¬ newVal;
};
IF NOT With2[enumItem, item, Item] THEN id ¬ GetIdentifier[enumItem];
new ¬ LIST[[id, val]];
IF last = NIL THEN type.items ¬ new ELSE last.rest ¬ new;
last ¬ new;
val ¬ val + 1;
};
type.class ¬ $ENUMERATION;
val ¬ 0; DoList[idsNode, Each]; -- first pass determines range
IndicateType[type];
};
2 => {
All work has been done in the first pass.
};
ENDCASE;
};
VarTC:
PROC [baseTypeNode: Tree] = {
-- used for READONLY, VAR
[] ¬ AnalyzeTypePass[context, baseTypeNode, pass];
IF GetAttribute[self, $TYPECODE] =
NIL
THEN {
PropagateAttribute[self, $TYPECODE, NARROW[baseTypeNode], $TYPECODE];
};
};
AnyTC:
PROC = {
SELECT pass
FROM
1 => {
type: REF TypeRep.simple = NEW[TypeRep.simple];
type.class ¬ $ANY;
IndicateType[type];
};
ENDCASE;
};
OpaqueTC:
PROC [
REF] = {
SELECT pass
FROM
1 => {
type: REF TypeRep.simple = NEW[TypeRep.simple];
type.class ¬ $OPAQUE;
IndicateType[type];
};
ENDCASE;
};
TypeExpression:
PROC
RETURNS [
BOOL] = {
SELECT pass
FROM
1 => {
IF self #
NIL
THEN {
AddTypeCodeAttribute[self, $NEEDTYPECODE, 0]; -- 0 is predeclared to mean the right thing.
RETURN [CrankAnalyze.AnalyzeExpression[context, self]];
};
RETURN [FALSE]
};
2, 3 => {
IF pass = 3 THEN TypeExprPass3[context, self];
WITH UnderType[context.types, GetTypeCodeAttribute[self]]
SELECT
FROM
t: REF TypeRep.type => RETURN [TRUE];
ENDCASE => RETURN [FALSE];
};
ENDCASE => ERROR;
};
RETURN[With1[self, enumeratedTC, EnumeratedTC] OR With1[self, recordTC, RecordTC] OR With1[self, monitoredTC, RecordTC] OR ReferenceTypes[] OR With2[self, arrayTC, ArrayTC] OR With2[self, sequenceTC, SequenceTC] OR With2[self, procTC, ControlTC] OR With2[self, signalTC, ControlTC] OR With2[self, errorTC, ControlTC] OR With2[self, programTC, ControlTC] OR With2[self, processTC, ControlTC] OR With1[self, varTC, VarTC] OR With0[self, anyTC, AnyTC] OR With2[self, unionTC, UnionTC] OR With2[self, subrangeTC, SubrangeTC] OR With0[self, zoneTC, ZoneTC] OR With1[self, arraydescTC, ArraydescTC] OR With1[self, longTC, LongTC] OR With1[self, opaqueTC, OpaqueTC] OR With0[self, linkTC, LinkTC] OR With0[self, definitionTC, DefinitionTC] OR TypeExpression[]];
};
TypeExprPass3:
PROC [context: Context, tree: Tree] = {
self: AttributedNode = NARROW[tree];
Apply:
PROC [operatorNode, operandListNode, catchNode:
REF] = {
SELECT self.syntaxNodeName
FROM
$DISCRIMINATE => TypeExprPass3[context, operatorNode];
$SEQUENCEALLOC => TypeExprPass3[context, operatorNode];
ENDCASE => Assert[FALSE,"What was this?",,self];
};
Dot:
PROC [leftNode, rightNode:
REF] = {
SELECT self.syntaxNodeName
FROM
$DISCRIMINATE => TypeExprPass3[context, leftNode];
$INTERFACESELECT => NULL;
ENDCASE => Assert[FALSE,"What was this?",,self];
};
Identifier:
PROC [id:
ROPE] = {
IF GetAttribute[self, $QUAL] =
NIL
THEN {
WITH LookupSymbol[context, id]
SELECT
FROM
ste: REF SymbolTableEntryRep.other => { QualifyIdentifierNode[self, ste.qualifier] };
ENDCASE => Assert[FALSE,"What was this?",,self];
};
};
Assert[WithId[self, Identifier] OR With3[self, apply, Apply] OR With2[self, dot, Dot],"What was this?",,self];
};
FindExportee:
PROC [context: Context, name:
ROPE]
RETURNS [to:
ROPE ¬
NIL, tc: TypeCode ¬ nullTypeCode] = {
matches: INT ¬ 0;
FOR e:
LIST
OF Export ¬ context.exports, e.rest
UNTIL e =
NIL
DO
FOR f: FieldList ¬ e.first.fieldList, f.rest
UNTIL f =
NIL
DO
IF Rope.Equal[f.first.name, name]
THEN {
to ¬ e.first.interfaceName;
tc ¬ f.first.rangeType;
matches ¬ matches + 1;
EXIT;
};
ENDLOOP;
ENDLOOP;
IF matches # 1
THEN {
[] ¬ Help[IO.PutFR["%g is exported to %g interfaces", [rope[name]], [integer[matches]]]];
};
};
TryExportingType:
PROC [context: Context, name:
ROPE, concrete: TypeCode]
RETURNS [to:
ROPE ¬
NIL] = {
matches: INT ¬ 0;
FOR each:
LIST
OF Export ¬ context.exports, each.rest
UNTIL each =
NIL
DO
FOR f: FieldList ¬ each.first.fieldList, f.rest
UNTIL f =
NIL
DO
IF Rope.Equal[f.first.name, name]
THEN {
WITH UnderType[context.types, f.first.rangeType]
SELECT
FROM
t:
REF TypeRep.type => {
opaque: REF TypeRep = UnderType[context.types, t.value];
IF opaque.class = $OPAQUE
THEN {
ExportType[context: context, concrete: concrete, opaque: opaque.typeCode];
to ¬ each.first.interfaceName;
matches ¬ matches + 1;
EXIT;
};
};
ENDCASE => NULL;
};
ENDLOOP;
ENDLOOP;
IF matches # 1
THEN {
[] ¬ Help[IO.PutFR["%g is exported to %g interfaces", [rope[name]], [integer[matches]]]];
};
};
ProcessModuleList:
PUBLIC
PROC [context: Context, moduleList: Tree, import:
BOOL] = {
Action:
PROC [item: Tree] = {
E:
PROC [rename, name:
REF] = {
id: ROPE = GetIdentifier[name];
reid: ROPE = GetIdentifier[rename];
ste: REF SymbolTableEntryRep.directory ¬ NARROW[LookupSymbol[context, id]];
IF
NOT Rope.Equal[reid, id]
THEN {
new: REF SymbolTableEntryRep.directory ¬ NEW[SymbolTableEntryRep.directory ¬ ste];
AddSymbol[context, reid, new];
ste ¬ new;
};
Assert[NOT (IF import THEN ste.import ELSE ste.export)]; -- check for duplicates
IF import THEN ste.import ¬ TRUE ELSE ste.export ¬ TRUE;
IF
NOT import
THEN {
context.exports ¬ CONS[[id, ste.interfaceRecordType.fieldList], context.exports];
};
};
Assert[With2[item, item, E]];
};
DoList[moduleList, Action];
};
ProcessSharesList:
PUBLIC
PROC [context: Context, moduleList: Tree] = {
Action:
PROC [item: Tree] = {
id: ROPE = GetIdentifier[item];
ste: REF SymbolTableEntryRep.directory ¬ NARROW[LookupSymbol[context, id]];
Assert[NOT ste.share];
ste.share ¬ TRUE;
};
DoList[moduleList, Action];
};
AddDirectoryItem:
PUBLIC
PROC [context: Context, tree: Tree] = {
D:
PROC [directoryItem, from, usingList:
REF] = {
ste: REF SymbolTableEntryRep.directory ¬ NEW[SymbolTableEntryRep.directory];
directoryItemName: ROPE = GetIdentifier[directoryItem];
ste.import ¬ FALSE;
ste.export ¬ FALSE;
ste.from ¬ IF from = NIL THEN directoryItemName ELSE GetRopeLiteral[from];
ste.interfaceRecordType ¬ CrankAnalyze.GetSymbols[context, ste.from];
IF usingList =
NIL
THEN { ste.hasUsing ¬ FALSE; ste.using ¬ NIL }
ELSE {
list: LIST OF ROPE ¬ NIL;
Action: PROC [item: Tree] = { list ¬ CONS[GetIdentifier[item], list] };
DoList[usingList, Action];
ste.hasUsing ¬ TRUE;
ste.using ¬ list;
};
AddSymbol[context, directoryItemName, ste];
};
Assert[With3[tree, diritem, D]];
};