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.Arrays where
15
16> import Data.Maybe
17
18> import Semantics
19> import Constructs
20> import PureExpressions
21> import {-# SOURCE #-} Expressions
22
23> import Eval
24
25> import IL.FoF.FoF
26> import IL.FoF.Compile
27
28%endif
29
30\section{Arrays}
31
32The |Array| construct, as well as the subsequent constructs, is
33organized as follow. First, we define some smart constructors, which
34are directly used by the DSL designer when implementing the
35compiler. Then, we implement the one-step interpreter and compiler to
36FoF.
37
38|Array| offers an abstraction over C arrays, both statically defined
39or statically allocated. Hence, it offers the possibility to create,
40read from, and write into arrays.
41
42\subsection{Smart Constructors}
43
44We can create dynamic and static anonymous arrays using the following
45combinators:
46
47> newArray :: [Data] -> FoFCode Loc
48> newArray value = inject (NewArray Nothing DynamicArray value return)
49
50> newStaticArray :: [Data] -> FoFCode Loc
51> newStaticArray value = inject (NewArray Nothing (StaticArray $ length value) value return)
52
53Similarly, they can be named:
54
55> newArrayN :: String -> [Data] -> FoFCode Loc
56> newArrayN name value = inject (NewArray (Just name) DynamicArray value return)
57
58> newStaticArrayN :: String -> [Data] -> FoFCode Loc
59> newStaticArrayN name value = inject (NewArray (Just name) (StaticArray $ length value) value return)
60
61Then, we can read the content of an array:
62
63> readArray :: Loc -> Index -> FoFCode Data
64> readArray l f = inject (ReadArray l f return)
65
66As well as write some data in a cell:
67
68> writeArray :: Loc -> Index -> Data -> FoFCode ()
69> writeArray l f d = inject (WriteArray l f d (return ()))
70
71
72\subsection{Run Instantiation}
73
74The interpretation of an array operation is dispatched by the
75following code.
76
77> runArrays :: FoFConst (Heap -> (a, Heap)) -> (Heap -> (a, Heap))
78> runArrays (NewArray a b c r) heap = uncurry r $ runNewArray b c heap
79> runArrays (ReadArray a b r) heap = uncurry r $ runReadArray a b heap
80> runArrays (WriteArray a b c r) heap = r $ runWriteArray a b c heap
81
82Creating, reading, and writing to or from an array are trivially
83implemented by the following code:
84
85> runNewArray :: AllocArray -> [Data] -> Heap -> (Loc, Heap)
86> runNewArray alloc initData heap = 
87>     let loc = freshALoc heap in
88>     let sizeInt = length initData in
89>     let name = makeVarName Dynamic loc in
90>     let ref = CLRef Dynamic (TArray alloc $ typeOf $ head initData) name in
91>     let heap1 = heap { freshALoc = loc + 1,
92>                        arrayMap = (name, initData) : (arrayMap heap) } in
93>     (ref, heap1)
94>
95> runReadArray :: Loc -> Index -> Heap -> (Data, Heap)
96> runReadArray (CLRef _ (TArray _ _) loc) index heap = 
97>     let array = fromJust $ loc `lookup` (arrayMap heap) in
98>     let (CLInteger _ _ indexInt) = symbEval index in
99>     let val = array !! (fromInteger indexInt) in
100>     (val, heap)
101>
102> runWriteArray :: Loc -> Index -> Data -> Heap -> Heap
103> runWriteArray (CLRef _ (TArray _ _) loc) index dat heap = 
104>     let array = fromJust $ loc `lookup` (arrayMap heap) in
105>     let (CLInteger _ _ indexInt) = symbEval index in
106>     let (arrayBegin, arrayEnd) = splitAt (fromInteger indexInt) array in
107>     let array1 = arrayBegin ++ (dat : tail arrayEnd) in
108>     let heap1 = heap { arrayMap = (loc, array1) : arrayMap heap } in
109>     heap1
110
111\subsection{Compile Instantiation}
112
113Similarly, the compilation of array operations consists in
114implementing the following function:
115
116> compileArrays :: FoFConst (Binding -> (ILFoF, Binding)) ->
117>                  (Binding -> (ILFoF, Binding))
118
119The translation from the |FoFConst| terms to |FoF| terms is almost
120automatic. The added value of this process consists in generating or
121deriving names for the references.
122
123> compileArrays (NewArray name allocArray dat r) binding =
124>     let scopeVar 
125>               = case allocArray of
126>               DynamicArray -> Dynamic
127>               StaticArray _ -> Global in
128>     let (publicName, binding1)
129>             = case name of 
130>               Just x -> (Provided x, binding)
131>               Nothing -> 
132>                   let (loc, binding1) = getFreshVar binding in
133>                   (makeVarName scopeVar loc, 
134>                    binding1) in
135>     let typeOfDat = typeOf $ head dat in
136>     let ret = CLRef Dynamic (TArray allocArray typeOfDat) publicName in
137>     let (cont, binding2) = r ret binding in
138>     (FStatement (FNewArray publicName allocArray dat) cont, 
139>      binding2)
140>
141> compileArrays (ReadArray ref@(CLRef origin (TArray arrayAlloc typ) xloc) index r) binding =
142>     let (loc, name, binding1) = heritVarName binding xloc in
143>     let ret = CLRef Dynamic (readOf typ) name in
144>     let (cont, binding2) = r ret binding1 in
145>     (FStatement (FReadArray name ref index) cont,
146>      binding2)
147>
148> compileArrays (WriteArray ref@(CLRef origin 
149>                                      (TArray arrayAlloc typ) 
150>                                      xloc) 
151>                           index dat r) binding =
152>     let (cont, binding1) = r binding in
153>     (FStatement (FWriteArray ref index dat) cont,
154>      binding1)
155
156
157