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 where
15
16> import PureExpressions
17> import Semantics
18
19%endif
20
21
22\section{Filet-o-Fish standard constructs}
23\label{sec:fof_syntax_constructs}
24
25
26The FoF language is defined by the syntax tree below. It gathers every
27constructs defined in the |Constructs| directory as well as foreign
28functions defined in the |Libc| and |Libbarrelfish| directories.
29
30
31> data FoFConst a 
32
33Foreign-call to libc Assert:
34
35>     = Assert PureExpr a
36
37Foreign-call to libc Printf:
38
39>     | Printf String [PureExpr] a
40
41Foreign-call to libarrelfish |has_descendants|:
42
43>     | HasDescendants (Maybe String) PureExpr (PureExpr -> a)
44
45Foreign-call to libarrelfish |mem_to_phys|:
46
47>     | MemToPhys (Maybe String) PureExpr (PureExpr -> a)
48
49Foreign-call to Hamlet |get_address|:
50
51>     | GetAddress (Maybe String) PureExpr (PureExpr -> a)
52
53Support for Union:
54
55>     | NewUnion (Maybe String) AllocUnion String [(String,TypeExpr)] (String, Data) (Loc -> a)
56>     | ReadUnion Loc String (Data -> a)
57>     | WriteUnion Loc String Data a
58
59Support for Typedef:
60
61>     | Typedef TypeExpr a
62>     | TypedefE String TypeExpr a
63
64Support for Structures:
65
66>     | NewStruct (Maybe String) AllocStruct String [(String,(TypeExpr,Data))] (Loc -> a)
67>     | ReadStruct Loc String (Data -> a)
68>     | WriteStruct Loc String Data a
69
70Support for Strings:
71
72>     | NewString (Maybe String) String (Loc -> a)
73
74Support for Reference cells:
75
76>      | NewRef (Maybe String) Data (Loc -> a)
77>      | ReadRef Loc (Data -> a)
78>      | WriteRef Loc Data a
79
80Support for Functions:
81
82>      | NewDef [FunAttr] String Function TypeExpr [(TypeExpr, Maybe String)] 
83>               (PureExpr -> a)
84>      | CallDef (Maybe String) PureExpr [PureExpr] 
85>                (PureExpr -> a)
86>      | Return PureExpr
87
88Support for Enumerations:
89
90>      | NewEnum (Maybe String) String Enumeration String (Loc -> a)
91
92Support for Conditionals:
93
94>      | If (FoFCode PureExpr)
95>           (FoFCode PureExpr) 
96>           (FoFCode PureExpr) a
97>      | For (FoFCode PureExpr)  
98>            (FoFCode PureExpr) 
99>            (FoFCode PureExpr) 
100>            (FoFCode PureExpr) a
101>      | While (FoFCode PureExpr) 
102>              (FoFCode PureExpr) a
103>      | DoWhile (FoFCode PureExpr) 
104>                (FoFCode PureExpr) a
105>      | Switch PureExpr 
106>               [(PureExpr, FoFCode PureExpr)] 
107>               (FoFCode PureExpr) a
108>      | Break
109>      | Continue 
110
111Support for Arrays:
112
113>      | NewArray (Maybe String) AllocArray [Data] (Loc -> a)
114>      | ReadArray Loc Index (Data -> a)
115>      | WriteArray Loc Index Data a
116
117The following type synonyms have been used above as a documentation
118purpose. A |Data| represents a value used to initialize a
119data-structure. A |Loc| represents a reference. An |Index| is a value
120used to index an array.
121
122> type Data = PureExpr
123> type Loc = PureExpr
124> type Index = PureExpr
125
126\paragraph{Function attributes}
127
128A function can be characterized by the following attributes, following
129their C semantics:
130
131> data FunAttr = Static
132>              | Inline
133>              deriving (Eq)
134
135> instance Show FunAttr where
136>     show Static = "static"
137>     show Inline = "inline"
138
139\paragraph{Enumeration}
140
141When defining an enumeration, we use the following type synonym to
142describe the list of pair name-value:
143
144> type Enumeration = [(String, Int)]
145
146
147\subsection{Functor instance}
148
149A crucial specificity of |FoFConst| is that it defines a functor. This
150functor is defined as follow.
151
152> instance Functor FoFConst where
153>     fmap f (Assert a b) = Assert a (f b)
154>     fmap f (Printf a b c) = Printf a b (f c)
155>     fmap f (HasDescendants a b c) = HasDescendants a b (f . c)
156>     fmap f (MemToPhys a b c) = MemToPhys a b (f . c)
157>     fmap f (GetAddress a b c) = GetAddress a b (f . c)
158>     fmap f (NewUnion a b c d e g) = NewUnion a b c d e (f . g)
159>     fmap f (ReadUnion a b c) = ReadUnion a b (f . c)
160>     fmap f (WriteUnion a b c d) = WriteUnion a b c (f d)
161>     fmap f (Typedef a c) = Typedef a (f c)
162>     fmap f (TypedefE a b c) = TypedefE a b (f c)
163>     fmap f (NewStruct a b c d e) = NewStruct a b c d (f . e)
164>     fmap f (ReadStruct a b c) = ReadStruct a b (f . c)
165>     fmap f (WriteStruct a b c d) = WriteStruct a b c (f d)
166>     fmap f (NewString a b c) = NewString a b (f . c)
167>     fmap f (NewRef a b c) = NewRef a b (f . c)
168>     fmap f (ReadRef a b) = ReadRef a (f . b)
169>     fmap f (WriteRef a b c) = WriteRef a b (f c)
170>     fmap g (NewDef a b c d e f) = NewDef a b c d e (g . f)
171>     fmap f (CallDef a b c d) = CallDef a b c (f . d)
172>     fmap f (Return a) = Return a
173>     fmap f (NewEnum a b c d e) = NewEnum a b c d (f . e)
174>     fmap f (If a b c d) = If a b c (f d)
175>     fmap f (For a b c d e) = For a b c d (f e)
176>     fmap f (While a b c) = While a b (f c)
177>     fmap f (DoWhile a b c) = DoWhile a b (f c)
178>     fmap f (Switch a b c d) = Switch a b c (f d)
179>     fmap f Break = Break
180>     fmap f Continue = Continue
181>     fmap f (NewArray a b c d) = NewArray a b c (f . d)
182>     fmap f (ReadArray a b c) = ReadArray a b (f . c)
183>     fmap f (WriteArray a b c d) = WriteArray a b c (f d)
184
185Thanks to this functor structure, it makes sense to embed |FoFConst|
186in a |Semantics|: the machinery we build in
187Chapter~\ref{sec:semantics_machinery} will take care of transforming
188this functor into a free monad. Hence the following type synonym.
189
190> type FoFCode a = Semantics FoFConst a
191
192