Include [SaffronAG, SaffronTreeDecls, SaffronBaseDecls]; SaffronMakeType: Module = Begin for Top.modulep: AbstractProduction [ ModuleP ] let DoTop[tree] _ where n _ FindBottomTGN[c] where c _ CreateEmptyContext[]; for Top.scope: AbstractProduction [ Scope ] let DoTop[tree] _ where n _ FindBottomTGN[c] where c _ CreateEmptyContext[]; for Top.tc: AbstractProduction [ TypeExp ] let DoTop[tree] _ MakeType[TypeExp, BooleanConst["False"], CreateEmptyContext[]]; for TypeExp.record: AbstractProduction [ MachineDependent, Monitored, RecList ] let MakeType[tree, paintRecords, localContext] _ where _ CreateRecordTGN [ localContext3, paint, frozenFieldList] where _ FreezeFieldList [localContext2, fieldList] where _ MakeFieldList [RecList, paintRecords, localContext1] where _ 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] _ where _ CreateRefTGN [localContext1, refereeTgn, refereeTgn] where _ MakeType [TypeExp, paintRecords, localContext] ; End; SaffronMakeFieldList: Module = Begin for RecList.empty: AbstractProduction [ ] let MakeFieldList [tree, paintRecords, localContext] _ < FakeDamageContext[localContext], CreateEmptyFieldList []> ; for RecList.pairlist: AbstractProduction [ PairList ] let MakeFieldList [tree, paintRecords,localContext] _ where _ AddPairsToFieldList [PairList, newFieldList, paintRecords, localContext] where newFieldList _ CreateEmptyFieldList [] ; for RecList.typelist: AbstractProduction [ TypeList ] let MakeFieldList [tree, paintRecords, localContext] _ where _ AddToFieldList [TypeList, newFieldList, paintRecords, localContext] where newFieldList _ CreateEmptyFieldList [] ; End; SaffronAddToFieldList: Module = Begin for TypeList.many: AbstractProduction [ TypeList.head, TypeList.tail ] let AddToFieldList [tree, fieldList, paintRecords, localContext] _ AddToFieldList [ TypeList.tail, fieldList1, paintRecords, localContext1] where _ AddToFieldList [ TypeList.head, fieldList, paintRecords, localContext] ; for TypeList.one: AbstractProduction [ TypeItem ] let AddToFieldList [tree, fieldList, paintRecords, localContext] _ AddToFieldList [ TypeItem, fieldList , paintRecords, localContext] ; for TypeItem: AbstractProduction [ TypeExp, Default ] let AddToFieldList [tree, fieldList, paintRecords, localContext] _ where fieldList1 _ AppendFieldToFieldList [ fieldList, field] where field _ CreateUnnamedField [tgn] where _ MakeType [TypeExp, paintRecords, localContext] ; End; SaffronAddPairsToFieldList: Module = Begin for PairList.many: AbstractProduction [ PairList.head, PairList.tail ] let AddPairsToFieldList [tree, fieldList, paintRecords, localContext] _ AddPairsToFieldList [ PairList.tail, fieldList1, paintRecords, localContext1] where _ AddPairsToFieldList [PairList.head, fieldList, paintRecords, localContext] ; for PairList.one: AbstractProduction [ PairItem ] let AddPairsToFieldList [tree, fieldList, paintRecords, localContext] _ AddPairsToFieldList [tree, fieldList, paintRecords, localContext] ; for PairItem: AbstractProduction [ IdentList, Access, TypeExp, Default ] let AddPairsToFieldList [tree, fieldList, paintRecords, localContext] _ < localContext1, AddNamesToFieldList [IdentList, tgn, fieldList] > where _ MakeType [TypeExp, paintRecords, localContext] ; End; SaffronAddNamesToFieldList: Module = Begin 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] ; for Ident.id: AbstractProduction [ Id ] let AddNamesToFieldList [tree, tgn, fieldList] _ AppendFieldToFieldList [fieldList, field] where field _ CreateNamedField [Id, tgn] ; End; SaffronMakeElementList: Module = Begin for ElementList.empty: AbstractProduction [ ] let MakeElementList [tree, localContext] _ CreateEmptyEnumTypeTGN [localContext] ; for ElementList.more: AbstractProduction [ ElementList, Element ] let MakeElementList [tree, localContext] _ where localContext1 _ AppendElementToEnumTypeTGN [localContext2, tgn, elementName] where _ MakeElementList [ElementList, localContext] where elementName _ ElementName [Element] ; End; SaffronElementName: Module = Begin for Element.id: AbstractProduction [ Id ] let ElementName [tree] _ Id ; End. Œ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 need DoTop to take MakeType of the TypeExp Top TypeExp RecList TypeList TypeItem PairList PairItem IdentList Ident ElementList Element ??? There are other Element Productions !!! eof... Κ ˜codešœ5™5K™;K™*K™%—K™J˜8J˜K™KšΟn+™+K™Kšœ˜K˜š™˜codetabšΠizœΟb œžœ ˜/Lšžœžœžœ˜W——™šžœŸ œžœ ˜+Lšžœžœžœ˜W—L˜šžœŸœžœ ˜*KšžœN˜Q—K˜—K˜—š™˜šžœŸœžœ)˜OšžœE˜HLšžœi˜nLšœS˜SL˜WLšœ|˜|—Lšœ˜——™šžœŸ œžœ"˜FLšžœY˜\L˜—L˜šžœŸ œžœ˜9šžœE˜HKšœU˜UKšœR˜R—Kšœ˜—K˜—K˜—K˜K˜K˜$˜K™˜šœžœ˜*Kšœr˜rK˜—K˜šœžœ ˜6šœQ˜QKšœl˜lK˜,—K˜—K˜šœŸœžœ ˜5šœQ˜QKšœg˜gK˜,—K˜———K˜K˜K˜K˜%˜K™˜šžœŸ œžœ!˜F˜ŒK˜k—K˜—K˜šžœŸ œžœ ˜1K˜‡K˜—K˜—™K˜šžœœžœ˜5˜^K˜=K˜&K˜K—K˜——K˜˜K˜——˜*K˜™K˜šžœŸ œžœ!˜F˜•K˜o—K˜—K˜šžœŸ œžœ ˜1K˜‰K˜—K˜—™K˜šžœΠbnœžœ(˜H˜ŠK˜K—K˜——K˜˜K˜——˜*K˜K™ ˜šžœŸœžœ#˜I˜fK˜G—K˜—K˜šžœŸ œžœ ˜/K˜\K˜—K˜—™K˜šžœŸœžœ˜'˜ZK˜(—K˜——K˜K˜—˜&K˜K™ ˜šžœŸœžœ˜-K˜PK˜K˜—šžœŸœžœ˜A˜?K˜SK˜HK˜)—K˜—K˜—K˜K˜—šœ˜"headšΟz ™ L™'L™šžœŸ œžœ˜)Kšžœ˜Kšœ˜—K˜—K˜K˜—K˜K™K™—…—Κ_