1%if false 2 Copyright (c) 2009, ETH Zurich. 3 All rights reserved. 4 5 This file is distributed under the terms in the attached LICENSE file. 6 If you do not find this file, copies can be found by writing to: 7 ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group. 8%endif 9 10%include polycode.fmt 11 12%if false 13 14> module Constructs.Conditionals where 15 16> import Data.List 17 18> import Semantics 19> import Constructs 20> import PureExpressions 21> import {-# SOURCE #-} Expressions 22> import Eval 23 24> import IL.FoF.FoF 25> import IL.FoF.Compile 26> import IL.FoF.Run 27 28%endif 29 30\section{Conditionals} 31\label{chap:conditionals} 32 33The |Conditionals| constructs consist of all control-flow operators 34defined in the C language, excepted the @goto@ statement and 35fall-through switches. 36 37\subsection{Smart Constructors} 38 39We provide the DSL designer with all standard C control-flow 40operators. Hence, we define the following combinators: |ifc|, |for|, 41|while|, |doWhile|, |break|, and |continue|. 42 43> ifc :: FoFCode PureExpr -> 44> FoFCode PureExpr -> 45> FoFCode PureExpr -> 46> FoFCode PureExpr 47> ifc cond ifTrue ifFalse = 48> inject (If cond ifTrue ifFalse (return Void)) 49> 50> for :: FoFCode PureExpr -> 51> FoFCode PureExpr -> 52> FoFCode PureExpr -> 53> FoFCode PureExpr -> 54> FoFCode PureExpr 55> for init cond incr loop = 56> inject (For init cond incr loop (return Void)) 57> 58> while :: FoFCode PureExpr -> 59> FoFCode PureExpr -> 60> FoFCode PureExpr 61> while cond loop = 62> inject (While cond loop (return Void)) 63> 64> doWhile :: FoFCode PureExpr -> 65> FoFCode PureExpr -> 66> FoFCode PureExpr 67> doWhile loop cond = 68> inject (DoWhile loop cond (return Void)) 69> 70> break :: FoFCode PureExpr 71> break = inject Break 72> 73> continue :: FoFCode PureExpr 74> continue = inject Continue 75 76The |switch| statement is slightly different from the C one: every 77case is automatically terminated by a @break@ statement. Hence, it is 78impossible to \emph{fall through} a case. 79 80> switch :: PureExpr -> 81> [(PureExpr, FoFCode PureExpr)] -> 82> FoFCode PureExpr -> 83> FoFCode PureExpr 84> switch cond cases defaultCase = 85> inject (Switch cond cases defaultCase (return Void)) 86 87 88\subsection{Compile Instantiation} 89 90The compilation step is mostly standard. Note that we often have to 91compile sub-blocks of code. Therefore, we need to carefully update the 92relevant binding states, so as to ensure the freshness of generated 93names while respecting the scope of locally defined variables. 94 95> compileConditionals (If condi ifTrue ifFalse r) binding = 96> (FIf compCond compIfTrue compIfFalse cont, 97> binding2) 98> where (compCond, binding1) = compileSemtoFoF' condi binding 99> (compIfTrue, binding1') = compileSemtoFoF' ifTrue binding1 100> (compIfFalse, binding1'') = compileSemtoFoF' ifFalse 101> (binding1' |-> binding1) 102> (cont, binding2) = r (binding1'' |-> binding) 103> 104> compileConditionals (While condW loop r) binding = 105> (FWhile compCond compLoop cont, 106> binding3) 107> where (compCond, binding1) = compileSemtoFoF' condW binding 108> (compLoop, binding2) = compileSemtoFoF' loop binding1 109> (cont, binding3 ) = r (binding2 |-> binding) 110> 111> 112> compileConditionals (DoWhile loop condD r) binding = 113> (FDoWhile compLoop compCond cont, 114> binding3) 115> where (compLoop, binding1) = compileSemtoFoF' loop binding 116> (compCond, binding2) = compileSemtoFoF' condD 117> (binding1 |-> binding) 118> (cont, binding3 ) = r (binding2 |-> binding) 119> 120> compileConditionals (For init test inc loop r) binding = 121> (FFor compInit compTest compInc compLoop cont, 122> binding5) 123> where (compInit, binding1) = compileSemtoFoF' init binding 124> (compTest, binding2) = compileSemtoFoF' test binding1 125> (compInc, binding3) = compileSemtoFoF' inc binding2 126> (compLoop, binding4) = compileSemtoFoF' loop 127> (binding1 |-> binding3) 128> (cont, binding5) = r (binding4 |-> binding) 129> 130> compileConditionals (Switch test cases defaultC r) binding = 131> (FSwitch test compCases compDefault cont, 132> binding3) 133> where compileCase (compCodes, binding) (i, code) = 134> ((i, compCode) : compCodes, 135> (binding1 |-> binding)) 136> where (compCode, binding1) = compileSemtoFoF' code binding 137> (compCases, binding1) = 138> foldl' compileCase ([], binding) cases 139> (compDefault, binding2) = 140> compileSemtoFoF' defaultC (binding1 |-> binding) 141> (cont, binding3) = r (binding2 |-> binding) 142> 143> compileConditionals Break binding = 144> (FClosing $ FBreak, binding) 145> 146> compileConditionals Continue binding = 147> (FClosing $ FContinue, binding) 148 149 150 151\subsection{Run Instantiation} 152 153The implementation of the interpreter is straightforward. We start by 154dispatching calls to construct-specific functions: 155 156> runConditionals (If a b c r) heap = 157> r $ runIf a b c heap 158> runConditionals (For a b c d r) heap = 159> r $ runFor a b c d heap 160> runConditionals (While a b r) heap = 161> r $ runWhile a b heap 162> runConditionals (DoWhile a b r) heap = 163> r $ runDoWhile a b heap 164> runConditionals (Switch a b c r) heap = 165> r $ runSwitch a b c heap 166> runConditionals Break heap = 167> error "runAlgebra: Break not yet implemented" 168> runConditionals Continue heap = 169> error "runAlgebra: Continue not yet implemented" 170 171Then, we implement the semantics of each of these constructs: 172 173> runIf :: FoFCode PureExpr -> 174> FoFCode PureExpr -> 175> FoFCode PureExpr -> 176> Heap -> Heap 177> runIf test ifTrue ifFalse heap = 178> let (vtest, heap1) = run test heap in 179> let CLInteger _ _ valVtest = symbEval vtest in 180> if (valVtest /= 0) then 181> let (_, heap2) = run ifTrue heap1 in 182> heap2 183> else 184> let (_, heap2) = run ifFalse heap1 in 185> heap2 186> 187> runFor :: FoFCode PureExpr -> 188> FoFCode PureExpr -> 189> FoFCode PureExpr -> 190> FoFCode PureExpr -> 191> Heap -> Heap 192> runFor init test incr loop heap = 193> let (_, heap1) = run init heap in 194> loopWhile heap1 195> where loopWhile heap = 196> let (vtest, heap1) = run test heap in 197> let CLInteger _ _ valVtest = symbEval vtest in 198> if (valVtest /= 0) then 199> let (_, heap2) = run loop heap1 in 200> let (_, heap3) = run incr heap2 in 201> loopWhile heap3 202> else heap1 203> 204> runWhile :: FoFCode PureExpr -> 205> FoFCode PureExpr -> 206> Heap -> Heap 207> runWhile test loop heap = 208> let (vtest, heap1) = run test heap in 209> let (CLInteger _ _ valVtest) = symbEval vtest in 210> if (valVtest /= 0) then 211> let (_, heap2) = run loop heap1 in 212> runWhile test loop heap2 213> else heap1 214> 215> runDoWhile :: FoFCode PureExpr -> 216> FoFCode PureExpr -> 217> Heap -> Heap 218> runDoWhile loop test heap = 219> let (_, heap1) = run loop heap in 220> let (vtest, heap2) = run test heap1 in 221> let CLInteger _ _ valVtest = symbEval vtest in 222> if (valVtest /= 0) then 223> runDoWhile loop test heap2 224> else 225> heap2 226> 227> runSwitch :: PureExpr -> 228> [(PureExpr, FoFCode PureExpr)] -> 229> FoFCode PureExpr -> 230> Heap -> Heap 231> runSwitch test cases defaultCase heap = 232> let res = symbEval test in 233> case res `lookup` cases of 234> Just stmt -> let (_, heap1) = run stmt heap in 235> heap1 236> Nothing -> let (_, heap1) = run defaultCase heap in 237> heap1 238 239