3a_asm: FIX: parser fail bei labels aufloesen

[calu.git] / 3a_asm / Expr_eval.hs

diff --git a/3a_asm/Expr_eval.hs b/3a_asm/Expr_eval.hs
index 9919b54f49e8ca61d7aedce2fbb597aa3c71f4ce..71e0f4de63ae06f083fde358ea8a9bb3a64c758f 100644 (file)
--- a/3a_asm/Expr_eval.hs
+++ b/3a_asm/Expr_eval.hs
@@ -1,59 +1,71 @@
+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.List
+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
+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 {
+               char '('; r <- expr d; char ')';
+               return r
+       } <|> 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)]