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

Parent Directory | Revision Log

---

Revision 2708 - (view) (download)

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

---

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