SaffronMethods.ThreeC4 (July 16, 1987 4:02:51 pm PDT)
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Lucy Hederman August 20, 1987 3:49:01 pm PDT
Sturgis, July 21, 1987 3:16:17 pm PDT
James Rauen, June 18, 1988 12:27:04 pm PDT
replaced FreezeLocalContext[foo] with FreezeLocalContext[AnalyzeDependencies[foo]]
Last edited by: James Rauen August 18, 1988 1:20:23 am PDT
Include [SaffronAG, SaffronTreeDecls, SaffronBaseDecls];
SaffronMakeFieldList: Module = Begin
RecList
for RecList.empty:  AbstractProduction [ ]
let MakeFieldList [tree, localContext, paintRecords, cs ] ←
< FakeDamageContext[localContext], CreateEmptyFieldList []>
;
for RecList.pairlist:  AbstractProduction [ PairList ]
let MakeFieldList [tree, localContext, paintRecords, cs] ← <localContext1, fieldList>
where <localContext1, fieldList> ←
AddPairsToFieldList [PairList, localContext, newFieldList, paintRecords, cs]
where newFieldList ← CreateEmptyFieldList []
;
for RecList.typelist: AbstractProduction [ TypeList ]
let MakeFieldList [tree, localContext, paintRecords, cs] ← <localContext1, fieldList>
where <localContext1, fieldList> ← AddToFieldList [TypeList, localContext, newFieldList, paintRecords, cs]
where newFieldList ← CreateEmptyFieldList []
;
ParameterList
for ParameterList.empty: AbstractProduction [ ]
let MakeFieldList [tree, localContext, paintRecords, cs ] ←
 <FakeDamageContext[localContext], CreateEmptyFieldList []>
;
for ParameterList.any: AbstractProduction [ ]
let MakeFieldList [tree, localContext, paintRecords, cs] ←
      <FakeDamageContext [localContext], AnyFieldList []>
;
for ParameterList.pairlist: AbstractProduction [ PairList ]
let MakeFieldList [tree, localContext, paintRecords, cs] ← <localContext1, fieldList>
where <localContext1, fieldList> ←
AddPairsToFieldList [PairList, localContext, newFieldList, paintRecords, cs]
where newFieldList ← CreateEmptyFieldList []
;
for ParameterList.typelist: AbstractProduction [ TypeList ]
let MakeFieldList [tree, localContext, paintRecords, cs] ← <localContext1, fieldList>
where <localContext1, fieldList> ← AddToFieldList [TypeList, localContext, newFieldList, paintRecords, cs]
where newFieldList ← CreateEmptyFieldList []
;
VariantList
for VariantList.one: AbstractProduction [ VariantItem ]
let MakeUnionList [tree, localContext, paintRecords, cs] ←
AddVariantsToUnionList [VariantItem, localContext, newUnionList, paintRecords, cs]
where newUnionList ← CreateEmptyUnionList []
let AddVariantsToUnionList [tree, localContext, unionList, paintRecords, cs] ←
AddVariantsToUnionList [VariantItem, localContext, unionList, paintRecords, cs]
let MakeStarTagType [tree, localContext] ← <localContext2, tgn>
where localContext2 ←
AddVariantNamesToEnumTypeTGN [VariantItem, localContext1, tgn]
where <localContext1, tgn> ← CreateEmptyEnumTypeTGN [localContext, False []]
let AddVariantNamesToEnumTypeTGN [tree, localContext, tgn] ←
AddVariantNamesToEnumTypeTGN [VariantItem, localContext, tgn]
;
for VariantList.more: AbstractProduction [ VariantList, VariantItem ]
let MakeUnionList [tree, localContext, paintRecords, cs] ←
AddVariantsToUnionList [VariantItem, localContext1, unionList, paintRecords, cs]
where <localContext1, unionList> ←
AddVariantsToUnionList [VariantList, localContext, newUnionList, paintRecords, cs]
where newUnionList ← CreateEmptyUnionList []
let AddVariantsToUnionList [tree, localContext, unionList, paintRecords, cs] ←
AddVariantsToUnionList [VariantItem, localContext1, unionList1, paintRecords, cs]
where <localContext1, unionList1> ←
AddVariantsToUnionList [VariantList, localContext, unionList, paintRecords, cs]
let MakeStarTagType [tree, localContext] ← <localContext3, tgn>
where localContext3 ←
AddVariantNamesToEnumTypeTGN [VariantItem, localContext2, tgn]
where localContext2 ←
AddVariantNamesToEnumTypeTGN [VariantList, localContext1, tgn]
where <localContext1, tgn> ← CreateEmptyEnumTypeTGN [localContext, False []]
let AddVariantNamesToEnumTypeTGN [tree, localContext, tgn] ←
AddVariantNamesToEnumTypeTGN [VariantItem, localContext1, tgn]
where localContext1 ←
AddVariantNamesToEnumTypeTGN [VariantList, localContext, tgn]
;
VariantItem
for VariantItem: AbstractProduction [ IdList, RecList ]
let AddVariantsToUnionList [tree, localContext, unionList, paintRecords, cs] ← < localContext1, AddNamesToUnionList [IdList, ffl, unionList]>
where ffl ← FreezeFieldList [fieldList]
where <localContext1, fieldList> ← MakeFieldList [RecList, localContext, paintRecords, cs ]
let AddVariantNamesToEnumTypeTGN [tree, localContext, tgn] ←
AddVariantNamesToEnumTypeTGN [IdList, localContext, tgn]
;
IdList
for IdList.one: AbstractProduction [ Id ]
let AddNamesToUnionList [tree, ffl, unionList] ← AppendToUnionList [unionList, Id, ffl]
let AddVariantNamesToEnumTypeTGN [tree, localContext, tgn] ←
AppendElementToEnumTypeTGN [localContext, tgn, Id, MakeUnparsedNullValue[]]
let AddIdsToRestrictionList[tree, namedTGN] ← AddIdToRestrictionList[Id, namedTGN]
let AddIdsToInterfaceTGN [tree, localContext, interfaceTGN, interface] ←
AddTGNToInterfaceTGN [localContext1, interfaceTGN, Id, accessVal, linkTgn]
where <localContext1, linkTgn> ← CreateLinkTGN [localContext, entryTgn, interface, Id]
entryTgn is NIL if the Id is for an entry point rather than a type.
Until we know about entry points we can't handle this correctly
where <accessVal, entryTgn> ← LookupInterfaceEntry [interface, Id]
;
for IdList.more: AbstractProduction [ Id, IdList ]
let AddNamesToUnionList [tree, ffl, unionList] ←
AddNamesToUnionList [IdList, ffl, unionList1]
where unionList1 ← AppendToUnionList [unionList, Id, ffl]
let AddVariantNamesToEnumTypeTGN [tree, localContext, tgn] ←
AddVariantNamesToEnumTypeTGN [IdList, localContext1, tgn]
where localContext1 ← AppendElementToEnumTypeTGN [localContext, tgn, Id, MakeUnparsedNullValue[]]
let AddIdsToRestrictionList[tree, tgn] ← tgn2
where tgn2 ← AddIdsToRestrictionList[IdList, tgn1]
where tgn1 ← AddIdToRestrictionList[Id, tgn]
let AddIdsToInterfaceTGN [tree, localContext, interfaceTGN, interface] ←
  AddIdsToInterfaceTGN [IdList, localContext2, interfaceTGN, interface]
