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
13%if false
14
15> module Constructs.References where
16
17> import Text.PrettyPrint.HughesPJ as Pprinter
18> import Data.Maybe
19
20> import Semantics
21> import Constructs
22> import PureExpressions
23> import {-# SOURCE #-} Expressions
24
25> import IL.FoF.FoF
26> import IL.FoF.Compile
27
28%endif
29
30\section{Reference Cells}
31\label{chap:references}
32
33The reference cell construct provides an abstraction to both variables
34and C pointers. It composed by three combinators to create, read from,
35and write to reference cells. It can be compared to OCaml references
36or Haskell @IORef@.
37
38\subsection{Smart Constructors}
39
40A reference cell is created in an initialized state. The variant
41|newRefN| allows the DSL designer to provide a name to the created
42variable.
43
44> newRef :: Data -> FoFCode Loc
45> newRef d = inject (NewRef Nothing d return)
46>
47> newRefN :: String -> Data -> FoFCode Loc
48> newRefN name d = inject (NewRef (Just name) d return)
49
50Follow primitives to read from and write to these reference cells:
51
52> readRef :: Loc -> FoFCode Data
53> readRef l = inject (ReadRef l return)
54>
55> writeRef :: Loc -> Data -> FoFCode PureExpr
56> writeRef l d = inject (WriteRef l d (return Void))
57
58The current implementation lacks lots of sanity checks:
59\begin{itemize}
60        \item read and Write on CLRef,
61        \item write from and to compatible types,
62        \item do not write local pointers into param/global ones,
63        \item \ldots
64\end{itemize}
65
66
67\subsection{Compile Instantiation}
68
69The compilation is tricky when it comes to computing the pointer
70type. I wouldn't be surprised if some bugs were lying there. This
71concerns |newRef| and |readRef|, which effect on references is not
72trivial. 
73
74> compileReferences (NewRef refName ref r) binding =
75>     (FStatement (FNewRef publicName ref) cont,
76>      binding2)         
77>         where (publicName, binding1)
78>                   = case refName of
79>                     Just x -> (Provided x, binding)
80>                     Nothing -> 
81>                         let (loc, binding1) = getFreshVar binding in
82>                         (makeVarName Local loc, binding1) 
83>               ret = CLRef Local (TPointer (typeOf ref) Avail) publicName 
84>               (cont, binding2) = r ret binding1 
85>
86> compileReferences (ReadRef ref@(CLRef _ _ xloc) r) binding =
87>     (FStatement (FReadRef name ref) cont, 
88>      binding2)
89>         where (loc, name, binding1) = heritVarName binding xloc 
90>               ret = CLRef Local (unfoldPtrType ref) name 
91>               (cont, binding2) = r ret binding1
92
93|writeRef| is straightforward.
94
95> compileReferences (WriteRef ref d r) binding =
96>     (FStatement (FWriteRef ref d) cont,
97>      binding1)
98>         where (cont, binding1) = r binding 
99
100
101\subsection{Run Instantiation}
102
103On the other hand, the implementation of the interpreter is much
104simpler. We start with the dispatcher:
105
106> runReferences (NewRef _ d r) heap = uncurry r $ runNewRef d heap
107> runReferences (ReadRef l r) heap = uncurry r $ runReadRef l heap
108> runReferences (WriteRef l v r) heap = r $ runWriteRef l v heap
109
110And the per-construct interpreters follow:
111
112> runNewRef :: Data -> Heap -> (Loc, Heap)
113> runNewRef value heap =
114>     ( CLRef Local typeOfVal name, heap2 )
115>         where typeOfVal = typeOf value 
116>               loc = freshLoc heap
117>               refs = refMap heap 
118>               name = makeVarName Local loc 
119>               heap1 = heap { freshLoc = loc + 1 } 
120>               heap2 = heap1 { refMap = (name, value) : refs } 
121>
122> runReadRef :: Loc -> Heap -> (Data, Heap)
123> runReadRef (CLRef _ _ location) heap =
124>     let refs = refMap heap in
125>     let val = fromJust $ location `lookup` refs in
126>     (val, heap)
127>
128> runWriteRef :: Loc -> Data -> Heap -> Heap
129> runWriteRef (CLRef _ _ location) value heap =
130>     let refs = refMap heap in
131>     let refs1 = (location, value) : refs in
132>     heap { refMap = refs1 }