(* 
  File: PWB.sml

  This is the PEPA Workbench.
*)

structure PWB =
(* structure PWB :> PWB  = *)
struct 

  val version = "0.74";
  val compiled = "01/09/99";

  local
    fun rmext (#"\n" :: t) = rmext t
      | rmext (#"a" :: #"p" :: #"e" :: #"p" :: #"." :: t) = implode (rev t)
      | rmext other = implode (rev other)
  in 
    fun removeExtension s = rmext (rev (explode s))
  end

  fun tableentries 1 = "only one entry\n"
    | tableentries n = Int.toString n ^ " entries\n"
  fun statespace 1 = "only one state\n"
    | statespace n = Int.toString n ^ " states\n"
  fun transitionsspace 1 = "only one transition\n"
    | transitionsspace n = Int.toString n ^ " transitions\n"
  fun exceptionsraised 0 = "no exceptions\n"
    | exceptionsraised 1 = "only one exception\n"
    | exceptionsraised n = Int.toString n ^ " exceptions\n"

  fun startsWithHyphen [] = false
    | startsWithHyphen (#"-" :: _) = true
    | startsWithHyphen _ = false

  fun isNotFlag s = not (startsWithHyphen (explode s))

  fun checkForFlags "-nohashing" = Options.setNohashing ()
    | checkForFlags "-maple" = Options.setSolver Options.Maple
    | checkForFlags "-matlab" = Options.setSolver Options.Matlab
    | checkForFlags "-mathematica" = Options.setSolver Options.Mathematica
    | checkForFlags s = if isNotFlag s then () else 
        Error.warning ("unrecognised flag ignored: " ^ s)

  val nonFlagArgs = List.filter isNotFlag
 

  val modelName = ref ""
     
  fun getJobName args =
     case (!modelName) of
	"" => (TextIO.output (TextIO.stdOut, "Filename: ");
	       TextIO.flushOut TextIO.stdOut;
	       let val n = removeExtension (TextIO.inputLine TextIO.stdIn)
	       in
		  (modelName := n;
		   n)
	       end)
    | s => s

(*     case nonFlagArgs args of *)
(*     [x] => removeExtension x *)
(*     | _ => (TextIO.output (TextIO.stdOut, "Filename: "); *)
(*             TextIO.flushOut TextIO.stdOut; *)
(*             removeExtension (TextIO.inputLine TextIO.stdIn)) *)




  (* gcla - from lexyacc/Main.sml *)
(*   fun parseExprReport file stream lexbuf = *)
(*      let val expr =  *)
(* 	PepaParser.Process PepaLexer.Token lexbuf *)
(* 	handle *)
(* 	Parsing.ParseError f => *)
(* 	   let val pos1 = Lexing.getLexemeStart lexbuf *)
(* 	      val pos2 = Lexing.getLexemeEnd lexbuf *)
(* 	   in *)
(* 	      Location.errMsg (file, stream, lexbuf)  *)
(* 	      (Location.Loc(pos1, pos2)) *)
(* 	      "Syntax error." *)
(* 	   end *)
(*       | PepaLexer.LexicalError(msg, pos1, pos2) => *)
(* 	   if pos1 >= 0 andalso pos2 >= 0 then *)
(* 	      Location.errMsg (file, stream, lexbuf) *)
(* 	      (Location.Loc(pos1, pos2)) *)
(* 	      ("Lexical error: " ^ msg) *)
(* 	   else  *)
(* 	      (Location.errPrompt ("Lexical error: " ^ msg ^ "\n\n"); *)
(* 	       raise Fail "Lexical error"); *)
(*      in *)
(*         Parsing.clearParser(); *)
(*         expr *)
(*      end *)
(*   handle exn => (Parsing.clearParser(); raise exn); *)
     
  (* gcla - from lexyacc/Main.sml *)
(*   fun createLexerStream (is : BasicIO.instream) = *)
(*      Lexing.createLexer (fn buff => fn n => Nonstdio.buff_input is buff 0 n) *)





  val invoke = fn lexstream =>
     let val print_error = fn (s,i:int,_) =>
	TextIO.output(TextIO.stdOut,"Error, line " ^
	       "[unknown]" ^ ", " ^ s ^ "\n")
     in PepaParser.parse(0,lexstream,print_error,())
     end
  
(*   val input_line = fn f => *)
(*      let fun loop result = *)
(* 	let val c = TextIO.input (f,1) *)
(* 	   val result = c :: result *)
(* 	in if String.size c = 0 orelse c = "\n" then *)
(* 	   String.implode (rev result) *)
(* 	   else loop result *)
(* 	end *)
(*      in loop nil *)
(*      end *)
  
  val parse = fn s =>
     let val dev = TextIO.openIn s
	val stream = PepaParser.makeLexer(fn i => TextIO.inputLine dev)
	val _ = PepaLex.UserDeclarations.linenum := 1
	val error = fn (e,i:int,_) =>
	   TextIO.output(TextIO.stdOut,s ^ "," ^
			 " line " ^ "unknown" ^ ", Error: " ^ e ^ "\n")
	val res = PepaParser.parse(0,stream,error,()) before TextIO.closeIn dev
     in
	(#1 res)
     end

(*   val parse = fn () =>  *)
(*      let val lexer = PepaParser.makeLexer (fn _ => TextIO.inputLine TextIO.stdIn) *)
(*         val dummyEOF = PepaLrVals.Tokens.PEOF(0,0) *)
(*         val dummySEMI = PepaLrVals.Tokens.SEMI(0,0) *)
(*         fun loop lexer = *)
(*            let val (result,lexer) = invoke lexer *)
(* 	      val (nextToken,lexer) = PepaParser.Stream.get lexer *)
(* 	      val _ = case result *)
(* 		 of SOME r => () *)
(* (* 		    TextIO.output(TextIO.stdOut, *) *)
(* (* 			   "result = " ^ (makestring r) ^ "\n") *) *)
(* 	       | NONE => () *)
(*            in if PepaParser.sameToken(nextToken,dummyEOF) then () *)
(*               else loop lexer *)
(*            end *)
(*      in loop lexer *)
(*      end *)






  fun run jobname = 
    let
       val theFile = Files.setFile jobname
	  
    (* gcla - new parser stuff *)
       val jobname' = jobname ^ ".pepa"
    in
      TextIO.output (TextIO.stdOut, "Compiling the model\n");
      TextIO.flushOut TextIO.stdOut;
      let 
	 (* gcla *)
 	 val model = parse jobname'
(* 	 val _ = (TextIO.output(TextIO.stdOut, "value of agg is "^(if (!Options.noagg) then "true" else "false")^"\n"); *)
(* 		  TextIO.flushOut(TextIO.stdOut)) *)
 	 val M =
	    if (!Options.noagg) then
	       Semantic.analyse model
	    else 
	       Semantic.analyse (Min.fixpointfold model)

	 val _ = (Derivatives.proc := M)
      in
	 (Graph.compile M
	  )
      end;
      TextIO.output (TextIO.stdOut, "The model has " ^
            statespace (Table.show_size()));
      TextIO.flushOut TextIO.stdOut;
      TextIO.output (TextIO.stdOut, "The model has " ^ 
            transitionsspace (!Statespace.transitions));
      TextIO.flushOut TextIO.stdOut
    end

  fun writeHashFile jobname =
    if !Options.nohashing then () else
      let 
        val hashfile = jobname ^ ".hash"
        val h = TextIO.openOut hashfile
      in 
        TextIO.output (TextIO.stdOut, "Writing the hash table file to " ^ 
           hashfile ^ "\n");
        TextIO.flushOut TextIO.stdOut;
        TextIO.output (h, HashTable.show_hash_table());
        TextIO.closeOut h
      end
   

  datatype flag = 
     Version 
    | Debug of string
    | Help
    | Hashing of bool
    | Aggregation of bool
    | Maple
    | Mathematica
    | Matlab
    | BCG

  fun defhash NONE = Hashing true
    | defhash (SOME s) = Hashing (if (s = "on") then true else false)

  fun defagg NONE = Aggregation true
    | defagg (SOME s) = Aggregation (if (s = "on") then true else false)

  fun deflevel NONE = Debug "none"
    | deflevel (SOME x) = Debug x

  fun show (Version) = "Version"
    | show (Debug s) = concat ["Debug \"",s,"\""]
    | show (Help) = "Help"
    | show (Hashing b) = concat ["Hashing \"",(if b then "on" else "off"),"\""]
    | show (Aggregation b) = concat ["Aggregation \"",
				     (if b then "on" else "off"),"\""]
    | show (Maple) = "Maple"
    | show (Mathematica) = "Mathematica"
    | show (Matlab) = "Matlab"
    | show (BCG) = "BCG"

  val usage = "Usage: pwb [OPTION...] file"
 
  val options = [
		 {short="v",
		  long=["version", "release"],
		  desc=(Getopt.NoArg Version),
		  help="version of PWB"},
		 {short="?",
		  long=["help", "usage"],
		  desc=(Getopt.NoArg Help),
		  help="display this information"},
		 {short="d",
		  long=["debug"],
		  desc=(Getopt.OptArg (deflevel,"LEVEL")),
		  help="set debugging LEVEL (none/medium/high)"},
		 {short="h",
		  long=["hashing"],
		  desc=(Getopt.OptArg (defhash,"HASHING")),
		  help="enable HASHING (on/off)"},
		 {short="a",
		  long=["aggregation"],
		  desc=(Getopt.OptArg (defagg,"AGG.")),
		  help="enable AGGREGATION (on/off)"},
		 {short="m",
		  long=["maple"],
		  desc=(Getopt.NoArg Maple),
		  help="output data for MAPLE solver"},
		 {short="e",
		  long=["mathematica"],
		  desc=(Getopt.NoArg Mathematica),
		  help="output data for MATHEMATICA solver"},
		 {short="l",
		  long=["matlab"],
		  desc=(Getopt.NoArg Matlab),
		  help="output data for MATLAB solver"},
		 {short="b",
		  long=["bcg"],
		  desc=(Getopt.NoArg BCG),
		  help="output data for BCG solver"}
		 ]
     
  fun processOptions [] = true
    | processOptions (h::t) =
      if (
	  case h of
	     Version =>
		(TextIO.output(TextIO.stdOut, version^"\n"); false)
	   | (Debug s) =>
		if (s = "on") then
		   true
		else
		   true
	   | Help =>
		(TextIO.output(TextIO.stdOut, Getopt.usageInfo usage options);
		 false)
	   | (Hashing b) =>
		(
		 if b then
		    true
		 else
		    (Options.setNohashing (); true)
		    )
	   | (Aggregation b) =>
		(
		 if b then
		    true
		 else
(* 		    let val _ = (TextIO.output(TextIO.stdOut, "value of arg is "^(if (b) then "true" else "false")^"\n"); *)
(* 		  TextIO.flushOut(TextIO.stdOut)) *)
(* 		    in *)
		       (Options.setNoAggregation (); true)
(* 		    end *)
		    )
	   | Maple =>
		(
		 (Options.setSolver Options.Maple; true)
		 )
	   | Mathematica =>
		(Options.setSolver Options.Mathematica; true)
	   | Matlab =>
		(Options.setSolver Options.Matlab; true)
	   | BCG =>
		(
		 (Options.setSolver Options.BCG; true)
		 )) then
	 (processOptions t)
      else
	 false

  fun processArgs [] = true
    | processArgs [filename] = (modelName := removeExtension filename; true)
    | processArgs _ =
      (TextIO.output(TextIO.stdErr, "Please supply one filename only.\n"
		     ^(Getopt.usageInfo usage options));
       false)

  fun processCommandLine args = 
     case (Getopt.getOpt Getopt.Permute options args) of 
	(os,n,[]) => 
	   (
	    if (processOptions os) then
	      processArgs n
	   else
	      false
	      )
      | (_,_,errs) =>
	   (TextIO.output(TextIO.stdErr, "bad command line - "^
			  (foldl (fn (a,b) => a^"\n"^b) "" errs)
			  ^(Getopt.usageInfo usage options));
	    false)
	   

  fun showTiming t = 
     TextIO.output (TextIO.stdOut, "Computed run time: " ^ 
		    Int32.toString (Time.toMilliseconds t) 
		    ^ " milliseconds\n") 
     handle Overflow => 
	TextIO.output (TextIO.stdOut, "Computed run time: " ^ 
		       Int32.toString (Time.toSeconds t) ^ " seconds\n") 
 

  fun main () =
    let
       (* gcla - hack in the real unhash function first *)
       val _ = ()
       val _ = (HashTable.translatefn := (Expressions.toString o Expressions.simplify o Expressions.getExp o Identifiers.makeID))
       val _ = (Prettyprinter.style := (Prettyprinter.OLD))
       val args = CommandLine.arguments ()
    in
       (* gcla - now ueses getopt *)
       (* true means continue *)
       if (processCommandLine args) then
	  (TextIO.output (TextIO.stdOut, "PEPA Workbench Version "^
			  version ^ " [" ^
			  compiled ^ "]\n");
	   TextIO.flushOut TextIO.stdOut;
	   (*       map checkForFlags args; *)
	   let val jobname = getJobName args
	      val startTime = Time.now() 
	   in  run jobname;
	      writeHashFile jobname;
	      showTiming (Time.- (Time.now(), startTime)); 
	      TextIO.output (TextIO.stdOut, "Exiting PEPA Workbench.\n");
	      TextIO.flushOut TextIO.stdOut
	   end)
       else
	  ()
    end

end;
