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

SCM Repository

[diderot] Diff of /branches/vis12-cl/src/compiler/c-util/tree-to-c.sml
ViewVC logotype

Diff of /branches/vis12-cl/src/compiler/c-util/tree-to-c.sml

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

revision 1858, Fri Apr 20 20:14:41 2012 UTC revision 2033, Fri Oct 12 03:05:33 2012 UTC
# Line 27  Line 27 
27    
28      val trBlock : env * TreeIL.block -> CLang.stm      val trBlock : env * TreeIL.block -> CLang.stm
29    
30        val trFree : env * TreeIL.block -> CLang.stm
31    
32      val trFragment : env * TreeIL.block -> env * CLang.stm list      val trFragment : env * TreeIL.block -> env * CLang.stm list
33    
34      val trExp : env * TreeIL.exp -> CLang.exp      val trExp : env * TreeIL.exp -> CLang.exp
# Line 77  Line 79 
79    (* translate IL basis functions *)    (* translate IL basis functions *)
80      local      local
81        fun mkLookup suffix = let        fun mkLookup suffix = let
82              val tbl = ILBasis.Tbl.mkTable (16, Fail "basis table")              val tbl = MathFuns.Tbl.mkTable (16, Fail "basis table")
83              fun ins f = ILBasis.Tbl.insert tbl (f, ILBasis.toString f ^ suffix)              fun ins f = MathFuns.Tbl.insert tbl (f, MathFuns.toString f ^ suffix)
84              in              in
85                List.app ins ILBasis.allFuns;                List.app ins MathFuns.allFuns;
86                ILBasis.Tbl.lookup tbl                MathFuns.Tbl.lookup tbl
87              end              end
88        val fLookup = mkLookup "f"        val fLookup = mkLookup "f"
89        val dLookup = mkLookup ""        val dLookup = mkLookup ""
# Line 142  Line 144 
144                  (* end case *))                  (* end case *))
145              | (Op.Dot d, args) => CL.E_Apply(N.dot d, args)              | (Op.Dot d, args) => CL.E_Apply(N.dot d, args)
146              | (Op.MulVecMat(m, n), args) =>              | (Op.MulVecMat(m, n), args) =>
147                  if (1 < m) andalso (m < 4) andalso (m = n)                  if (1 < m) andalso (m <= 4) andalso (m = n)
148                    then CL.E_Apply(N.mulVecMat(m,n), args)                    then CL.E_Apply(N.mulVecMat(m,n), args)
149                    else raise Fail "unsupported vector-matrix multiply"                    else raise Fail "unsupported vector-matrix multiply"
150              | (Op.MulMatVec(m, n), args) =>              | (Op.MulMatVec(m, n), args) =>
151                  if (1 < m) andalso (m < 4) andalso (m = n)                  if (1 < m) andalso (m <= 4) andalso (m = n)
152                    then CL.E_Apply(N.mulMatVec(m,n), args)                    then CL.E_Apply(N.mulMatVec(m,n), args)
153                    else raise Fail "unsupported matrix-vector multiply"                    else raise Fail "unsupported matrix-vector multiply"
154              | (Op.MulMatMat(m, n, p), args) =>              | (Op.MulMatMat(m, n, p), args) =>
155                  if (1 < m) andalso (m < 4) andalso (m = n) andalso (n = p)                  if (1 < m) andalso (m <= 4) andalso (m = n) andalso (n = p)
156                    then CL.E_Apply(N.mulMatMat(m,n,p), args)                    then CL.E_Apply(N.mulMatMat(m,n,p), args)
157                    else raise Fail "unsupported matrix-matrix multiply"                    else raise Fail "unsupported matrix-matrix multiply"
158                | (Op.ColonMul(Ty.TensorTy dd1, Ty.TensorTy dd2), args) =>
159                    CL.E_Apply(N.colonMul(dd1, dd2), args)
160              | (Op.Cross, args) => CL.E_Apply(N.cross(), args)              | (Op.Cross, args) => CL.E_Apply(N.cross(), args)
161              | (Op.Norm(Ty.TensorTy[n]), args) => CL.E_Apply(N.length n, args)              | (Op.Norm(Ty.TensorTy[n]), args) => CL.E_Apply(N.length n, args)
162              | (Op.Norm(Ty.TensorTy[m,n]), args) => CL.E_Apply(N.norm(m,n), args)              | (Op.Norm(Ty.TensorTy[m,n]), args) => CL.E_Apply(N.normMat(m,n), args)
163                | (Op.Norm(Ty.TensorTy[m,n,p]), args) => CL.E_Apply(N.normTen3(m,n,p), args)
164              | (Op.Normalize d, args) => CL.E_Apply(N.normalize d, args)              | (Op.Normalize d, args) => CL.E_Apply(N.normalize d, args)
165              | (Op.Scale(Ty.TensorTy[n]), args) => CL.E_Apply(N.scale n, args)              | (Op.Scale(Ty.TensorTy[n]), args) => CL.E_Apply(N.scale n, args)
166              | (Op.PrincipleEvec ty, _) => raise Fail "PrincipleEvec unimplemented"              | (Op.PrincipleEvec ty, _) => raise Fail "PrincipleEvec unimplemented"
# Line 169  Line 174 
174                    CL.mkSubscript(vecExp, ix)                    CL.mkSubscript(vecExp, ix)
175                  end                  end
176              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)
177                | (Op.Subscript(Ty.DynSeqTy ty), [v, ix]) => let
178                    val elemTy = trType ty
179                    in
180                      CL.mkUnOp (CL.%*,
181                        CL.mkCast(CL.T_Ptr elemTy,
182                          CL.mkApply("Diderot_DynSeqAddr", [CL.mkSizeof elemTy, v, ix])))
183                    end
184              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
185                  val unionTy = CL.T_Named(N.unionTy n)                  val unionTy = CL.T_Named(N.unionTy n)
186                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")
# Line 191  Line 203 
203              | (Op.Concat ty, [seq1, seq2]) => CL.mkApply("Diderot_DynSeqConcat", [              | (Op.Concat ty, [seq1, seq2]) => CL.mkApply("Diderot_DynSeqConcat", [
204                    CL.mkSizeof(trType ty), seq1, seq2                    CL.mkSizeof(trType ty), seq1, seq2
205                  ])                  ])
206                | (Op.Length _, [seq]) => CL.mkApply("Diderot_DynSeqLength", [seq])
207              | (Op.Ceiling d, args) => CL.mkApply(N.addTySuffix("ceil", d), args)              | (Op.Ceiling d, args) => CL.mkApply(N.addTySuffix("ceil", d), args)
208              | (Op.Floor d, args) => CL.mkApply(N.addTySuffix("floor", d), args)              | (Op.Floor d, args) => CL.mkApply(N.addTySuffix("floor", d), args)
209              | (Op.Round d, args) => CL.mkApply(N.addTySuffix("round", d), args)              | (Op.Round d, args) => CL.mkApply(N.addTySuffix("round", d), args)
# Line 217  Line 230 
230                  CL.mkApply(N.toImageSpace(ImageInfo.dim info), [img, pos])                  CL.mkApply(N.toImageSpace(ImageInfo.dim info), [img, pos])
231              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
232                  CL.mkApply(N.toWorldSpace ty, [v, x])                  CL.mkApply(N.toWorldSpace ty, [v, x])
             | (Op.LoadImage info, [a]) =>  
                 raise Fail("impossible " ^ Op.toString rator)  
