summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2017-02-02 21:00:10 +0100
committertomsmeding <tom.smeding@gmail.com>2017-02-02 21:00:10 +0100
commitdd1a2323e743df5ca3109bae6e213cd7b02dddee (patch)
treea064a9197de268a934a2fb7564df8424d8882541
parent9e67d68574bf4b78451469d5e149cfd95b0ec9f6 (diff)
Support 1U literals
-rw-r--r--ast.hs2
-rw-r--r--check.hs30
-rw-r--r--parser.hs7
3 files changed, 25 insertions, 14 deletions
diff --git a/ast.hs b/ast.hs
index b1b31b7..2f40b84 100644
--- a/ast.hs
+++ b/ast.hs
@@ -38,6 +38,7 @@ data Type = TypeInt Int
deriving (Show, Eq)
data Literal = LitInt Integer
+ | LitUInt Integer
| LitFloat Double
| LitString String
| LitVar Name
@@ -128,6 +129,7 @@ instance PShow Type where
instance PShow Literal where
pshow (LitInt i) = pshow i
+ pshow (LitUInt i) = pshow i ++ "U"
pshow (LitFloat x) = pshow x
pshow (LitString s) = pshow s
pshow (LitVar n) = n
diff --git a/check.hs b/check.hs
index b30ff25..a869f18 100644
--- a/check.hs
+++ b/check.hs
@@ -140,7 +140,8 @@ typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls
-- Postcondition: the expression (if any) has a type annotation.
goE :: Map.Map Name Type -> Expression -> Error Expression
- goE _ (ExLit l@(LitInt i) _) = return $ ExLit l $ Just (smallestIntType i)
+ goE _ (ExLit l@(LitInt i) _) = smallestIntType i >>= \t -> return $ ExLit l $ Just t
+ goE _ (ExLit l@(LitUInt i) _) = smallestUIntType i >>= \t -> return $ ExLit l $ Just t
goE _ (ExLit l@(LitFloat f) _) = return $ ExLit l $ Just (smallestFloatType f)
goE _ (ExLit l@(LitString _) _) = return $ ExLit l $ Just (TypePtr (TypeInt 8))
goE names (ExLit l@(LitVar n) _) = maybe (Left $ "Undefined variable '" ++ n ++ "'") (return . ExLit l . Just)
@@ -212,7 +213,7 @@ logicBO = [BoolAnd, BoolOr]
complogBO = compareBO ++ logicBO
resultTypeBO :: BinaryOperator -> Type -> Type -> Maybe Type
-resultTypeBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeUInt 1
+resultTypeBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeUInt 64
resultTypeBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeUInt 1
resultTypeBO bo t@(TypePtr _) (TypeInt _) | bo `elem` [Plus, Minus] = Just t
resultTypeBO bo t@(TypePtr _) (TypeUInt _) | bo `elem` [Plus, Minus] = Just t
@@ -255,19 +256,21 @@ smallestFloatType d =
let truncfloat = realToFrac (realToFrac d :: Float) :: Double
in if d == truncfloat then TypeFloat else TypeDouble
-smallestIntType :: Integer -> Type
+smallestIntType :: Integer -> Error Type
smallestIntType i
- | i >= -2^7 && i < 2^7 = TypeInt 8
- | i >= -2^15 && i < 2^15 = TypeInt 16
- | i >= -2^31 && i < 2^31 = TypeInt 32
- | otherwise = TypeInt 64
+ | i >= -2^7 && i < 2^7 = return $ TypeInt 8
+ | i >= -2^15 && i < 2^15 = return $ TypeInt 16
+ | i >= -2^31 && i < 2^31 = return $ TypeInt 32
+ | i >= -2^63 && i < 2^63 = return $ TypeInt 64
+ | otherwise = Left $ "Integer literal '" ++ pshow i ++ "' too wide for i64"
--- smallestUIntType :: Integer -> Type
--- smallestUIntType i
--- | i >= 0 && i < 2^8 = TypeUInt 8
--- | i >= 0 && i < 2^16 = TypeUInt 16
--- | i >= 0 && i < 2^32 = TypeUInt 32
--- | otherwise = TypeUInt 64
+smallestUIntType :: Integer -> Error Type
+smallestUIntType i
+ | i > -2^8 && i < 2^8 = return $ TypeUInt 8
+ | i > -2^16 && i < 2^16 = return $ TypeUInt 16
+ | i > -2^32 && i < 2^32 = return $ TypeUInt 32
+ | i > -2^64 && i < 2^64 = return $ TypeUInt 64
+ | otherwise = Left $ "Unsigned integer literal '" ++ pshow i ++ "U' too wide for u64"
type MapperHandler a = a -> Error a
@@ -408,6 +411,7 @@ mapProgram prog mapper = goP prog
goL :: MapperHandler Literal
goL l@(LitString _) = h_l l
goL l@(LitInt _) = h_l l
+ goL l@(LitUInt _) = h_l l
goL l@(LitFloat _) = h_l l
goL (LitVar n) = goN n >>= (h_l . LitVar)
goL (LitCall n a) = do
diff --git a/parser.hs b/parser.hs
index 3ba5e18..6e8b828 100644
--- a/parser.hs
+++ b/parser.hs
@@ -112,9 +112,14 @@ pParenExpr = do
return e
pLiteral :: Parser Literal
-pLiteral = (LitFloat <$> pFloat) <|> (LitInt <$> pInteger) <|> (LitInt <$> pCharStr)
+pLiteral = (LitFloat <$> pFloat) <|> pLitInt <|> (LitInt <$> pCharStr)
<|> (LitString <$> pString) <|> try pLitCall <|> (LitVar <$> pName)
+pLitInt :: Parser Literal
+pLitInt = do
+ i <- pInteger
+ liftM (maybe (LitInt i) (const $ LitUInt i)) $ optionMaybe (symbol "U")
+
pLitCall :: Parser Literal
pLitCall = do
n <- pName