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

SCM Repository

[diderot] View of /branches/vis12/src/compiler/driver/options.sml
ViewVC logotype

View of /branches/vis12/src/compiler/driver/options.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1706 - (download) (annotate)
Wed Mar 7 12:06:48 2012 UTC (7 years, 4 months ago) by jhr
File size: 5582 byte(s)
  more work on library support
(* options.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Support for processing runtime options.
 *)

structure Options : sig

    exception Usage of string

    val parseCmdLine : string list -> {
	    help : bool,			(* "-help" specified? *)
	    log : bool,				(* logging enabled? *)
	    defs : string list,			(* input-variable definitions *)
	    target : TargetUtil.target_desc,
	    file : string
	  }

    val usage : string -> string

  end = struct

    structure G = GetOpt
    structure P = OS.Path

    exception Usage of string

  (* some option flags *)
    val helpFlg = ref false
    val debugFlg = ref false
    val doubleFlg = ref false
    val outputOpt : string option ref = ref NONE
    val standaloneFlg = ref false
    val prefix : string option ref = ref NONE
    val logFlg = ref false
    val statsFlg = Stats.reportStats
    val target = ref TargetUtil.TARGET_C
    val parallel = ref false

    fun setFlag (flg, value) = G.NoArg(fn () => (flg := value))

    fun mkFlagOption (tag, flag, desc) = let
	  val default = !flag
	  val tag = if default
		then "disable-"^tag
		else "enable-"^tag
	  in {
	    short = "", long = [tag],
	    desc = setFlag (flag, not default),
	    help = desc
	  } end

  (* create the target option descriptor. *)
    local
      val desc = if Paths.cudaEnabled then ["  cuda    -- generate CUDA code"] else []
      val desc = if Paths.clEnabled then  "  cl      -- generate OpenCL code" :: desc else desc
      val desc = "  pthread -- generate parallel C code" :: desc
      val desc = "  c       -- generate C code (default)" :: desc
      val desc = "specify the target platform:" :: desc
      fun parseTargetOpt "c" = (target := TargetUtil.TARGET_C)
	| parseTargetOpt "cl" = if Paths.clEnabled
	    then (target := TargetUtil.TARGET_CL)
	    else raise Usage "cl target not supported by this version"
	| parseTargetOpt "cuda" = if Paths.cudaEnabled
	    then (target := TargetUtil.TARGET_CUDA)
	    else raise Usage "cuda target not supported by this version"
	| parseTargetOpt "pthread" = (target := TargetUtil.TARGET_C; parallel := true)
	| parseTargetOpt opt = raise Usage(concat["unrecognized target \"", opt, "\""])
    in
    val targetOptDesc = {
	    short = "",
	    long = ["target"],
	    desc = G.ReqArg(parseTargetOpt, "target"),
	    help = String.concatWith "\n" desc
	  }
    end

    val optionList = [
	    { short = "h", long = ["help"],
	      desc = setFlag (helpFlg, true),
	      help = "print command-line options"
	    },
            { short = "", long = ["exec"],
              desc = setFlag (standaloneFlg, true),
              help = "generate a standalone executable"
            },
            { short = "o", long = ["output"],
              desc = G.ReqArg(fn s => outputOpt := SOME s, "file"),
              help = "specify the executable file name"
            },
	    { short = "", long = ["namespace"],
	      desc = G.ReqArg(fn s => prefix := SOME s, "prefix"),
	      help = "specify namespace prefix for generated code"
	    },
	    { short = "g", long = ["debug"],
	      desc = setFlag (debugFlg, true),
	      help = "enable debugging information in executable"
	    },
            { short = "", long = ["double"],
              desc = setFlag (doubleFlg, true),
              help = "use double-precision floats for reals"
            },
	    { short = "", long = ["log"],
	      desc = setFlag (logFlg, true),
	      help = "generate compiler debugging log"
	    },
	    { short = "", long = ["stats"],
	      desc = setFlag (statsFlg, true),
	      help = "report optimization statistics"
	    },
	    targetOptDesc
(* TODO: -double *)
	  ]
	  @ List.map mkFlagOption HighOptimizer.controls
	  @ List.map mkFlagOption MidOptimizer.controls
	  @ List.map mkFlagOption LowOptimizer.controls

    fun parseCmdLine args = let
	(* first we filter out any variable definitions *)
	  val (defs, rest) = List.partition Inputs.isCmdLineInput args
	  val (opts, files) = G.getOpt {
		  argOrder = G.RequireOrder,
		  options = optionList,
		  errFn = fn s => raise Usage s
		} args
	(* figure out filename pieces *)
	  val srcFile = (case files
		 of [] => if !helpFlg then "" else raise Usage "missing file argument"
		  | [f] => f
		  | _ => raise Usage "too many files"
		(* end case *))
	  val (outDir, outBase) = (case !outputOpt
		 of NONE => let
		      val {dir, file} = P.splitDirFile srcFile
		      in
			case P.splitBaseExt file
			 of {base, ext=SOME "diderot"} => (dir, base)
			  | _ => (dir, file)
			(* end case *)
		      end
		  | SOME outFile => let
		      val {dir, file} = P.splitDirFile outFile
		      in
			if !standaloneFlg
			  then (dir, file)
			  else (case P.splitBaseExt file
			     of {base, ext=SOME "o"} => (dir, base)
			      | {base, ext=SOME "obj"} => (dir, base)
			      | _ => (dir, file)
			    (* end case *))
		      end
		(* end case *))
	(* figure out target details *)
	  val targetDesc : TargetUtil.target_desc = {
		  srcFile = srcFile,
		  outDir = outDir,
		  outBase = outBase,
		  exec = !standaloneFlg,
		  target = !target,
		  namespace = !prefix,
		  parallel = !parallel,
		  double = !doubleFlg,
		  longint = false,		(* currently always false *)
		  debug = !debugFlg
		}
	  in {
	    help = !helpFlg,
	    log = !logFlg,
	    defs = defs,
	    target = targetDesc,
	    file = srcFile
	  } end

    fun usage cmd = G.usageInfo {
	    header = concat["usage: ", cmd, " [options] file.diderot\n  Options:"],
	    options = optionList
	  }

  end

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