// The Fasto compiler command-line interface.
//
// This is the main program for when this compiler is turned into an executable.
// It ties together all the compiler modules.  You can build the compiler by
// running 'make' or 'dotnet build Fasto' in the top-level directory.

open System.Text
open FSharp.Text.Lexing
open System.IO

open AbSyn
open Inlining
open DeadFunctionRemoval
open DeadBindingRemoval
open CopyConstPropFold


// YOU DO NOT NEED TO UNDERSTAND THIS; IT IS A HACK: State machine for getting
// line and position numbers from a Parser error string.  This is really nasty.
// The problem is that we can only define the needed 'parse_error_rich' function
// in Parser.fsp at the top of the file, which means that we have not defined
// the actual tokens yet, so we cannot pattern match on them for extracting
// their source code positions, although we *can* print them.  An alternative
// solution is to inject a proper 'parse_error_rich' function in the bottom of
// the generated Parser.fs.
exception SyntaxError of int * int
let printPos (errString : string) : unit =
    let rec state3 (s : string) (p : int) (lin : string) (col : int) =
        (* read digits until not *)
        let c = s.[p]
        if System.Char.IsDigit c
        then state3 s (p-1) (System.Char.ToString c + lin) col
        else raise (SyntaxError (System.Int32.Parse lin, col))

    let rec state2 (s : string) (p : int) (col : string) =
        (* skip from position until digit *)
        let c = s.[p]
        if System.Char.IsDigit c
        then state3 s (p-1) (System.Char.ToString c) (System.Int32.Parse col)
        else state2 s (p-1) col

    let rec state1 (s : string) (p : int) (col : string) =
        (* read digits until not *)
        let c = s.[p]
        if System.Char.IsDigit c
        then state1 s (p-1) (System.Char.ToString c + col)
        else state2 s (p-1) col

    let rec state0 (s : string) (p : int) =
        (* skip from end until digit *)
        let c = s.[p]
        if System.Char.IsDigit c
        then state1 s (p-1) (System.Char.ToString c)
        else state0 s (p-1)

    state0 errString (String.length errString - 1)

// Parse program from string.
let parseString (s : string) : AbSyn.UntypedProg =
    Parser.Prog Lexer.Token
    <| LexBuffer<_>.FromBytes (Encoding.UTF8.GetBytes s)

////////////////////
/// Usage helper ///
////////////////////
let usage =
    [ "   fasto -i tests/fib.fo\n"
    ; "     Run 'fib.fo' in the 'tests' directory in interpreted mode.\n"
    ; "     and print the result.\n"
    ; "\n"
    ; "   fasto -r tests/fib.fo\n"
    ; "     Run 'fib.fo' in interpreted mode, but do not print the result.\n"
    ; "\n"
    ; "   fasto -c tests/fib.fo\n"
    ; "     Compile 'tests/fib.fo' into the MIPS program 'tests/fib.asm'.\n"
    ; "\n"
    ; "   fasto -o [opts] tests/fib.fo\n"
    ; "     Compile the optimised 'tests/fib.fo' into 'tests/fib.asm'.\n"
    ; "\n"
    ; "   fasto -p [opts] tests/fib.fo\n"
    ; "     Optimise 'tests/fib.fo' and print the result on standard output.\n"
    ; "     <opts> is a sequence of characters corresponding to optimisation\n"
    ; "     passes, where: \n"
    ; "       i                     - Inline functions.\n"
    ; "       c                     - Copy propagation and constant folding.\n"
    ; "       d                     - Remove dead bindings.\n"
    ; "       D                     - Remove dead functions.\n"
    ]


// Print error message to the standard error channel.
let errorMessage (message : string) : Unit =
    printfn "%s\n" message

let errorMessage' (errorType : string, message : string, line : int, col : int) =
    printfn "%s: %s at line %d, column %d" errorType message line col

let bad () : Unit =
    errorMessage "Unknown command-line arguments. Usage:\n"
    errorMessage (usage |> List.fold (+) "")

exception FileProblem of string

// Remove trailing .fo from filename.
let sanitiseFilename (argFilename : string) : string =
  if argFilename.EndsWith ".fo"
  then argFilename.Substring(0, (String.length argFilename)-3)
  else argFilename

// Save the content of a string to file.
let saveFile (filename : string) (content : string) : Unit =
  try
    let outFile = File.CreateText filename
    // Generate code here.
    outFile.Write content
    outFile.Close()
  with
    | ex ->
        printfn "Problem writing file named: %s, error: %s,\n where content is:\n %s\n" filename ex.Message content
        System.Environment.Exit 1