where localContext2 ←
AddTGNToInterfaceTGN [localContext1, interfaceTGN, Id, accessVal, linkTgn]
where <localContext1, linkTgn> ← CreateLinkTGN [localContext, entryTgn, interface, Id]
where <accessVal, entryTgn> ← LookupInterfaceEntry [interface, Id]
verify that entryTgn is as intended
;
Tag
for Tag.ident: AbstractProduction [ Ident, Access, TagType ]
let MakeVariantFlavor [tree, cs] ← VanillaVariantFlavorVal [
GetIdentInfo [Ident],
GetAccessVal [Access, GetDefaultAccess[cs]]]
let MakeTagType [tree, localContext, paintRecords, cs] ←
MakeTagType [TagType, localContext, paintRecords, cs]
let GetSequenceTagInfo [tree, cs] ← <GetIdentInfo [Ident], GetAccessVal [Access, GetDefaultAccess[cs]]>
;
for Tag.computed: AbstractProduction [ TagType ]
let MakeVariantFlavor [tree, cs] ← ComputedVariantFlavorConst []
let MakeTagType [tree, localContext, paintRecords, cs] ←
MakeTagType [TagType, localContext, paintRecords, cs]
let GetSequenceTagInfo [tree, cs] ← <NullId [], NullPosition [], AccessValConst ["empty"]>
;
for Tag.overlaid: AbstractProduction [ TagType ]
let MakeVariantFlavor [tree, cs] ← OverlaidVariantFlavorConst []
let MakeTagType [tree, localContext, paintRecords, cs] ←
MakeTagType [TagType, localContext, paintRecords, cs]
let GetSequenceTagInfo [tree, cs] ← <NullId [], NullPosition [], AccessValConst ["empty"]>
where x ← Error ["Sequences can't be overlaid"]
;
TagType
for TagType.star: AbstractProduction [ ]
let MakeTagType [tree, localContext, paintRecords, cs] ←
<localContext1, GetBottom [cs], True []>
where localContext1 ← FakeDamageContext [localContext]
;
for TagType.typeexp: AbstractProduction [ TypeExp ]
let MakeTagType [tree, localContext, paintRecords, cs] ←
<MakeType [TypeExp, localContext, paintRecords, cs], False []>
;
End;
SaffronAddToFieldList: Module = Begin
TypeList
for TypeList.many: AbstractProduction [ TypeList.head, TypeList.tail ]
let AddToFieldList [tree, localContext, fieldList, paintRecords, cs] ←
AddToFieldList [ TypeList.tail, localContext1, fieldList1, paintRecords, cs]
where <localContext1, fieldList1> ←
AddToFieldList [ TypeList.head, localContext, fieldList, paintRecords, cs]
;
for TypeList.one: AbstractProduction [ TypeItem ]
let AddToFieldList [tree, localContext, fieldList, paintRecords, cs] ←
AddToFieldList [ TypeItem, localContext, fieldList, paintRecords, cs]
;
TypeItem
for TypeItem: AbstractProduction [ TypeExp, Default ]
let AddToFieldList [tree, localContext, fieldList, paintRecords, cs] ← <localContext1, fieldList1>
where fieldList1 ← AppendFieldToFieldList [ fieldList, field]
where field ← CreateUnnamedField [tgn, defaultExp]
where <localContext1, tgn> ← MakeType [TypeExp, localContext, paintRecords, cs]
where defaultExp ← GetDefaultExpVal [Default]
End;
SaffronAddPairsToFieldList: Module = Begin
PairList
for PairList.many: AbstractProduction [ PairList.head, PairList.tail ]
let AddPairsToFieldList [tree, localContext, fieldList, paintRecords, cs] ←
AddPairsToFieldList [ PairList.tail, localContext1, fieldList1, paintRecords, cs]
where <localContext1, fieldList1> ←
AddPairsToFieldList [PairList.head, localContext, fieldList, paintRecords, cs]
;
for PairList.one: AbstractProduction [ PairItem ]
let AddPairsToFieldList [tree, localContext, fieldList, paintRecords, cs] ←
AddPairsToFieldList [PairItem, localContext, fieldList, paintRecords, cs]
;
PairItem
for PairItem: AbstractProduction [ IdentList, Access, TypeExp, Default ]
let AddPairsToFieldList [tree, localContext, fieldList, paintRecords, cs] ←
< localContext1, AddNamesToFieldList [IdentList, accessVal, tgn, defaultExp, fieldList] >
where <localContext1, tgn> ← MakeType [TypeExp, localContext, paintRecords, cs]
where accessVal ← GetAccessVal [Access, GetDefaultAccess[cs]]
where defaultExp ← GetDefaultExpVal [Default]
;
Access
for Access.empty:  AbstractProduction [ ]
let GetAccessVal [tree, default] ← FakeCopyAccessVal[default];
for Access.public:  AbstractProduction [ ]
let GetAccessVal [tree, default] ← AccessValConst ["public"];
for Access.private: AbstractProduction [ ]
let GetAccessVal [tree, default] ← AccessValConst ["private"];
End;
SaffronAddNamesToFieldList: Module = Begin
IdentList
for IdentList.many: AbstractProduction [ IdentList.head, IdentList.tail ]
let AddNamesToFieldList [tree, accessVal, tgn, defaultExp, fieldList] ←
AddNamesToFieldList [IdentList.tail, accessVal, tgn, defaultExp, fieldList1]
where fieldList1 ← AddNamesToFieldList [IdentList.head, accessVal, tgn, defaultExp, fieldList]
let AddNamedFieldsToFieldList [tree, templateField, fieldList] ← fl2
where fl2 ← AddNamedFieldsToFieldList [IdentList.tail, templateField, fl1]
where fl1 ← AddNamedFieldsToFieldList [IdentList.head, templateField, fieldList]
let PutNewTypeNamesInLocalContext[tree, localContext, accessVal]←
PutNewTypeNamesInLocalContext[IdentList.tail, localContext1, accessVal]
where localContext1 ←
PutNewTypeNamesInLocalContext[IdentList.head, localContext, accessVal]
let PutNewVariableNamesInLocalContext[tree, localContext, accessVal, constant]←
PutNewVariableNamesInLocalContext[IdentList.tail, localContext1, accessVal, constant]
where localContext1 ←
PutNewVariableNamesInLocalContext[IdentList.head, localContext, accessVal, constant]
let RecAddArcsfromLVTGNtoTGN[tree, localContext, accessVal, tgn, defaultExp]←
RecAddArcsfromLVTGNtoTGN[IdentList.tail, localContext1, accessVal, tgn, defaultExp]
where localContext1 ← RecAddArcsfromLVTGNtoTGN[IdentList.head, localContext, accessVal, tgn, defaultExp]
let RecAddArcsFromLocalNameToInstance[tree, localContext, accessVal, instance]←
RecAddArcsFromLocalNameToInstance[IdentList.tail, localContext1, accessVal, instance]
where localContext1 ← RecAddArcsFromLocalNameToInstance[IdentList.head, localContext, accessVal, instance]
let MakeNameSequence [tree] ← AddNamesToSequence [IdentList.head, nameSequence1]
where nameSequence1 ← AddNamesToSequence [IdentList.tail, nameSequence]
where nameSequence ← EmptyNameSequence []
let AddNamesToSequence [tree, nameSequence] ←
  AddNamesToSequence [IdentList.head, nameSequence1]
