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

SCM Repository

[diderot] Diff of /branches/vis15/src/compiler/cxx-util/gen-outputs-util.sml
ViewVC logotype

Diff of /branches/vis15/src/compiler/cxx-util/gen-outputs-util.sml

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

revision 4833, Wed Nov 2 18:40:13 2016 UTC revision 4834, Wed Nov 2 21:04:54 2016 UTC
# Line 5  Line 5 
5   * COPYRIGHT (c) 2015 The University of Chicago   * COPYRIGHT (c) 2015 The University of Chicago
6   * All rights reserved.   * All rights reserved.
7   *   *
8   * Target-independent code for generating the output code.   * Target-independent code for generating the output code.  For standalone executables,
9     * we generate command-line options based on the number of output files and whether
10     * snapshots are enabled.  The scheme is as follows:
11     *
12     * Single output variable with non-sequence type (say "out"):
13     *
14     *  "-o,--output" option to specify _full path_ to output file (default "out.nrrd")
15     *  "-sp,--snapshot-prefix" option to specify _prefix_ of the snapshot files (default "out")
16     *
17     * Single output variable with sequence type (say "out"):
18     *
19     *  "-o,--output" option to specify _prefix_ to output file (default "out")
20     *  "-sp,--snapshot-prefix" option to specify _prefix_ of the snapshot files (default "out")
21     *
22     * Multiple output variables.
23     *
24     *  With non-sequence type (say "foo"):
25     *
26     *    "-o-foo,--output-foo" option to specify _full path_ to output file (default "foo.nrrd")
27     *    "-sp-foo,--snapshot-prefix-foo" option so specify _prefix_ of the snapshot files (default "foo")
28     *
29     * With sequence type (say "bar"):
30     *
31     *   "-o-foo,--output-bar" option to specify _prefx_ to output file (default "bar")
32     *   "-sp-foo,--snapshot-prefix-bar" option so specify _prefix_ of the snapshot files (default "bar")
33   *)   *)
34    
35  structure GenOutputsUtil : sig  structure GenOutputsUtil : sig
# Line 76  Line 100 
100            (* endif*))            (* endif*))
101    
102    (* global variable names for output file/stems *)    (* global variable names for output file/stems *)
103      val outfile = "Outfile"      val outfile = "OutputFile"
104      fun outstem name = "OutStem_" ^ name      fun outstem (false, _) = outfile (* single output variable *)
105          | outstem (true, name) = "OutPrefix_" ^ name
106        val snapfile = "SnapshotPrefix"
107        fun snapstem (false, name) = snapfile (* single output variable *)
108          | snapstem (true, name) = "SnapshotPrefix_" ^ name
109    
110      (* register a command-line option *)
111        fun addOption {name, desc, var} =
112              CL.mkExpStm(CL.mkIndirectDispatch(CL.mkVar "opts", "add", [
113                  CL.mkStr name,
114                  CL.mkStr desc,
115                  CL.mkUnOp(CL.%&, CL.mkVar var),
116                  CL.mkBool true
117                ]))
118    
119    (* generate code to register command-line options for redirecting the output in standalone    (* generate code to register command-line options for redirecting the output in standalone
120     * executables.     * executables.
121     *)     *)
122      fun genRegisterOutputOpts (env, outputs : output_info list) = let      fun genRegisterOutputOpts (env, outputs : output_info list) = let
123          (* some common variables *)            val hasSnapshots = #snapshot(Env.target env)
           val optsV = CL.mkVar "opts"  
