AnalyzeExpressionOrStatement:
PROC [context: Context, tree: Tree, analyzeStatement:
BOOL]
RETURNS [
BOOL] = {
self: AttributedNode = NARROW[tree];
FunnyApply:
PROC [applyNode:
REF] = {
PropagateAttribute[applyNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
IF GetNodeName[applyNode] = $APPLY
THEN { Assert[AnalyzeExpression[context, applyNode]] }
ELSE { Apply[applyNode, NIL, NIL] };
};
Apply:
PROC [operatorNode, operandListNode, catchNode:
REF] = {
typeCode: TypeCode ¬ GetTypeCodeAttribute[self, $NEEDTYPECODE];
fieldList: FieldList ¬ NIL;
keywordOperands: BOOL ¬ FALSE;
positionalOperands: BOOL ¬ FALSE;
AnalyzeOperand:
PROC [exprNode:
REF, rangeType: TypeCode] = {
AddTypeCodeAttribute[exprNode, $NEEDTYPECODE, rangeType];
Assert[AnalyzeExpression[context, exprNode]]
};
EachOperand:
PROC [operandListItemNode:
REF] = {
NamedOperand:
PROC [nameNode, exprNode:
REF] = {
id: ROPE = GetIdentifier[nameNode];
keywordOperands ¬ TRUE;
Assert[NOT positionalOperands, "Mixed keyword/positional notation",, tree];
FOR each: FieldList ¬ fieldList, each.rest
UNTIL each =
NIL
DO
IF Rope.Equal[each.first.name, id,
TRUE]
THEN {
AnalyzeOperand[exprNode, each.first.rangeType];
RETURN;
};
ENDLOOP;
Assert[FALSE, "Unknown field name: %g", [rope[id]], self];
};
IF
NOT With2[operandListItemNode, item, NamedOperand]
THEN {
positionalOperands ¬ TRUE;
Assert[NOT keywordOperands, "Mixed keyword/positional notation",, tree];
IF fieldList =
NIL
THEN { [] ¬ Help["Too many items in group",,self] }
ELSE {
AnalyzeOperand[operandListItemNode, fieldList.first.rangeType];
fieldList ¬ fieldList.rest;
};
};
};
WITH UnderType[context.types, typeCode]
SELECT
FROM
u:
REF TypeRep.union => {
id: ROPE = GetIdentifier[operatorNode];
found: BOOL ¬ FALSE;
FOR each: VariantList ¬ u.variantList, each.rest
UNTIL found
OR each =
NIL
DO
IF Rope.Equal[id,
NARROW[each.first.value]]
THEN {
fieldList ¬ each.first.chooses;
found ¬ TRUE;
self.syntaxNodeName ¬ $MAKEVARIANT;
};
ENDLOOP;
Assert[found, "%g does not name a variant", [rope[id]], self];
};
ENDCASE => {
IF operatorNode =
NIL
THEN {
A constructor of some sort.
tc: TypeCode ¬ typeCode;
DO
WITH UnderType[context.types, tc]
SELECT
FROM
t:
REF TypeRep.array => {
self.syntaxNodeName ¬ $MAKEARRAY;
AddAttribute[self, $DOMAINTYPE, GetTypeName[context, t.domainType, TRUE]];
EXIT
};
t:
REF TypeRep.record => {
SELECT t.class
FROM
$RECORD => {
self.syntaxNodeName ¬ $MAKERECORD;
AddAttribute[self, $FROM, GetTypeName[context, typeCode, TRUE]];
};
ENDCASE => [] ¬ Help["I don't think this should happen",,tree];
EXIT;
};
t: REF TypeRep.qualifiedVariant => tc ¬ t.groundType;
ENDCASE => {[] ¬ Help["vasis?",,tree]; EXIT};
ENDLOOP;
fieldList ¬ GetConstructorFieldList[context, tc];
}
ELSE {
tc: TypeCode ¬ nullTypeCode;
dereferenceCount: NAT ¬ 0;
Assert[AnalyzeExpression[context, operatorNode]];
tc ¬ GetTypeCodeAttribute[operatorNode, $TYPECODE];
DO
WITH UnderType[context.types, tc]
SELECT
FROM
t:
REF TypeRep.control => {
AssertNotVar[self];
fieldList ¬ GetConstructorFieldList[context, t.argumentType];
self.syntaxNodeName ¬ (
SELECT t.class
FROM
$PROC => $FUNCTIONAPPLY,
$SIGNAL => $SIGNALAPPLY,
$ERROR => $ERRORAPPLY,
$PROGRAM => $STARTAPPLY,
ENDCASE => ERROR);
IF t.class # $ERROR THEN typeCode ¬ t.returnType;
};
t:
REF TypeRep.array => {
fieldList ¬ LIST[[name: NIL, rangeType: t.domainType]];
self.syntaxNodeName ¬ $ARRAYACCESS;
typeCode ¬ t.rangeType;
};
t:
REF TypeRep.type => {
This might be a coercion, or an obsolete notation for variant records, or a concrete sequence type in a NEW or SIZE.
need: Type = UnderType[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]];
IF need#
NIL
AND need.class = $TYPE
THEN {
Looking for a type, so it can't be a coercion
IF GetAttribute[self, $SIZEORNEW] #
NIL
THEN {
This is inside a SIZE or NEW, so it is OK to dive in deeper to see if we have a SEQUENCE type.
d: Type = GetSequenceInfo[context.types, t.value].domain;
IF d #
NIL
THEN {
AddTypeCodeAttribute[operandListNode, $NEEDTYPECODE, d.typeCode];
Assert[AnalyzeExpression[context, operandListNode], "expr required",,self];
AddTypeCodeAttribute[self, $TYPECODE, tc];
self.syntaxNodeName ¬ $SEQUENCEALLOC;
RETURN
};
};
{
This must be an obsolete notation for variant records
id: ROPE = GetIdentifier[operandListNode];
q: TypeCode = QualifyVariant[context.types, t.value, id];
AddTypeCodeAttribute[self, $TYPECODE, NewTypeType[context.types, q]];
self.syntaxNodeName ¬ $DISCRIMINATE;
RETURN; -- don't process the operand further!
};
}
ELSE {
Looking for a non-type, so it must be a coercion or a named constructor
WITH UnderType[context.types, t.value]
SELECT
FROM
r:
REF TypeRep.record => {
self.syntaxNodeName ¬ $MAKERECORD;
AddAttribute[self, $FROM, GetTypeName[context, t.value, TRUE]];
fieldList ¬ r.fieldList;
};
a:
REF TypeRep.array => {
self.syntaxNodeName ¬ $MAKEARRAY;
AddAttribute[self, $DOMAINTYPE, GetTypeName[context, a.domainType, TRUE]];
};
ENDCASE => {
self.syntaxNodeName ¬ $COERCE;
fieldList ¬ LIST[[name: NIL, rangeType: t.value]]
};
typeCode ¬ t.value;
};
};
t:
REF TypeRep.qualifiedVariant => {
This is probably a sugared sequence access.
r: ROPE; s: TypeCode;
[sequenceFieldName: r, sequenceTypeCode: s] ¬ GetSequenceInfo[context.types, t.typeCode];
IF s # nullTypeCode
THEN {
AddAttribute[self, $SEQUENCEFIELDNAME, r];
AddAttribute[self, $TAGS, GetTags[context.types, t.typeCode]];
tc ¬ s;
LOOP;
};
Assert[FALSE, "Unknown operator type for apply",,self];
};
t:
REF TypeRep.record => {
This is probably a sugared sequence access.
r: ROPE; s: TypeCode;
[sequenceFieldName: r, sequenceTypeCode: s] ¬ GetSequenceInfo[context.types, t.typeCode];
IF s # nullTypeCode
THEN {
AddAttribute[self, $SEQUENCEFIELDNAME, r];
AddAttribute[self, $FROM, GetTypeName[context, GetTypeCodeAttribute[operatorNode, $TYPECODE], FALSE]];
tc ¬ s;
LOOP;
};
Assert[FALSE, "Unknown operator type for apply",,self];
};
t:
REF TypeRep.sequence => {
fieldList ¬ LIST[[name: NIL, rangeType: t.domainType]];
self.syntaxNodeName ¬ $SEQUENCEACCESS;
typeCode ¬ t.rangeType;
};
t:
REF TypeRep.reference => {
Dereference until we can apply
tc ¬ t.referentType;
dereferenceCount ¬ dereferenceCount + 1;
LOOP;
};
ENDCASE => Assert[FALSE, "Unknown operator type for apply",,self];
EXIT;
ENDLOOP;
IF dereferenceCount > 0
THEN {
AddAttribute[self, $DEREFERENCE, NEW[INT ¬ dereferenceCount]];
};
};
};
{ fieldNames:
LIST
OF
REF = NamesFromFieldList[fieldList];
IF fieldNames #
NIL
THEN {
AddAttribute[self, $FIELDNAMES, fieldNames];
};
};
DoList[operandListNode, EachOperand];
IF catchNode # NIL THEN Assert[With2[catchNode, catch, Catch]];
AddTypeCodeAttribute[self, $TYPECODE, typeCode];
};
Error:
PROC [operandNode:
REF] = {
Assert[AnalyzeExpression[context, operandNode]];
};
SysError: PROC = { };
ListCons:
PROC [zoneNode, listNode:
REF ] = {
elementTypeCode: TypeCode = GetListElementTypeCode[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]];
EachElement:
PROC [elementNode:
REF] = {
AddTypeCodeAttribute[elementNode, $NEEDTYPECODE, elementTypeCode];
Assert[AnalyzeExpression[context, elementNode], "Expr needed here",, self];
};
DoList[listNode, EachElement];
};
If:
PROC [conditionalNode, truePartNode, falsePartNode:
REF] = {
tc: TypeCode ¬ IF analyzeStatement THEN nullTypeCode ELSE GetTypeCodeAttribute[self, $NEEDTYPECODE];
AddTypeCodeAttribute[conditionalNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "BOOL"]];
IF tc # nullTypeCode THEN PropagateAttribute[truePartNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
Assert[AnalyzeExpression[context, conditionalNode]];
Assert[AnalyzeExpressionOrStatement[context, truePartNode, analyzeStatement]];
IF
NOT analyzeStatement
THEN {
IF tc = nullTypeCode THEN tc ¬ GetTypeCodeAttribute[truePartNode];
AddTypeCodeAttribute[falsePartNode, $NEEDTYPECODE, tc];
};
Assert[AnalyzeExpressionOrStatement[context, falsePartNode, analyzeStatement]];
IF tc # nullTypeCode THEN AddTypeCodeAttribute[self, $TYPECODE, tc];
};
Do:
PROC [iterationControlNode, terminationTestNode, whatsitNode, loopBodyNode, huhNode, whyNode:
REF] = {
innerContext: Context = NewContext[context];
EachStatement:
PROC [item: Tree] = {
AnalyzeStatement[innerContext, item];
};
ForSeq:
PROC [declNode, initValueNode, nextValueNode:
REF] = {
IF GetNodeName[declNode] = $DECL
THEN {
Assert[AnalyzeDecl[innerContext, declNode, self, 1]];
Assert[AnalyzeDecl[innerContext, declNode, self, 2]];
Assert[AnalyzeDecl[innerContext, declNode, self, 3]];
PropagateAttribute[initValueNode, $NEEDTYPECODE, NARROW[declNode], $DECLTYPECODE];
}
ELSE {
AddAttribute[NARROW[declNode], $VAR, $TRUE];
Assert[AnalyzeExpression[innerContext, declNode]];
PropagateAttribute[initValueNode, $NEEDTYPECODE, NARROW[declNode], $TYPECODE];
};
Assert[AnalyzeExpression[context, initValueNode]];
IF nextValueNode #
NIL
THEN {
PropagateAttribute[nextValueNode, $NEEDTYPECODE, NARROW[initValueNode], $NEEDTYPECODE];
Assert[AnalyzeExpression[innerContext, nextValueNode]];
};
};
Thru:
PROC [declNode, rangeNode, whatsthisNode:
REF] = {
needType: TypeCode ¬ nullTypeCode;
Assert[whatsthisNode=NIL];
IF declNode #
NIL
THEN {
IF GetNodeName[declNode] = $DECL
THEN {
Assert[AnalyzeDecl[innerContext, declNode, self, 1]];
Assert[AnalyzeDecl[innerContext, declNode, self, 2]];
Assert[AnalyzeDecl[innerContext, declNode, self, 3]];
needType ¬ GetTypeCodeAttribute[declNode, $DECLTYPECODE];
}
ELSE {
AddAttribute[NARROW[declNode], $VAR, $TRUE];
Assert[AnalyzeExpression[innerContext, declNode]];
needType ¬ GetTypeCodeAttribute[declNode, $TYPECODE];
};
};
AnalyzeInterval[innerContext, rangeNode, needType];
};
Assert[analyzeStatement AND whatsitNode=NIL AND huhNode=NIL AND whyNode=NIL, "Unimplemented loop construct",,self];
Assert[iterationControlNode = NIL OR With3[iterationControlNode, forseq, ForSeq] OR With3[iterationControlNode, upthru, Thru] OR With3[iterationControlNode, downthru, Thru]];
IF terminationTestNode #
NIL
THEN {
AddTypeCodeAttribute[terminationTestNode, $NEEDTYPECODE, LookupTypeCode[Root[innerContext], "BOOL"]];
Assert[AnalyzeExpression[innerContext, terminationTestNode]];
};
DoList[loopBodyNode, EachStatement];
};
Return:
PROC [returnValuesNode:
REF] = {
IF returnValuesNode #
NIL
THEN {
fieldList: FieldList ¬ NIL;
keywordOperands: BOOL ¬ FALSE;
positionalOperands: BOOL ¬ FALSE;
EachReturnValue:
PROC [returnValueItemNode:
REF] = {
Named:
PROC [nameNode, exprNode:
REF] = {
id: ROPE = GetIdentifier[nameNode];
keywordOperands ¬ TRUE;
Assert[NOT positionalOperands, "Mixed keyword/positional notation",, tree];
FOR each: FieldList ¬ fieldList, each.rest
UNTIL each =
NIL
DO
IF Rope.Equal[each.first.name, id,
TRUE]
THEN {
AddTypeCodeAttribute[exprNode, $NEEDTYPECODE, each.first.rangeType];
Assert[AnalyzeExpression[context, exprNode]];
RETURN;
};
ENDLOOP;
Assert[FALSE, "Unknown field name: %g", [rope[id]], self];
};
IF
NOT With2[returnValueItemNode, item, Named]
THEN {
positionalOperands ¬ TRUE;
Assert[NOT keywordOperands, "Mixed keyword/positional notation",, tree];
IF fieldList =
NIL
THEN { [] ¬ Help["Too many items in group",,self] }
ELSE {
AddTypeCodeAttribute[returnValueItemNode, $NEEDTYPECODE, fieldList.first.rangeType];
Assert[AnalyzeExpression[context, returnValueItemNode], "Expr expected in returnValuesNode",, tree];
fieldList ¬ fieldList.rest;
};
};
};
WITH LookupSymbol[context,
IF GetNodeName[self] = $RETURN
THEN "*RETURN-VALUE*"
ELSE "*RESUME-VALUE*"]
SELECT
FROM
ste:
REF SymbolTableEntryRep.other => {
WITH UnderType[context.types, ste.typeCode]
SELECT
FROM
r: REF TypeRep.record => fieldList ¬ r.fieldList;
ENDCASE => NULL;
};
ENDCASE => Assert[FALSE, "No return value expected here",,self];
DoList[returnValuesNode, EachReturnValue];
};
};
Case:
PROC [exprNode, caseListNode, endcaseNode:
REF] = {
needTypeCode: TypeCode ¬ GetTypeCodeAttribute[self, $NEEDTYPECODE];
first: BOOL ¬ TRUE;
booleanTypeCode: TypeCode = LookupTypeCode[Root[context], "BOOL"];
EachCase:
PROC [itemNode: Tree] = {
DoItem:
PROC [conditionNode, choosesNode:
REF] = {
EachCond:
PROC [condItemNode: Tree] = {
AddTypeCodeAttribute[condItemNode, $NEEDTYPECODE, booleanTypeCode];
Assert[AnalyzeExpression[context, condItemNode
! GetLeftRelOperand => { RESUME[exprNode] }
], "Expr expected",, condItemNode];
};
DoList[conditionNode, EachCond];
IF NOT analyzeStatement THEN AddTypeCodeAttribute[choosesNode, $NEEDTYPECODE, needTypeCode];
Assert[AnalyzeExpressionOrStatement[context, choosesNode, analyzeStatement],,,choosesNode];
IF
NOT analyzeStatement
AND first
AND needTypeCode = nullTypeCode
THEN {
needTypeCode ¬ GetTypeCodeAttribute[choosesNode, $TYPECODE];
};
first ¬ FALSE;
};
Assert[With2[itemNode, item, DoItem], "Item expected",, itemNode];
};
Assert[AnalyzeExpression[context, exprNode]];
DoList[caseListNode, EachCase];
IF NOT analyzeStatement THEN AddTypeCodeAttribute[endcaseNode, $NEEDTYPECODE, needTypeCode];
Assert[AnalyzeExpressionOrStatement[context, endcaseNode, analyzeStatement],,,endcaseNode];
IF NOT analyzeStatement THEN AddTypeCodeAttribute[self, $TYPECODE, needTypeCode];
};
Bind:
PROC [selectOnNode, whatsitNode, caseListNode, endcaseNode:
REF] = {
needTypeCode: TypeCode ¬ GetTypeCodeAttribute[self, $NEEDTYPECODE];
first: BOOL ¬ TRUE;
unsafeSelectID: ROPE ¬ NIL;
unsafeSelectType: Type ¬ NIL;
SelectOn:
PROC [renameNode, exprNode:
REF] = {
Assert[AnalyzeExpression[context, exprNode]];
IF renameNode #
NIL
THEN {
unsafeSelectID ¬ GetIdentifier[renameNode];
unsafeSelectType ¬ UnderType[context.types, GetTypeCodeAttribute[exprNode]];
};
};
CaseList:
PROC [selectBranchItemNode: Tree] = {
SelectBranchItem:
PROC [declNode, choosesNode:
REF] = {
innerContext: Context = NewContext[context];
IF unsafeSelectType #
NIL
THEN {
q: TypeCode = QualifyVariant[context.types, unsafeSelectType.typeCode, GetIdentifier[declNode]];
AddSymbol[context: innerContext, id: unsafeSelectID, val: NEW[SymbolTableEntryRep.other ¬ [other[typeCode: q, readonly: TRUE]]]];
}
ELSE {
Assert[AnalyzeDecl[innerContext, declNode, NIL, 1], "Decl expected",,declNode];
[] ¬ AnalyzeDecl[innerContext, declNode, NIL, 2];
[] ¬ AnalyzeDecl[innerContext, declNode, NIL, 3];
};
IF NOT analyzeStatement THEN AddTypeCodeAttribute[choosesNode, $NEEDTYPECODE, needTypeCode];
Assert[AnalyzeExpressionOrStatement[innerContext, choosesNode, analyzeStatement],,,choosesNode];
IF
NOT analyzeStatement
AND first
AND needTypeCode = nullTypeCode
THEN {
needTypeCode ¬ GetTypeCodeAttribute[choosesNode, $TYPECODE];
};
};
Assert[With2[selectBranchItemNode, item, SelectBranchItem]];
};
Assert[With2[selectOnNode, item, SelectOn]];
Assert[whatsitNode=NIL,"What's the second node mean?",,self];
DoList[caseListNode, CaseList];
Assert[AnalyzeExpressionOrStatement[context, endcaseNode, analyzeStatement],,,endcaseNode];
IF NOT analyzeStatement THEN AddTypeCodeAttribute[self, $TYPECODE, needTypeCode];
};
Assign:
PROC [lhsNode, rhsNode:
REF] = {
AddAttribute[NARROW[lhsNode], $VAR, $TRUE];
Assert[AnalyzeExpression[context, lhsNode]];
PropagateAttribute[rhsNode, $NEEDTYPECODE, NARROW[lhsNode], $TYPECODE];
WITH UnderType[context.types, GetTypeCodeAttribute[lhsNode]]
SELECT
FROM
t:
REF TypeRep => {
AddAttribute[self, $ASSIGNTYPECLASS, t.class];
IF t.class = $RECORD
THEN {
AddAttribute[self, $FROM, GetTypeName[context, GetTypeCodeAttribute[lhsNode], FALSE]];
};
};
ENDCASE => NULL;
Assert[AnalyzeExpression[context, rhsNode]];
IF NOT analyzeStatement THEN PropagateAttribute[self, $TYPECODE, NARROW[lhsNode], $TYPECODE];
};
Extract:
PROC [lhsNode, rhsNode:
REF] = {
keywordOperands: BOOL ¬ FALSE;
positionalOperands: BOOL ¬ FALSE;
fieldList: FieldList ¬ NIL;
AnalyzeDest:
PROC [destNode:
REF, typeCode: TypeCode] = {
AddAttribute[NARROW[destNode], $VAR, $TRUE];
AddTypeCodeAttribute[destNode, $NEEDTYPECODE, typeCode];
Assert[AnalyzeExpression[context, destNode]];
};
Each:
PROC [lhsElementNode:
REF] = {
Named:
PROC [nameNode, destNode:
REF] = {
id: ROPE = GetIdentifier[nameNode];
keywordOperands ¬ TRUE;
Assert[NOT positionalOperands, "Mixed keyword/positional notation",, tree];
FOR each: FieldList ¬ fieldList, each.rest
UNTIL each =
NIL
DO
IF Rope.Equal[each.first.name, id,
TRUE]
THEN {
AnalyzeDest[destNode, each.first.rangeType];
RETURN;
};
ENDLOOP;
Assert[FALSE, "Unknown field name: %g", [rope[id]], self];
};
IF lhsElementNode =
NIL
OR
NOT With2[lhsElementNode, item, Named]
THEN {
positionalOperands ¬ TRUE;
Assert[NOT keywordOperands, "Mixed keyword/positional notation",, tree];
IF fieldList =
NIL
THEN { [] ¬ Help["Too many items in group",,self] }
ELSE {
IF lhsElementNode # NIL THEN AnalyzeDest[lhsElementNode, fieldList.first.rangeType];
fieldList ¬ fieldList.rest;
};
};
};
Assert[AnalyzeExpression[context, rhsNode]];
fieldList ¬ GetConstructorFieldList[context, GetTypeCodeAttribute[rhsNode]];
DoList[lhsNode, Each];
IF NOT analyzeStatement THEN PropagateAttribute[self, $TYPECODE, NARROW[rhsNode], $TYPECODE];
};
Unary:
PROC [operandNode:
REF] = {
AssertNotVar[self];
PropagateAttribute[operandNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
Assert[AnalyzeExpression[context, operandNode]];
PropagateAttribute[self, $TYPECODE, NARROW[operandNode], $TYPECODE];
};
BinaryOp:
PROC [aNode, bNode:
REF] = {
aClass, bClass, dClass: NumericTypeClass ¬ nonnumeric;
AssertNotVar[self];
Assert[AnalyzeExpression[context, aNode]];
Assert[AnalyzeExpression[context, bNode]];
aClass ¬ NumericTypeClassOf[context.types, GetTypeCodeAttribute[aNode]];
bClass ¬ NumericTypeClassOf[context.types, GetTypeCodeAttribute[bNode]];
dClass ¬ NumericTypeClassOf[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]];
IF self.syntaxNodeName = $PLUS
OR self.syntaxNodeName = $MINUS
THEN {
IF aClass = unspecified
AND bClass = unspecified
THEN {
PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
RETURN;
};
IF aClass = unspecified
THEN {
PropagateAttribute[self, $TYPECODE, NARROW[bNode], $TYPECODE];
RETURN;
};
IF bClass = unspecified
THEN {
PropagateAttribute[self, $TYPECODE, NARROW[aNode], $TYPECODE];
RETURN;
};
IF warnPointerArith AND aClass = pointer THEN Assert[true: FALSE, format: "warning: Pointer arithmetic", tree: self];
SELECT aClass
FROM
pointer, char => {
IF bClass
IN [signed..unsigned]
THEN {
PropagateAttribute[self, $TYPECODE, NARROW[aNode], $TYPECODE];
RETURN;
};
IF bClass = aClass
AND self.syntaxNodeName = $MINUS
THEN {
AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "INT"]];
RETURN;
};
};
ENDCASE => NULL;
IF self.syntaxNodeName = $PLUS
THEN
SELECT bClass
FROM
pointer, char => {
IF aClass
IN [signed..unsigned]
THEN {
PropagateAttribute[self, $TYPECODE, NARROW[bNode], $TYPECODE];
RETURN;
};
};
ENDCASE => NULL;
};
Assert[aClass IN [signed..real] AND bClass IN [signed..real], "Can't do arithmetic with this type",,self];
IF aClass # real
AND bClass # real
AND self.syntaxNodeName = $DIV
THEN {
self.syntaxNodeName ¬ $IDIV
};
IF aClass = real
OR bClass = real
OR dClass = real
THEN {
realCode: TypeCode = LookupTypeCode[Root[context], "REAL"];
AddAttribute[self, $ARITHTYPE, $REAL];
IF aClass # real
THEN {
AddAttribute[NARROW[aNode], $COERCIONS, Coercions[context: context, from: GetTypeCodeAttribute[aNode], to: realCode, tree: aNode]];
};
IF bClass # real
THEN {
AddAttribute[NARROW[bNode], $COERCIONS, Coercions[context: context, from: GetTypeCodeAttribute[bNode], to: realCode, tree: bNode]];
};
AddTypeCodeAttribute[self, $TYPECODE, realCode];
}
ELSE {
IF self.syntaxNodeName = $DIV THEN self.syntaxNodeName ¬ $IDIV;
PropagateAttribute[self, $TYPECODE, NARROW[aNode], $TYPECODE];
};
};
BinaryBoolOp:
PROC [aNode, bNode:
REF] = {
AssertNotVar[self];
PropagateAttribute[aNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
Assert[AnalyzeExpression[context, aNode]];
PropagateAttribute[bNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
Assert[AnalyzeExpression[context, bNode]];
PropagateAttribute[self, $TYPECODE, NARROW[bNode], $TYPECODE];
};
RelOp:
PROC [aNode, bNode:
REF] = {
typeCode: TypeCode ¬ nullTypeCode;
aClass, bClass: NumericTypeClass ¬ nonnumeric;
AssertNotVar[self];
IF aNode =
NIL
THEN {
If aNode is NIL, we are probably inside a case or casex, and need to get aNode from above. In this case, it has already been analyzed.
aNode ¬ SIGNAL GetLeftRelOperand[];
}
ELSE Assert[AnalyzeExpression[context, aNode]];
typeCode ¬ GetTypeCodeAttribute[aNode, $TYPECODE];
WITH UnderType[context.types, typeCode]
SELECT
FROM
t:
REF TypeRep.record => {
IF t.class = $STRUCTURE
AND t.fieldList #
NIL
AND t.fieldList.rest =
NIL
THEN {
one-component structure; try coercion to element type
typeCode ¬ t.fieldList.first.rangeType
};
};
ENDCASE => NULL;
WITH UnderType[context.types, typeCode]
SELECT
FROM
t: REF TypeRep.scalar => NULL;
ENDCASE => AddTypeCodeAttribute[bNode, $NEEDTYPECODE, typeCode];
Assert[AnalyzeExpression[context, bNode]];
aClass ¬ NumericTypeClassOf[context.types, GetTypeCodeAttribute[aNode]];
bClass ¬ NumericTypeClassOf[context.types, GetTypeCodeAttribute[bNode]];
IF aClass = real
OR bClass = real
THEN {
realCode: TypeCode = LookupTypeCode[Root[context], "REAL"];
AddAttribute[self, $COMPARETYPE, $REAL];
IF aClass # real
THEN {
AddAttribute[NARROW[aNode], $COERCIONS, Coercions[context: context, from: GetTypeCodeAttribute[aNode], to: realCode, tree: aNode]];
};
IF bClass # real
THEN {
AddAttribute[NARROW[bNode], $COERCIONS, Coercions[context: context, from: GetTypeCodeAttribute[bNode], to: realCode, tree: bNode]];
};
}
ELSE {
ct: ATOM ¬ NIL;
SELECT
TRUE
FROM
aClass IN [signed..unsigned] AND aClass IN [signed..unsigned] => ct ¬ $INTEGER;
aClass = unspecified OR bClass = unspecified => ct ¬ $UNSPECIFIED;
aClass = pointer AND bClass = pointer => ct ¬ $POINTER;
aClass = reference AND bClass = reference => ct ¬ $POINTER;
aClass = char AND bClass = char => ct ¬ $CHAR;
aClass = enumeration AND bClass = enumeration => ct ¬ $ENUMERATION;
aClass = nonnumeric AND bClass = nonnumeric => ct ¬ $COMPOSITE;
ENDCASE => Assert[FALSE, "Bad comparison",,self];
IF ct # NIL THEN AddAttribute[self, $COMPARETYPE, ct];
};
AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "BOOL"]];
};
All:
PROC [operandNode:
REF] = {
AssertNotVar[self];
WITH UnderType[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]]
SELECT
FROM
t:
REF TypeRep.array => {
AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, t.rangeType];
Assert[AnalyzeExpression[context, operandNode]];
AddTypeCodeAttribute[self, $TYPECODE, t.typeCode];
};
ENDCASE => Assert[FALSE, "ALL's not well here",, self];
};
In:
PROC [exprNode, rangeNode:
REF] = {
typeCode: TypeCode ¬ nullTypeCode;
AssertNotVar[self];
IF exprNode =
NIL
THEN {
If exprNode is NIL, we are probably inside a case or casex, and need to get aNode from above. In this case, it has already been analyzed.
exprNode ¬ SIGNAL GetLeftRelOperand[];
}
ELSE Assert[AnalyzeExpression[context, exprNode]];
typeCode ¬ GetTypeCodeAttribute[exprNode, $TYPECODE];
WITH UnderType[context.types, typeCode]
SELECT
FROM
t:
REF TypeRep.record => {
IF t.fieldList #
NIL
AND t.fieldList.rest =
NIL
THEN {
one-component structure; try coercion to element type
typeCode ¬ t.fieldList.first.rangeType
};
};
ENDCASE => NULL;
AnalyzeInterval[context, rangeNode, typeCode];
AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "BOOL"]];
};
Dot:
PROC [leftNode, rightNode:
REF] = {
id: ROPE ¬ GetIdentifier[rightNode];
dereferenceCount: NAT ¬ 0;
leftTypeCode: TypeCode ¬ nullTypeCode;
Assert[AnalyzeExpression[context, leftNode]];
leftTypeCode ¬ GetTypeCodeAttribute[leftNode];
DO
WITH UnderType[context.types, leftTypeCode]
SELECT
FROM
t:
REF TypeRep.type => {
WITH UnderType[context.types, t.value]
SELECT
FROM
et:
REF TypeRep.enumerated => {
WITH rightNode
SELECT
FROM
a: AttributedNode => {
a.syntaxNodeName ¬ $ENUMERATIONLITERAL;
AddTypeCodeAttribute[a, $TYPECODE, t.value];
AddAttribute[a, $FROM, GetTypeName[context, t.value, FALSE]];
self.syntaxNodeName ¬ $ENUMERATIONSELECT;
AddTypeCodeAttribute[self, $TYPECODE, t.value];
};
ENDCASE => ERROR;
};
ENDCASE => {
q: TypeCode = QualifyVariant[context.types, t.value, id];
self.syntaxNodeName ¬ $DISCRIMINATE;
AddTypeCodeAttribute[self, $TYPECODE, NewTypeType[context.types, q]];
};
RETURN;
};
t:
REF TypeRep.record => {
IF FieldSelect
[context
, self, leftTypeCode
, t, id, dereferenceCount
]
THEN {
IF t.class = $DEFINITIONS
THEN {
QualifyIdentifierNode[rightNode, GetUnderQualifier[context, GetIdentifier[leftNode], id, GetTypeCodeAttribute[self]]];
};
RETURN;
};
IF t.fieldList #
NIL
AND t.fieldList.rest =
NIL
THEN {
one-component structure; try coercion to element type
leftTypeCode ¬ t.fieldList.first.rangeType
}
ELSE EXIT;
};
t:
REF TypeRep.qualifiedVariant => {
IF FieldSelect[context, self, leftTypeCode, t, id, dereferenceCount] THEN RETURN ELSE EXIT;
};
t:
REF TypeRep.simple => {
IF t.class = $OPAQUE
THEN {
concrete: TypeCode = GetConcreteTypeCode[context, t.typeCode];
IF concrete = nullTypeCode THEN EXIT ELSE leftTypeCode ¬ concrete;
}
ELSE EXIT;
};
t:
REF TypeRep.reference => {
leftTypeCode ¬ t.referentType; -- try some dereferencing
dereferenceCount ¬ dereferenceCount + 1;
};
t:
REF TypeRep.control => {
IF
NARROW[leftNode, AttributedNode].syntaxNodeName = $FUNKYAPPLY
THEN { leftTypeCode ¬ t.returnType }
ELSE EXIT;
};
ENDCASE => EXIT;
ENDLOOP;
It is not a type or a structure or a reference to a structure, so it must be object notation.
WITH GetTypeName[context, GetTypeCodeAttribute[leftNode],
FALSE]
SELECT
FROM
l:
LIST
OF
REF => {
WITH LookupSymbol[context,
NARROW[l.first]]
SELECT
FROM
ste:
REF SymbolTableEntryRep.directory => {
Action:
PROC [fieldIndex:
INT, fieldName:
ROPE, fieldTypeCode: TypeCode, tagName:
ROPE, tagTypeCode: TypeCode]
RETURNS [quit:
BOOL ¬
FALSE] = {
Assert[tagTypeCode=nullTypeCode];
IF Rope.Equal[fieldName, id]
THEN {
use: BOOL ¬ NOT ste.hasUsing;
FOR u:
LIST
OF
ROPE ¬ ste.using, u.rest
UNTIL use
OR u=
NIL
DO
use ¬ Rope.Equal[id, u.first];
ENDLOOP;
IF use
THEN {
WITH UnderType[context.types, fieldTypeCode]
SELECT
FROM
p:
REF TypeRep.control => {
WITH UnderType[context.types, p.argumentType]
SELECT
FROM
s:
REF TypeRep.record => {
IF s.fieldList #
NIL
THEN {
Should make sure that leftNode type is compatible with s.fieldList.first.rangeType
newArgumentType: TypeCode = NewType[context.types, NEW[TypeRep.record ¬ [class: $STRUCTURE, v: record[fieldList: s.fieldList.rest]]]];
procTypeCode: TypeCode = NewType[context.types, NEW[TypeRep.control ¬ [class: $PROC, v: control[argumentType: newArgumentType, returnType: p.returnType]]]];
self.syntaxNodeName ¬ $FUNKYAPPLY;
QualifyIdentifierNode[rightNode, NARROW[l.first]];
AddAttribute[self, $FROMINTERFACE, l.first];
AddTypeCodeAttribute[self, $TYPECODE, procTypeCode];
RETURN [TRUE];
};
};
ENDCASE => NULL;
};
ENDCASE => NULL;
};
};
};
IF ste.interfaceRecordType # NIL AND EnumerateFields[context.types, ste.interfaceRecordType.typeCode, Action] THEN RETURN;
};
ENDCASE => NULL;
};
ENDCASE => NULL;
[] ¬ Help["Unable to deciper this dot notation",,self];
};
Addr:
PROC [operandNode:
REF] = {
AddAttribute[NARROW[operandNode], $VAR, $TRUE];
WITH UnderType[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]]
SELECT
FROM
t: REF TypeRep.reference => {AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, t.referentType]};
ENDCASE => NULL;
Assert[AnalyzeExpression[context, operandNode]];
IF GetTypeCodeAttribute[self, $NEEDTYPECODE] # nullTypeCode
THEN { PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE] }
ELSE {
AddTypeCodeAttribute[self, $TYPECODE, NewReferenceType[typeGraph: context.types, referentType: GetTypeCodeAttribute[operandNode], class: $LONGPOINTER]];
};
};
Uparrow:
PROC [operandNode:
REF] = {
Assert[AnalyzeExpression[context, operandNode]];
WITH UnderType[context.types, GetTypeCodeAttribute[operandNode]]
SELECT
FROM
t: REF TypeRep.reference => {AddTypeCodeAttribute[self, $TYPECODE, t.referentType]};
ENDCASE => Assert[FALSE, "Reference type required here",, operandNode];
};
MinMax:
PROC [listNode:
REF] = {
needTypeCode: TypeCode ¬ GetTypeCodeAttribute[self, $NEEDTYPECODE];
first: BOOL ¬ TRUE;
EachOperand:
PROC [operandNode:
REF] = {
AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, needTypeCode];
Assert[AnalyzeExpression[context, operandNode]];
IF first
THEN {
needTypeCode ¬ GetTypeCodeAttribute[operandNode, $TYPECODE];
first ¬ FALSE;
};
};
AssertNotVar[self];
DoList[listNode, EachOperand];
AddTypeCodeAttribute[self, $TYPECODE, needTypeCode];
};
Lengthen:
PROC [operandNode:
REF] = {
typeCode: TypeCode ¬ GetTypeCodeAttribute[self, $NEEDTYPECODE];
IF typeCode # nullTypeCode
THEN {
typeCode ← LengthenTypeCode[context, typeCode]; do this later
AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, typeCode];
};
Assert[AnalyzeExpression[context, operandNode]];
typeCode ¬ GetTypeCodeAttribute[operandNode, $TYPECODE];
typeCode ← LengthenTypeCode[context, typeCode]; do this later
AddTypeCodeAttribute[self, $TYPECODE, typeCode];
};
Size:
PROC [typeNode, packingNode:
REF] = {
AssertNotVar[self];
AddAttribute[NARROW[typeNode], $SIZEORNEW, $TRUE];
AnalyzeType[context, typeNode];
IF packingNode #
NIL
THEN {
AddTypeCodeAttribute[packingNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "INT"]];
Assert[AnalyzeExpression[context, packingNode]];
};
AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "INT"]];
};
FirstLast:
PROC [typeNode:
REF] = {
AnalyzeType[context, typeNode];
AddTypeCodeAttribute[self, $TYPECODE, GetTypeValueAttribute[context.types, typeNode]];
WITH UnderType[context.types, GetTypeValueAttribute[context.types, typeNode]]
SELECT
FROM
t: REF TypeRep.subrange => NULL;
t: REF TypeRep.scalar => NULL;
t: REF TypeRep.enumerated => NULL;
ENDCASE => Assert[FALSE, "Scalar, subrange, or enumeration type required here",, typeNode];
};
Narrow:
PROC [exprNode, typeNode:
REF] = {
Assert[AnalyzeExpression[context, exprNode]];
IF typeNode =
NIL
THEN {
PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
}
ELSE {
AnalyzeType[context, typeNode];
AddTypeCodeAttribute[self, $TYPECODE, GetTypeValueAttribute[context.types, typeNode]];
};
};
Nil:
PROC [typeNode:
REF] = {
IF typeNode =
NIL
THEN {PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE]}
ELSE {
AnalyzeType[context, typeNode];
AddTypeCodeAttribute[self, $TYPECODE, GetTypeValueAttribute[context.types, typeNode]];
WITH UnderType[context.types, GetTypeValueAttribute[context.types, typeNode]]
SELECT
FROM
t: REF TypeRep.reference => NULL;
ENDCASE => Assert[FALSE, "Reference type required here",, typeNode];
};
};
New:
PROC [zoneNode, typeNode, valueNode:
REF] = {
AssertNotVar[self];
AddAttribute[NARROW[typeNode], $SIZEORNEW, $TRUE];
AnalyzeType[context, typeNode];
IF valueNode #
NIL
THEN {
AddTypeCodeAttribute[valueNode, $NEEDTYPECODE, GetTypeValueAttribute[context.types, typeNode]];
Assert[AnalyzeExpression[context, valueNode]];
};
AddTypeCodeAttribute[self, $TYPECODE, NewReferenceType[context.types, GetTypeValueAttribute[context.types, typeNode], $REF]];
};
CharLit:
PROC [exprNode:
REF] = {
AddTypeCodeAttribute[exprNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "CHAR"]];
Assert[AnalyzeExpression[context, exprNode]];
AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "CHAR"]];
};
Cons:
PROC [zoneNode, argListNode:
REF] = {
ArgList:
PROC [newElementNode, oldListNode:
REF] = {
listTypeCode: TypeCode = GetTypeCodeAttribute[self, $NEEDTYPECODE];
elementTypeCode: TypeCode = GetListElementTypeCode[context.types, listTypeCode];
AddTypeCodeAttribute[newElementNode, $NEEDTYPECODE, elementTypeCode];
Assert[AnalyzeExpression[context, newElementNode]];
AddTypeCodeAttribute[oldListNode, $NEEDTYPECODE, listTypeCode];
Assert[AnalyzeExpression[context, oldListNode]];
};
Assert[With2[argListNode, list, ArgList], "CONS takes two arguments",,self];
};
Atom:
PROC [operandNode:
REF] = {
AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "ATOM"]];
Assert[AnalyzeExpression[context, operandNode]];
PropagateAttribute[self, $TYPECODE, NARROW[operandNode], $NEEDTYPECODE];
};
Cast:
PROC [operandNode:
REF] = {
IF operandNode #
NIL
THEN {
PropagateAttribute[operandNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
Assert[AnalyzeExpression[context, operandNode]];
PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
};
};
Float:
PROC [operandNode:
REF] = {
AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "REAL"]];
Assert[AnalyzeExpression[context, operandNode]];
PropagateAttribute[self, $TYPECODE, NARROW[operandNode], $NEEDTYPECODE];
};
Ord:
PROC [operandNode:
REF] = {
Assert[AnalyzeExpression[context, operandNode]];
PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
};
MWConst:
PROC [operandNode:
REF] = {
IF operandNode #
NIL
THEN {
PropagateAttribute[operandNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
Assert[AnalyzeExpression[context, operandNode]];
PropagateAttribute[self, $TYPECODE, NARROW[operandNode], $TYPECODE];
};
};
Identifier:
PROC [id:
ROPE] = {
WITH BaseType[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]]
SELECT
FROM
t:
REF TypeRep.enumerated => {
FOR each:
LIST
OF EnumerationItem ¬ t.items, each.rest
UNTIL each =
NIL
DO
IF Rope.Equal[each.first.name, id]
THEN {
AssertNotVar[self];
PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
self.syntaxNodeName ¬ $ENUMERATIONLITERAL;
AddAttribute[self, $FROM, GetTypeName[context, GetTypeCodeAttribute[self, $NEEDTYPECODE], FALSE]];
AddAttribute[self, $ORDINALVALUE, NEW[CARD ¬ each.first.value]];
RETURN;
};
ENDLOOP;
};
ENDCASE => NULL;
WITH LookupSymbol[context, id]
SELECT
FROM
ste:
REF SymbolTableEntryRep.directory => {
AssertNotVar[self];
AddTypeCodeAttribute[self, $TYPECODE, ste.interfaceRecordType.typeCode];
};
ste:
REF SymbolTableEntryRep.other => {
IF ste.readonly THEN AssertNotVar[self];
AddTypeCodeAttribute[self, $TYPECODE, ste.typeCode];
QualifyIdentifierNode[self, ste.qualifier];
};
ENDCASE => Assert[FALSE, "Identifier not an expression: %g", [rope[id]], self];
};
Enable:
PROC [catchNode, statementNode:
REF] = {
IF catchNode # NIL THEN Assert[With2[catchNode, catch, Catch]];
AnalyzeStatement[context, statementNode];
};
Label:
PROC [statementNode, itemsNode:
REF] = {
LabelItem:
PROC [itemNode:
REF] = {
LabelledStatement:
PROC [labelNode, labelledStatementNode:
REF] = {
AnalyzeStatement[context, labelledStatementNode];
};
Assert[With2[itemNode, item, LabelledStatement], "???",,itemsNode];
};
AnalyzeStatement[context, statementNode];
DoList[itemsNode, LabelItem];
};
Catch:
PROC [itemNode, whatsitNode:
REF] = {
CatchItem:
PROC [signalNode, statementNode:
REF] = {
innerContext: Context ¬ context;
IF GetNodeName[signalNode] = $ID
AND Rope.Equal[GetIdentifier[signalNode], "UNWIND"]
THEN NULL
ELSE {
IF AnalyzeExpression[context, signalNode]
THEN {
signalTypeCode: TypeCode = GetTypeCodeAttribute[signalNode];
innerContext ¬ NewContext[context];
WITH UnderType[context.types, signalTypeCode]
SELECT
FROM
type:
REF TypeRep.control => {
WITH UnderType[context.types, type.argumentType]
SELECT
FROM
arguments:
REF TypeRep.record => {
AddFieldListToContext[innerContext, arguments.fieldList];
-- makes the names of the arguments known within the body.
};
ENDCASE => NULL;
IF type.class = $SIGNAL
THEN {
WITH UnderType[context.types, type.returnType]
SELECT
FROM
returns:
REF TypeRep.record => {
AddSymbol[innerContext, "*RESUME-VALUE*", NEW[SymbolTableEntryRep.other ¬ [other[typeCode: type.returnType, readonly: FALSE, constantValue: NIL]]]];
AddFieldListToContext[innerContext, returns.fieldList];
};
ENDCASE => NULL;
};
};
ENDCASE => NULL;
};
};
AnalyzeStatement[innerContext, statementNode];
};
Assert[whatsitNode = NIL, "whatsit?",,whatsitNode];
Assert[With2[itemNode, item, CatchItem], "Bad catch",,self];
};
Literal:
PROC [literal:
REF MPLeaves.LTNode] = {
Should do some checking here.
typeName: ROPE ¬ NIL;
WITH literal.value
SELECT
FROM
r: REF REAL => typeName ¬ "REAL";
r: REF DREAL => typeName ¬ "DREAL";
r: REF INT => typeName ¬ "INT32";
r: REF DINT => IF r IN INT32 THEN typeName ¬ "INT32" ELSE IF r IN DINT[0..CARD32.LAST] THEN typeName ¬ "CARD32" ELSE typeName ¬ "DINT";
r: REF CARD => typeName ¬ "CARD32";
r: REF DCARD => IF r IN CARD32 THEN typeName ¬ "CARD32" ELSE typeName ¬ "DCARD";
r: REF CHAR => typeName ¬ "CHAR";
ENDCASE => NULL;
IF typeName #
NIL
THEN {AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], typeName]]}
ELSE {PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE]};
};
IF analyzeStatement
THEN {
Oops:
PROC = {
[] ¬ Help["Unimplemented statement kind: %g", [refAny[GetNodeName[self]]], self];
};
EachStatement: PROC [item: Tree] = { AnalyzeStatement[context, item] };
IF self = NIL THEN RETURN [TRUE];
IF GetNodeName[self] = $ID
THEN {
Should be a proc (or signal or error) with no arguments.
FunnyApply[self];
Should inspect GetAttribute[self, $TYPECODE];
RETURN [TRUE]
};
IF WithId[self, Identifier]
THEN {
Should check that this is a proc (or signal or error) with no arguments.
RETURN [TRUE]
};
SELECT GetNodeNameCode[self]
FROM
void => NULL;
list => DoList[self, EachStatement];
block => AnalyzeBlockOrBody[context, self];
body => AnalyzeBlockOrBody[context, self];
apply => DoWith3[self, Apply];
assign => DoWith2[self, Assign];
extract => DoWith2[self, Extract];
if => DoWith3[self, If];
case => DoWith3[self, Case];
bind => DoWith4[self, Bind];
do => DoWith6[self, Do];
return => DoWith1[self, Return];
result => Oops[];
goto => NULL;
exit => NULL;
loop => NULL;
free => Oops[];
resume => DoWith1[self, Return];
reject => NULL;
continue => NULL;
retry => Oops[];
lock, wait, notify, broadcast, unlock => Oops[];
null => NULL;
label => DoWith2[self, Label];
open => AnalyzeBlockOrBody[context, self];
enable => DoWith2[self, Enable];
dst, lst, lstf => Oops[];
syscall => NULL;
checked => DoWith1[self, EachStatement];
subst, call, portcall => Oops[];
signal => DoWith1[self, FunnyApply];
error => DoWith1[self, FunnyApply];
syserror => NULL;
xerror => DoWith1[self, FunnyApply];
start, join => Oops[];
ENDCASE => RETURN [FALSE];
RETURN [TRUE]
}
ELSE {
Oops:
PROC = {
[] ¬ Help["Unimplemented expression kind: %g", [refAny[GetNodeName[self]]], self];
};
IF
NOT (WithId[self, Identifier]
OR WithLiteral[self, Literal])
THEN {
SELECT GetNodeNameCode[self]
FROM
apply => DoWith3[self, Apply];
errorx => DoWith1[self, FunnyApply];
syserrorx => NULL;
callx, portcallx, signalx, startx, fork, joinx => Oops[];
index, dindex, seqindex, reloc => Oops[];
construct, union, rowcons, sequence => Oops[];
listcons => DoWith2[self, ListCons];
substx => Oops[];
ifx => DoWith3[self, If];
casex => DoWith3[self, Case];
bindx => DoWith4[self, Bind];
assignx => DoWith2[self, Assign];
or => DoWith2[self, BinaryBoolOp];
and => DoWith2[self, BinaryBoolOp];
relE => DoWith2[self, RelOp];
relN => DoWith2[self, RelOp];
relL => DoWith2[self, RelOp];
relGE => DoWith2[self, RelOp];
relG => DoWith2[self, RelOp];
relLE => DoWith2[self, RelOp];
in => DoWith2[self, In];
notin => DoWith2[self, In];
plus => DoWith2[self, BinaryOp];
minus => DoWith2[self, BinaryOp];
times => DoWith2[self, BinaryOp];
div => DoWith2[self, BinaryOp];
mod => DoWith2[self, BinaryOp];
power => DoWith2[self, BinaryOp];
dot => DoWith2[self, Dot];
cdot, dollar, create => Oops[];
not => DoWith1[self, Unary];
uminus => DoWith1[self, Unary];
addr => DoWith1[self, Addr];
uparrow => DoWith1[self, Uparrow];
min => DoWith1[self, MinMax];
max => DoWith1[self, MinMax];
lengthen => DoWith1[self, Lengthen];
abs => DoWith1[self, Unary];
all => DoWith1[self, All];
size => DoWith2[self, Size];
first => DoWith1[self, FirstLast];
last => DoWith1[self, FirstLast];
pred => DoWith1[self, Unary];
succ => DoWith1[self, Unary];
val => DoWith1[self, Ord];
ord => DoWith1[self, Ord];
arraydesc, length, base => Oops[];
loophole => DoWith2[self, Narrow];
nil => DoWith1[self, Nil];
new => DoWith3[self, New];
void => PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
clit => DoWith1[self, CharLit];
llit => Oops[];
cast => DoWith1[self, Cast];
float => DoWith1[self, Float];
check, float, pad, chop, safen => Oops[];
syscallx => Oops[];
narrow => DoWith2[self, Narrow];
istype, openx => Oops[];
mwconst => DoWith1[self, MWConst];
cons => DoWith2[self, Cons];
atom => DoWith1[self, Atom];
typecode, stringinit, textlit => Oops[];
signalinit => NULL;
procinit => Oops[];
ENDCASE => RETURN [FALSE];
};
{ need: TypeCode = GetTypeCodeAttribute[self, $NEEDTYPECODE];
have: TypeCode = GetTypeCodeAttribute[self, $TYPECODE];
IF need # nullTypeCode
AND have # nullTypeCode
THEN {
coercions: LIST OF REF ¬ Coercions[context: context, from: have, to: need, tree: self];
IF coercions # NIL THEN { AddAttribute[self, $COERCIONS, coercions] };
};
};
RETURN [TRUE];
};
};