SaffronMethods.ThreeC4 (July 16, 1987 4:02:51 pm PDT)
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Lucy Hederman July 21, 1987 4:49:11 pm PDT
Sturgis, July 21, 1987 3:16:17 pm PDT
Include [SaffronAG, SaffronTreeDecls, SaffronBaseDecls];
need DoTop to take MakeType of the TypeExp
SaffronMakeType: Module = Begin
Top
for Top.modulep: AbstractProduction [ ModuleP ]
let DoTop[tree] ← <c, n>
where n ← FindBottomTGN[c]
where c ← CreateEmptyContext[];
for Top.scope: AbstractProduction [ Scope ]
let DoTop[tree] ← <c, n>
where n ← FindBottomTGN[c]
where c ← CreateEmptyContext[];
for Top.tc: AbstractProduction [ TypeExp ]
let DoTop[tree] ← MakeType[TypeExp, BooleanConst["False"], CreateEmptyContext[]];
TypeExp
for TypeExp.record: AbstractProduction [ MachineDependent, Monitored, RecList ]
let MakeType[tree, paintRecords, localContext] ← <localContext4, newTgn>
where <localContext4, newTgn> ← CreateRecordTGN [ localContext3, paint, 
                   frozenFieldList]
where <localContext3, frozenFieldList> ← FreezeFieldList [localContext2, fieldList]
where <localContext2, fieldList> ← MakeFieldList [RecList, paintRecords, localContext1]
where <localContext1, paint> ←
if paintRecords then GetUniquePaint [localContext]
  else GetUnpaintedPaint [localContext]
;
for TypeExp.enum: AbstractProduction [ MachineDependent, ElementList ]
let MakeType[tree, paintRecords, localContext] ← MakeElementList [ElementList, localContext]
;
for TypeExp.ref: AbstractProduction [ ReadOnly, TypeExp ]
let MakeType[tree, paintRecords, localContext] ← <localContext2, newTgn>
where <localContext2, newTgn> ← CreateRefTGN [localContext1, refereeTgn, refereeTgn]
where <localContext1, refereeTgn> ← MakeType [TypeExp, paintRecords, localContext]
;
End;
SaffronMakeFieldList: Module = Begin
RecList
for RecList.empty:  AbstractProduction [ ]
let MakeFieldList [tree, paintRecords, localContext] ← < FakeDamageContext[localContext], CreateEmptyFieldList []>
;
for RecList.pairlist:  AbstractProduction [ PairList ]
let MakeFieldList [tree, paintRecords,localContext] ← <localContext1, fieldList>
where <localContext1, fieldList> ←
AddPairsToFieldList [PairList, newFieldList, paintRecords, localContext]
where newFieldList ← CreateEmptyFieldList []
;
for RecList.typelist: AbstractProduction [ TypeList ]
let MakeFieldList [tree, paintRecords, localContext] ← <localContext1, fieldList>
where <localContext1, fieldList> ← AddToFieldList [TypeList, newFieldList, paintRecords, localContext]
where newFieldList ← CreateEmptyFieldList []
;
End;
SaffronAddToFieldList: Module = Begin
TypeList
for TypeList.many: AbstractProduction [ TypeList.head, TypeList.tail ]
let AddToFieldList [tree, fieldList, paintRecords, localContext] ←
AddToFieldList [ TypeList.tail, fieldList1, paintRecords, localContext1]
where <localContext1, fieldList1> ←
AddToFieldList [ TypeList.head, fieldList, paintRecords, localContext]
;
for TypeList.one: AbstractProduction [ TypeItem ]
let AddToFieldList [tree, fieldList, paintRecords, localContext] ←
AddToFieldList [ TypeItem, fieldList , paintRecords, localContext]
;
TypeItem
for TypeItem: AbstractProduction [ TypeExp, Default ]
let AddToFieldList [tree, fieldList, paintRecords, localContext] ← <localContext1, fieldList1>
where fieldList1 ← AppendFieldToFieldList [ fieldList, field]
where field ← CreateUnnamedField [tgn]
where <localContext1, tgn> ← MakeType [TypeExp, paintRecords, localContext]
;
End;
SaffronAddPairsToFieldList: Module = Begin
PairList
for PairList.many: AbstractProduction [ PairList.head, PairList.tail ]
let AddPairsToFieldList [tree, fieldList, paintRecords, localContext] ←
AddPairsToFieldList [ PairList.tail, fieldList1, paintRecords, localContext1]
where <localContext1, fieldList1> ←
AddPairsToFieldList [PairList.head, fieldList, paintRecords, localContext]
;
for PairList.one: AbstractProduction [ PairItem ]
let AddPairsToFieldList [tree, fieldList, paintRecords, localContext] ←
AddPairsToFieldList [tree, fieldList, paintRecords, localContext]
;
PairItem
for PairItem: AbstractProduction [ IdentList, Access, TypeExp, Default ]
let AddPairsToFieldList [tree, fieldList, paintRecords, localContext] ←
< localContext1, AddNamesToFieldList [IdentList, tgn, fieldList] >
where <localContext1, tgn> ← MakeType [TypeExp, paintRecords, localContext]
;
End;
SaffronAddNamesToFieldList: Module = Begin
IdentList
for IdentList.many: AbstractProduction [ IdentList.head, IdentList.tail ]
let AddNamesToFieldList [tree, tgn, fieldList] ←
AddNamesToFieldList [IdentList.tail, tgn, fieldList1]
where fieldList1 ← AddNamesToFieldList [IdentList.head, tgn, fieldList]
;
for IdentList.one: AbstractProduction [ Ident ]
let AddNamesToFieldList [tree, tgn, fieldList] ←
AddNamesToFieldList [Ident, tgn, fieldList]
;
Ident
for Ident.id: AbstractProduction [ Id ]
let AddNamesToFieldList [tree, tgn, fieldList] ← AppendFieldToFieldList [fieldList, field]
where field ← CreateNamedField [Id, tgn]
;
End;
SaffronMakeElementList: Module = Begin
ElementList
for ElementList.empty: AbstractProduction [ ]
let MakeElementList [tree, localContext] ← CreateEmptyEnumTypeTGN [localContext]
;
for ElementList.more: AbstractProduction [ ElementList, Element ]
let MakeElementList [tree, localContext] ← <localContext1, tgn>
where localContext1 ←
AppendElementToEnumTypeTGN [localContext2, tgn, elementName]
where <localContext2, tgn> ← MakeElementList [ElementList, localContext]
where elementName ← ElementName [Element]
;
End;
SaffronElementName: Module = Begin
Element ???
There are other Element Productions !!!
for Element.id: AbstractProduction [ Id ]
let ElementName [tree] ← Id
;
End.
eof...