1 module Expr_eval (expr, testExpr) where
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
15 lexer :: P.TokenParser ()
16 lexer = P.makeTokenParser (haskellDef { reservedOpNames = ["*","/","+","-","<<",">>","^"] })
18 decimal = P.decimal lexer
19 hexadecimal = P.hexadecimal lexer
20 reservedOp = P.reservedOp lexer
22 expr :: [DictElem] -> Parser Word32
23 expr d = buildExpressionParser table (factor_spaces d) <?> "expression"
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]
32 op s f assoc = Infix (do{ reservedOp s; return f } <?> "operator") assoc
33 unary s f = Prefix (do{ reservedOp s; return f })
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)
40 factor_spaces :: [DictElem] -> Parser Word32
47 factor :: [DictElem] -> Parser Word32
50 char '('; r <- expr d; char ')';
54 s <- foldl1 (<|>) (fmap (try . string . fst) d);
55 return $ (get_elem s d)
59 return $ fromInteger r
62 return $ fromInteger r
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}
70 dict = [("lolz", 0x1337), ("rofl", 0xaaaa)]