module silc

import StdArray
import StdBool
import StdChar
import StdFile
from StdFunc import id, o, seq
import StdList
import StdMaybe
import StdOverloaded
import StdString
import StdTuple

import Control.Applicative
import Control.Monad
import Data.Error
from Data.Func import $
import Data.Functor
import Data.Tuple
import System.CommandLine
import System.Directory
import System.File
import System.FilePath
import System.Process

import ABC.Assembler

from Sil.Check import checkProgram
import Sil.Compile
import Sil.Error
import Sil.Parse
from Sil.Syntax import :: Program
import Sil.Util.Parser
from Sil.Util.Printer import :: PrintState, instance zero PrintState,
	class PrettyPrinter(..), instance PrettyPrinter Program

:: CLI =
	{ prettyprint :: Bool
	, check       :: Bool
	, compile     :: Bool
	, generate    :: Bool
	, help        :: Bool
	, inputfile   :: ?String
	}

instance zero CLI
where
	zero =
		{ prettyprint = False
		, check       = True
		, compile     = True
		, generate    = True
		, help        = False
		, inputfile   = ?None
		}

Start w
#! (io,w) = stdio w
#! err = stderr
#! (cmd,w)  = getCommandLine w
#! (args,_) = runParser (arg until eof) $ makeParseState $ map PI_Token $ tl cmd
| isError args
	# err = err <<< toString (fromError args) <<< "\r\n"
	= finish 1 io err w
#! args = seq (fromOk args) zero
| args.help
	# io = io <<< HELP
	= finish 0 io err w
| isNone args.inputfile
	# err = err <<< "No input file given.\r\n"
	= finish 1 io err w
# infile = fromJust args.inputfile
# (dir, module, infile, abcfile, sfile, ofile) =
	( if (size dir==0) ?None (?Just dir)
	, name
	, indir $ addExtension name "sil"
	, indir $ addExtension name "abc"
	, indir $ addExtension name "s"
	, indir $ addExtension name "o"
	)
	with
		(dir, name) = splitFileName $ if (ext == "sil") base` infile
		(base`, ext) = splitExtension infile
		indir s = if (size dir==0) s (dir </> s)
#! (file,w) = readFile infile w
| isError file
	# err = err <<< "Could not open '" <<< infile <<< "' for reading.\r\n"
	= finish 1 io err w
#! prog = tokenise (fromString $ fromOk file) >>= parse
| isError prog
	# err = err <<< toString (fromError prog) <<< "\r\n"
	= finish 1 io err w
#! prog = fromOk prog
#! io = if args.prettyprint
	(io <<< print zero prog <<< "\r\n")
	io
#! (errs, err) = if args.check
	(appSnd fromJust $ checkProgram (?Just err) prog)
	([], err)
| not (isEmpty errs)
	= finish 1 io err w
| not args.compile
	= finish 0 io err w
#! (ok,f,w) = fopen abcfile FWriteText w
| not ok
	# err = err <<< "Could not open '" <<< abcfile <<< "' for writing\r\n"
	= finish 1 io err w
#! prog = compile prog
| isError prog
	# err = err <<< fromError prog
	= finish 1 io err w
#! f = printAssembler (fromOk prog) f
#! (_,w) = fclose f w
| not args.generate
	= finish 0 io err w
#! (p,w) = callProcess "/opt/clean/exe/cg" [module, "-s", sfile] dir w
| isError p
	# err = err <<< snd (fromError p) <<< "\r\n"
	= finish 1 io err w
| fromOk p <> 0
	= finish (fromOk p) io err w
#! (_,f,w) = fopen sfile FAppendText w
#! f = foldl (<<<) f options
#! (_,w) = fclose f w
#! (p,w) = callProcess "/usr/bin/as"
	[ sfile
	, "-o"
	, ofile
	] dir w
| isError p
	# err = err <<< snd (fromError p) <<< "\r\n"
	= finish 1 io err w
| fromOk p <> 0
	= finish (fromOk p) io err w
#! (p,w) = callProcess "/usr/bin/gcc"
	[ "-lc"
	, "-s"
	, "-no-pie"
	, ofile
	, "/opt/clean/lib/StdEnv/Clean System Files/_system.o"
	, "/opt/clean/lib/StdEnv/Clean System Files/_startup.o"
	, "-o"
	, module
	] dir w
| isError p
	# err = err <<< snd (fromError p) <<< "\r\n"
	= finish 1 io err w
| fromOk p <> 0
	= finish (fromOk p) io err w
= finish 0 io err w
where
	arg :: Parser String (CLI -> CLI)
	arg = peek >>= \opt ->
		(   (\     cli -> {cli & prettyprint=True}) <$  anyItem ["-p", "--pretty-print"]
		<|> (\     cli -> {cli & check=False})      <$  item     "--no-check"
		<|> (\     cli -> {cli & compile=False})    <$  item     "--no-compile"
		<|> (\     cli -> {cli & generate=False})   <$  item     "--no-generate"
		<|> (\     cli -> {cli & help=True})        <$  anyItem ["-h", "--help"]
		<|> (\name cli -> {cli & inputfile= ?Just name}) <$> satisfy isFilename
		)
		<?> P_Invalid "command line argument" opt

	HELP = "silc: simple imperative language compiler\r\n\r\n" +++
		"Usage: silc [-p|--pretty-print] [--no-check] [--no-compile] [--no-generate] [-h|--help] [FILE]\r\n\r\n" +++
		"\t-p, --pretty-print  Pretty-print program\r\n" +++
		"\t--no-check          Do not check program for common errors\r\n" +++
		"\t--no-compile        Do not compile program to ABC-code\r\n" +++
		"\t--no-generate       Do not generate machine code from ABC-code\r\n" +++
		"\t-h, --help          Print this help\r\n"

	isFilename :: (String -> Bool)
	isFilename = all (\c -> isAlphanum c || isMember c ['./-']) o fromString

	finish :: !Int !*File !*File -> *(*World -> *World)
	finish ret io err = setReturnCode ret o snd o fclose err o snd o fclose io

	options :: [String]
	options =
		[ "\t.data\n"
		: flatten
			[ [ "\t.globl " +++ var +++ "\n"
			  , var +++ ":\n"
			  , "\t.quad " +++ val +++ "\n"
			  ]
			\\ (var,val) <-
			  [ ("heap_size",          "0x00200000")
			  , ("ab_stack_size",      "0x00080000")
			  , ("flags",              "0x00000008")
			  , ("heap_size_multiple", "0x00001400")
			  , ("initial_heap_size",  "0x00019000")
			  ]
			] ++ ["\t.text\n"]
		]