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