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

diff --git a/3a_asm/DTFormat.hs b/3a_asm/DTFormat.hs
index 3e607fdec50803ccd2ad8f7758e044d798ac9af1..be9aafe462d7ebbeb8f35161fe3a31cc1c6b0a18 100644 (file)
--- 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 9919b54f49e8ca61d7aedce2fbb597aa3c71f4ce..1b12f4b7b3e1401287e286aa9d9f8ac4d18a7947 100644 (file)
--- 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)]