where nameSequence1 ← AddNamesToSequence [IdentList.tail, nameSequence]
;
for IdentList.one: AbstractProduction [ Ident ]
let AddNamesToFieldList [tree, accessVal, tgn, defaultExp, fieldList] ←
AddNamesToFieldList [Ident, accessVal, tgn, defaultExp, fieldList]
let AddNamedFieldsToFieldList [tree, templateField, fieldList] ← fl1
where fl1 ← AddNamedFieldsToFieldList [Ident, templateField, fieldList]
let PutNewTypeNamesInLocalContext[tree, localContext, accessVal] ←
PutNewTypeNamesInLocalContext[Ident, localContext, accessVal]
let PutNewVariableNamesInLocalContext[tree, localContext, accessVal, constant] ←
PutNewVariableNamesInLocalContext[Ident, localContext, accessVal, constant]
let RecAddArcsfromLVTGNtoTGN[tree, localContext, accessVal, tgn, defaultExp] ←
RecAddArcsfromLVTGNtoTGN[Ident, localContext, accessVal, tgn, defaultExp]
let RecAddArcsFromLocalNameToInstance[tree, localContext, accessVal, instance] ←
RecAddArcsFromLocalNameToInstance[Ident, localContext, accessVal, instance]
let MakeNameSequence [tree] ← AddNamesToSequence [Ident, nameSequence]
where nameSequence ← EmptyNameSequence []
let AddNamesToSequence [tree, nameSequence] ←
  AddNamesToSequence [Ident, nameSequence]
;
Ident
for Ident.id: AbstractProduction [ Id ]
let AddNamesToFieldList [tree, accessVal, tgn, defaultExp, fieldList] ←
AppendFieldToFieldList [fieldList, field]
where field ← CreateNamedField [Id, NullPosition [], accessVal, tgn, defaultExp]
let AddNamedFieldsToFieldList [tree, templateField, fieldList] ← fl1
where fl1 ← AppendFieldToFieldList[fieldList, field]
where field ← RenameField[templateField, Id]
let PutNewTypeNamesInLocalContext[tree, localContext, accessVal] ← localContext1
where <localContext1, tgn> ← CreateLocallyVisibleTGN [localContext, Id, accessVal ]
let PutNewVariableNamesInLocalContext[tree, localContext, accessVal, constant] ← localContext1
where localContext1 ← AddVariableName[localContext, Id, accessVal, constant]
let RecAddArcsfromLVTGNtoTGN[tree, localContext, accessVal, tgn, defaultExp] ←
AddArcFromLVTGNToTGN [localContext, lvtgn, accessVal, tgn, defaultExp]
where lvtgn ← LookupTypeNameInLocalContext [localContext, Id]
let RecAddArcsFromLocalNameToInstance[tree, localContext, accessVal, instance] ←
AddArcFromLocalNameToInstance [localContext, Id, accessVal, instance]
let GetIdentInfo [tree] ← <Id, NullPosition []>
let AddNamesToSequence [tree, nameSequence] ←
  InsertNameOnNameSequence [Id, nameSequence]
