module Expr_eval (expr, testExpr) where

import DTFormat

import Text.Printf
import Text.Parsec.String
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language
import System.IO
import Data.Word
import Data.Bits

lexer :: P.TokenParser ()
lexer = P.makeTokenParser (haskellDef { reservedOpNames = ["*","/","+","-","<<",">>","^"] })

decimal = P.decimal lexer
hexadecimal = P.hexadecimal lexer
parens = P.parens lexer
reservedOp = P.reservedOp lexer

expr :: [DictElem] -> Parser Word32
expr d = buildExpressionParser table (factor_spaces d) <?> "expression"
	where
	table = [
		[unary "-" negate, unary "+" id],
		[op "<<" myShiftL AssocLeft, op ">>" myShiftR AssocLeft],
		[op "*" (*) AssocLeft, op "/" div AssocLeft],
		[op "^" xor AssocLeft],
		[op "+" (+) AssocLeft, op "-" (-) AssocLeft]
		]
	op s f assoc = Infix (do{ reservedOp s; return f } <?> "operator") assoc
	unary s f = Prefix (do{ reservedOp s; return f })

myShiftL :: Word32 -> Word32 -> Word32
myShiftL b x = shiftL b (fromInteger $ toInteger x)
myShiftR :: Word32 -> Word32 -> Word32
myShiftR b x = shiftR b (fromInteger $ toInteger x)

factor_spaces :: [DictElem] -> Parser Word32
factor_spaces d = do
	parseMySpaces
	r <- factor d
	parseMySpaces
	return r

factor :: [DictElem] -> Parser Word32
factor d =
	do {
		parens (expr d);
	} <|> do {
		-- define or label
		s <- foldl1 (<|>) (fmap (try . string . fst) d);
		return $ (get_elem s d)
	} <|> try (do {
		string "0";
		r <- hexadecimal;
		return $ fromInteger r
	} ) <|> do {
		r <- decimal;
		return $ fromInteger r
	} <?> "factor"

testExpr :: String -> IO ()
testExpr i = case (parse (expr dict) "" i) of
	Left err -> do {putStr "failz ;(\n"; print err}
	Right x -> do {printf "erg: 0x%08x\n" x}
	where
	dict = [("lolz", 0x1337), ("rofl", 0xaaaa)]