233              | (Op.Inside(info, s), [pos, img]) =>              | (Op.Inside(info, s), [pos, img]) =>
234                  CL.mkApply(N.inside(ImageInfo.dim info), [pos, img, intExp s])                  CL.mkApply(N.inside(ImageInfo.dim info), [pos, img, intExp s])
235              | (Op.Input(ty, desc, name), []) =>              | (Op.LoadSeq(ty, nrrd), []) =>
236                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
237              | (Op.InputWithDefault(ty, desc, name), [a]) =>              | (Op.LoadImage(ty, nrrd, info), []) =>
238                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
239                | (Op.Input _, []) => raise Fail("impossible " ^ Op.toString rator)
240              | _ => raise Fail(concat[              | _ => raise Fail(concat[
241                    "unknown or incorrect operator ", Op.toString rator                    "unknown or incorrect operator ", Op.toString rator
242                  ])                  ])
# Line 343  Line 355 
355                  [CL.mkCall(N.scaleMat(m,n),  lhs :: trExps(env, args))]                  [CL.mkCall(N.scaleMat(m,n),  lhs :: trExps(env, args))]
356              | IL.E_Op(Op.MulMatMat(m,n,p), args) =>              | IL.E_Op(Op.MulMatMat(m,n,p), args) =>
357                  [CL.mkCall(N.mulMatMat(m,n,p), lhs :: trExps(env, args))]                  [CL.mkCall(N.mulMatMat(m,n,p), lhs :: trExps(env, args))]
358                | IL.E_Op(Op.MulVecTen3(m, n, p), args) =>
359                    if (1 < m) andalso (m <= 4) andalso (m = n) andalso (n = p)
360                      then [CL.mkCall(N.mulVecTen3(m,n,p), lhs :: trExps(env, args))]
361                      else raise Fail "unsupported vector-tensor multiply"
362                | IL.E_Op(Op.MulTen3Vec(m, n, p), args) =>
363                    if (1 < m) andalso (m <= 4) andalso (m = n) andalso (n = p)
364                      then [CL.mkCall(N.mulTen3Vec(m,n,p), lhs :: trExps(env, args))]
365                      else raise Fail "unsupported tensor-vector multiply"
366                | IL.E_Op(Op.ColonMul(Ty.TensorTy dd1, Ty.TensorTy dd2), args) =>
367                    if (length dd1 + length dd2 > 5)
368                      then [CL.mkCall(N.colonMul(dd1, dd2), lhs :: trExps(env, args))]
369                      else [CL.mkAssign(lhs, trExp(env, rhs))]
370              | IL.E_Op(Op.EigenVals2x2, [m]) => let              | IL.E_Op(Op.EigenVals2x2, [m]) => let
371                  val (m, stms) = expToVar (env, CL.T_Named(N.matTy(2,2)), "m", m)                  val (m, stms) = expToVar (env, CL.T_Named(N.matTy(2,2)), "m", m)
372                  in                  in
# Line 370  Line 394 
394                  [CL.mkCall(N.identityMat n, [lhs])]                  [CL.mkCall(N.identityMat n, [lhs])]
395              | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>              | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>
396                  [CL.mkCall(N.zeroMat(m,n), [lhs])]                  [CL.mkCall(N.zeroMat(m,n), [lhs])]
397              | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy[_,_]), args) =>              | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy(_::_::_)), args) =>
398                  [CL.mkCall(N.toWorldSpace ty, lhs :: trExps(env, args))]                  [CL.mkCall(N.toWorldSpace ty, lhs :: trExps(env, args))]
399              | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>              | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>
400                  if (n > 1)                  if (n > 1)
# Line 425  Line 449 
449                  end                  end
450              | IL.E_State x => (case IL.StateVar.ty x              | IL.E_State x => (case IL.StateVar.ty x
451                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueStateVar x])]                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueStateVar x])]
452                    | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen(n,m,l), [lhs, VarToC.rvalueStateVar x])]                    | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen3(n,m,l), [lhs, VarToC.rvalueStateVar x])]
453                    | _ => [CL.mkAssign(lhs, VarToC.rvalueStateVar x)]                    | _ => [CL.mkAssign(lhs, VarToC.rvalueStateVar x)]
454                  (* end case *))                  (* end case *))
455              | IL.E_Var x => (case IL.Var.ty x              | IL.E_Var x => (case IL.Var.ty x
456                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueVar(env, x)])]                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueVar(env, x)])]
457                    | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen(n,m,l), [lhs, VarToC.rvalueVar(env, x)])]                    | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen3(n,m,l), [lhs, VarToC.rvalueVar(env, x)])]
458                    | _ => [CL.mkAssign(lhs, VarToC.rvalueVar(env, x))]                    | _ => [CL.mkAssign(lhs, VarToC.rvalueVar(env, x))]
459                  (* end case *))                  (* end case *))
460              | _ => [CL.mkAssign(lhs, trExp(env, rhs))]              | _ => [CL.mkAssign(lhs, trExp(env, rhs))]
# Line 482  Line 506 
506                CL.mkReturn(SOME(CL.mkVar "true")))]                CL.mkReturn(SOME(CL.mkVar "true")))]
507            end            end
508    
509      (* given the global initialization code, generate code to free the storage that is heap
510       * allocated for globals.
511       *)
512        fun trFree (env, IL.Block{locals, body}) = let
513              val env = trLocals (env, locals)
514              fun trStmt (env, stm) = (case stm
515                     of IL.S_Comment text => [CL.mkComment text]
516    (* DEPRECATED
517                      | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let
518                          val lhs = VarToC.lvalueVar (env, lhs)
519                          val imgTy = CL.T_Named(N.imageTy dim)
520                          val freeFn = N.freeImage dim
521                          in [
522                            CL.mkDecl(
523                              CL.T_Named N.statusTy, sts,
524                              SOME(CL.I_Exp(CL.E_Apply(freeFn, [
525                                  CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),
526                                  addrOf lhs
527                                ]))))
528                          ] end)
529    *)
530                      | IL.S_LoadNrrd _ => [] (* FIXME *)
531                      | IL.S_InputNrrd _ => [] (* FIXME *)
532                      | _ => []
533                    (* end case *))
534              val stms = List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body
535              fun mkDecl (x, stms) = (case V.Map.find (env, x)
536                     of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
537                      | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
538                    (* end case *))
539              val stms = List.foldr mkDecl stms locals
540              in
541                CL.mkBlock stms
542              end
543    
544      fun trStms (env, stms) = let      fun trStms (env, stms) = let
545            fun trStmt (env, stm) = (case stm            fun trStmt (env, stm) = (case stm
546                   of IL.S_Comment text => [CL.mkComment text]                   of IL.S_Comment text => [CL.mkComment text]
# Line 498  Line 557 
557                    | IL.S_Save([x], exp) => trAssign (env, VarToC.lvalueStateVar x, exp)                    | IL.S_Save([x], exp) => trAssign (env, VarToC.lvalueStateVar x, exp)
558                    | IL.S_Save(xs, exp) =>                    | IL.S_Save(xs, exp) =>
559                        trMultiAssign (env, List.map VarToC.lvalueStateVar xs, exp)                        trMultiAssign (env, List.map VarToC.lvalueStateVar xs, exp)
560    (* DEPRECATED
561                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let
562                        val lhs = VarToC.lvalueVar (env, lhs)                        val lhs = VarToC.lvalueVar (env, lhs)
563                        val name = trExp(env, name)                        val name = trExp(env, name)
# Line 511  Line 571 
571                                name, addrOf lhs                                name, addrOf lhs
572                              ]))))                              ]))))
573                        ] end)                        ] end)
574    *)
575                      | IL.S_LoadNrrd(lhs, Ty.DynSeqTy ty, nrrd) => let
576                          val lhs = VarToC.lvalueVar (env, lhs)
577                          val (nDims, dimInit, dimExp, elemTy) = (case ty
578                                 of Ty.TensorTy(dims as _::_) => let
579                                      val nDims = List.length dims
580                                      fun lp (_, [], init) = CL.I_Array(List.rev init)
581                                        | lp (i, d::dd, init) =
582                                            lp(i+1, dd, (i, CL.I_Exp(CL.mkInt(IntInf.fromInt d)))::init)
583                                      val dimInit = CL.mkDecl(
584                                            CL.T_Ptr(CL.T_Named "unsigned int"), "_dims",
585                                            SOME(lp(0, dims, [])))
586                                      in
587                                        (nDims, [dimInit], CL.mkVar "_dims", Ty.TensorTy[])
588                                      end
589                                  | Ty.SeqTy ty' => raise Fail "type not supported yet"
590                                  | _ => (0, [], CL.mkInt 0, ty)
591                                (* end case *))
592                          val loadFn = N.loadDynSeqFromFile elemTy
593                          in [CL.mkBlock (
594                            dimInit @
595                            [CL.mkAssign(
596                              lhs,
597                              CL.E_Apply(loadFn, [
598                                  CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),
599                                  CL.mkStr nrrd,
600                                  CL.mkInt(IntInf.fromInt nDims),
601                                  dimExp
602                                ]))]
603                          )] end
604                      | IL.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) => checkSts (fn sts => let
605                          val lhs = VarToC.lvalueVar (env, lhs)
606                          val name = CL.E_Str nrrd
607                          val dim = ImageInfo.dim info
608                          val imgTy = CL.T_Named(N.imageTy dim)
609                          val loadFn = N.loadImage dim
610                          in [
611                            CL.mkDecl(
612                              CL.T_Named N.statusTy, sts,
613                              SOME(CL.I_Exp(CL.E_Apply(loadFn, [
614                                  CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),
615                                  name, addrOf lhs
616                                ]))))
617                          ] end)
618                    | IL.S_Input(_, _, _, NONE) => []                    | IL.S_Input(_, _, _, NONE) => []
619                    | IL.S_Input(lhs, name, _, SOME dflt) => [                    | IL.S_Input(lhs, name, _, SOME dflt) => [
620                          CL.mkAssign(VarToC.lvalueVar(env, lhs), trExp(env, dflt))                          CL.mkAssign(VarToC.lvalueVar(env, lhs), trExp(env, dflt))
621                        ]                        ]
622                      | IL.S_InputNrrd _ => []
623                    | IL.S_Exit args => []                    | IL.S_Exit args => []
624                    | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]                    | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]
625                    | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]                    | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]

Legend:
Removed from v.1858  
changed lines
  Added in v.2033

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0