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 Expressions where
15
16> import Semantics
17> import Constructs
18> import PureExpressions
19
20> import IL.FoF.FoF
21
22> import Constructs.Arrays(compileArrays, runArrays)
23> import Constructs.Conditionals(compileConditionals, runConditionals)
24> import Constructs.Enumerations(compileEnumerations, runEnumerations)
25> import Constructs.Functions(compileFunctions, runFunctions)
26> import Constructs.References(compileReferences, runReferences)
27> import Constructs.Strings(compileString, runString)
28> import Constructs.Typedef(compileTypedef, runTypedef)
29> import Constructs.Structures(compileStructures, runStructures)
30> import Constructs.Unions(compileUnions, runUnions)
31
32> import Libc.Assert(compileAssert, runAssert)
33> import Libc.Printf(compilePrintf, runPrintf)
34
35> import Libbarrelfish.HasDescendants(compileHasDescendants, runHasDescendants)
36> import Libbarrelfish.MemToPhys(compileMemToPhys, runMemToPhys)
37> import Libbarrelfish.GetAddress(compileGetAddress, runGetAddress)
38
39%endif
40
41
42\section{Building the FoF interpreter and compiler}
43\label{sec:semantics_constructs}
44
45
46In this section, we glue together the constructs of the FoF language,
47defined in the @Constructs@, @Libc@, and @Libbarrelfish@
48directories. This gluing builds a one-step interpreter for FoF,
49|compileAlgebra| (Section~\ref{sec:semantics_constructs_interpreter}),
50and a one-step compiler, |compileAlgebra|
51(Section~\ref{sec:semantics_constructs_compiler}). We rely
52on the machinery defined in Section~\ref{sec:semantics_machinery} to
53automatically build an interpreter and a compiler from these
54functions.
55
56\subsection{Gluing the Interpreter}
57\label{sec:semantics_constructs_interpreter}
58
59The run-time is actually quite simple. It is described by a heap, in
60which we first store fresh identifiers, |freshLoc|, |freshSLoc|, and
61|freshALoc|. When we want to store a value in memory, we pick a fresh
62identifier and, respectively update the |refMap|, |strMap|, or
63|arrayMap| with a new map from the identifier to the value. Similarly,
64we can read and modify these mappings. Intuitively, the |Heap| is a
65representation of the machine's memory.
66
67These different maps have different purposes: |refMap| maps an
68identifier to a single value, |strMap| maps an identifier to a mapping
69from strings to values (modelling a structure or union), and
70|arrayMap| maps an identifier to a bounded array of values.
71
72
73> data Heap = Hp { freshLoc :: Int ,
74>                  refMap :: [(VarName, Data)],
75>                  freshSLoc :: Int,
76>                  strMap :: [(VarName, [(String, Data)])],
77>                  freshALoc :: Int,
78>                  arrayMap :: [(VarName, [Data])]}
79
80Then, the one-step interpreter takes a FoF term, a Heap, and returns a
81pair of value and resulting heap. This is simply implemented by
82matching the term and calling the corresponding construct-specific
83interpreter.
84
85> runAlgebra :: FoFConst (Heap -> (PureExpr, Heap)) -> Heap -> (PureExpr, Heap)
86> runAlgebra x@(NewArray _ _ _ _) = runArrays x
87> runAlgebra x@(ReadArray _ _ _) = runArrays x
88> runAlgebra x@(WriteArray _ _ _ _) = runArrays x
89> runAlgebra x@(If _ _ _ _) = runConditionals x
90> runAlgebra x@(For _ _ _ _ _) = runConditionals x
91> runAlgebra x@(While _ _ _) = runConditionals x
92> runAlgebra x@(DoWhile _ _ _) = runConditionals x
93> runAlgebra x@(Switch _ _ _ _) = runConditionals x
94> runAlgebra x@Break = runConditionals x
95> runAlgebra x@Continue = runConditionals x
96> runAlgebra x@(NewEnum _ _ _ _ _) = runEnumerations x
97> runAlgebra x@(NewDef _ _ _ _ _ _) = runFunctions x 
98> runAlgebra x@(CallDef _ _ _ _) = runFunctions x
99> runAlgebra x@(Return _) = runFunctions x 
100> runAlgebra x@(NewRef _ _ _) = runReferences x
101> runAlgebra x@(ReadRef _ _) = runReferences x
102> runAlgebra x@(WriteRef _ _ _) = runReferences x
103> runAlgebra x@(NewString _ _ _) = runString x
104> runAlgebra x@(Typedef _ _) = runTypedef x
105> runAlgebra x@(TypedefE _ _ _) = runTypedef x
106> runAlgebra x@(NewStruct _ _ _ _ _) = runStructures x
107> runAlgebra x@(ReadStruct _ _ _) = runStructures x
108> runAlgebra x@(WriteStruct _ _ _ _) = runStructures x
109> runAlgebra x@(NewUnion _ _ _ _ _ _) = runUnions x
110> runAlgebra x@(ReadUnion _ _ _) = runUnions x 
111> runAlgebra x@(WriteUnion _ _ _ _) = runUnions x
112> runAlgebra x@(Assert _ _) = runAssert x
113> runAlgebra x@(Printf _ _ _) = runPrintf x
114> runAlgebra x@(HasDescendants _ _ _) = runHasDescendants x
115> runAlgebra x@(MemToPhys _ _ _) = runMemToPhys x
116> runAlgebra x@(GetAddress _ _ _) = runGetAddress x
117
118
119\subsection{Gluing the Compiler}
120\label{sec:semantics_constructs_compiler}
121  
122Similarly, the one-step compiler is organized around the notion of
123|Binding| environment: this environment is carried over the
124compilation process. Hence, the |Binding| represents the compiler's state:
125\begin{itemize}
126\item |freshVar| is a free identifier, used to generate unique variable names,
127\item |def...| maps the defined structure names with their type
128\end{itemize}
129
130> data Binding = Binding { freshVar :: Int ,
131>                          defStructs :: [(String,TypeExpr)],
132>                          defUnions :: [(String,TypeExpr)],
133>                          defEnums :: [(String, [(String, Int)])] }
134
135This binding is then modified by the one-step compiler, which takes a
136term, a binding, and return an FoF expression as well as an updated
137binding.
138
139> compileAlgebra :: FoFConst (Binding -> (ILFoF, Binding)) ->
140>                   (Binding -> (ILFoF, Binding))
141> compileAlgebra x@(NewArray _ _ _ _) = compileArrays x
142> compileAlgebra x@(ReadArray _ _ _) = compileArrays x
143> compileAlgebra x@(WriteArray _ _ _ _) = compileArrays x
144> compileAlgebra x@(If _ _ _ _) = compileConditionals x
145> compileAlgebra x@(For _ _ _ _ _) = compileConditionals x
146> compileAlgebra x@(While _ _ _) = compileConditionals x
147> compileAlgebra x@(DoWhile _ _ _) = compileConditionals x
148> compileAlgebra x@(Switch _ _ _ _) = compileConditionals x
149> compileAlgebra x@Break = compileConditionals x
150> compileAlgebra x@Continue = compileConditionals x
151> compileAlgebra x@(NewDef _ _ _ _ _ _) = compileFunctions x 
152> compileAlgebra x@(CallDef _ _ _ _) = compileFunctions x
153> compileAlgebra x@(Return _) = compileFunctions x 
154> compileAlgebra x@(NewEnum _ _ _ _ _) = compileEnumerations x
155> compileAlgebra x@(NewRef _ _ _) = compileReferences x
156> compileAlgebra x@(ReadRef _ _) = compileReferences x
157> compileAlgebra x@(WriteRef _ _ _) = compileReferences x
158> compileAlgebra x@(NewString _ _ _) = compileString x
159> compileAlgebra x@(Typedef _ _) = compileTypedef x
160> compileAlgebra x@(TypedefE _ _ _) = compileTypedef x
161> compileAlgebra x@(NewStruct _ _ _ _ _) = compileStructures x
162> compileAlgebra x@(ReadStruct _ _ _) = compileStructures x
163> compileAlgebra x@(WriteStruct _ _ _ _) = compileStructures x
164> compileAlgebra x@(NewUnion _ _ _ _ _ _) = compileUnions x
165> compileAlgebra x@(ReadUnion _ _ _) = compileUnions x 
166> compileAlgebra x@(WriteUnion _ _ _ _) = compileUnions x
167> compileAlgebra x@(Assert _ _) = compileAssert x
168> compileAlgebra x@(Printf _ _ _) = compilePrintf x
169> compileAlgebra x@(HasDescendants _ _ _) = compileHasDescendants x
170> compileAlgebra x@(MemToPhys _ _ _) = compileMemToPhys x
171> compileAlgebra x@(GetAddress _ _ _) = compileGetAddress x
172