From 185623be46dfd9a60e5a021259a6c7778cfb07cd Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Thu, 2 Feb 2017 22:29:41 +0100
Subject: Parse and typecheck casts

---
 ast.hs       |  3 +++
 check.hs     | 25 +++++++++++++++++++++++++
 nl/mandel.nl |  7 ++++++-
 parser.hs    | 11 ++++++++++-
 4 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/ast.hs b/ast.hs
index 2f40b84..480b133 100644
--- a/ast.hs
+++ b/ast.hs
@@ -57,6 +57,7 @@ data UnaryOperator
 
 data Expression    -- (Maybe Type)'s are type annotations by the type checker
     = ExLit Literal (Maybe Type)
+    | ExCast Type Expression  -- No type annotation needed
     | ExBinOp BinaryOperator Expression Expression (Maybe Type)
     | ExUnOp UnaryOperator Expression (Maybe Type)
   deriving (Show)
@@ -84,6 +85,7 @@ exUnOp_ uo e = ExUnOp uo e Nothing
 
 exTypeOf :: Expression -> Maybe Type
 exTypeOf (ExLit _ mt) = mt
+exTypeOf (ExCast t _) = Just t
 exTypeOf (ExBinOp _ _ _ mt) = mt
 exTypeOf (ExUnOp _ _ mt) = mt
 
@@ -160,6 +162,7 @@ instance PShow UnaryOperator where
 instance PShow Expression where
     pshow (ExLit lit Nothing) = pshow lit
     pshow (ExLit lit (Just t)) = concat ["(", pshow lit, " :: ", pshow t, ")"]
+    pshow (ExCast t ex) = concat ["cast(", pshow t, ")(", pshow ex, ")"]
     pshow (ExBinOp op a b Nothing) = concat ["(", pshow a, " ", pshow op, " ", pshow b, ")"]
     pshow (ExBinOp op a b (Just t)) = concat ["(", pshow a, " ", pshow op, " ", pshow b, " :: ", pshow t, ")"]
     pshow (ExUnOp op a Nothing) = concat [pshow op, pshow a]
diff --git a/check.hs b/check.hs
index a869f18..dbbcfd8 100644
--- a/check.hs
+++ b/check.hs
@@ -160,6 +160,12 @@ typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls
                           else Left $ "Cannot convert type '" ++ pshow argtype ++ "' to '" ++ pshow (snd ft !! i)
                                       ++ "' in call of function '" ++ n ++ "'"
         return $ ExLit (LitCall n rargs) (Just (fst ft))
+    goE names (ExCast totype ex) = do
+        rex <- goE names ex
+        let fromtype = fromJust (exTypeOf rex)
+        if canCast fromtype totype
+            then return $ ExCast totype rex
+            else Left $ "Cannot cast type '" ++ pshow fromtype ++ "' to '" ++ pshow totype ++ "'"
     goE names (ExBinOp bo e1 e2 _) = do
         re1 <- goE names e1
         re2 <- goE names e2
@@ -206,6 +212,21 @@ canConvert (TypeUInt _) TypeFloat = True
 canConvert (TypeUInt _) TypeDouble = True
 canConvert _ _ = False
 
+canCast :: Type -> Type -> Bool
+canCast t1 t2 = any (\f -> f t1 && f t2) [numberGroup, intptrGroup]
+  where
+    numberGroup (TypeInt _) = True
+    numberGroup (TypeUInt _) = True
+    numberGroup TypeFloat = True
+    numberGroup TypeDouble = True
+    numberGroup _ = False
+
+    intptrGroup (TypeInt _) = True
+    intptrGroup (TypeUInt _) = True
+    intptrGroup (TypePtr _) = True
+    intptrGroup (TypeFunc _ _) = True
+    intptrGroup _ = False
+
 arithBO, compareBO, logicBO, complogBO :: [BinaryOperator]
 arithBO = [Plus, Minus, Times, Divide, Modulo]
 compareBO = [Equal, Unequal, Greater, Less, GEqual, LEqual]
@@ -373,6 +394,10 @@ mapProgram prog mapper = goP prog
         goE (ExLit l mt) = do
             rl <- goL l
             h_e $ ExLit rl mt
+        goE (ExCast t e) = do
+            rt <- goT t
+            re <- goE e
+            h_e $ ExCast rt re
         goE (ExBinOp bo e1 e2 mt) = do
             rbo <- goBO bo
             re1 <- goE e1
diff --git a/nl/mandel.nl b/nl/mandel.nl
index cef9eb2..2bdc25b 100644
--- a/nl/mandel.nl
+++ b/nl/mandel.nl
@@ -3,6 +3,7 @@ type char = i8;
 type string = ptr(char);
 
 extern func void(int) putchar;
+extern func u64(string) strlen;
 
 void printnum(int n) {
 	if (n < 0) {
@@ -53,12 +54,16 @@ int main() {
 	hincr = 0.0625;
 	vincr = 0.0625;
 
+	string shade = " .,-:!%@#";
+	int shadelen = cast(int)(strlen(shade));
+
 	double y = tbound;
 	while (y >= bbound) {
 		double x = lbound;
 		while (x <= rbound) {
 			int niter = mandeliter(x, y);
-			printnum(niter);
+			putchar(*(shade + niter*(shadelen-1)/maxiter));
+			// printnum(niter);
 			putchar(' ');
 			x = x + hincr;
 		}
diff --git a/parser.hs b/parser.hs
index 6e8b828..942c63c 100644
--- a/parser.hs
+++ b/parser.hs
@@ -99,7 +99,16 @@ exprTable =
     prefix name op = E.Prefix (exUnOp_ op <$ symbol name)
 
 pExpression :: Parser Expression
-pExpression = E.buildExpressionParser exprTable pExLit
+pExpression = E.buildExpressionParser exprTable (pExCast <|> pExLit)
+
+pExCast :: Parser Expression
+pExCast = do
+    symbol "cast"
+    symbol "("
+    t <- pType
+    symbol ")"
+    e <- pParenExpr
+    return $ ExCast t e
 
 pExLit :: Parser Expression
 pExLit = (exLit_ <$> pLiteral) <|> pParenExpr
-- 
cgit v1.2.3