;
for Ident.idposition: AbstractProduction [ Id, Position ]
let AddNamesToFieldList [tree, accessVal, tgn, defaultExp, fieldList] ←
AppendFieldToFieldList [fieldList, field]
where field ← CreateNamedField [Id, GetPositionVal [Position], accessVal, tgn, defaultExp]
let AddNamedFieldsToFieldList [tree, templateField, fieldList] ← fl1
where fl1 ← AppendFieldToFieldList[fieldList, field]
where field ← RenameField[templateField, Id]
it would be nice to pass Position to RenameField....
let PutNewTypeNamesInLocalContext[tree, localContext, accessVal] ← localContext1
where <localContext1, tgn> ← CreateLocallyVisibleTGN [localContext, Id, accessVal ]
let PutNewVariableNamesInLocalContext[tree, localContext, accessVal, constant] ← localContext1
where localContext1 ← AddVariableName[localContext, Id, accessVal, constant]
let RecAddArcsfromLVTGNtoTGN[tree, localContext, accessVal, tgn, defaultExp] ←
AddArcFromLVTGNToTGN [localContext, lvtgn, accessVal, tgn, defaultExp]
where lvtgn ← LookupTypeNameInLocalContext [localContext, Id]
let RecAddArcsFromLocalNameToInstance[tree, localContext, accessVal, instance] ←
AddArcFromLocalNameToInstance [localContext, Id, accessVal, instance]
let GetIdentInfo [tree] ← <Id, GetPositionVal [Position]>
let AddNamesToSequence [tree, nameSequence] ←
  InsertNameOnNameSequence [Id, nameSequence]