let parseFastoFile (filename : string) : AbSyn.UntypedProg =
  let txt = try  // read text from file given as parameter with added extension
              let inStream = File.OpenText (filename + ".fo")
              let txt = inStream.ReadToEnd()
              inStream.Close()
              txt
            with  // or return empty string
              | ex -> ""
  if txt <> "" then // valid file content
    let program =
      try
        parseString txt
      with
        | Lexer.LexicalError (info,(line,col)) ->
            printfn "%s at line %d, position %d\n" info line col
            System.Environment.Exit 1
            []
        | ex ->
            if ex.Message = "parse error"
            then printPos Parser.ErrorContextDescriptor
            else printfn "%s" ex.Message
            System.Environment.Exit 1
            []
    program
  else failwith "Invalid file name or empty file"

let compile (filename : string) optimiser : Unit =
    let pgm = parseFastoFile filename
    let pgm_decorated  = TypeChecker.checkProg pgm
    //printfn "%A" pgm_decorated
    let pgm_optimised  = optimiser pgm_decorated
    //printfn "%A" pgm_optimised
    let mips_code      = CodeGen.compile pgm_optimised
    let mips_code_text = Mips.ppMipsProg mips_code
    saveFile (filename + ".asm") mips_code_text

let interpret (filename : string) : Unit =
    let pgm = parseFastoFile filename
    printfn "Program is:\n\n%s" (AbSyn.ppProg pgm)
    printfn "\n+-----------------------------------------+"
    printfn "\n| You might need to enter some input now. |"
    printfn "\n+-----------------------------------------+"
    printfn "\n"
    let res = Interpreter.evalProg pgm
    printfn "\n\nResult of 'main': %s\n" (AbSyn.ppVal 0 res)

let interpretSimple (filename : string) : AbSyn.Value =
    let pgm = parseFastoFile filename
    Interpreter.evalProg pgm

let printOptimised (argFilename : string) optimiser : Unit =
    let pgm = parseFastoFile argFilename
    let pgm_decorated = TypeChecker.checkProg pgm
    let pgm_optimised = optimiser pgm_decorated
    printfn "%s\n" (ppProg pgm_optimised)

let withoutOptimisations (prog : TypedProg) = prog

let defaultOptimisations (prog : TypedProg) =
    (removeDeadFunction <<
     removeDeadBindings <<
     optimiseProgram <<
     inlineOptimiseProgram) prog

type opt = char

let rec extractOpts (opts : opt list) =
    match opts with
        | [] -> Some (fun x -> x)
        | opt::opls ->
            let extractOpt (op : opt) =
                match op with
                    | 'i' -> Some inlineOptimiseProgram
                    | 'c' -> Some optimiseProgram
                    | 'd' -> Some removeDeadBindings
                    | 'D' -> Some removeDeadFunction
                    | _   -> None
            match (extractOpt opt, extractOpts opls) with
                | (Some opt', Some opts') -> Some (fun x -> opts' (opt' x))
                | _                       -> None

let explode (s:string) =
    [for c in s -> c]

[<EntryPoint>]
let main (paramList: string[]) : int =
  try
    match paramList with
      | [|"-i"; file|] -> interpret (sanitiseFilename file)
      | [|"-r"; file|] -> let res = interpretSimple (sanitiseFilename file)
                          printfn "\n\nResult of 'main': %s\n" (AbSyn.ppVal 0 res)
      | [|"-c"; file|] -> compile  (sanitiseFilename file) (fun x -> x)
      | [|"-o"; file|] -> compile  (sanitiseFilename file) defaultOptimisations
      | [|"-o"; opts; file|] ->
          match extractOpts (explode opts) with
            | Some (opts') -> compile (sanitiseFilename file) opts'
            | None         -> bad ()
      | [|"-P"; file|] ->
          printOptimised (sanitiseFilename file) withoutOptimisations
      | [|"-p"; file|] ->
          printOptimised (sanitiseFilename file) defaultOptimisations
      | [|"-p"; opts; file|] ->
          match extractOpts (explode opts) with
              | Some (opts') -> printOptimised (sanitiseFilename file) opts'
              | None         -> bad ()
      | _ -> bad ()
    0
  with
    | SyntaxError (line, col) ->
        errorMessage' ("Parse error", "Error", line, col)
        System.Environment.Exit 1
        1
    | Lexer.LexicalError (message, (line, col)) ->
        errorMessage' ("Lexical error", message, line, col)
        System.Environment.Exit 1
        1
    | Interpreter.MyError (message, (line, col)) ->
        errorMessage' ("Interpreter error", message, line, col)
        System.Environment.Exit 1
        1
    | CodeGen.MyError (message, (line, col)) ->
        errorMessage' ("Code generator error", message, line, col)
        System.Environment.Exit 1
        1
    | TypeChecker.MyError (message, (line, col)) ->
        errorMessage' ("Type error", message, line, col)
        System.Environment.Exit 1
        1
    | FileProblem filename ->
        errorMessage ("There was a problem with the file: " + filename)
        System.Environment.Exit 1
        1