SCM Repository
View of /branches/pure-cfg/src/compiler/fields/run-dnorm_sml.in
Parent Directory
|
Revision Log
Revision 632 -
(download)
(annotate)
Thu Mar 17 00:32:17 2011 UTC (11 years, 3 months ago) by jhr
File size: 1812 byte(s)
Thu Mar 17 00:32:17 2011 UTC (11 years, 3 months ago) by jhr
File size: 1812 byte(s)
Preparing to support the rest of the build process in the compiler
(* run-dnorm_sml.in * * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu) * All rights reserved. * * This module supports running the dnorm program on a nrrd file. *) structure RunDNorm : sig val run : string -> { version : string, header : (string * string) list } end = struct structure SS = Substring (* search path for the dnorm executable *) val paths = [ "@DIDEROT_ROOT@/bin", "@prefix@/bin" ] (* FIXME: with SML/NJ 110.73, we'll be able to use PathUtil.findExe *) fun findExe () = let fun isExe p = OS.FileSys.access(p, [OS.FileSys.A_EXEC]) in case PathUtil.existsFile isExe paths "dnorm" of SOME cmd => cmd | NONE => raise Fail "unable to find dnorm executable" (* end case *) end fun run srcFile = let val proc = Unix.execute (findExe(), ["-h", "-i", srcFile]) val inS = Unix.textInstreamOf proc fun stripWS ss = SS.string (SS.dropl Char.isSpace (SS.dropr Char.isSpace ss)) fun read content = (case TextIO.inputLine inS of SOME "\n" => read content (* dnorm outputs an extra blank line at the end *) | SOME ln => ( case SS.fields (fn #":" => true | _ => false) (SS.full ln) of [name, value] => read((SS.string name, stripWS value)::content) | _ => raise Fail(concat["bogus nrrd header line \"", String.toString ln, "\""]) (* end case *)) | NONE => List.rev content (* end case *)) val info = (case TextIO.inputLine inS of SOME version => { version = stripWS(SS.full version), header = read [] } | NONE => raise Fail "bogus nrrd file" (* end case *)) val sts = Unix.reap proc in if OS.Process.isSuccess sts then info else raise Fail "error running dnorm" end end
root@smlnj-gforge.cs.uchicago.edu | ViewVC Help |
Powered by ViewVC 1.0.0 |