From: Bernhard Urban <lewurm@gmail.com>
Date: Sun, 31 Oct 2010 23:40:45 +0000 (+0100)
Subject: 3a_asm: modified expr stuff (inclusive reusing existing defines and labels)
X-Git-Tag: bootrom_v1~207
X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=calu.git;a=commitdiff_plain;h=9dd69a23aa1aceb8afc59218daa197fcba49f4b7

3a_asm: modified expr stuff (inclusive reusing existing defines and labels)
---

diff --git a/3a_asm/DTFormat.hs b/3a_asm/DTFormat.hs
index 3e607fd..be9aafe 100644
--- a/3a_asm/DTFormat.hs
+++ b/3a_asm/DTFormat.hs
@@ -5,6 +5,9 @@ import Text.Printf
 import Text.Parsec
 import Text.Parsec.String
 import Text.Parsec.Combinator
+import Text.Parsec.Expr
+import Text.ParserCombinators.Parsec.Token
+import Text.ParserCombinators.Parsec.Expr
 import Control.Monad
 
 data DT_State = NoState | InData | InText deriving (Show,Eq)
diff --git a/3a_asm/Expr_eval.hs b/3a_asm/Expr_eval.hs
index 9919b54..1b12f4b 100644
--- a/3a_asm/Expr_eval.hs
+++ b/3a_asm/Expr_eval.hs
@@ -1,59 +1,70 @@
+module Expr_eval (expr) 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 = ["*","/","+","-","**"] })
-
-naturalOrFloat = P.naturalOrFloat lexer
-parens         = P.parens lexer
-reservedOp     = P.reservedOp lexer
-
-expr :: Parser Double
-expr = buildExpressionParser table factor <?> "expression"
-   where
-       table = [
-           [unary "-" negate, unary "+" id],
-           [op "**" (**) AssocRight],
-           [op "*" (*) AssocLeft, op "/" (/) 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 })
-
-factor :: Parser Double
-factor =
-   do {
-       parens expr;
-   } <|> do {
-       norf <- naturalOrFloat;
-       case norf of
-           Left i    -> return $ fromInteger i
-           Right f    -> return $ f
-   } <?>
-       "factor"
-
-repl :: String -> (String -> Bool) -> (String -> String) -> IO ()
-repl prompt bQuit eval = loop
-   where
-       loop = do
-           putStr prompt
-           s <- getLine
-           if bQuit s
-               then return ()
-               else putStrLn (eval s) >> loop
-
-calc :: IO ()
-calc = repl "> " (== ":q") (tostring . parse stmt "")
-   where
-       tostring (Right v)    = show v
-       tostring (Left err)    = show err
-       stmt = do
-           e <- expr
-           eof
-           return e
-
-main = hSetBuffering stdout NoBuffering >> putStrLn "type ':q' to quit." >> calc >> putStrLn "Bye"
+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)
+	} <|> 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)]