1 {- `Deep Thought', a softcore CPU implemented on a FPGA
3 Copyright (C) 2010 Markus Hofstaetter <markus.manrow@gmx.at>
4 Copyright (C) 2010 Martin Perner <e0725782@student.tuwien.ac.at>
5 Copyright (C) 2010 Stefan Rebernig <stefan.rebernig@gmail.com>
6 Copyright (C) 2010 Manfred Schwarz <e0725898@student.tuwien.ac.at>
7 Copyright (C) 2010 Bernhard Urban <lewurm@gmail.com>
9 This program is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. -}
22 module Expr_eval (expr, testExpr) where
27 import Text.Parsec.String
28 import Text.ParserCombinators.Parsec
29 import Text.ParserCombinators.Parsec.Expr
30 import qualified Text.ParserCombinators.Parsec.Token as P
31 import Text.ParserCombinators.Parsec.Language
37 lexer :: P.TokenParser ()
38 lexer = P.makeTokenParser (haskellDef { reservedOpNames = ["*","/","+","-","<<",">>","^"] })
40 decimal = P.decimal lexer
41 hexadecimal = P.hexadecimal lexer
42 reservedOp = P.reservedOp lexer
44 expr :: [DictElem] -> Parser Word32
45 expr d = buildExpressionParser table (factor_spaces d) <?> "expression"
48 [unary "-" negate, unary "+" id],
49 [op "<<" myShiftL AssocLeft, op ">>" myShiftR AssocLeft],
50 [op "*" (*) AssocLeft, op "/" div AssocLeft],
51 [op "^" xor AssocLeft],
52 [op "+" (+) AssocLeft, op "-" (-) AssocLeft]
54 op s f assoc = Infix (do{ reservedOp s; return f } <?> "operator") assoc
55 unary s f = Prefix (do{ reservedOp s; return f })
57 myShiftL :: Word32 -> Word32 -> Word32
58 myShiftL b x = shiftL b (fromInteger $ toInteger x)
59 myShiftR :: Word32 -> Word32 -> Word32
60 myShiftR b x = shiftR b (fromInteger $ toInteger x)
62 factor_spaces :: [DictElem] -> Parser Word32
69 factor :: [DictElem] -> Parser Word32
72 char '('; r <- expr d; char ')';
76 s <- foldl1 (<|>) (fmap (try . string . fst) d);
77 return $ (get_elem s d)
81 return $ fromInteger r
84 return $ fromInteger r
87 testExpr :: String -> IO ()
88 testExpr i = case (parse (expr dict) "" i) of
89 Left err -> do {putStr "failz ;(\n"; print err}
90 Right x -> do {printf "erg: 0x%08x\n" x}
92 dict = [("lolz", 0x1337), ("rofl", 0xaaaa)]