lama_byterun/lama-compiler/src/Driver.lama

-- Driver: a top-level compiler utility

import List;
import Ref;
import Array;
import Fun;
import Ostap;
import Parser;
import Matcher;
import Lexer;
import Expr;
import SM;
import X86;
import Timer;
import Manifest;

-- Parses a command-line arguments, represented as a list, and
-- returns an environment. The environment's interface is
-- defined in the unit Manifest
fun parseArgs (args) {
  var mode     = ref (Comp),
      infile   = ref ({}),
      smDump   = ref (false),
      astDump  = ref (false),
      timeDump = ref (false);

  fun setDump (m) {
    case m of
      SM   -> smDump   
    | AST  -> astDump  
    | TIME -> timeDump 
    esac ::= true
  }
  
  fun setMode (m) {
    case deref (mode) of
      Comp -> mode ::= m
    | _    -> failure ("mode already set: %s\n", deref (mode).string)
    esac
  }

  fun setInFile (fn) {
    case deref (infile) of
      #val -> infile ::= fn
    | _    -> failure ("omitting ""%s"", input file name already set to ""%s""\n", fn, deref (infile))
    esac
  }
  
  fix (fun (rec) {
         fun (args) {
            case args of
              {}    -> skip
            | h : t ->
               case h of
                 "-i"  -> setMode (Int)
               | "-s"  -> setMode (SM)
               | "-ds" -> setDump (SM)
               | "-dp" -> setDump (AST)
               | "-dt" -> setDump (TIME)
               | fn    -> setInFile (fn)
               esac;
               rec (t)
            esac
         }
      })(args);

  [fun () {deref (mode)},
   fun () {case deref(infile) of #val -> failure ("input file name not set\n") | fn -> fn esac},
   fun () {deref (smDump)},
   fun () {deref (astDump)},
   fun () {deref (timeDump)}
  ]        
}

-- Logging
fun createLog (args) {
  var ast        = ref ({}),
      sm         = ref ({}),
      parseTime  = ref (None),
      smTime     = ref (None),
      x86Time    = ref (None),
      evalTime   = ref (None),
      evalSMTime = ref (None);
        
  fun logAST (p, t) {
    ast ::= p;
    parseTime ::= Some (t);
    p
  }

  fun logSM (p, t) {
    sm ::= p;
    smTime ::= Some (t);
    p
  }

  fun logX86 (t) {
    x86Time ::= Some (t)
  }

  fun logEval (t) {
    evalTime ::= Some (t)
  }

  fun logSMEval (t) {
    evalSMTime ::= Some (t)
  }

  fun print () {
    fun printTime (memo, p) {
      case p of
        None     -> skip
      | Some (t) -> printf ("%s: %s\n", memo, toSeconds (t))
      esac
    }

    dumpAST (args, lazy (deref (ast).string));
    dumpSM  (args, lazy (showSM (deref $ sm)));

    if args [4] () then
      printTime ("Parsing time          ", deref (parseTime));
      printTime ("SM compile time       ", deref (smTime));
      printTime ("X86 compile time      ", deref (x86Time));
      printTime ("Interpretation time   ", deref (evalTime));
      printTime ("SM interpretation time", deref (evalSMTime))
    fi
  }

  [logAST,
   logSM,
   logX86,
   logEval,
   logSMEval,
   print
  ]   
}

-- Accessor functions
fun logAST (log, p, t) {
  log [0] (p, t)
}

fun logSM (log, p, t) {
  log [1] (p, t)
}

fun logX86 (log, t) {
  log [2] (t)
}

fun logEval (log, t) {
  log [3] (t)
}

fun logSMEval (log, t) {
  log [4] (t)
}

fun print (log) {
  log [5] ()
}

var args = parseArgs (arrayList (sysargs).tl), t = timer (), log = createLog (args);

-- The main part: parses input file, invokes interpreter/stack machine interpreter/x86
-- code generator
case parseString (syntax (parse -end), fread (args.getInFile)) of
  Succ (program) ->
    log.logAST (program, t ());
    t := timer (); 
    case args.getMode of
      Comp -> var sm = log.logSM (compileSM (program), t ());
              t := timer ();
              compileX86 (args, sm);
              log.logX86 (t ())
    | mode ->
       var input =
          reverse (fix (fun (f) {
                          fun (acc) {
                            case readLine () of
                              #val -> acc
                            | arg  -> f (stringInt (arg) : acc) esac
                          }
                        }) ({}));

       iter (fun (x) {printf ("%d\n", x)},
             case mode of
               Int -> var out = evalExpr (input, program);
                      log.logEval (t ());
                      out
                      
             | SM  -> var sm = log.logSM (compileSM (program), t ()), out;                      
                      t := timer ();  log.print;
                      out := evalSM (input, sm);
                      log.logSMEval (t ());
                      out
             esac) 
    esac; 
    log.print
    
| x@Fail (err, line, col) ->   
   failure ("%s at %d:%d\n", err.hd, line, col)
esac