module spl

import StdFile
import StdBool
import StdMisc
import StdFunc
import StdTuple
import StdList
import StdString
import Data.Either
import Data.Maybe
import Data.Func
import System.CommandLine
import GenPrint
import Data.Map
from Text import class Text(concat,join), instance Text String

import parse
import lex
import sem
import AST
import gen
from yard import :: Error, instance toString Error

:: Opts = {
	version :: Bool,
	program :: String,
	lex :: Bool,
	parse :: Bool,
	sem :: Bool,
    gen :: Bool,
	fp :: Maybe String,
	help :: Bool}

derive gPrint TokenValue

preamble :: AST -> AST
preamble (AST fd) = AST (pre ++ fd)
	where
		pre = [
			FunDecl zero "1printstr" ["x"] Nothing [] [
				IfStmt (FunExpr zero "isEmpty" [VarExpr zero (VarDef "x" [])] [])
					[]
					[FunStmt "1printchar" [VarExpr zero (VarDef "x" [FieldHd])] []
					,FunStmt "1printstr" [VarExpr zero (VarDef "x" [FieldTl])] []]]
			,
			FunDecl zero "1printbool" ["x"] Nothing [] [
				IfStmt (VarExpr zero (VarDef "x" []))
					[FunStmt "1printstr" [makeStrExpr zero $ fromString "True"] []]
					[FunStmt "1printstr" [makeStrExpr zero $ fromString "False"] []]]
			] 

Start :: *World -> *World
Start w
# (args, w) = parseArgs w
# (stdin, w) = stdio w
| args.version
	# stdin = stdin 
		<<< "spl 1.0 (9 June 2016)\n"
		<<< "Copyright Pim Jager and Mart Lubbers\n"
	= snd $ fclose stdin w
| args.help
	# stdin = stdin 
		<<< "Usage: " <<< args.program <<< " [OPTION] [FILE]\n"
		<<< "\n"
		<<< "Options:\n"
		<<< "  --help             Show this help\n"
		<<< "  --version          Show the version\n"
		<<< "  --[no-]lex         Lexer output(default: disabled)\n"
		<<< "  --[no-]parse       Parser output(default: disabled)\n"
		<<< "  --[no-]sem         Semantic analysis output(default: disabled)\n"
		<<< "  --[no-]code        Code generation output(default: enabled)\n"
	= snd $ fclose stdin w
# (contents, stdin, w) = readFileOrStdin stdin args.fp w
= case contents of
	(Left cs) = snd $ fclose (stdin <<< cs) w
	(Right cs) = case lexer cs of
		(Left e) = snd $ fclose (stdin <<< toString e <<< "\n") w
		(Right lexOut)
		# stdin = if (not args.lex) stdin (
			stdin <<< "//LEXER\n" <<< printTokens lexOut <<< "//LEXER\n")
		= case parser lexOut of
			(Left e) = snd $ fclose (stdin <<< toString e <<< "\n") w
			(Right parseOut)
			# stdin = if (not args.parse) stdin (
				stdin <<<  "//PARSER\n" <<< toString parseOut <<< "//PARSER\n")
			= case sem (preamble parseOut) of
				(Left e) = snd $ fclose (stdin <<< join "\n" (map toString e) <<< "\n") w
				(Right (ast, gam))
				# stdin = if (not args.sem) stdin (stdin
					<<< "//SEM AST\n" <<< toString ast <<< "//SEM AST\n"
                    <<< "//SEM GAMMA\n" <<< toString gam <<< "//SEM GAMMA\n")
				= case gen ast of
					(Left e) = snd $ fclose (stdin <<< e) w
					(Right asm)
					# stdin = if (not args.gen) stdin (stdin
                    	<<< ";CODE GEN\n" <<< asm <<< "\n;CODE GEN\n")
					= snd $ fclose (stdin <<< "\n") w
		where
			printConstraints :: Constraints -> String
			printConstraints [] = ""
			printConstraints [(t1, t2):ts] = concat [
				"(", toString t1, ",", toString t2, ")"] +++ printConstraints ts

			printTokens :: [Token] -> String
			printTokens ts = concat $ flatten $ map pt ts
				where
				pt ({line,col},token) = [toString line, ":", 
						toString col, ": ", printToString token, "\n"]

parseArgs :: *World -> (Opts, *World)
parseArgs w
# ([p:args], w) = getCommandLine w
= (pa args {
	program=p,
	version=False,
	lex=False,
	parse=False,
	sem=False,
    gen=True,
	fp=Nothing,
	help=False}, w)
where
	pa :: [String] Opts -> Opts
	pa [] o = o
	pa ["--help":r] o = pa r {o & help=True}
	pa ["--version":r] o = pa r {o & version=True}
	pa ["--lex":r] o = pa r {o & lex=True}
	pa ["--no-lex":r] o = pa r {o & lex=False}
	pa ["--parse":r] o = pa r {o & parse=True}
	pa ["--no-parse":r] o = pa r {o & parse=False}
	pa ["--sem":r] o = pa r {o & sem=True}
	pa ["--no-sem":r] o = pa r {o & sem=False}
    pa ["--code":r] o = pa r {o & gen=True}
    pa ["--no-code":r] o = pa r {o & gen=False}
	pa [x:r] o = pa r {o & fp=Just x}

readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World)
readFileOrStdin stdin Nothing w
# (cs, stdin) = readEntireFile stdin
= (Right cs, stdin, w)
readFileOrStdin stdin (Just fp) w
# (b, fin, w) = fopen fp FReadText w
| not b = (Left "Unable to open file", stdin, w)
# (cs, 	fin) = readEntireFile fin
# (b, w) = fclose fin w
| not b = (Left "Unable to close file", stdin, w)
= (Right cs, stdin, w)

readEntireFile :: *File -> *([Char], *File)
readEntireFile f
# (b, c, f) = freadc f
| not b = ([], f)
# (cs, f) = readEntireFile f
= ([c:cs], f)