diff options
| -rw-r--r-- | ast.hs | 3 | ||||
| -rw-r--r-- | check.hs | 25 | ||||
| -rw-r--r-- | nl/mandel.nl | 7 | ||||
| -rw-r--r-- | parser.hs | 11 |
4 files changed, 44 insertions, 2 deletions
@@ -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] @@ -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; } @@ -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 |