From dd1a2323e743df5ca3109bae6e213cd7b02dddee Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Thu, 2 Feb 2017 21:00:10 +0100
Subject: Support 1U literals

---
 ast.hs    |  2 ++
 check.hs  | 30 +++++++++++++++++-------------
 parser.hs |  7 ++++++-
 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
-- 
cgit v1.2.3