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

SCM Repository

[diderot] View of /branches/pure-cfg/src/compiler/driver/main.sml
ViewVC logotype

View of /branches/pure-cfg/src/compiler/driver/main.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1017 - (download) (annotate)
Sun May 1 03:06:05 2011 UTC (8 years, 4 months ago) by jhr
File size: 5531 byte(s)
  A lot of changes to better handle variable scoping etc.
(* main.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *)

structure Main : sig

    val main : (string * string list) -> OS.Process.status

    val test : string -> unit

  end = struct

  (* exception tracing magic *)
    val _ = (
        SMLofNJ.Internals.TDP.mode := true;
        Coverage.install ();
        BackTrace.install ())

    structure HighPP = SSAPPFn (HighIL)
    structure MidPP = SSAPPFn (MidIL)
    structure LowPP = SSAPPFn (LowIL)

    fun err s = TextIO.output (TextIO.stdErr, s)
    fun err1 c =  TextIO.output1 (TextIO.stdErr, c)
    fun errnl s = (err s; err1 #"\n")

    exception ERROR

    fun quitWithError srcFile = raise Fail("Error in compiling " ^ srcFile)

  (* check for errors and report them if there are any *)
    fun checkForErrors errStrm = (
	  Error.report (TextIO.stdErr, errStrm);
	  if Error.anyErrors errStrm
	    then quitWithError (Error.sourceFile errStrm)
	    else ())


  (* compiler front end (parsing, typechecking, and simplification *)
    fun frontEnd filename = let
	  val errStrm = Error.mkErrStream filename
	  val _ = if OS.FileSys.access(filename, [OS.FileSys.A_READ])
		then ()
		else (
		  err(concat["source file \"", filename, "\" does not exist or is not readable\n"]);
		  raise ERROR)
	(***** PARSING *****)
	  val parseTree = PhaseTimer.withTimer Timers.timeParser (fn () => let
		val inS = TextIO.openIn filename
		val pt = Parser.parseFile (errStrm, inS)
		in
		  TextIO.closeIn inS;
		  checkForErrors errStrm;
		  valOf pt
		end) ()
	(***** TYPECHECKING *****)
	  val _ = PhaseTimer.start Timers.timeTypechecker
	  val ast = (Typechecker.check errStrm parseTree) handle Typechecker.Error => AST.Program[]
	  val _ = PhaseTimer.stop Timers.timeTypechecker
	  val _ = checkForErrors errStrm
	  val _ = ASTPP.output (Log.logFile(), ast) (* DEBUG *)
	(***** SIMPLIFY *****)
	  val _ = PhaseTimer.start Timers.timeSimplify
	  val simple = Simplify.transform ast
	  val _ = PhaseTimer.stop Timers.timeSimplify
	  val _ = SimplePP.output (Log.logFile(), simple) (* DEBUG *)
	  in
	    simple
	  end

    fun doFile filename = let
	  val baseName = (case OS.Path.splitBaseExt filename
		 of {base, ext=SOME "diderot"} => base
		  | _ => (errnl "expected diderot file"; quitWithError filename)
		(* end case *))
	  val simple = PhaseTimer.withTimer Timers.timeFront frontEnd filename
	(***** TRANSLATION TO HIGH IL*****)
	  val _ = PhaseTimer.start Timers.timeTranslate
	  val highIL = Translate.translate simple
	  val _ = PhaseTimer.stop Timers.timeTranslate
	  val _ = ( (* DEBUG *)
		HighPP.output (Log.logFile(), "HighIL after translation", highIL);
		if CheckHighIL.check ("after translation to HighIL", highIL)
		  then quitWithError filename
		  else ())
	(***** HIGH-IL OPTIMIZATION *****)
	  val _ = PhaseTimer.start Timers.timeHigh
	  val highIL = HighOptimizer.optimize highIL
	  val _ = PhaseTimer.stop Timers.timeHigh
	  val _ = ( (* DEBUG *)
		HighPP.output (Log.logFile(), "HighIL after optimization", highIL);
		if CheckHighIL.check ("after HighIL optimization", highIL)
		  then quitWithError filename
		  else ())
	(***** TRANSLATION TO MID IL *****)
	  val _ = PhaseTimer.start Timers.timeMid
	  val midIL = HighToMid.translate highIL
	  val _ = PhaseTimer.stop Timers.timeMid
	  val _ = ( (* DEBUG *)
		MidPP.output (Log.logFile(), "MidIL after translation", midIL);
		if CheckMidIL.check ("after translation to MidIL", midIL)
		  then quitWithError filename
		  else ())
	(***** TRANSLATION TO LOW IL *****)
	  val _ = PhaseTimer.start Timers.timeLow
	  val lowIL = MidToLow.translate midIL
	  val _ = PhaseTimer.stop Timers.timeLow
	  val _ = ( (* DEBUG *)
		LowPP.output (Log.logFile(), "LowIL after translation", lowIL);
		if CheckLowIL.check ("after translation to LowIL", lowIL)
		  then quitWithError filename
		  else ())
	  val _ = PhaseTimer.start Timers.timeLow
	  val lowIL = LowOptimizer.optimize lowIL
	  val _ = PhaseTimer.stop Timers.timeLow
	  val _ = ( (* DEBUG *)
		LowPP.output (Log.logFile(), "LowIL after optimization", lowIL);
		if CheckLowIL.check ("after LowIL optimization", lowIL)
		  then quitWithError filename
		  else ())
	  in
	  (***** CODE GENERATION *****)
	    PhaseTimer.withTimer Timers.timeCodegen CBackEnd.generate (baseName, lowIL)
	  end

    fun doOptions args = let
	  val log = ref false
	  val defs = ref []
	  fun doOpts [file] = {log = !log, defs = !defs, file = file}
	    | doOpts ("-log"::r) = (log := true; doOpts r)
	    | doOpts (opt::r) = 
		if Inputs.isCmdLineInput opt
		  then (defs := opt :: !defs; doOpts r)
		  else (
		    err(concat["invalid command-line input \"", opt, "\"\n"]);
		    raise ERROR)
	  in
	    doOpts args
	  end

    fun main (name: string, args: string list) = let
	  val {log, defs, file} = doOptions args
	  val {base, ...} = OS.Path.splitBaseExt file
	  in
	    if Inputs.initFromArgs defs
	      then (
		Log.init(base ^ ".log");
		PhaseTimer.withTimer Timers.timeCompiler doFile file;
		Log.reportTiming Timers.timeCompiler;
		OS.Process.success)
		handle exn => (
		  err (concat [
		      "uncaught exception ", General.exnName exn, " [", General.exnMessage exn, "]\n"]);
		      List.app (fn s => err (concat ["  raised at ", s, "\n"]))
			(SMLofNJ.exnHistory exn);
		      OS.Process.failure)
	      else (err "invalid command-line inputs\n"; OS.Process.failure)
	  end
	    handle ERROR => OS.Process.failure

    fun test file = (main ("", [file]); print "** Success!!\n")

  end

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