<> <> <> <<>> Include [SaffronAG, SaffronTreeDecls, SaffronBaseDecls]; SaffronMakeType: Module = Begin TypeExp 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 ; <<>> 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 RecList for RecList.empty: AbstractProduction [ ] let MakeFieldList [tree, paintRecords, localContext] _ < 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 TypeList 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] ; TypeItem 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 PairList 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] ; PairItem 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 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] _ 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; <> <<>>