where x ← Error ["Is Position field valid in a ModuleName list"]
;
Position
for Position: AbstractProduction [ Exp, OptBits ]
let GetPositionVal [tree] ← PositionValFun [MakeUnparsedValue [Exp], boundsVal]
where boundsVal ← GetBoundsVal [OptBits]
;
OptBits
for OptBits.absent: AbstractProduction [ ]
let GetBoundsVal [tree] ← NullBounds []
;
for OptBits.present: AbstractProduction [ Bounds ]
let GetBoundsVal [tree] ← BoundsValFun ["[", GetLowerAndUpper [Bounds], "]"]
;
End;
SaffronMakeElementList: Module = Begin
ElementList
for ElementList.empty: AbstractProduction [ ]
let MakeElementList [tree, localContext, machineDependent] ← CreateEmptyEnumTypeTGN [localContext, machineDependent]
;
for ElementList.more: AbstractProduction [ ElementList, Element ]
let MakeElementList [tree, localContext, machineDependent] ← <localContext1, tgn>
where localContext1 ←
AppendElementToEnumTypeTGN [localContext2, tgn, elementName, rep]
where <localContext2, tgn> ← MakeElementList [ElementList, localContext, machineDependent]
where <elementName, rep> ← ElementInfo [Element]
End;
SaffronElementName: Module = Begin
Element
for Element.id: AbstractProduction [ Id ]
let ElementInfo [tree] ← <Id, MakeUnparsedNullValue[]>
;
for Element.idwithrep: AbstractProduction [ Id, Exp ]
let ElementInfo [tree] ← <Id, MakeUnparsedValue [Exp]>
;
for Element.anonymousrep: AbstractProduction [ Exp ]
let ElementInfo [tree] ← <NullId [], MakeUnparsedValue [Exp]>
;
Exp
for Exp.id: AbstractProduction [ Id ]
let IdVal [tree] ← Id
;
for Exp.sum: AbstractProduction [ Exp.left, AddOp, Exp.right ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.unarysum: AbstractProduction [ AddOp, Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.product: AbstractProduction [ Exp.left, MultOp, Exp.right ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.or: AbstractProduction [ Exp.left, Exp.right ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.and: AbstractProduction [ Exp.left, Exp.right ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.not: AbstractProduction [ Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.relation: AbstractProduction [ Exp, Relation ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.ifthenelse: AbstractProduction [ Exp.cond, Exp.thenpart, Exp.elsepart ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.select: AbstractProduction [ SelectHead, SelectExpList, Exp.default ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.assign: AbstractProduction [ Exp.lhs, Exp.rhs ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.multiassign: AbstractProduction [ ExpList, Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.num: AbstractProduction [ Num ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.string: AbstractProduction [ String ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.flnum: AbstractProduction [ Flnum ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.char: AbstractProduction [ Char ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.atom: AbstractProduction [ Atom ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.narrow: AbstractProduction [ Exp, OptType, Catch ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.loophole: AbstractProduction [ Exp, OptType ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.apply: AbstractProduction [ Exp.rator, Exp.rand, Catch ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.qualifier: AbstractProduction [ Exp, Qualifier ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.explist: AbstractProduction [ ExpList ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.prefixop: AbstractProduction [ PrefixOp, OrderList ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.val: AbstractProduction [ OrderList ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.all: AbstractProduction [ OrderList ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.new: AbstractProduction [ New, TypeExp, Initialization, Catch ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.cons: AbstractProduction [ Cons, ExpList, Catch ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.listcons: AbstractProduction [ ListCons, ExpList ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.nil: AbstractProduction [ ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.typeop: AbstractProduction [ TypeOp, TypeExp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.size: AbstractProduction [ TypeExp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.size2: AbstractProduction [ TypeExp, Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.bits: AbstractProduction [ TypeExp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.bits2: AbstractProduction [ TypeExp, Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.bytes: AbstractProduction [ TypeExp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.bytes2: AbstractProduction [ TypeExp, Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.units: AbstractProduction [ TypeExp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.units2: AbstractProduction [ TypeExp, Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.words: AbstractProduction [ TypeExp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.words2: AbstractProduction [ TypeExp, Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.istype: AbstractProduction [ Exp, TypeExp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.address: AbstractProduction [ Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.descriptor: AbstractProduction [ DescList ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.error: AbstractProduction [ ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
for Exp.transfer: AbstractProduction [ TransferOp, Exp ]
let IdVal [tree] ← NullId [] where x ← Error ["Expected an Id"];
End;
SaffronScope: Module = Begin
Scope
Look carefully at this. The syntax does not match the nesting semantics.
for Scope: AbstractProduction [ BindList, Catch, OptDecList, StatementList ]
let MakeContextTree [tree, rib, paintRecords, cs] ←
Make the contextTree for the entire scope, nesting everything else inside the bindlist's context.
MakeBindListContextTreeWithScope [BindList, scopePTree, rib, paintRecords, cs]
where scopePTree ← ScopePTreeVal [tree]
let MakeContextTree1 [tree, rib, paintRecords, cs] ←
Make the contextTree for the context nested within the BindList.
HangContextsFromContextTree [StatementList, decListContextTree, newRib, paintRecords, cs]
where decListContextTree ← HangContextsFromContextTree [OptDecList, thisScopeContextTree, newRib, paintRecords, cs]
where thisScopeContextTree ← EmptyContextTree [newRib]
(process statements here? this will probably require a nested context for newly constructed types, but they can never be circular)
where newRib ← FreezeLocalContext[thisScopeLocalContext]
(note: Freeze will "process" the type graph, looking for cycles etc.)
where thisScopeLocalContext ← UpdateLocalContext [OptDecList, localContext, paintRecords, cs]
where localContext ← CreateEmptyContext [rib, False[]]
;
ignoring Catch in Scope
BindList
for BindList.empty: AbstractProduction [ ]
let MakeBindListContextTreeWithDefBody [tree, defBodyPTree, rib, paintRecords, cs] ←
MakeContextTree1 [defBody, rib, paintRecords, cs]
where defBody ← DefBodyVal [defBodyPTree]
avoids making an unnecessary context tree node
let MakeBindListContextTreeWithScope [tree, scopePTree, rib, paintRecords, cs] ←
MakeContextTree1 [scope, rib, paintRecords, cs]
where scope ← ScopeVal [scopePTree]
avoids making an unnecessary context tree node
let UpdateLocalContext [tree, localContext, paintRecords, cs] ←
FakeDamageContext [localContext]
;
for BindList.more: AbstractProduction [ BindList, BindItem ]
Semantically the scope creates a subcontext (contextTree2) of the Bindlist.
Rib2 is the rib corresponding to the context of Bindlist.
let MakeBindListContextTreeWithDefBody [tree, defBodyPTree, rib, paintRecords, cs] ←
 AddSubContextTree [EmptyContextTree [rib2], contextTree2]
where contextTree2 ← MakeContextTree1[defBody, rib2, paintRecords, cs]
where defBody ← DefBodyVal [defBodyPTree]
where rib2 ← FreezeLocalContext[bindListsLocalContext]
where bindListsLocalContext ← UpdateLocalContext [tree, localContext, paintRecords, cs]
where localContext ← CreateEmptyContext [rib, False[]]
let MakeBindListContextTreeWithScope [tree, scopePTree, rib, paintRecords, cs] ←
 AddSubContextTree [EmptyContextTree [rib2], contextTree2]
where contextTree2 ← MakeContextTree1[scope, rib2, paintRecords, cs]
where scope ← ScopeVal [scopePTree]
where rib2 ← FreezeLocalContext[bindListsLocalContext]
where bindListsLocalContext ← UpdateLocalContext [tree, localContext, paintRecords, cs]
where localContext ← CreateEmptyContext [rib, False[]]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ←
UpdateLocalContext [BindItem, localContext1, paintRecords, cs]
where localContext1 ← UpdateLocalContext [BindList, localContext, paintRecords, cs]
;
BindItem
for BindItem.named: AbstractProduction [ Id, Exp ]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ←
RenameInterface [localContext, Id, interfaceTgn]
where interfaceTgn ← LookupTypeNameInLocalContext [localContext, IdVal [Exp]]
;
for BindItem.unnamed: AbstractProduction [ Exp ]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ←
OpenInterface [localContext, interfaceTgn]
where interfaceTgn ← LookupTypeNameInLocalContext [localContext, IdVal [Exp]]
;
OptDecList
for OptDecList.absent: AbstractProduction [ ]
let AddDeclarationsToFieldList[tree, fieldList, localContext, cs] ← <
FakeDamageFieldList[fieldList],
FakeDamageContext[localContext]
>
let UpdateLocalContext [tree, localContext, paintRecords, cs] ←
FakeDamageContext [localContext]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree];
for OptDecList.present: AbstractProduction [ DecList ]
let AddDeclarationsToFieldList[tree, fieldList, localContext, cs] ←
AddDeclarationsToFieldList[DecList, fieldList, localContext, cs]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ←
UpdateLocalContext [DecList, localContext, paintRecords, cs]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ← localContext2
where localContext2 ← stuff fl into wherever.
where localContext2 ← localContext1
where <fl, localContext1> ← MakeFieldListFromDecList[DecList, localContext, cs]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
HangContextsFromContextTree [DecList, contextTree, rib, paintRecords, cs]
;
for OptDecList.present: AbstractProduction [ DecList ]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ←
FillInLocalContext [DecList, localContext1, paintRecords, cs]
where localContext1 ← PutNewNamesInLocalContext [DecList, localContext, cs]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
HangContextsFromContextTree [DecList, contextTree, rib, paintRecords, cs]
;
DecList
for DecList.many: AbstractProduction [ DecList.head, DecList.tail ]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ← lc3
where lc3 ← AddDeclarationsToLocalContext[fl2, lc2, cs]
where <fl2, lc2> ← AddDeclarationsToFieldList[tree, fl1, localContext, cs]
where fl1 ← CreateEmptyFieldList[]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ← lc1
where lc1 ← FakeDamageContext[localContext]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ← lc1
where lc1 ← CompileDecList[tree, localContext, cs]
let AddDeclarationsToFieldList [tree, fl, localContext, cs] ← <fl2, lc2>
where <fl2, lc2> ← AddDeclarationsToFieldList[DecList.tail, fl1, lc1, cs]
where <fl1, lc1> ← AddDeclarationsToFieldList[DecList.head, fl, localContext, cs]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ←
FillInLocalContext [tree, localContext1, paintRecords, cs]
where localContext1 ← PutNewNamesInLocalContext [tree, localContext, cs]
let PutNewNamesInLocalContext [tree, localContext, cs] ←
PutNewNamesInLocalContext [DecList.tail, localContext1, cs]
where localContext1 ← PutNewNamesInLocalContext [DecList.head, localContext, cs]
let FillInLocalContext [tree, localContext, paintRecords, cs] ←
FillInLocalContext [DecList.tail, localContext1, paintRecords, cs]
where localContext1 ← FillInLocalContext [DecList.head, localContext, paintRecords, cs]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
HangContextsFromContextTree [DecList.tail, contextTree1, rib, paintRecords, cs]
where contextTree1 ← HangContextsFromContextTree [DecList.head, contextTree, rib, paintRecords, cs]
;
for DecList.one: AbstractProduction [ Declaration ]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ← lc1
where lc1 ← FakeDamageContext[localContext]
where lc1 ← CompileDecList[tree, localContext, cs]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ← lc3
where lc3 ← AddDeclarationsToLocalContext[fl2, lc2, cs]
where <fl2, lc2> ← AddDeclarationsToFieldList[tree, fl1, localContext, cs]
where fl1 ← CreateEmptyFieldList[]
let AddDeclarationsToFieldList [tree, fl, localContext, cs] ← <fl1, lc1>
where <fl1, lc1> ← AddDeclarationToFieldList[Declaration, fl, localContext, cs]
let UpdateLocalContext [tree, localContext, paintRecords, cs] ←
FillInLocalContext [tree, localContext1, paintRecords, cs]
where localContext1 ← PutNewNamesInLocalContext [tree, localContext, cs]
let PutNewNamesInLocalContext[tree, localContext, cs] ←
PutNewNamesInLocalContext[Declaration, localContext, cs]
let FillInLocalContext[tree, localContext, paintRecords, cs] ←
FillInLocalContext[Declaration, localContext, paintRecords, cs]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
HangContextsFromContextTree [Declaration, contextTree, rib, paintRecords, cs]
;
Declaration
for Declaration.opaquetype: AbstractProduction [ IdentList, Access, OptSize ]
let AddDeclarationToFieldList[tree, fl, localContext, cs] ← AddTypeDeclarationToFieldList[IdentList, fl, lc2, cs, idAccess, typeAccess, tgn, typeExp, default]
where idAccess ← GetAccessVal[Access, GetDefaultAccess[cs]]
where typeAccess ← NullAccessVal[]
where typeExp ← BogusTypeExpPTree[] -- this is okay; there is no such thing as an anonymous opaque type constructor, so this will never be used. Trust me.
where default ← NullDefaultVal[]
where <lc2, tgn> ← CreateOpaqueTGN [lc1, paint, sizeExp]
where <lc1, paint> ← GetUniquePaint [localContext]
where sizeExp ← GetExpVal [OptSize]
let AddDeclarationToFieldList[tree, fl, localContext, cs] ← <fl1, lc3>
where fl1 ← AddNamedFieldsToFieldList[IdentList, templateField, fl]
where templateField ← CreateNamedTypeField[name1, position1, access1, namedTGN]
where name1 ← IdFromRope["(Fill me in)"]
where position1 ← NullPosition[]
where access1 ← GetAccessVal[Access, GetDefaultAccess[cs]]
where <lc3, namedTGN> ← CreateNamedTGN[lc2, name, position, access, tgn, default]
where name ← IdFromRope["(Named TGN)"]
where position ← NullPosition[]
where access ← NullAccessVal[]
where default ← NullDefaultVal[]
where <lc2, tgn> ← CreateOpaqueTGN [localContext1, paint, sizeExp]
where <localContext1, paint> ← GetUniquePaint [localContext]
where sizeExp ← GetExpVal [OptSize]
let PutNewNamesInLocalContext[tree, localContext, cs] ←
PutNewTypeNamesInLocalContext[IdentList, localContext, GetAccessVal[Access, GetDefaultAccess[cs]]]
let FillInLocalContext[tree, localContext, paintRecords, cs] ←
RecAddArcsfromLVTGNtoTGN [IdentList, localContext2, NullAccessVal [], tgn, NullDefaultVal []]
where <localContext2, tgn> ← CreateOpaqueTGN [localContext1, paint, sizeExp]
where <localContext1, paint> ← GetUniquePaint [localContext]
where sizeExp ← GetExpVal [OptSize]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
ignoring optsize
for Declaration.type: AbstractProduction [ IdentList, Access.id, Access.type, TypeExp, Default ]
let AddDeclarationToFieldList[tree, fl, localContext, cs] ← AddTypeDeclarationToFieldList[IdentList, fl, lc2, cs, idAccess, typeAccess, tgn, typeExp, default]
where idAccess ← GetAccessVal[Access.id, GetDefaultAccess[cs]]
where typeAccess ← GetAccessVal[Access.type, GetDefaultAccess[cs]]
where typeExp ← TypeExpPTreeVal[TypeExp]
where default ← GetDefaultExpVal [Default]
where <lc2, tgn> ← MakeType [TypeExp, lc1, paintRecords, cs]
where paintRecords ← True[] -- this is a crock!
where <lc1, paint> ← GetUniquePaint [localContext]
let AddDeclarationToFieldList[tree, fl, localContext, cs] ← <fl1, lc3>
where fl1 ← AddNamedFieldsToFieldList[IdentList, templateField, fl]
where templateField ← CreateNamedTypeField[name1, position1, access1, namedTGN]
where name1 ← IdFromRope["(Fill me in)"]
where position1 ← NullPosition[]
where access1 ← GetAccessVal[Access.id, GetDefaultAccess[cs]]
where <lc3, namedTGN> ← CreateNamedTGN[lc2, name, position, access, tgn, default]
where name ← IdFromRope["(Named TGN)"]
where position ← NullPosition[]
where access ← GetAccessVal[Access.type, GetDefaultAccess[cs]]
where default ← GetDefaultExpVal [Default]
where <lc2, tgn> ← MakeType [TypeExp, localContext1, paintRecords, cs]
where paintRecords ← True[] -- this is a crock!
where <localContext1, paint> ← GetUniquePaint [localContext]
let PutNewNamesInLocalContext[tree, localContext, cs] ←
PutNewTypeNamesInLocalContext[IdentList, localContext, GetAccessVal[Access.id, GetDefaultAccess[cs]]]
let FillInLocalContext[tree, localContext, paintRecords, cs] ←
RecAddArcsfromLVTGNtoTGN [IdentList, localContext1, GetAccessVal[Access.type, GetDefaultAccess[cs]], tgn, defaultExp]
where <localContext1, tgn> ← MakeType [TypeExp, localContext, paintRecords, cs]
where defaultExp ← GetDefaultExpVal [Default]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Declaration.value: AbstractProduction [ IdentList, Access, Entry, ReadOnly, TypeExp, Initialization ]
let AddDeclarationToFieldList[tree, fl, localContext, cs] ← <fl1, lc1>
where fl1 ← AddValueDeclarationToFieldList[IdentList, fl, cs, parseTree, access, tgn, init]
where parseTree ← DeclarationPTreeVal[tree]
where init ← InitializationPTreeVal[Initialization]
where access ← GetAccessVal[Access, GetDefaultAccess[cs]]
where <lc1, tgn> ← MakeType [TypeExp, localContext, paintRecords, cs]
where paintRecords ← True[] -- this is a crock!
let AddDeclarationToFieldList[tree, fl, localContext, cs] ← <fl1, lc2>
where fl1 ← AddNamedFieldsToFieldList[IdentList, templateField, fl]
where templateField ← if InitializationIsBinding[Initialization]
then CreateConstantField[name, position, access, tgn, value]
else CreateVariableField[name, position, access, tgn, value]
where name ← IdFromRope["(Fill me in)"]
where position ← NullPosition[]
where access ← GetAccessVal[Access, GetDefaultAccess[cs]]
where <value, lc2> ← GetInitialValue[Initialization, tgn, lc1, cs]
where <lc1, tgn> ← MakeType [TypeExp, localContext, paintRecords, cs]
where paintRecords ← True[] -- this is a crock!
let PutNewNamesInLocalContext[tree, localContext, cs] ← PutNewVariableNamesInLocalContext[IdentList, localContext, GetAccessVal[Access, GetDefaultAccess[cs]], GetBooleanVal[ReadOnly]]
so far, we're only evaluating the initialization expressions...
let FillInLocalContext[tree, localContext, paintRecords, cs] ← RecAddArcsFromLocalNameToInstance[IdentList, localContext2, GetAccessVal[Access, GetDefaultAccess[cs]], initializationInstance]
where <initializationInstance, localContext2> ←
GetInitialValue[Initialization, tgn, localContext1, cs]
where <localContext1, tgn> ← MakeType [TypeExp, localContext, paintRecords, cs]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
ignoring value declarations
for IdentList.many:    AbstractProduction [IdentList.head, IdentList.tail]
let AddValueDeclarationToFieldList[tree, fl, cs, parseTree, access, tgn, init] ← fl2
where fl2 ← AddValueDeclarationToFieldList[IdentList.tail, fl1, cs, parseTree, access, tgn, init]
where fl1 ← AddValueDeclarationToFieldList[IdentList.head, fl, cs, parseTree, access, tgn, init]
let AddTypeDeclarationToFieldList[tree, fl, lc, cs, idAccess, typeAccess, tgn, typeExp, default] ← <fl2, lc2>
where <fl2, lc2> ← AddTypeDeclarationToFieldList[IdentList.tail, fl1, lc1, cs, idAccess, typeAccess, tgn, typeExp, default]
where <fl1, lc1> ← AddTypeDeclarationToFieldList[IdentList.head, fl, lc, cs, idAccess, typeAccess, tgn, typeExp, default]
;
for IdentList.one:  AbstractProduction [Ident]
let AddValueDeclarationToFieldList[tree, fl, cs, access, parseTree, tgn, init] ←
AddValueDeclarationToFieldList[Ident, fl, cs, access, parseTree, tgn, init]
let AddTypeDeclarationToFieldList[tree, fl, lc, cs, idAccess, typeAccess, tgn, typeExp, default] ←
AddTypeDeclarationToFieldList[Ident, fl, lc, cs, idAccess, typeAccess, tgn, typeExp, default]
;
for Ident.id:  AbstractProduction [Id]
let AddValueDeclarationToFieldList[tree, fl, cs, parseTree, access, tgn, init] ← fl1
where fl1 ← AppendFieldToFieldList[fl, field]
where field ← if InitializationIsBinding[InitializationVal[init]]
then CreateConstantField[Id, position, parseTree, access, tgn, init]
else CreateVariableField[Id, position, parseTree, access, tgn, init]
where position ← NullPosition[]
let AddTypeDeclarationToFieldList[tree, fl, lc, cs, idAccess, typeAccess, tgn, typeExp, default] ← <fl1, lc1>
where fl1 ← AppendFieldToFieldList[fl, field]
where field ← CreateNamedTypeField[Id, position, idAccess, namedTGN, typeExp]
where <lc1, namedTGN> ← CreateNamedTGN[lc, Id, position, typeAccess, tgn, default]
where position ← NullPosition[]
;
for Ident.idposition: AbstractProduction [Id, Position]
let AddValueDeclarationToFieldList[tree, fl, cs, parseTree, access, tgn, init] ← fl1
where fl1 ← AppendFieldToFieldList[fl, field]
where field ← if InitializationIsBinding[InitializationVal[init]]
then CreateConstantField[Id, position, parseTree, access, tgn, init]
else CreateVariableField[Id, position, parseTree, access, tgn, init]
where position ← GetPositionVal[Position]
let AddTypeDeclarationToFieldList[tree, fl, lc, cs, idAccess, typeAccess, tgn, typeExp, default] ← <fl1, lc1>
where fl1 ← AppendFieldToFieldList[fl, field]
where field ← CreateNamedTypeField[Id, position, idAccess, namedTGN, typeExp]
where <lc1, namedTGN> ← CreateNamedTGN[lc, Id, position, typeAccess, tgn, default]
where position ← GetPositionVal[Position]
;
OptSize
for OptSize.absent: AbstractProduction [ ]
let GetExpVal [tree] ← MakeUnparsedNullValue []
;
for OptSize.present: AbstractProduction [ Exp ]
let GetExpVal [tree] ← MakeUnparsedValue [Exp]
;
StatementList
for StatementList.empty: AbstractProduction [ ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for StatementList.more: AbstractProduction [ StatementList, Statement ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
HangContextsFromContextTree [Statement, contextTree1, rib, paintRecords, cs]
where contextTree1 ←
HangContextsFromContextTree [StatementList, contextTree, rib, paintRecords, cs]
;
Statement
for Statement.ifthen: AbstractProduction [ Exp, Statement ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
HangContextsFromContextTree [Statement, contextTree, rib, paintRecords, cs]
;
can exp change context tree ?
for Statement.ifthenelse: AbstractProduction [ Exp, Statement.thenpart, Statement.elsepart ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
HangContextsFromContextTree [Statement.elsepart, contextTree1, rib, paintRecords, cs]
where contextTree1 ←
HangContextsFromContextTree [Statement.thenpart, contextTree, rib, paintRecords, cs]
;
for Statement.select: AbstractProduction [ SelectHead, SelectStmtList, OptStatement ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.exp: AbstractProduction [ Exp ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
can exp change context tree ?
for Statement.assign: AbstractProduction [ Exp.lhs, Exp.rhs ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.multiassign: AbstractProduction [ ExpList, Exp ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.block: AbstractProduction [ Checked, Block ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
HangContextsFromContextTree [Block, contextTree, rib, paintRecords, cs]
;
ignoring Checked on a block statement
for Statement.loopcontrol: AbstractProduction [ ForClause, DoTest, Scope, DoExit ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.exit: AbstractProduction [ ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.loop: AbstractProduction [ ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.goto: AbstractProduction [ Id ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.return: AbstractProduction [ OptArgs ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.transfer: AbstractProduction [ Transfer, Exp ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.free: AbstractProduction [ Free, Exp, Catch ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.wait: AbstractProduction [ Exp ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.error: AbstractProduction [ ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.stop: AbstractProduction [ ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.null: AbstractProduction [ ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.resume: AbstractProduction [ OptArgs ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.reject: AbstractProduction [ ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.continue: AbstractProduction [ ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.retry: AbstractProduction [ ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.getstate: AbstractProduction [ Exp ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
for Statement.setstate: AbstractProduction [ Exp ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree [contextTree]
;
Block
for Block: AbstractProduction [ Scope, ExitList ]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
FakeDamageContextTree[contextTree]
where err ← Error["should not be here"]
let MakeContextTree[tree, parentRib, paintRecords, cs] ← EmptyContextTree[parentRib]
where err ← Error["should not be here"]
let HangContextsFromContextTree [tree, contextTree, rib, paintRecords, cs] ←
AddSubContextTree[contextTree, subContextTree]
where subContextTree ← MakeContextTree [Scope, rib, paintRecords, cs]
let MakeContextTree[tree, parentRib, paintRecords, cs] ← MakeContextTree[Scope, parentRib, paintRecords, cs]
;
ignoring ExitList
for IdOrString.id:  AbstractProduction [Id]
let RopeFromIdOrString[tree] ← RopeFromId[Id];
for IdOrString.string:  AbstractProduction [String]
let RopeFromIdOrString[tree] ← RopeFromString[String];
End.
eof...