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-70-g09d2