<> <> <> <<>> Include [ SaffronBaseDecls, SaffronTreeDecls, SaffronAG, SaffronProgramGraphDecls ]; SaffronBlockCompile: Module = Begin for Block: AbstractProduction [Scope, ExitList] let CompileFrameBlock[tree, transferType, parentTree, pg, cs] _ where newTree _ AddSubContextTree[parentTree, childTree] where _ InternalCompileBlock[tree, lc1, fl, pg, cs] where fl _ CreateEmptyFieldList[] -- add transfer bindings to field list!! where lc1 _ CreateEmptyContext[Rib[parentTree], True[]] let Compile[tree, parentTree, pg, cs] _ where newTree _ AddSubContextTree[parentTree, childTree] where _ InternalCompileBlock[tree, lc1, fl, pg, cs] where fl _ CreateEmptyFieldList[] where lc1 _ CreateEmptyContext[Rib[parentTree], False[]] let InternalCompileBlock[tree, localContext, fl, pg, cs] _ CompileScope[Scope, lc1, fl, pg, cs] where lc1 _ FakeDamageContext[localContext] -- add exit list to lc!! ; for Scope: AbstractProduction [BindList, Catch, OptDecList, StatementList] let CompileScope[tree, localContext, fl, pg, cs] _ where pf3 _ ConcatProgramFragments[pf1, pf2] where _ Compile[StatementList, contextTree2, pg1, cs] where _ Compile[OptDecList, contextTree1, pg, cs] where contextTree1 _ EmptyContextTree[rib] where rib _ FreezeLocalContext[localContext3, blockTGN] where _ CreateBlockTGN[localContext2, FreezeFieldList[fieldList4]] where _ AnalyzeDependencies[dependencyGraph, fieldList3, localContext1, cs] where dependencyGraph _ BuildDependencyGraph[fieldList3, localContext1] where fieldList3 _ DiscernSpecianatedTGNs[fieldList2, localContext1] where fieldList2 _ LookupIdentifierTGNs[fieldList1, localContext1] where _ AddDeclarationsToFieldList[OptDecList, fl, localContext, cs] ; for DefBody: AbstractProduction [ BindList, DecList ] let MakeContextTree[tree, contextRib, paintRecords, cs] _ contextTree2 <> where _ Compile[DecList, contextTree1, pg, cs] where pg _ CreateEmptyProgramGraph[] where contextTree1 _ EmptyContextTree[rib] where rib _ FreezeLocalContext[localContext3, interfaceTGN] where _ CreateInterfaceContentsTGN[localContext2, FreezeFieldList[fieldList4]] where _ AnalyzeDependencies[dependencyGraph, fieldList3, localContext1, cs] where dependencyGraph _ BuildDependencyGraph[fieldList3, localContext1] where fieldList3 _ DiscernSpecianatedTGNs[fieldList2, localContext1] where fieldList2 _ LookupIdentifierTGNs[fieldList1, localContext1] where _ AddDeclarationsToFieldList[DecList, CreateEmptyFieldList[], localContext, cs] where localContext _ CreateEmptyContext[contextRib, True[]] ; End; SaffronDeclarationCompile: Module = Begin for OptDecList.absent: AbstractProduction [] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > ; for OptDecList.present: AbstractProduction [DecList] let Compile[tree, contextTree, pg, cs] _ Compile[DecList, contextTree, pg, cs] ; for DecList.one: AbstractProduction [Declaration] let Compile[tree, contextTree, pg, cs] _ Compile[Declaration, contextTree, pg, cs] ; for DecList.many: AbstractProduction [DecList.head, DecList.tail] let Compile[tree, contextTree, pg, cs] _ where pf3 _ ConcatProgramFragments[pf1, pf2] where _ Compile[DecList.tail, contextTree1, pg1, cs] where _ Compile[DecList.head, contextTree, pg, cs] ; for Declaration.opaquetype: AbstractProduction [ IdentList, Access, OptSize ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > ; for Declaration.type: AbstractProduction [ IdentList, Access.id, Access.type, TypeExp, Default ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > ; for Declaration.value: AbstractProduction [ IdentList, Access, Entry, ReadOnly, TypeExp, Initialization ] let Compile[tree, contextTree, pg, cs] _ where pf _ if IsTrash[initialValue] then MakePGNoOp[] else (ConcatProgramFragments[pushInitialValue, storeInitialValue] where pushInitialValue _ Code[initialValue] where storeInitialValue _ MakeCodeToStoreTOSInVariousLocalFrameSlots[IdentList, contextTree1] ) where _ CompileInitialization[Initialization, contextTree, pg, cs, targetType] where targetType _ FieldType[anyCorrespondingField] where anyCorrespondingField _ FindAFieldCorrespondingToDeclaration[contextTree, DeclarationPTreeVal[tree]] ; for Initialization.empty: AbstractProduction [] let CompileInitialization[tree, contextTree, pg, cs, targetType] _ < FakeDamageContextTree[contextTree], CompileDefaultInitialization[targetType], FakeDamageProgramGraph[pg] > ; for Initialization.binding: AbstractProduction [InitialValue] let CompileInitialization[tree, contextTree, pg, cs, targetType] _ CompileInitialization[InitialValue, contextTree, pg, cs, targetType] ; for Initialization.assignment: AbstractProduction [InitialValue] let CompileInitialization[tree, contextTree, pg, cs, targetType] _ CompileInitialization[InitialValue, contextTree, pg, cs, targetType] ; for InitialValue.trash: AbstractProduction [] let CompileInitialization[tree, contextTree, pg, cs, targetType] _ < FakeDamageContextTree[contextTree], MakeTrash[targetType], FakeDamageProgramGraph[pg] > ; for InitialValue.code: AbstractProduction [] let CompileInitialization[tree, contextTree, pg, cs, targetType] _ < FakeDamageContextTree[contextTree], MakeTrash[targetType], FakeDamageProgramGraph[pg] > where err _ Error["CompileInitialization for InitialValue.code not yet implemented."] ; for InitialValue.exp: AbstractProduction [Exp] let CompileInitialization[tree, contextTree, pg, cs, targetType] _ where _ CompileExpression[Exp, contextTree, cs, targetType] where pg1 _ FakeDamageProgramGraph[pg] <> ; for InitialValue.block: AbstractProduction [Checked, Inline, Block] let CompileInitialization[tree, contextTree, pg, cs, targetType] _ where pg2 _ AddSubroutineProcedureGraphToProgramGraph[procedureGraph, pg1] where value _ MakeTransferValue[targetType, procedureGraph] where procedureGraph _ MakeProcedureGraph[blockCode] where _ CompileFrameBlock[Block, targetType, contextTree, pg, cs] <> <> ; for InitialValue.machinecode: AbstractProduction [Checked, CodeList] let CompileInitialization[tree, contextTree, pg, cs, targetType] _ < FakeDamageContextTree[contextTree], MakeTrash[targetType], FakeDamageProgramGraph[pg] > where err _ Error["CompileInitialization for InitialValue.machinecode not yet implemented."] ; for IdentList.one: AbstractProduction [Ident] let MakeCodeToStoreTOSInVariousLocalFrameSlots[tree, contextTree] _ MakeCodeToStoreTOSInVariousLocalFrameSlots[Ident, contextTree] ; for IdentList.many: AbstractProduction [IdentList.head, IdentList.tail] let MakeCodeToStoreTOSInVariousLocalFrameSlots[tree, ct] _ pf4 where pf4 _ ConcatProgramFragments[ConcatProgramFragments[pf1, pf2], pf3] where pf3 _ MakeCodeToStoreTOSInVariousLocalFrameSlots[IdentList.tail, ct] where pf2 _ MakePGNoOp[] -- this should be MakePGDuplicate!!! where pf1 _ MakeCodeToStoreTOSInVariousLocalFrameSlots[IdentList.head, ct] ; for Ident.id: AbstractProduction [Id] let MakeCodeToStoreTOSInVariousLocalFrameSlots[tree, contextTree] _ pf where pf _ MakePGStoreLocal[pfd] where _ GetPathToName[contextTree, Id] ; for Ident.idposition: AbstractProduction [Id, Position] let MakeCodeToStoreTOSInVariousLocalFrameSlots[tree, contextTree] _ pf where pf _ MakePGStoreLocal[pfd] where _ GetPathToName[contextTree, Id] ; End; SaffronStatementCompile: Module = Begin for StatementList.empty: AbstractProduction [ ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > ; for StatementList.more: AbstractProduction [ StatementList, Statement ] let Compile[tree, contextTree, pg, cs] _ where pf3 _ ConcatProgramFragments[pf1, pf2] where _ Compile[Statement, contextTree1, pg1, cs] where _ Compile[StatementList, contextTree, pg, cs] ; <> for Statement.ifthen: AbstractProduction [ Exp, Statement ] let Compile[tree, contextTree, pg, cs] _ where code _ MakePGTest[Code[testValue], ifTrueCode, ifFalseCode] where ifFalseCode _ MakePGNoOp[] where _ Compile[Statement, contextTree1, pg, cs] where _ CompileAndTypeCheckExpression[Exp, contextTree, cs, booleanType] where booleanType _ GetIntrinsicBooleanType[cs] ; <> for Statement.ifthenelse:AbstractProduction [ Exp, Statement.thenpart, Statement.elsepart ] let Compile[tree, contextTree, pg, cs] _ where code _ MakePGTest[testCode, ifTrueCode, ifFalseCode] where _ Compile[Statement.elsepart, contextTree2, pg1, cs] where _ Compile[Statement.thenpart, contextTree1, pg, cs] where testCode _ Code[testValue] where _ CompileAndTypeCheckExpression[Exp, contextTree, cs, booleanType] where booleanType _ GetIntrinsicBooleanType[cs] <> <>> <> <> <> <> <> < _ Compile[Statement.elsepart, contextTree2, cs]>> < _ Compile[Statement.thenpart, contextTree1, cs]>> <> < _ >> <> <> ; for Statement.select: AbstractProduction [ SelectHead, SelectStmtList, OptStatement ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.select not implemented yet."] ; for Statement.exp: AbstractProduction [ Exp ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.exp not implemented yet."] ; for Statement.assign: AbstractProduction [ Exp.lhs, Exp.rhs ] let Compile[tree, contextTree, pg, cs] _ where code _ ConcatProgramFragments[Code[rhsValue], storeTOS] where storeTOS _ if PFDIsLocal[lvalue] then MakePGStoreLocal[lvalue] else MakePGStoreIndirect[lvalue] where _ CompileAndTypeCheckExpression[Exp.rhs, contextTree, cs, tgn] where _ CompileLValue[Exp.lhs, contextTree, cs] ; for Statement.multiassign: AbstractProduction [ ExpList, Exp ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.multiassign not implemented yet."] ; for Statement.block: AbstractProduction [ Checked, Block ] let Compile[tree, contextTree, pg, cs] _ Compile[Block, contextTree, pg, cs] <> ; for Statement.loopcontrol: AbstractProduction [ ForClause, DoTest, Scope, DoExit ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.loopcontrol not implemented yet."] ; for Statement.exit: AbstractProduction [ ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.exit not implemented yet."] ; for Statement.loop: AbstractProduction [ ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.loop not implemented yet."] ; for Statement.goto: AbstractProduction [ Id ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.goto not implemented yet."] ; for Statement.return: AbstractProduction [ OptArgs ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.return not implemented yet."] ; for Statement.transfer: AbstractProduction [ Transfer, Exp ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.transfer not implemented yet."] ; for Statement.free: AbstractProduction [ Free, Exp, Catch ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.free not implemented yet."] ; for Statement.wait: AbstractProduction [ Exp ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.wait not implemented yet."] ; for Statement.error: AbstractProduction [ ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.error not implemented yet."] ; for Statement.stop: AbstractProduction [ ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.stop not implemented yet."] ; for Statement.null: AbstractProduction [ ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > ; for Statement.resume: AbstractProduction [ OptArgs ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.resume not implemented yet."] ; for Statement.reject: AbstractProduction [ ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > <> ; for Statement.continue: AbstractProduction [ ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.continue not implemented yet."] ; for Statement.retry: AbstractProduction [ ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.retry not implemented yet."] ; for Statement.getstate: AbstractProduction [ Exp ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.getstate not implemented yet."] ; for Statement.setstate: AbstractProduction [ Exp ] let Compile[tree, contextTree, pg, cs] _ < FakeDamageContextTree[contextTree], MakePGNoOp[], FakeDamageProgramGraph[pg] > where err _ Error["Compile for Statement.setstate not implemented yet."] ; End.