module silc

import StdBool
import StdChar
import StdFile
from StdFunc import o, seq
import StdList
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   :: Maybe String
	}

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

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
| isNothing args.inputfile
	# err = err <<< "No input file given.\r\n"
	= finish 1 io err w
# infile = fromJust args.inputfile
# (dir, module, dclfile, sysfiles, abcfile) =
	( dir
	, name
	, dir </> addExtension name "dcl"
	, dir </> "Clean System Files"
	, dir </> "Clean System Files" </> addExtension name "abc")
	with
		(dir, name) = splitFileName $ if (ext == "sil") base` infile
		(base`, ext) = splitExtension infile
#! (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 dclfile FWriteText w
| not ok
	# err = err <<< "Could not open '" <<< dclfile <<< "' for writing\r\n"
	= finish 1 io err w
#! f = f <<< "definition module " <<< module
#! (_,w) = fclose f w
#! (_,w) = sleep 1 w
#! (_,w) = createDirectory sysfiles 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 = f <<< fromOk prog
#! (_,w) = fclose f w
| not args.generate
	= finish 0 io err w
#! (p,w) = callProcess "/opt/clean/bin/clm" [module, "-o", module] (Just 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

	sleep :: !Int !*World -> *(!Int, !*World)
	sleep i w = code inline {
		ccall sleep "I:I:A"
	}