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

SCM Repository

[diderot] Annotation of /branches/vis12/src/compiler/c-util/gen-load-nrrd.sml
ViewVC logotype

Annotation of /branches/vis12/src/compiler/c-util/gen-load-nrrd.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3291 - (view) (download)

1 : jhr 2051 (* gen-load-nrrd.sml
2 :     *
3 : jhr 3291 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 : jhr 2051 * All rights reserved.
7 :     *)
8 :    
9 :     structure GenLoadNrrd : sig
10 :    
11 :     (* loadImage (lhs, info, name)
12 : jhr 2255 * returns code to load an image from a Nrrd file, where "lhs" is the l-value to hold
13 :     * the image, "info" specifies information about the image format, and "name" specifies
14 :     * the file name. The generated code check the status of the load attempt and will
15 :     * return "true" (i.e., error) if the load fails.
16 : jhr 2051 *)
17 :     val loadImage : CLang.exp * ImageInfo.info * CLang.exp -> CLang.stm
18 :    
19 :     (* setImage (lhs, info, nrrd)
20 : jhr 2255 * returns code to initialize an image from a Nrrd, where "lhs" is the l-value to hold
21 :     * the image, "info" specifies information about the image format, and "nrrd" specifies
22 :     * the nrrd. The generated code check the status of the initialization and will
23 :     * return "true" (i.e., error) if the load fails.
24 : jhr 2051 *)
25 :     val setImage : CLang.exp * ImageInfo.info * CLang.exp -> CLang.stm
26 :    
27 : jhr 2053 val loadSeqFromFile : CLang.exp * TreeIL.Ty.ty * CLang.exp -> CLang.stm
28 : jhr 2052 val loadSeq : CLang.exp * TreeIL.Ty.ty * CLang.exp -> CLang.stm
29 :    
30 : jhr 2051 end = struct
31 :    
32 :     structure CL = CLang
33 : jhr 3098 structure RN = RuntimeNames
34 : jhr 2052 structure Ty = TreeIL.Ty
35 : jhr 2051
36 :     val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")
37 :    
38 :     fun doImage imageFn (lhs, info, arg) = let
39 : jhr 2255 val dim = ImageInfo.dim info
40 : jhr 2719 val loadExp = CL.mkApply(imageFn dim, [
41 : jhr 2255 CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
42 :     arg,
43 :     CL.mkUnOp(CL.%&, lhs)
44 : jhr 2719 ])
45 :     in
46 : jhr 2051 (* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
47 : jhr 2719 CL.mkIfThen(loadExp, CL.mkReturn(SOME(CL.mkVar "true")))
48 :     end
49 : jhr 2051
50 :    
51 : jhr 3098 val loadImage = doImage RN.loadImage
52 :     val setImage = doImage RN.setImage
53 : jhr 2051
54 : jhr 2053 fun doSeq loadFn (lhs, elemTy, arg) = let
55 : jhr 2255 val (nDims, dimInit, dimExp, elemTy) = (case elemTy
56 :     of Ty.TensorTy(dims as _::_) => let
57 :     val nDims = List.length dims
58 :     fun lp (_, [], init) = CL.I_Array(List.rev init)
59 :     | lp (i, d::dd, init) =
60 :     lp(i+1, dd, (i, CL.I_Exp(CL.mkInt(IntInf.fromInt d)))::init)
61 :     val dimInit = CL.mkDecl(
62 : jhr 2212 CL.T_Array(CL.T_Named "unsigned int", SOME nDims), "_dims",
63 : jhr 2255 SOME(lp(0, dims, [])))
64 :     in
65 :     (nDims, [dimInit], CL.mkVar "_dims", Ty.TensorTy[])
66 :     end
67 :     | Ty.SeqTy ty' => raise Fail "loading sequences of type not supported yet"
68 :     | _ => (0, [], CL.mkInt 0, elemTy)
69 :     (* end case *))
70 :     in CL.mkBlock (
71 :     dimInit @ [
72 :     CL.mkAssign(
73 :     lhs,
74 : jhr 2708 CL.mkApply(loadFn elemTy, [
75 : jhr 2255 CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),
76 :     arg,
77 :     CL.mkInt(IntInf.fromInt nDims),
78 :     dimExp
79 :     ])),
80 :     CL.mkIfThen(
81 :     CL.mkBinOp(lhs, CL.#==, CL.mkInt 0),
82 :     CL.mkReturn(SOME(CL.mkVar "true")))
83 :     ]
84 :     ) end
85 : jhr 2052
86 : jhr 3098 val loadSeqFromFile = doSeq RN.loadDynSeqFromFile
87 :     val loadSeq = doSeq RN.loadDynSeq
88 : jhr 2053
89 : jhr 2051 end

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