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 parens = P.parens lexer
21 reservedOp = P.reservedOp lexer
23 expr :: [DictElem] -> Parser Word32
24 expr d = buildExpressionParser table (factor_spaces d) <?> "expression"
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]
33 op s f assoc = Infix (do{ reservedOp s; return f } <?> "operator") assoc
34 unary s f = Prefix (do{ reservedOp s; return f })
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)
41 factor_spaces :: [DictElem] -> Parser Word32
48 factor :: [DictElem] -> Parser Word32
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)]