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

module Main where

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]


type Counter = Word32

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


type DictLabel = (String,Word32)

get_label :: String -> [DictLabel] -> Maybe Word32
get_label = lookup

add_label :: [DictLabel] -> (String,Word32) -> [DictLabel]
add_label dic (s,w)
	| s == "" = dic -- ignore empty string
	| already_in =  error ("Label " ++ s ++ " already exists")
	| otherwise = (s,w):dic
	where
	already_in = case (get_label s dic) of
		Just _ -> True
		Nothing -> False


convertDTF :: [(Int,String)] -> DT_State -> Counter -> Counter -> [DictLabel] -> ([DictLabel], [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 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_label` (l,a)
	ndict (DTF_SectionToDet a _ _ l _) = dict `add_label` (l,a)
	ndict (DTF_InstrToParse a _ _ l _) = dict `add_label` (l,a)
	ndict (DTF_Data a _ _ l _) = dict `add_label` (l,a)
	ndict (DTF_Instr a _ _ l _) = dict `add_label` (l,a)
	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



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_sdata, lf_stext, lf_org, lf_data, lf_comment, lf_toparse, lf_label]

-- helper
parseLabel :: Parser String
parseLabel = do
	label <- letter 
	labels <- many $ (letter <|> digit <|> char '_')
	char ':'
	return $ (label:labels)

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

parseMySpaces :: Parser String
parseMySpaces = do
	ret <- many $ oneOf "\t "
	return $ ret

-- 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