Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/c-target/c-target.sml
[diderot] / branches / pure-cfg / src / compiler / c-target / c-target.sml  
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/c-target/c-target.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 622, Mon Mar 14 19:56:40 2011 UTC revision 623, Tue Mar 15 17:04:53 2011 UTC
# Line 14  Line 14 
14    
15      datatype ty = datatype TargetTy.ty      datatype ty = datatype TargetTy.ty
16    
17        datatype var = V of (ty * string)
18    
19        datatype exp = E of CLang.exp * ty
20    
21        type stm = CL.stm
22    
23      datatype strand = Strand of {      datatype strand = Strand of {
24          name : string,          name : string,
25          tyName : string,          tyName : string,
26          state : (ty * string) list ref,          state : var list ref,
27          code : CL.decl list ref          code : CL.decl list ref
28        }        }
29    
     type var = (ty * string) (* FIXME *)  
   
     type exp = CLang.exp * ty  
   
     type stm = CL.stm  
   
     type method = unit (* FIXME *)  
   
30      datatype program = Prog of {      datatype program = Prog of {
31          globals : CL.decl list ref,          globals : CL.decl list ref,
32          topDecls : CL.decl list ref,          topDecls : CL.decl list ref,
# Line 69  Line 67 
67    (* report invalid arguments *)    (* report invalid arguments *)
68      fun invalid (name, []) = raise Fail("invaild "^name)      fun invalid (name, []) = raise Fail("invaild "^name)
69        | invalid (name, args) = let        | invalid (name, args) = let
70            fun arg2s (e, ty) = concat["(", CL.expToString e, " : ", TargetTy.toString ty, ")"]            fun arg2s (E(e, ty)) = concat["(", CL.expToString e, " : ", TargetTy.toString ty, ")"]
71            val args = String.concatWith ", " (List.map arg2s args)            val args = String.concatWith ", " (List.map arg2s args)
72            in            in
73              raise Fail(concat["invalid arguments to ", name, ": ", args])              raise Fail(concat["invalid arguments to ", name, ": ", args])
# Line 106  Line 104 
104              topDecls := initFn :: !topDecls              topDecls := initFn :: !topDecls
105            end            end
106    
107    (* register the initially code for a program *)    (* create and register the initially function for a program *)
108      fun initially (Prog{topDecls, ...}, init) = let      fun initially {
109  (* FIXME: what is the correct return type for this function? *)              prog = Prog{topDecls, ...},
110            val initFn = CL.D_Func([], CL.voidTy, RN.initially, [], init)              isArray : bool,
111                iterPrefix : stm list,
112                iters : (var * exp * exp) list,
113                createPrefix : stm list,
114                strand=Strand{name, ...},
115                args : exp list
116              } = let
117              val nDims = List.length iters
118              val worldTy = CL.T_Ptr(CL.T_Named RN.worldTy)
119              fun mapi f xs = let
120                    fun mapf (_, []) = []
121                      | mapf (i, x::xs) = f(i, x) :: mapf(i+1, xs)
122                    in
123                      mapf (0, xs)
124                    end
125              val baseInit = mapi (fn (i, (_, E(e, _), _)) => (i, CL.I_Exp e)) iters
126              val sizeInit = mapi
127                    (fn (i, (V(ty, _), E(lo, _), E(hi, _))) =>
128                        (i, CL.I_Exp(CL.mkBinOp(CL.mkBinOp(hi, CL.#-, lo), CL.#+, CL.E_Int(1, cvtTy ty))))
129                    ) iters
130              val allocCode = [
131                      CL.S_Comment["allocate initial block of strands"],
132                      CL.S_Decl(CL.T_Array(CL.int32, SOME nDims), "base", SOME(CL.I_Array baseInit)),
133                      CL.S_Decl(CL.T_Array(CL.uint32, SOME nDims), "size", SOME(CL.I_Array sizeInit)),
134                      CL.S_Decl(worldTy, "wrld",
135                        SOME(CL.I_Exp(CL.E_Apply(RN.allocInitially, [
136                            CL.mkUnOp(CL.%&, CL.E_Var(RN.strandDesc name)),
137                            CL.E_Bool isArray,
138                            CL.E_Int(IntInf.fromInt nDims, CL.int32),
139                            CL.E_Var "base",
140                            CL.E_Var "size"
141                          ]))))
142                    ]
143            (* create the loop nest for the initially iterations *)
144              val indexVar = "ix"
145              fun mkLoopNest [] = CL.mkBlock(createPrefix @ [
146                      CL.S_Decl(CL.T_Ptr(CL.T_Named(RN.strandTy name)), "sp",
147                        SOME(CL.I_Exp(CL.E_Apply(RN.inState, [CL.E_Var "wrld", CL.E_Var indexVar])))),
148                      CL.S_Call(RN.strandInit name, CL.E_Var "sp" :: List.map (fn (E(e, _)) => e) args)
149                    ])
150                | mkLoopNest ((V(ty, param), E(lo,_), E(hi, _))::iters) = let
151                    val body = mkLoopNest iters
152                    in
153                      CL.S_For(
154                        [(cvtTy ty, param, lo)],
155                        CL.mkBinOp(CL.E_Var param, CL.#<=, hi),
156                        [CL.mkPostOp(CL.E_Var param, CL.^++)],
157                        body)
158                    end
159              val iterCode = [
160                      CL.S_Comment["initially"],
161                      CL.S_Decl(CL.uint32, indexVar, SOME(CL.I_Exp(CL.E_Int(0, CL.uint32)))),
162                      mkLoopNest iters
163                    ]
164              val body = CL.mkBlock(iterPrefix @ allocCode @ iterCode @ [CL.S_Return(SOME(CL.E_Var "wrld"))])
165              val initFn = CL.D_Func([], worldTy, RN.initially, [], body)
166            in            in
167              topDecls := initFn :: !topDecls              topDecls := initFn :: !topDecls
168            end            end
# Line 118  Line 171 
171        struct        struct
172          fun global (Prog{globals, ...}, ty, name) = (          fun global (Prog{globals, ...}, ty, name) = (
173                globals := CL.D_Var([], cvtTy ty, name, NONE) :: !globals;                globals := CL.D_Var([], cvtTy ty, name, NONE) :: !globals;
174                (ty, name))                V(ty, name))
175          fun param (ty, name) = (ty, name)          fun param (ty, name) = V(ty, name)
176          fun state (Strand{state, ...}, ty, name) = (          fun state (Strand{state, ...}, ty, name) = (
177                state := (ty, name) :: !state;                state := V(ty, name) :: !state;
178                (ty, name))                V(ty, name))
179          fun var (ty, name) = (ty, name)          fun var (ty, name) = V(ty, name)
180          local          local
181            val count = ref 0            val count = ref 0
182            fun freshName prefix = let            fun freshName prefix = let
# Line 133  Line 186 
186                    concat[prefix, "_", Int.toString n]                    concat[prefix, "_", Int.toString n]
187                  end                  end
188          in          in
189          fun tmp ty = (ty, freshName "tmp")          fun tmp ty = V(ty, freshName "tmp")
190          fun fresh prefix = freshName prefix          fun fresh prefix = freshName prefix
191          end (* local *)          end (* local *)
192        end        end
# Line 145  Line 198 
198          fun allowedInline _ = true (* FIXME *)          fun allowedInline _ = true (* FIXME *)
199    
200        (* variable references *)        (* variable references *)
201          fun global (ty, x) = (CL.mkVar x, ty)          fun global (V(ty, x)) = E(CL.mkVar x, ty)
202          fun getState (ty, x) = (CL.mkIndirect(CL.mkVar "selfIn", x), ty)          fun getState (V(ty, x)) = E(CL.mkIndirect(CL.mkVar "selfIn", x), ty)
203          fun param (ty, x) = (CL.mkVar x, ty)          fun param (V(ty, x)) = E(CL.mkVar x, ty)
204          fun var (ty, x) = (CL.mkVar x, ty)          fun var (V(ty, x)) = E(CL.mkVar x, ty)
205    
206        (* literals *)        (* literals *)
207          fun intLit n = (CL.mkInt(n, !RN.gIntTy), intTy)          fun intLit n = E(CL.mkInt(n, !RN.gIntTy), intTy)
208          fun floatLit f = (CL.mkFlt(f, !RN.gRealTy), realTy)          fun floatLit f = E(CL.mkFlt(f, !RN.gRealTy), realTy)
209          fun stringLit s = (CL.mkStr s, stringTy)          fun stringLit s = E(CL.mkStr s, stringTy)
210          fun boolLit b = (CL.mkBool b, boolTy)          fun boolLit b = E(CL.mkBool b, boolTy)
211    
212        (* select from a vector.  We have to cast to the corresponding union type and then        (* select from a vector.  We have to cast to the corresponding union type and then
213         * select from the array field.         * select from the array field.
# Line 168  Line 221 
221                      val e1 = CL.mkCast(unionTy, e)                      val e1 = CL.mkCast(unionTy, e)
222                      val e2 = CL.mkSelect(e1, field)                      val e2 = CL.mkSelect(e1, field)
223                      in                      in
224                        (CL.mkSubscript(e2, CL.mkInt(IntInf.fromInt i, CL.int32)), ty)                        E(CL.mkSubscript(e2, CL.mkInt(IntInf.fromInt i, CL.int32)), ty)
225                      end                      end
226          val selF = sel (RN.gRealSuffix, "r", T_Real)          val selF = sel (RN.gRealSuffix, "r", T_Real)
227          val selI = sel (RN.gIntSuffix, "i", T_Int)          val selI = sel (RN.gIntSuffix, "i", T_Int)
228          in          in
229          fun select (i, (e, T_Vec n)) = selF (i, e, n)          fun select (i, E(e, T_Vec n)) = selF (i, e, n)
230            | select (i, (e, T_IVec n)) = selI (i, e, n)            | select (i, E(e, T_IVec n)) = selI (i, e, n)
231            | select (_, x) = invalid("select", [x])            | select (_, x) = invalid("select", [x])
232          end (* local *)          end (* local *)
233    
234        (* vector (and scalar) arithmetic *)        (* vector (and scalar) arithmetic *)
235          local          local
236            fun checkTys (ty1, ty2) = (ty1 = ty2) andalso numTy ty1            fun checkTys (ty1, ty2) = (ty1 = ty2) andalso numTy ty1
237            fun binop rator ((e1, ty1), (e2, ty2)) =            fun binop rator (E(e1, ty1), E(e2, ty2)) =
238                  if checkTys (ty1, ty2)                  if checkTys (ty1, ty2)
239                    then (CL.mkBinOp(e1, rator, e2), ty1)                    then E(CL.mkBinOp(e1, rator, e2), ty1)
240                    else invalid (                    else invalid (
241                      concat["binary operator \"", CL.binopToString rator, "\""],                      concat["binary operator \"", CL.binopToString rator, "\""],
242                      [(e1, ty1), (e2, ty2)])                      [E(e1, ty1), E(e2, ty2)])
243          in          in
244          fun add ((e1, ty as T_Ptr _), (e2, T_Int)) = (CL.mkBinOp(e1, CL.#+, e2), ty)          fun add (E(e1, ty as T_Ptr _), E(e2, T_Int)) = E(CL.mkBinOp(e1, CL.#+, e2), ty)
245            | add args = binop CL.#+ args            | add args = binop CL.#+ args
246          fun sub ((e1, ty as T_Ptr _), (e2, T_Int)) = (CL.mkBinOp(e1, CL.#-, e2), ty)          fun sub (E(e1, ty as T_Ptr _), E(e2, T_Int)) = E(CL.mkBinOp(e1, CL.#-, e2), ty)
247            | sub args = binop CL.#- args            | sub args = binop CL.#- args
248        (* NOTE: multiplication and division are also used for scaling *)        (* NOTE: multiplication and division are also used for scaling *)
249          fun mul ((e1, T_Real), (e2, T_Vec n)) =          fun mul (E(e1, T_Real), E(e2, T_Vec n)) =
250                (CL.E_Apply(RN.scale n, [e1, e2]), T_Vec n)                E(CL.E_Apply(RN.scale n, [e1, e2]), T_Vec n)
251            | mul args = binop CL.#* args            | mul args = binop CL.#* args
252          fun divide ((e1, T_Vec n), (e2, T_Real)) =          fun divide (E(e1, T_Vec n), E(e2, T_Real)) = let
253                (CL.E_Apply(RN.scale n,                val E(one, _) = floatLit FloatLit.one
254                  [CL.mkBinOp(#1(floatLit FloatLit.one), CL.#/, e2), e1]), T_Vec n)                in
255                    E(CL.E_Apply(RN.scale n, [CL.mkBinOp(one, CL.#/, e2), e1]), T_Vec n)
256                  end
257            | divide args = binop CL.#/ args            | divide args = binop CL.#/ args
258          end (* local *)          end (* local *)
259          fun neg (e, T_Bool) = raise Fail "invalid argument to neg"          fun neg (E(e, T_Bool)) = raise Fail "invalid argument to neg"
260            | neg (e, ty) = (CL.mkUnOp(CL.%-, e), ty)            | neg (E(e, ty)) = E(CL.mkUnOp(CL.%-, e), ty)
261    
262          fun abs (e, T_Int) = (CL.mkApply("abs", [e]), T_Int)    (* FIXME: not the right type for 64-bit ints *)          fun abs (E(e, T_Int)) = E(CL.mkApply("abs", [e]), T_Int)        (* FIXME: not the right type for 64-bit ints *)
263            | abs (e, T_Real) = (CL.mkApply("fabs" ^ !RN.gRealSuffix, [e]), T_Real)            | abs (E(e, T_Real)) = E(CL.mkApply("fabs" ^ !RN.gRealSuffix, [e]), T_Real)
264            | abs (e, T_Vec n) = raise Fail "FIXME: Expr.abs"            | abs (E(e, T_Vec n)) = raise Fail "FIXME: Expr.abs"
265            | abs (e, T_IVec n) = raise Fail "FIXME: Expr.abs"            | abs (E(e, T_IVec n)) = raise Fail "FIXME: Expr.abs"
266            | abs _ = raise Fail "invalid argument to abs"            | abs _ = raise Fail "invalid argument to abs"
267    
268          fun dot ((e1, T_Vec n1), (e2, T_Vec n2)) = (CL.E_Apply(RN.dot n1, [e1, e2]), T_Real)          fun dot (E(e1, T_Vec n1), E(e2, T_Vec n2)) = E(CL.E_Apply(RN.dot n1, [e1, e2]), T_Real)
269            | dot _ = raise Fail "invalid argument to dot"            | dot _ = raise Fail "invalid argument to dot"
270    
271          fun cross ((e1, T_Vec 3), (e2, T_Vec 3)) = (CL.E_Apply(RN.cross(), [e1, e2]), T_Vec 3)          fun cross (E(e1, T_Vec 3), E(e2, T_Vec 3)) = E(CL.E_Apply(RN.cross(), [e1, e2]), T_Vec 3)
272            | cross _ = raise Fail "invalid argument to cross"            | cross _ = raise Fail "invalid argument to cross"
273    
274          fun length (e, T_Vec n) = (CL.E_Apply(RN.length n, [e]), T_Real)          fun length (E(e, T_Vec n)) = E(CL.E_Apply(RN.length n, [e]), T_Real)
275            | length _ = raise Fail "invalid argument to length"            | length _ = raise Fail "invalid argument to length"
276    
277          fun normalize (e, T_Vec n) = (CL.E_Apply(RN.normalize n, [e]), T_Vec n)          fun normalize (E(e, T_Vec n)) = E(CL.E_Apply(RN.normalize n, [e]), T_Vec n)
278            | normalize _ = raise Fail "invalid argument to length"            | normalize _ = raise Fail "invalid argument to length"
279    
280        (* comparisons *)        (* comparisons *)
281          local          local
282            fun checkTys (ty1, ty2) =            fun checkTys (ty1, ty2) =
283                  (ty1 = ty2) andalso scalarTy ty1                  (ty1 = ty2) andalso scalarTy ty1
284            fun cmpop rator ((e1, ty1), (e2, ty2)) =            fun cmpop rator (E(e1, ty1), E(e2, ty2)) =
285                  if checkTys (ty1, ty2)                  if checkTys (ty1, ty2)
286                    then (CL.mkBinOp(e1, rator, e2), T_Bool)                    then E(CL.mkBinOp(e1, rator, e2), T_Bool)
287                    else invalid (                    else invalid (
288                      concat["compare operator \"", CL.binopToString rator, "\""],                      concat["compare operator \"", CL.binopToString rator, "\""],
289                      [(e1, ty1), (e2, ty2)])                      [E(e1, ty1), E(e2, ty2)])
290          in          in
291          val lt = cmpop CL.#<          val lt = cmpop CL.#<
292          val lte = cmpop CL.#<=          val lte = cmpop CL.#<=
# Line 242  Line 297 
297          end (* local *)          end (* local *)
298    
299        (* logical connectives *)        (* logical connectives *)
300          fun not (e, T_Bool) = (CL.mkUnOp(CL.%!, e), T_Bool)          fun not (E(e, T_Bool)) = E(CL.mkUnOp(CL.%!, e), T_Bool)
301            | not _ = raise Fail "invalid argument to not"            | not _ = raise Fail "invalid argument to not"
302          fun && ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#&&, e2), T_Bool)          fun && (E(e1, T_Bool), E(e2, T_Bool)) = E(CL.mkBinOp(e1, CL.#&&, e2), T_Bool)
303            | && _ = raise Fail "invalid arguments to &&"            | && _ = raise Fail "invalid arguments to &&"
304          fun || ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#||, e2), T_Bool)          fun || (E(e1, T_Bool), E(e2, T_Bool)) = E(CL.mkBinOp(e1, CL.#||, e2), T_Bool)
305            | || _ = raise Fail "invalid arguments to ||"            | || _ = raise Fail "invalid arguments to ||"
306    
307          local          local
308            fun checkTys (ty1, ty2) = (ty1 = ty2) andalso scalarTy ty1            fun checkTys (ty1, ty2) = (ty1 = ty2) andalso scalarTy ty1
309            fun binFn f ((e1, ty1), (e2, ty2)) =            fun binFn f (E(e1, ty1), E(e2, ty2)) =
310                  if checkTys (ty1, ty2)                  if checkTys (ty1, ty2)
311                    then (CL.mkApply(f ty1, [e1, e2]), ty1)                    then E(CL.mkApply(f ty1, [e1, e2]), ty1)
312                    else raise Fail "invalid arguments to binary function"                    else raise Fail "invalid arguments to binary function"
313          in          in
314        (* misc functions *)        (* misc functions *)
# Line 262  Line 317 
317          end (* local *)          end (* local *)
318    
319        (* math functions *)        (* math functions *)
320          fun pow ((e1, T_Real), (e2, T_Real)) =          fun pow (E(e1, T_Real), E(e2, T_Real)) =
321                if !Controls.doublePrecision                if !Controls.doublePrecision
322                  then (CL.mkApply("pow", [e1, e2]), T_Real)                  then E(CL.mkApply("pow", [e1, e2]), T_Real)
323                  else (CL.mkApply("powf", [e1, e2]), T_Real)                  else E(CL.mkApply("powf", [e1, e2]), T_Real)
324            | pow _ = raise Fail "invalid arguments to pow"            | pow _ = raise Fail "invalid arguments to pow"
325    
326          local          local
327            fun r2r (ff, fd) (e, T_Real) = if !Controls.doublePrecision            fun r2r (ff, fd) (E(e, T_Real)) = if !Controls.doublePrecision
328                  then (CL.mkApply(fd, [e]), T_Real)                  then E(CL.mkApply(fd, [e]), T_Real)
329                  else (CL.mkApply(ff, [e]), T_Real)                  else E(CL.mkApply(ff, [e]), T_Real)
330              | r2r (_, fd) e = invalid (fd, [e])              | r2r (_, fd) e = invalid (fd, [e])
331          in          in
332          val sin = r2r ("sinf", "sin")          val sin = r2r ("sinf", "sin")
# Line 280  Line 335 
335          end (* local *)          end (* local *)
336    
337        (* rounding *)        (* rounding *)
338          fun trunc (e, ty) = (CL.mkApply(RN.addTySuffix("trunc", ty), [e]), ty)          fun trunc (E(e, ty)) = E(CL.mkApply(RN.addTySuffix("trunc", ty), [e]), ty)
339          fun round (e, ty) = (CL.mkApply(RN.addTySuffix("round", ty), [e]), ty)          fun round (E(e, ty)) = E(CL.mkApply(RN.addTySuffix("round", ty), [e]), ty)
340          fun floor (e, ty) = (CL.mkApply(RN.addTySuffix("floor", ty), [e]), ty)          fun floor (E(e, ty)) = E(CL.mkApply(RN.addTySuffix("floor", ty), [e]), ty)
341          fun ceil (e, ty) = (CL.mkApply(RN.addTySuffix("ceil", ty), [e]), ty)          fun ceil (E(e, ty)) = E(CL.mkApply(RN.addTySuffix("ceil", ty), [e]), ty)
342    
343        (* conversions *)        (* conversions *)
344          fun toInt (e, T_Real) = (CL.mkCast(!RN.gIntTy, e), T_Int)          fun toInt (E(e, T_Real)) = E(CL.mkCast(!RN.gIntTy, e), T_Int)
345            | toInt (e, T_Vec n) = (CL.mkApply(RN.vecftoi n, [e]), ivecTy n)            | toInt (E(e, T_Vec n)) = E(CL.mkApply(RN.vecftoi n, [e]), ivecTy n)
346            | toInt e = invalid ("toInt", [e])            | toInt e = invalid ("toInt", [e])
347          fun toReal (e, T_Int) = (CL.mkCast(!RN.gRealTy, e), T_Real)          fun toReal (E(e, T_Int)) = E(CL.mkCast(!RN.gRealTy, e), T_Real)
348            | toReal e = invalid ("toReal", [e])            | toReal e = invalid ("toReal", [e])
349    
350        (* runtime system hooks *)        (* runtime system hooks *)
351          fun imageAddr (e, T_Image(_, rTy)) = let          fun imageAddr (E(e, T_Image(_, rTy))) = let
352                val cTy = CL.T_Ptr(CL.T_Num rTy)                val cTy = CL.T_Ptr(CL.T_Num rTy)
353                in                in
354                  (CL.mkCast(cTy, CL.mkIndirect(e, "data")), T_Ptr rTy)                  E(CL.mkCast(cTy, CL.mkIndirect(e, "data")), T_Ptr rTy)
355                end                end
356            | imageAddr a = invalid("imageAddr", [a])            | imageAddr a = invalid("imageAddr", [a])
357          fun getImgData (e, T_Ptr rTy) = let          fun getImgData (E(e, T_Ptr rTy)) = let
358                val realTy as CL.T_Num rTy' = !RN.gRealTy                val realTy as CL.T_Num rTy' = !RN.gRealTy
359                val e = CL.E_UnOp(CL.%*, e)                val e = CL.E_UnOp(CL.%*, e)
360                in                in
361                  if (rTy' = rTy)                  if (rTy' = rTy)
362                    then (e, T_Real)                    then E(e, T_Real)
363                    else (CL.E_Cast(realTy, e), T_Real)                    else E(CL.E_Cast(realTy, e), T_Real)
364                end                end
365            | getImgData a = invalid("getImgData", [a])            | getImgData a = invalid("getImgData", [a])
366          fun posToImgSpace ((img, T_Image(d, _)), (pos, T_Vec n)) = let          fun posToImgSpace (E(img, T_Image(d, _)), E(pos, T_Vec n)) = let
367                val e = CL.mkApply(RN.toImageSpace d, [img, pos])                val e = CL.mkApply(RN.toImageSpace d, [img, pos])
368                in                in
369                  (e, T_Vec n)                  E(e, T_Vec n)
370                end                end
371            | posToImgSpace (a, b) = invalid("posToImgSpace", [a, b])            | posToImgSpace (a, b) = invalid("posToImgSpace", [a, b])
372          fun inside ((pos, T_Vec n), (img, T_Image(d, _)), s) = let          fun inside (E(pos, T_Vec n), E(img, T_Image(d, _)), s) = let
373                val e = CL.mkApply(RN.inside d,                val e = CL.mkApply(RN.inside d,
374                      [pos, img, CL.mkInt(IntInf.fromInt s, CL.int32)])                      [pos, img, CL.mkInt(IntInf.fromInt s, CL.int32)])
375                in                in
376                  (e, T_Bool)                  E(e, T_Bool)
377                end                end
378            | inside (a, b, _) = invalid("inside", [a, b])            | inside (a, b, _) = invalid("inside", [a, b])
379    
# Line 328  Line 383 
383      structure Stmt =      structure Stmt =
384        struct        struct
385          val comment = CL.S_Comment          val comment = CL.S_Comment
386          fun assignState ((_, x), (e, _)) =          fun assignState (V(_, x), E(e, _)) =
387                CL.mkAssign(CL.mkIndirect(CL.mkVar "selfOut", x), e)                CL.mkAssign(CL.mkIndirect(CL.mkVar "selfOut", x), e)
388          fun assign ((_, x), (e, _)) = CL.mkAssign(CL.mkVar x, e)          fun assign (V(_, x), E(e, _)) = CL.mkAssign(CL.mkVar x, e)
389          fun decl ((ty, x), SOME(e, _)) = CL.mkDecl(cvtTy ty, x, SOME e)          fun decl (V(ty, x), SOME(E(e, _))) = CL.mkDecl(cvtTy ty, x, SOME(CL.I_Exp e))
390            | decl ((ty, x), NONE) = CL.mkDecl(cvtTy ty, x, NONE)            | decl (V(ty, x), NONE) = CL.mkDecl(cvtTy ty, x, NONE)
391          val block = CL.mkBlock          val block = CL.mkBlock
392          fun ifthen ((e, T_Bool), s1) = CL.mkIfThen(e, s1)          fun ifthen (E(e, T_Bool), s1) = CL.mkIfThen(e, s1)
393          fun ifthenelse ((e, T_Bool), s1, s2) = CL.mkIfThenElse(e, s1, s2)          fun ifthenelse (E(e, T_Bool), s1, s2) = CL.mkIfThenElse(e, s1, s2)
394          fun for ((ty, x), (lo, _), (hi, _), body) = CL.mkFor(          fun for (V(ty, x), E(lo, _), E(hi, _), body) = CL.mkFor(
395                  [(cvtTy ty, x, lo)],                  [(cvtTy ty, x, lo)],
396                  CL.mkBinOp(CL.mkVar x, CL.#<=, hi),                  CL.mkBinOp(CL.mkVar x, CL.#<=, hi),
397                  [CL.mkPostOp(CL.mkVar x, CL.^++)],                  [CL.mkPostOp(CL.mkVar x, CL.^++)],
398                  body)                  body)
399        (* special Diderot forms *)        (* special Diderot forms *)
400          fun cons ((T_Vec n, x), args : exp list) =          fun cons (V(T_Vec n, x), args : exp list) =
401                CL.mkAssign(CL.mkVar x, CL.mkApply(RN.mkVec n, List.map #1 args))                CL.mkAssign(CL.mkVar x, CL.mkApply(RN.mkVec n, List.map (fn E(e, _) => e) args))
402            | cons _ = raise Fail "bogus cons"            | cons _ = raise Fail "bogus cons"
403          fun getImgData ((T_Vec n, x), (e, T_Ptr rTy)) = let          fun getImgData (V(T_Vec n, x), E(e, T_Ptr rTy)) = let
404                val addr = Var.fresh "vp"                val addr = Var.fresh "vp"
405                val needsCast = (CL.T_Num rTy <> !RN.gRealTy)                val needsCast = (CL.T_Num rTy <> !RN.gRealTy)
406                fun mkLoad i = let                fun mkLoad i = let
# Line 354  Line 409 
409                        if needsCast then CL.mkCast(!RN.gRealTy, e) else e                        if needsCast then CL.mkCast(!RN.gRealTy, e) else e
410                      end                      end
411                in [                in [
412                  CL.mkDecl(CL.T_Ptr(CL.T_Num rTy), addr, SOME e),                  CL.mkDecl(CL.T_Ptr(CL.T_Num rTy), addr, SOME(CL.I_Exp e)),
413                  CL.mkAssign(CL.mkVar x,                  CL.mkAssign(CL.mkVar x,
414                    CL.mkApply(RN.mkVec n, List.tabulate (n, mkLoad)))                    CL.mkApply(RN.mkVec n, List.tabulate (n, mkLoad)))
415                ] end                ] end
# Line 369  Line 424 
424                      CL.mkCall("exit", [CL.mkInt(1, CL.int32)]))]                      CL.mkCall("exit", [CL.mkInt(1, CL.int32)]))]
425                  end                  end
426          in          in
427          fun loadImage (lhs : var, dim, name : exp) = checkSts (fn sts => let          fun loadImage (V(_, lhs), dim, E(name, _)) = checkSts (fn sts => let
428                val imgTy = CL.T_Named(RN.imageTy dim)                val imgTy = CL.T_Named(RN.imageTy dim)
429                val loadFn = RN.loadImage dim                val loadFn = RN.loadImage dim
430                in [                in [
431                  CL.S_Decl(                  CL.S_Decl(
432                    statusTy, sts,                    statusTy, sts,
433                    SOME(CL.E_Apply(loadFn, [#1 name, CL.mkUnOp(CL.%&, CL.E_Var(#2 lhs))])))                    SOME(CL.I_Exp(CL.E_Apply(loadFn, [name, CL.mkUnOp(CL.%&, CL.E_Var lhs)]))))
434                ] end)                ] end)
435          fun input (lhs : var, name, optDflt) = checkSts (fn sts => let          fun input (V(ty, lhs), name, optDflt) = checkSts (fn sts => let
436                val inputFn = RN.input(#1 lhs)                val inputFn = RN.input ty
437                val lhs = CL.E_Var(#2 lhs)                val lhs = CL.E_Var lhs
438                val (initCode, hasDflt) = (case optDflt                val (initCode, hasDflt) = (case optDflt
439                       of SOME(e, _) => ([CL.S_Assign(lhs, e)], true)                       of SOME(E(e, _)) => ([CL.S_Assign(lhs, e)], true)
440                        | NONE => ([], false)                        | NONE => ([], false)
441                      (* end case *))                      (* end case *))
442                val code = [                val code = [
443                      CL.S_Decl(                      CL.S_Decl(
444                        statusTy, sts,                        statusTy, sts,
445                        SOME(CL.E_Apply(inputFn, [                        SOME(CL.I_Exp(CL.E_Apply(inputFn, [
446                            CL.E_Str name, CL.mkUnOp(CL.%&, lhs), CL.mkBool hasDflt                            CL.E_Str name, CL.mkUnOp(CL.%&, lhs), CL.mkBool hasDflt
447                          ])))                          ]))))
448                      ]                      ]
449                in                in
450                  initCode @ code                  initCode @ code
# Line 422  Line 477 
477                val fName = RN.strandInit name                val fName = RN.strandInit name
478                val params =                val params =
479                      CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut") ::                      CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut") ::
480                        List.map (fn (ty, x) => CL.PARAM([], cvtTy ty, x)) params                        List.map (fn (V(ty, x)) => CL.PARAM([], cvtTy ty, x)) params
481                val initFn = CL.D_Func([], CL.voidTy, fName, params, init)                val initFn = CL.D_Func([], CL.voidTy, fName, params, init)
482                in                in
483                  code := initFn :: !code                  code := initFn :: !code
# Line 443  Line 498 
498    
499      fun genStrand (Strand{name, tyName, state, code}) = let      fun genStrand (Strand{name, tyName, state, code}) = let
500            val selfTyDef = CL.D_StructDef(            val selfTyDef = CL.D_StructDef(
501                    List.rev (List.map (fn (ty, x) => (cvtTy ty, x)) (!state)),                    List.rev (List.map (fn V(ty, x) => (cvtTy ty, x)) (!state)),
502                    tyName)                    tyName)
503            in            in
504              selfTyDef :: List.rev (!code)              selfTyDef :: List.rev (!code)
# Line 480  Line 535 
535            in            in
536              List.app ppDecl (List.rev (!globals));              List.app ppDecl (List.rev (!globals));
537              List.app ppDecl (List.rev (!topDecls));              List.app ppDecl (List.rev (!topDecls));
 (* what about the strands, etc? *)  
538              List.app (fn strand => List.app ppDecl (genStrand strand)) (!strands);              List.app (fn strand => List.app ppDecl (genStrand strand)) (!strands);
539              genStrandTable (ppStrm, !strands);              genStrandTable (ppStrm, !strands);
540              PrintAsC.close ppStrm;              PrintAsC.close ppStrm;
Legend:
Removed from v.622  
changed lines
  Added in v.623
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge