3a_asm/Expr_eval.hs

   1 module Expr_eval (expr, testExpr) where
   2
   3 import DTFormat
   4
   5 import Text.Printf
   6 import Text.Parsec.String
   7 import Text.ParserCombinators.Parsec
   8 import Text.ParserCombinators.Parsec.Expr
   9 import qualified Text.ParserCombinators.Parsec.Token as P
  10 import Text.ParserCombinators.Parsec.Language
  11 import System.IO
  12 import Data.Word
  13 import Data.Bits
  14
  15 lexer :: P.TokenParser ()
  16 lexer = P.makeTokenParser (haskellDef { reservedOpNames = ["*","/","+","-","<<",">>","^"] })
  17
  18 decimal = P.decimal lexer
  19 hexadecimal = P.hexadecimal lexer
  20 reservedOp = P.reservedOp lexer
  21
  22 expr :: [DictElem] -> Parser Word32
  23 expr d = buildExpressionParser table (factor_spaces d) <?> "expression"
  24         where
  25         table = [
  26                 [unary "-" negate, unary "+" id],
  27                 [op "<<" myShiftL AssocLeft, op ">>" myShiftR AssocLeft],
  28                 [op "*" (*) AssocLeft, op "/" div AssocLeft],
  29                 [op "^" xor AssocLeft],
  30                 [op "+" (+) AssocLeft, op "-" (-) AssocLeft]
  31                 ]
  32         op s f assoc = Infix (do{ reservedOp s; return f } <?> "operator") assoc
  33         unary s f = Prefix (do{ reservedOp s; return f })
  34
  35 myShiftL :: Word32 -> Word32 -> Word32
  36 myShiftL b x = shiftL b (fromInteger $ toInteger x)
  37 myShiftR :: Word32 -> Word32 -> Word32
  38 myShiftR b x = shiftR b (fromInteger $ toInteger x)
  39
  40 factor_spaces :: [DictElem] -> Parser Word32
  41 factor_spaces d = do
  42         parseMySpaces
  43         r <- factor d
  44         parseMySpaces
  45         return r
  46
  47 factor :: [DictElem] -> Parser Word32
  48 factor d =
  49         do {
  50                 char '('; r <- expr d; char ')';
  51                 return r
  52         } <|> do {
  53                 -- define or label
  54                 s <- foldl1 (<|>) (fmap (try . string . fst) d);
  55                 return $ (get_elem s d)
  56         } <|> try (do {
  57                 string "0";
  58                 r <- hexadecimal;
  59                 return $ fromInteger r
  60         } ) <|> do {
  61                 r <- decimal;
  62                 return $ fromInteger r
  63         } <?> "factor"
  64
  65 testExpr :: String -> IO ()
  66 testExpr i = case (parse (expr dict) "" i) of
  67         Left err -> do {putStr "failz ;(\n"; print err}
  68         Right x -> do {printf "erg: 0x%08x\n" x}
  69         where
  70         dict = [("lolz", 0x1337), ("rofl", 0xaaaa)]