124          (* make a global variable declaration *)          (* make a global variable declaration *)
125            fun mkDecl (name, value) =            fun mkDecl (name, value) =
126                  CL.D_Var(["static"], CL.T_Named "std::string", [], name,                  CL.D_Var(["static"], CL.T_Named "std::string", [], name,
127                    SOME(CL.I_Exp(CL.mkStr value)))                    SOME(CL.I_Exp(CL.mkStr value)))
128          (* register a flag for a given output *)          (* register options for an output.  multiVar should be true if there
129            fun registerOutput {name, ty, kind} = let           * is more than one output.
130                  val optName = "redirect-" ^ name           *)
131                  in            fun registerOut multiVar = let
132                    CL.mkExpStm(CL.mkIndirectDispatch(optsV, "add", [                  fun doOutput ({name, ty, kind}, (stms, dcls)) = let
133                        CL.mkStr(concat["o-", name, ",", "output-", name]),                        val hasSeqTy = (case ty of Ty.SeqTy(_, NONE) => true | _ => false)
134                        CL.mkStr("specify output-file stem for " ^ name),                        val stms = if hasSnapshots
135                        CL.mkUnOp(CL.%&, CL.mkVar(outstem name)),                              then addOption {
136                        CL.mkBool true                                  name = if multiVar
137                      ]))                                    then concat["sp-", name, ",", "snapshot-prefix-", name]
138                  end                                    else "sp,snapshot-prefix",
139            fun multi () = let                                  desc = if multiVar
140                  val stms = List.map registerOutput outputs                                    then "specify snapshot-file prefix for " ^ name
141                  val dcls = List.map (fn {name, ...} => mkDecl (outstem name, name)) outputs                                    else "specify snapshot-file prefix",
142                                    var = snapstem (multiVar, name)
143                                  } :: stms
144                                else stms
145                          val stms = addOption {
146                                  name = if multiVar
147                                    then concat["o-", name, ",", "output-", name]
148                                    else "o,output",
149                                  desc = (case (multiVar, hasSeqTy)
150                                     of (true, true) => "specify output-file prefix for " ^ name
151                                      | (true, false) => "specify output file for " ^ name
152                                      | (false, true) => "specify output-file prefix"
153                                      | (false, false) => "specify output file"
154                                    (* end case *)),
155                                  var = outstem (multiVar, name)
156                                } :: stms
157                          val dcls = if hasSnapshots
158                                then mkDecl (snapstem(multiVar, name), name) :: dcls
159                                else dcls
160                          val dcls = mkDecl (
161                                outstem (multiVar, name),
162                                if hasSeqTy then name else name ^ ".nrrd") :: dcls
163                  in                  in
164                    (stms, dcls)                    (stms, dcls)
165                  end                  end
           val (stms, dcls) = (case outputs  
                  of [{ty = Ty.SeqTy(_, NONE), ...}] => multi () (* two ouput files *)  
                   | [{name, ...}] => let (* one output file, so use "-o" redirect option *)  
                       val stm = CL.mkExpStm(CL.mkIndirectDispatch(optsV, "add", [  
                           CL.mkStr "o,output", CL.mkStr("specify output-file file"),  
                           CL.mkUnOp(CL.%&, CL.mkVar outfile),  
                           CL.mkBool true  
                         ]))  
                       val dcl = mkDecl (outfile, name)  
166                        in                        in
167                          ([stm], [dcl])                    doOutput
168                        end                        end
169                    | _ => multi ()            val (stms, dcls) =
170                  (* end case *))                  List.foldr
171                      (registerOut (case outputs of _::_::_ => true | _ => false))
172                        ([], []) outputs
173            val registerFn = CL.D_Func(            val registerFn = CL.D_Func(
174                  ["static"], CL.voidTy, [], "register_outputs",                  ["static"], CL.voidTy, [], "register_outputs",
175                  [CL.PARAM([], RN.optionsPtrTy, "opts")],                  [CL.PARAM([], RN.optionsPtrTy, "opts")],
# Line 128  Line 178 
178              dcls @ [registerFn]              dcls @ [registerFn]
179            end            end
180    
181        fun ++ (a, b) = CL.mkBinOp (a, CL.#+, b)
182        infix ++
183    
184    (* generate the nrrd-file output and snapshot functions used by standalone executables *)    (* generate the nrrd-file output and snapshot functions used by standalone executables *)
185      fun genOutput' (env, snapshot, outputs : output_info list) = let      fun genOutput' (env, snapshot, outputs : output_info list) = let
186            val spec = Env.target env            val spec = Env.target env
# Line 148  Line 201 
201            val prDecls = outDecls @ [CL.mkDecl(filePtrTy, "outS", NONE)]            val prDecls = outDecls @ [CL.mkDecl(filePtrTy, "outS", NONE)]
202            fun nrrdNew v = CL.mkAssign(v, CL.mkApply("nrrdNew", []))            fun nrrdNew v = CL.mkAssign(v, CL.mkApply("nrrdNew", []))
203            fun nrrdNuke v = CL.mkCall("nrrdNuke", [v])            fun nrrdNuke v = CL.mkCall("nrrdNuke", [v])
204            val isMultiOutput = (case outputs            val isMultiOutput = (case outputs of _::_::_ => true | _ => false)
205                   of [{ty, ...}] => isDyn ty          (* make the name of an output file (to be passed to nrrd_save_helper) from
206                    | _ => true           * a variable name and optional annotation.
207                  (* end case *))           *)
208              fun mkOutFile (name, NONE) = if snapshot
209                    then CL.mkVar (snapstem (isMultiOutput, name))
210                      ++ CL.mkVar "suffix"
211                      ++ CL.mkStr ".nrrd"
212                    else CL.mkVar (outstem (isMultiOutput, name))
213                | mkOutFile (name, SOME kind) = if snapshot
214                    then CL.mkVar (snapstem (isMultiOutput, name))
215                      ++ CL.mkStr kind
216                      ++ CL.mkVar "suffix"
217                      ++ CL.mkStr ".nrrd"
218                    else CL.mkVar(outstem(isMultiOutput, name))
219                      ++ CL.mkStr(kind ^ ".nrrd")
220            fun writeNrrd {name, ty, kind} = if isDyn ty            fun writeNrrd {name, ty, kind} = if isDyn ty
221                  then [                  then [
222                      nrrdNew (nLengthsV),                      nrrdNew (nLengthsV),
# Line 167  Line 232 
232                        CL.mkIfThen(                        CL.mkIfThen(
233                          CL.mkBinOp(                          CL.mkBinOp(
234                            CL.mkApply("nrrd_save_helper", [                            CL.mkApply("nrrd_save_helper", [
235                                CL.mkVar(outstem name),                                mkOutFile (name, SOME "-len"),
236                                if snapshot                                nLengthsV
                                 then CL.mkBinOp(CL.mkStr "-len", CL.#+, CL.mkVar "suffix")  
                                 else CL.mkStr "-len",  
                               CL.mkStr "nrrd", nLengthsV  
237                              ]),                              ]),
238                            CL.#||,                            CL.#||,
239                            CL.mkApply("nrrd_save_helper", [                            CL.mkApply("nrrd_save_helper", [
240                                CL.mkVar(outstem name),                                mkOutFile (name, SOME "-data"),
241                                if snapshot                                nDataV
                                 then CL.mkBinOp(CL.mkStr "-data", CL.#+, CL.mkVar "suffix")  
                                 else CL.mkStr "-data",  
                               CL.mkStr "nrrd", nDataV  
242                              ])),                              ])),
243                        (* then *)                        (* then *)
244                          error []                          error []
# Line 188  Line 247 
247                      nrrdNuke nLengthsV,                      nrrdNuke nLengthsV,
248                      nrrdNuke nDataV                      nrrdNuke nDataV
249                    ]                    ]
               else if isMultiOutput  
                 then [  
                     nrrdNew (nDataV),  
                     CL.mkIfThenElse(  
                       CL.mkApply(outputGet(spec, name), [wrldV, nDataV]),  
                     (* then *)  
                         error [  
                             CL.mkStr "Error getting nrrd data:\n",  
                             CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "_errors")])  
                           ],  
                     (* else *)  
                       CL.mkIfThen(  
                         CL.mkApply("nrrd_save_helper", [  
                             CL.mkVar(outstem name),  
                             if snapshot then CL.mkVar "suffix" else CL.mkStr "",  
                             CL.mkStr "nrrd", nDataV  
                           ]),  
                       (* then *)  
                         error []  
                       (* endif *))  
                     (* endif *)),  
                     nrrdNuke nDataV  
                   ]  
250                  else [                  else [
251                      nrrdNew (nDataV),                      nrrdNew (nDataV),
252                      CL.mkIfThenElse(                      CL.mkIfThenElse(
# Line 222  Line 258 
258                            ],                            ],
259                      (* else *)                      (* else *)
260                        CL.mkIfThen(                        CL.mkIfThen(
261                          CL.mkApply("nrrd_save_helper", [                          CL.mkApply("nrrd_save_helper", [mkOutFile (name, NONE), nDataV]),
                             CL.mkVar outfile,  
                             if snapshot then CL.mkVar "suffix" else CL.mkStr "",  
                             CL.mkStr "nrrd", nDataV  
                           ]),  
262                        (* then *)                        (* then *)
263                          error []                          error []
264                        (* endif *))                        (* endif *))

Legend:
Removed from v.4833  
changed lines
  Added in v.4834

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