-- as for deep thoughts ISA
-----------------------------------------------------------------------------


import DT
import DTFormat

import Control.Applicative hiding ((<|>),many)

import System.IO
import System.Environment
import Text.Printf
import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Combinator
import qualified Data.Map as M
import Data.List
import Data.Word
import qualified Data.ByteString.Lazy as BL
import Control.Monad


main :: IO ()
main = do
	args <- getArgs
	content <- getContents
	let src = (filter (((/=) "") . snd) $ (zip [1..] (lines content)))
	let (dict,formatedsrc) = convertDTF src NoState 0x00 0x00 []
	printf "\nlabels:\n"
	sequence_ [printf "%10s @ 0x%08x\n" l a | (l,a) <- (reverse dict)]
	printf "\nparsed asm:\n"
	sequence_ [printf "%s" (show x) | x <- formatedsrc]
	let parsed = parseInstr dict formatedsrc
	printf "\nafter parsing the instructions:\n"
	sequence_ [printf "%s" (show x) | x <- parsed]


parseInstr :: [DictElem] -> [DTF] -> [DTF]
parseInstr _ [] = []
parseInstr dict ((DTF_InstrToParse a instr c l s):xs) =
	(DTF_Instr a bytecode c l s):(parseInstr dict xs)
	where
	bytecode = case (parse (instruction (a,dict)) "" (instr++"\n")) of
		Left err -> error ("couldn't parse Instruction: " ++ instr ++ "\n" ++ show err)
		Right x -> x
parseInstr dict (x:xs) = x:(parseInstr dict xs)


type Counter = Word32

inc :: Counter -> Counter
inc = ((+) 4)


convertDTF :: [(Int,String)] -> DT_State -> Counter -> Counter -> [DictElem] -> ([DictElem], [DTF])
convertDTF [] _ _ _ d = (d,[])
convertDTF ((lno,str):xs) state datacnt instrcnt dict = (newdict, (actlist newdtf))
	where
	actlist (DTF_Org _) = next
	actlist (DTF_State _) = next
	actlist (DTF_Define _ _ _) = next
	actlist y = y:next

	(newdict,next) = convertDTF xs (nstate newdtf) (ndatacnt newdtf) (ninstrcnt newdtf) (ndict newdtf)

	ndatacnt (DTF_Org adr)
		| state == InData = adr
		| otherwise = datacnt
	ndatacnt (DTF_Data _ _ _ _ _) = inc datacnt
	ndatacnt _ = datacnt

	ninstrcnt (DTF_Org adr)
		| state == InText = adr
		| otherwise = instrcnt
	ninstrcnt (DTF_Instr _ _ _ _ _) = inc instrcnt
	ninstrcnt (DTF_InstrToParse _ _ _ _ _) = inc instrcnt
	ninstrcnt _ = instrcnt

	nstate (DTF_State s) = s
	nstate _ = state

	ndict (DTF_Label l _ a) = dict `add_elem` (l,a)
	ndict (DTF_SectionToDet a _ _ l _) = dict `add_elem` (l,a)
	ndict (DTF_InstrToParse a _ _ l _) = dict `add_elem` (l,a)
	ndict (DTF_Data a _ _ l _) = dict `add_elem` (l,a)
	ndict (DTF_Instr a _ _ l _) = dict `add_elem` (l,a)
	ndict (DTF_Define l v _) = dict `add_elem` (l,v)
	ndict _ = dict

	newdtf = case (parse parseDTFLine "" (str++"\n")) of
		Left err -> error ("couldn't parse line " ++ (show lno) ++ ": " ++ (show err))
		Right (DTF_SectionToDet _ v c l s) ->
			case state of
				NoState -> error "missing .data or .text"
				InData -> (DTF_Data datacnt v c l s)
				InText -> (DTF_Instr instrcnt v c l s)
		Right (DTF_InstrToParse _ v c l s) ->
			(DTF_InstrToParse instrcnt v c l s)
		Right y@(DTF_Org _) ->
			case state of
				NoState -> error "missing .data or .text"
				_ -> y
		Right (DTF_Label l c _) ->
			case state of
				NoState -> error "missing .data or .text"
				InData -> (DTF_Label l c datacnt)
				InText -> (DTF_Label l c instrcnt)
		Right z -> z -- DTF_Comment, DTF_State, DTF_Define



testDTF :: String -> IO ()
testDTF input =
	case (parse parseDTFLine "" (input++"\n")) of
		Left err -> do { putStr "failz ;(\n"; print err}
		Right x -> do { print x }

parseDTFLine :: Parser DTF
parseDTFLine = foldl1 (<|>) (fmap try lineFormats) <* char '\n'

lineFormats = [lf_define, lf_sdata, lf_stext, lf_org, lf_data, lf_comment, lf_toparse, lf_label]

-- helper
parseIdent :: Parser String
parseIdent = do
	ident <- letter
	idents <- many $ (letter <|> digit <|> char '_')
	return $ (ident:idents)

parseLabel :: Parser String
parseLabel = do
	l <- parseIdent
	char ':'
	return $ l

parseComment :: Parser String
parseComment = do
	skipMany space
	char ';'
	comment <- many $ noneOf "\n"
	return $ comment

parseConst :: Parser Word32
parseConst = do
	skipMany space
	-- TODO: only decimal and hex (since this is supported by read)
	-- TODO: howto check too big values? atm they get truncated
	str <- try(do pref <- string "0x"; z <- many1 hexDigit; return $ (pref ++ z)) <|> (many1 digit)
	let val = read str
	return $ val

-- teh pars0rs
lf_data = do
	l <- try (parseLabel) <|> string ""
	skipMany space
	fill <- string ".fill "
	-- TODO: atm 32bit imm only
	code <- many1 $ noneOf "\n;"
	-- TODO: this is quite ugly here :/
	let (Right val) = parse parseConst "" code
	comment <- try(parseComment) <|> parseMySpaces
	return $ DTF_SectionToDet 0 val (fill ++ code) l comment

lf_comment = do
	comment <- parseComment
	return $ DTF_Comment comment

lf_label = do
	l <- parseLabel
	comment <- try(parseComment) <|> parseMySpaces
	return $ DTF_Label l comment 0

lf_toparse = do
	l <- try(parseLabel) <|> string ""
	skipMany space
	code <- many1 $ noneOf "\n;"
	comment <- try(parseComment) <|> parseMySpaces
	return $ DTF_InstrToParse 0 code code l comment

lf_org = do
	skipMany space
	string ".org"
	val <- parseConst
	parseMySpaces
	return $ DTF_Org val

lf_sdata = do
	skipMany space
	string ".data"
	parseMySpaces
	return $ DTF_State InData

lf_stext = do
	skipMany space
	string ".text"
	parseMySpaces
	return $ DTF_State InText

lf_define = do
	skipMany space
	string ".define"
	parseMySpaces
	id <- parseIdent
	parseMySpaces; char ','; parseMySpaces
	ret <- parseConst
	comment <- try(parseComment) <|> parseMySpaces
	return $ DTF_Define id ret comment