Floats, bugfixes, small reorganisations

6 files changed, 298 insertions, 100 deletions

diff --git a/ast.hs b/ast.hs
index 8cecab6..b1b31b7 100644
--- a/ast.hs
+++ b/ast.hs
@@ -38,6 +38,7 @@ data Type = TypeInt Int
   deriving (Show, Eq)
 
 data Literal = LitInt Integer
+             | LitFloat Double
              | LitString String
              | LitVar Name
              | LitCall Name [Expression]
@@ -127,6 +128,7 @@ instance PShow Type where
 
 instance PShow Literal where
     pshow (LitInt i) = pshow i
+    pshow (LitFloat x) = pshow x
     pshow (LitString s) = pshow s
     pshow (LitVar n) = n
     pshow (LitCall n a) = concat [n, "(", intercalate ", " (map pshow a), ")"]
diff --git a/check.hs b/check.hs
index 9b8ffc6..22d8196 100644
--- a/check.hs
+++ b/check.hs
@@ -141,6 +141,7 @@ 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@(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)
                                              (Map.lookup n names)
@@ -156,7 +157,7 @@ typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls
                       in if canConvert argtype (snd ft !! i)
                           then return a
                           else Left $ "Cannot convert type '" ++ pshow argtype ++ "' to '" ++ pshow (snd ft !! i)
-                                      ++ "' in call of function '" ++ pshow n ++ "'"
+                                      ++ "' in call of function '" ++ n ++ "'"
         return $ ExLit (LitCall n rargs) (Just (fst ft))
     goE names (ExBinOp bo e1 e2 _) = do
         re1 <- goE names e1
@@ -196,7 +197,12 @@ canConvert :: Type -> Type -> Bool
 canConvert x y | x == y = True
 canConvert (TypeInt f) (TypeInt t) = f <= t
 canConvert (TypeUInt f) (TypeUInt t) = f <= t
+canConvert (TypeUInt 1) (TypeInt _) = True
 canConvert TypeFloat TypeDouble = True
+canConvert (TypeInt _) TypeFloat = True
+canConvert (TypeInt _) TypeDouble = True
+canConvert (TypeUInt _) TypeFloat = True
+canConvert (TypeUInt _) TypeDouble = True
 canConvert _ _ = False
 
 arithBO, compareBO, logicBO, complogBO :: [BinaryOperator]
@@ -206,30 +212,32 @@ logicBO = [BoolAnd, BoolOr]
 complogBO = compareBO ++ logicBO
 
 resultTypeBO :: BinaryOperator -> Type -> Type -> Maybe Type
-resultTypeBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeInt 1
-resultTypeBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeInt 1
+resultTypeBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeUInt 1
+resultTypeBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeUInt 1
 resultTypeBO _ (TypePtr _) _ = Nothing
 resultTypeBO _ _ (TypePtr _) = Nothing
 
 resultTypeBO bo (TypeInt s1) (TypeInt s2) | bo `elem` arithBO = Just $ TypeInt (max s1 s2)
-resultTypeBO bo (TypeInt _) (TypeInt _) | bo `elem` complogBO = Just $ TypeInt 1
+resultTypeBO bo (TypeInt _) (TypeInt _) | bo `elem` complogBO = Just $ TypeUInt 1
 
 resultTypeBO bo (TypeUInt s1) (TypeUInt s2) | bo `elem` arithBO = Just $ TypeUInt (max s1 s2)
-resultTypeBO bo (TypeUInt _) (TypeUInt _) | bo `elem` complogBO = Just $ TypeInt 1
+resultTypeBO bo (TypeUInt _) (TypeUInt _) | bo `elem` complogBO = Just $ TypeUInt 1
 
-resultTypeBO bo t1 t2 | bo `elem` complogBO && t1 == t2 = Just $ TypeInt 1
+resultTypeBO bo t1 t2 | bo `elem` complogBO && t1 == t2 = Just $ TypeUInt 1
 
-resultTypeBO bo TypeFloat (TypeInt s) | s <= 24  = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-resultTypeBO bo (TypeInt s) TypeFloat | s <= 24  = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-resultTypeBO bo TypeDouble (TypeInt s) | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
-resultTypeBO bo (TypeInt s) TypeDouble | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
-resultTypeBO bo TypeFloat TypeDouble = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-resultTypeBO bo TypeDouble TypeFloat = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
+resultTypeBO bo TypeFloat (TypeInt s) | s <= 24  = Just $ if bo `elem` arithBO then TypeFloat else TypeUInt 1
+resultTypeBO bo (TypeInt s) TypeFloat | s <= 24  = Just $ if bo `elem` arithBO then TypeFloat else TypeUInt 1
+resultTypeBO bo TypeDouble (TypeInt s) | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1
+resultTypeBO bo (TypeInt s) TypeDouble | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1
+resultTypeBO bo TypeFloat TypeFloat = Just $ if bo `elem` arithBO then TypeFloat else TypeUInt 1
+resultTypeBO bo TypeDouble TypeDouble = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1
+resultTypeBO bo TypeFloat TypeDouble = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1
+resultTypeBO bo TypeDouble TypeFloat = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1
 
 resultTypeBO _ _ _ = Nothing
 
 resultTypeUO :: UnaryOperator -> Type -> Maybe Type
-resultTypeUO Not _ = Just $ TypeInt 1
+resultTypeUO Not _ = Just $ TypeUInt 1
 resultTypeUO Address t = Just $ TypePtr t
 resultTypeUO uo t@(TypeInt _) | uo `elem` [Negate, Invert] = Just t
 resultTypeUO uo t@(TypeUInt _) | uo `elem` [Negate, Invert] = Just t
@@ -238,6 +246,11 @@ resultTypeUO Negate TypeDouble = Just TypeDouble
 resultTypeUO Dereference t@(TypePtr _) = Just t
 resultTypeUO _ _ = Nothing
 
+smallestFloatType :: Double -> Type
+smallestFloatType d =
+    let truncfloat = realToFrac (realToFrac d :: Float) :: Double
+    in if d == truncfloat then TypeFloat else TypeDouble
+
 smallestIntType :: Integer -> Type
 smallestIntType i
     | i >= -2^7 && i < 2^7 = TypeInt 8
@@ -391,6 +404,7 @@ mapProgram prog mapper = goP prog
         goL :: MapperHandler Literal
         goL l@(LitString _) = h_l l
         goL l@(LitInt _) = h_l l
+        goL l@(LitFloat _) = h_l l
         goL (LitVar n) = goN n >>= (h_l . LitVar)
         goL (LitCall n a) = do
             rn <- goN n
diff --git a/codegen.hs b/codegen.hs
index f1c4305..e56caa4 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -72,7 +72,7 @@ newBlock = do
     name <- getNewName ".bb"
     state $ \s -> (name, s {
             currentBlock = Just name,
-            allBlocks = Map.insert name (A.BasicBlock (A.Name name) [] undefined) $ allBlocks s
+            allBlocks = Map.insert name (A.BasicBlock (A.Name name) [] (A.Do $ A.Unreachable [])) $ allBlocks s
         })
 
 newBlockJump :: LLName -> CGMonad LLName
@@ -116,6 +116,12 @@ setTerminator term = do
     let replace (A.BasicBlock n il _) = A.BasicBlock n il (A.Do term)
     state $ \s -> ((), s {allBlocks = Map.adjust replace (fromJust (currentBlock s)) (allBlocks s)})
 
+getTerminator :: CGMonad (A.Named A.Terminator)
+getTerminator = do
+    s <- get
+    let (A.BasicBlock _ _ t) = fromJust $ Map.lookup (fromJust $ currentBlock s) (allBlocks s)
+    return t
+
 setCurrentFunction :: Declaration -> CGMonad ()
 setCurrentFunction dec = do
     state $ \s -> ((), s {currentFunction = dec})
@@ -385,56 +391,67 @@ genSingle (StWhile cexpr st) following = do
 genExpression :: Expression -> CGMonad A.Operand
 genExpression (ExLit lit (Just t)) = literalToOperand lit t
 genExpression (ExBinOp bo e1 e2 (Just t)) = do
-    e1op <- genExprArgument e1
-    e2op <- genExprArgument e2
     case bo of
         Plus -> do
-            e1op' <- castOperand e1op t
-            e2op' <- castOperand e2op t
+            e1op <- genExprArgument e1 >>= flip castOperand t
+            e2op <- genExprArgument e2 >>= flip castOperand t
             label <- case t of
-                (TypeInt _) -> addInstr $ A.Add False False e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.Add False False e1op' e2op' []
-                TypeFloat -> addInstr $ A.FAdd A.NoFastMathFlags e1op' e2op' []
-                TypeDouble -> addInstr $ A.FAdd A.NoFastMathFlags e1op' e2op' []
-                (TypePtr _) -> addInstr $ A.Add False False e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.Add False False e1op e2op []
+                (TypeUInt _) -> addInstr $ A.Add False False e1op e2op []
+                TypeFloat -> addInstr $ A.FAdd A.NoFastMathFlags e1op e2op []
+                TypeDouble -> addInstr $ A.FAdd A.NoFastMathFlags e1op e2op []
+                (TypePtr _) -> throwError $ "Plus '+' operator not defined on pointers"
                 (TypeFunc _ _) -> throwError $ "Plus '+' operator not defined on function pointers"
                 (TypeName _) -> undefined
                 TypeVoid -> undefined
             return $ A.LocalReference (toLLVMType t) (A.Name label)
         Minus -> do
-            e1op' <- castOperand e1op t
-            e2op' <- castOperand e2op t
+            e1op <- genExprArgument e1 >>= flip castOperand t
+            e2op <- genExprArgument e2 >>= flip castOperand t
             label <- case t of
-                (TypeInt _) -> addInstr $ A.Sub False False e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.Sub False False e1op' e2op' []
-                TypeFloat -> addInstr $ A.FSub A.NoFastMathFlags e1op' e2op' []
-                TypeDouble -> addInstr $ A.FSub A.NoFastMathFlags e1op' e2op' []
-                (TypePtr _) -> addInstr $ A.Sub False False e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.Sub False False e1op e2op []
+                (TypeUInt _) -> addInstr $ A.Sub False False e1op e2op []
+                TypeFloat -> addInstr $ A.FSub A.NoFastMathFlags e1op e2op []
+                TypeDouble -> addInstr $ A.FSub A.NoFastMathFlags e1op e2op []
+                (TypePtr _) -> throwError $ "Minus '-' operator not defined on pointers"
                 (TypeFunc _ _) -> throwError $ "Minus '-' operator not defined on function pointers"
                 (TypeName _) -> undefined
                 TypeVoid -> undefined
             return $ A.LocalReference (toLLVMType t) (A.Name label)
+        Times -> do
+            e1op <- genExprArgument e1 >>= flip castOperand t
+            e2op <- genExprArgument e2 >>= flip castOperand t
+            label <- case t of
+                (TypeInt _) -> addInstr $ A.Mul False False e1op e2op []
+                (TypeUInt _) -> addInstr $ A.Mul False False e1op e2op []
+                TypeFloat -> addInstr $ A.FMul A.NoFastMathFlags e1op e2op []
+                TypeDouble -> addInstr $ A.FMul A.NoFastMathFlags e1op e2op []
+                (TypePtr _) -> throwError $ "Multiply '*' operator not defined on pointers"
+                (TypeFunc _ _) -> throwError $ "Multiply '*' operator not defined on function pointers"
+                (TypeName _) -> undefined
+                TypeVoid -> undefined
+            return $ A.LocalReference (toLLVMType t) (A.Name label)
         Divide -> do
-            e1op' <- castOperand e1op t
-            e2op' <- castOperand e2op t
+            e1op <- genExprArgument e1 >>= flip castOperand t
+            e2op <- genExprArgument e2 >>= flip castOperand t
             label <- case t of
-                (TypeInt _) -> addInstr $ A.SDiv False e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.UDiv False e1op' e2op' []
-                TypeFloat -> addInstr $ A.FDiv A.NoFastMathFlags e1op' e2op' []
-                TypeDouble -> addInstr $ A.FDiv A.NoFastMathFlags e1op' e2op' []
-                (TypePtr _) -> throwError $ "Modulo '%' operator not defined on pointers"
+                (TypeInt _) -> addInstr $ A.SDiv False e1op e2op []
+                (TypeUInt _) -> addInstr $ A.UDiv False e1op e2op []
+                TypeFloat -> addInstr $ A.FDiv A.NoFastMathFlags e1op e2op []
+                TypeDouble -> addInstr $ A.FDiv A.NoFastMathFlags e1op e2op []
+                (TypePtr _) -> throwError $ "Divide '/' operator not defined on pointers"
                 (TypeFunc _ _) -> throwError $ "Divide '/' operator not defined on function pointers"
                 (TypeName _) -> undefined
                 TypeVoid -> undefined
             return $ A.LocalReference (toLLVMType t) (A.Name label)
         Modulo -> do
-            e1op' <- castOperand e1op t
-            e2op' <- castOperand e2op t
+            e1op <- genExprArgument e1 >>= flip castOperand t
+            e2op <- genExprArgument e2 >>= flip castOperand t
             label <- case t of
-                (TypeInt _) -> addInstr $ A.SRem e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.URem e1op' e2op' []
-                TypeFloat -> addInstr $ A.FRem A.NoFastMathFlags e1op' e2op' []
-                TypeDouble -> addInstr $ A.FRem A.NoFastMathFlags e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.SRem e1op e2op []
+                (TypeUInt _) -> addInstr $ A.URem e1op e2op []
+                TypeFloat -> addInstr $ A.FRem A.NoFastMathFlags e1op e2op []
+                TypeDouble -> addInstr $ A.FRem A.NoFastMathFlags e1op e2op []
                 (TypePtr _) -> throwError $ "Modulo '%' operator not defined on pointers"
                 (TypeFunc _ _) -> throwError $ "Modulo '%' operator not defined on function pointers"
                 (TypeName _) -> undefined
@@ -442,79 +459,100 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
             return $ A.LocalReference (toLLVMType t) (A.Name label)
         Equal -> do
             sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
-            e1op' <- castOperand e1op sharedType
-            e2op' <- castOperand e2op sharedType
+            e1op <- genExprArgument e1 >>= flip castOperand sharedType
+            e2op <- genExprArgument e2 >>= flip castOperand sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.IP.EQ e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.ICmp A.IP.EQ e1op' e2op' []
-                TypeFloat -> addInstr $ A.FCmp A.FPP.OEQ e1op' e2op' []
-                TypeDouble -> addInstr $ A.FCmp A.FPP.OEQ e1op' e2op' []
-                (TypePtr _) -> addInstr $ A.ICmp A.IP.EQ e1op' e2op' []
-                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.EQ e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.ICmp A.IP.EQ e1op e2op []
+                (TypeUInt _) -> addInstr $ A.ICmp A.IP.EQ e1op e2op []
+                TypeFloat -> addInstr $ A.FCmp A.FPP.OEQ e1op e2op []
+                TypeDouble -> addInstr $ A.FCmp A.FPP.OEQ e1op e2op []
+                (TypePtr _) -> addInstr $ A.ICmp A.IP.EQ e1op e2op []
+                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.EQ e1op e2op []
                 (TypeName _) -> undefined
                 TypeVoid -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         Greater -> do
             sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
-            e1op' <- castOperand e1op sharedType
-            e2op' <- castOperand e2op sharedType
+            e1op <- genExprArgument e1 >>= flip castOperand sharedType
+            e2op <- genExprArgument e2 >>= flip castOperand sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.IP.SGT e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.ICmp A.IP.UGT e1op' e2op' []
-                TypeFloat -> addInstr $ A.FCmp A.FPP.OGT e1op' e2op' []
-                TypeDouble -> addInstr $ A.FCmp A.FPP.OGT e1op' e2op' []
-                (TypePtr _) -> addInstr $ A.ICmp A.IP.UGT e1op' e2op' []
-                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.UGT e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.ICmp A.IP.SGT e1op e2op []
+                (TypeUInt _) -> addInstr $ A.ICmp A.IP.UGT e1op e2op []
+                TypeFloat -> addInstr $ A.FCmp A.FPP.OGT e1op e2op []
+                TypeDouble -> addInstr $ A.FCmp A.FPP.OGT e1op e2op []
+                (TypePtr _) -> addInstr $ A.ICmp A.IP.UGT e1op e2op []
+                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.UGT e1op e2op []
                 (TypeName _) -> undefined
                 TypeVoid -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         Less -> do
             sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
-            e1op' <- castOperand e1op sharedType
-            e2op' <- castOperand e2op sharedType
+            e1op <- genExprArgument e1 >>= flip castOperand sharedType
+            e2op <- genExprArgument e2 >>= flip castOperand sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.IP.SLT e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.ICmp A.IP.ULT e1op' e2op' []
-                TypeFloat -> addInstr $ A.FCmp A.FPP.OLT e1op' e2op' []
-                TypeDouble -> addInstr $ A.FCmp A.FPP.OLT e1op' e2op' []
-                (TypePtr _) -> addInstr $ A.ICmp A.IP.ULT e1op' e2op' []
-                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.ULT e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.ICmp A.IP.SLT e1op e2op []
+                (TypeUInt _) -> addInstr $ A.ICmp A.IP.ULT e1op e2op []
+                TypeFloat -> addInstr $ A.FCmp A.FPP.OLT e1op e2op []
+                TypeDouble -> addInstr $ A.FCmp A.FPP.OLT e1op e2op []
+                (TypePtr _) -> addInstr $ A.ICmp A.IP.ULT e1op e2op []
+                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.ULT e1op e2op []
                 (TypeName _) -> undefined
                 TypeVoid -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         GEqual -> do
             sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
-            e1op' <- castOperand e1op sharedType
-            e2op' <- castOperand e2op sharedType
+            e1op <- genExprArgument e1 >>= flip castOperand sharedType
+            e2op <- genExprArgument e2 >>= flip castOperand sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.IP.SGE e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.ICmp A.IP.UGE e1op' e2op' []
-                TypeFloat -> addInstr $ A.FCmp A.FPP.OGE e1op' e2op' []
-                TypeDouble -> addInstr $ A.FCmp A.FPP.OGE e1op' e2op' []
-                (TypePtr _) -> addInstr $ A.ICmp A.IP.UGE e1op' e2op' []
-                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.UGE e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.ICmp A.IP.SGE e1op e2op []
+                (TypeUInt _) -> addInstr $ A.ICmp A.IP.UGE e1op e2op []
+                TypeFloat -> addInstr $ A.FCmp A.FPP.OGE e1op e2op []
+                TypeDouble -> addInstr $ A.FCmp A.FPP.OGE e1op e2op []
+                (TypePtr _) -> addInstr $ A.ICmp A.IP.UGE e1op e2op []
+                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.UGE e1op e2op []
                 (TypeName _) -> undefined
                 TypeVoid -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         LEqual -> do
             sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
-            e1op' <- castOperand e1op sharedType
-            e2op' <- castOperand e2op sharedType
+            e1op <- genExprArgument e1 >>= flip castOperand sharedType
+            e2op <- genExprArgument e2 >>= flip castOperand sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.IP.SLE e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.ICmp A.IP.ULE e1op' e2op' []
-                TypeFloat -> addInstr $ A.FCmp A.FPP.OLE e1op' e2op' []
-                TypeDouble -> addInstr $ A.FCmp A.FPP.OLE e1op' e2op' []
-                (TypePtr _) -> addInstr $ A.ICmp A.IP.ULE e1op' e2op' []
-                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.ULE e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.ICmp A.IP.SLE e1op e2op []
+                (TypeUInt _) -> addInstr $ A.ICmp A.IP.ULE e1op e2op []
+                TypeFloat -> addInstr $ A.FCmp A.FPP.OLE e1op e2op []
+                TypeDouble -> addInstr $ A.FCmp A.FPP.OLE e1op e2op []
+                (TypePtr _) -> addInstr $ A.ICmp A.IP.ULE e1op e2op []
+                (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.ULE e1op e2op []
                 (TypeName _) -> undefined
                 TypeVoid -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
-        BoolOr -> do
-            e1op' <- castToBool e1op
-            e2op' <- castToBool e2op
-            label <- addInstr $ A.Or e1op' e2op' []
-            return $ A.LocalReference (A.IntegerType 1) (A.Name label)
+        BoolAnd -> do
+            firstbb <- liftM (fromJust . currentBlock) get
+            (A.LocalReference (A.IntegerType 1) (A.Name label1)) <- genExprArgument e1 >>= castToBool
+            (A.Do origterm) <- getTerminator
+
+            bb2 <- newBlock
+            (A.LocalReference (A.IntegerType 1) (A.Name label2)) <- genExprArgument e2 >>= castToBool
+
+            bb3 <- newBlock
+
+            changeBlock firstbb
+            setTerminator $ A.CondBr (A.LocalReference A.i1 (A.Name label1)) (A.Name bb2) (A.Name bb3) []
+
+            changeBlock bb2
+            setTerminator $ A.Br (A.Name bb3) []
+
+            changeBlock bb3
+            setTerminator origterm
+            reslabel <- addInstr $ A.Phi A.i1 [(A.ConstantOperand (A.C.Int 1 0), A.Name firstbb),
+                                               (A.LocalReference A.i1 (A.Name label2), A.Name bb2)] []
+            return $ A.LocalReference A.i1 (A.Name reslabel)
+        -- BoolOr -> do
+        --     e1op' <- castToBool e1op
+        --     e2op' <- castToBool e2op
+        --     label <- addInstr $ A.Or e1op' e2op' []
+        --     return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         _ -> throwError $ "Binary operator " ++ pshow bo ++ " not implemented"
 genExpression (ExUnOp uo e1 (Just t)) = do
     e1op <- genExprArgument e1
@@ -530,6 +568,22 @@ genExpression (ExUnOp uo e1 (Just t)) = do
                 (TypeFunc _ _) -> throwError $ "Negate '-' operator not defined on a function pointer"
                 TypeVoid -> undefined
             return $ A.LocalReference (toLLVMType t) (A.Name label)
+        Not -> do
+            label <- case t of
+                (TypeInt s) -> addInstr $ A.ICmp A.IP.EQ (A.ConstantOperand (A.C.Int (fromIntegral s) 0)) e1op []
+                (TypeUInt s) -> addInstr $ A.ICmp A.IP.EQ (A.ConstantOperand (A.C.Int (fromIntegral s) 0)) e1op []
+                TypeFloat -> addInstr $ A.FCmp A.FPP.OEQ (A.ConstantOperand (A.C.Float (A.F.Single 0))) e1op []
+                TypeDouble -> addInstr $ A.FCmp A.FPP.OEQ (A.ConstantOperand (A.C.Float (A.F.Double 0))) e1op []
+                (TypePtr _) -> addInstr $ A.ICmp A.IP.EQ (A.ConstantOperand (A.C.Null (toLLVMType t))) e1op []
+                (TypeName _) -> undefined
+                (TypeFunc _ _) -> throwError $ "Not '!' operator not defined on a function pointer"
+                TypeVoid -> undefined
+            return $ A.LocalReference (toLLVMType t) (A.Name label)
+        Dereference -> do
+            label <- case t of
+                (TypePtr _) -> addInstr $ A.Load False e1op Nothing 0 []
+                _ -> throwError $ "Dereference '*' operator only defined on pointers"
+            return $ A.LocalReference (toLLVMType t) (A.Name label)
         _ -> throwError $ "Unary operator " ++ pshow uo ++ " not implemented"
 genExpression ex = throwError $ "Expression '" ++ pshow ex ++ "' not implemented"
 
@@ -540,6 +594,8 @@ genExprArgument expr = case expr of
 
 literalToOperand :: Literal -> Type -> CGMonad A.Operand
 literalToOperand (LitInt i) (TypeInt sz) = return $ A.ConstantOperand (A.C.Int (fromIntegral sz) i)
+literalToOperand (LitFloat f) TypeFloat = return $ A.ConstantOperand (A.C.Float (A.F.Single (realToFrac f)))
+literalToOperand (LitFloat f) TypeDouble = return $ A.ConstantOperand (A.C.Float (A.F.Double f))
 literalToOperand (LitVar n) t = do
     oper <- variableOperand n
     oper' <- castOperand oper t
@@ -572,9 +628,21 @@ literalToOperand (LitCall n args) _ = do
 literalToOperand lit _ = throwError $ "Literal '" ++ pshow lit ++ "' not implemented"
 
 castOperand :: A.Operand -> Type -> CGMonad A.Operand
-castOperand orig@(A.LocalReference (A.IntegerType 1) _) t2@(TypeInt _) = do
-    label <- addInstr $ A.ZExt orig (toLLVMType t2) []
-    return $ A.LocalReference (toLLVMType t2) (A.Name label)
+castOperand orig@(A.ConstantOperand (A.C.Int s1 val)) t2@(TypeInt s2)
+    | fromIntegral s1 == s2 = return orig
+    | fromIntegral s1 < s2 = return $ A.ConstantOperand (A.C.Int (fromIntegral s2) val)
+    | fromIntegral s1 > s2 = throwError $ "Integer " ++ show val ++ " too large for type '" ++ pshow t2 ++ "'"
+castOperand (A.ConstantOperand (A.C.Int _ val)) TypeFloat = do
+    return $ A.ConstantOperand (A.C.Float (A.F.Single (fromIntegral val)))
+castOperand (A.ConstantOperand (A.C.Int _ val)) TypeDouble = do
+    return $ A.ConstantOperand (A.C.Float (A.F.Double (fromIntegral val)))
+castOperand orig@(A.ConstantOperand (A.C.Float (A.F.Single _))) TypeFloat = do
+    return orig
+castOperand orig@(A.ConstantOperand (A.C.Float (A.F.Double _))) TypeDouble = do
+    return orig
+castOperand (A.ConstantOperand (A.C.Float (A.F.Single f))) TypeDouble = do
+    return $ A.ConstantOperand (A.C.Float (A.F.Double (realToFrac f)))
+
 castOperand orig@(A.LocalReference (A.IntegerType s1) _) t2@(TypeInt s2)
     | fromIntegral s1 == s2 = return orig
     | fromIntegral s1 < s2 = do
@@ -582,10 +650,13 @@ castOperand orig@(A.LocalReference (A.IntegerType s1) _) t2@(TypeInt s2)
         return $ A.LocalReference (toLLVMType t2) (A.Name label)
     | fromIntegral s1 > s2 = throwError $ "Cannot implicitly cast '" ++ pshow (TypeInt (fromIntegral s1))
                                           ++ "' to '" ++ pshow t2 ++ "'"
-castOperand orig@(A.ConstantOperand (A.C.Int s1 val)) t2@(TypeInt s2)
+castOperand orig@(A.LocalReference (A.IntegerType s1) _) t2@(TypeUInt s2)
     | fromIntegral s1 == s2 = return orig
-    | fromIntegral s1 < s2 = return $ A.ConstantOperand (A.C.Int (fromIntegral s2) val)
-    | fromIntegral s1 > s2 = throwError $ "Integer " ++ show val ++ " too large for type '" ++ pshow t2 ++ "'"
+    | fromIntegral s1 < s2 = do
+        label <- addInstr $ A.ZExt orig (toLLVMType t2) []
+        return $ A.LocalReference (toLLVMType t2) (A.Name label)
+    | fromIntegral s1 > s2 = throwError $ "Cannot implicitly cast '" ++ pshow (TypeUInt (fromIntegral s1))
+                                          ++ "' to '" ++ pshow t2 ++ "'"
 castOperand orig@(A.ConstantOperand (A.C.GlobalReference (A.IntegerType s1) _)) t2@(TypeInt s2)
     | fromIntegral s1 == s2 = return orig
     | fromIntegral s1 < s2 = do
@@ -593,6 +664,22 @@ castOperand orig@(A.ConstantOperand (A.C.GlobalReference (A.IntegerType s1) _))
         return $ A.LocalReference (toLLVMType t2) (A.Name label)
     | fromIntegral s1 > s2 = throwError $ "Cannot implicitly cast '" ++ pshow (TypeInt (fromIntegral s1))
                                           ++ "' to '" ++ pshow t2 ++ "'"
+castOperand orig@(A.ConstantOperand (A.C.GlobalReference (A.IntegerType s1) _)) t2@(TypeUInt s2)
+    | fromIntegral s1 == s2 = return orig
+    | fromIntegral s1 < s2 = do
+        label <- addInstr $ A.ZExt orig (toLLVMType t2) []
+        return $ A.LocalReference (toLLVMType t2) (A.Name label)
+    | fromIntegral s1 > s2 = throwError $ "Cannot implicitly cast '" ++ pshow (TypeUInt (fromIntegral s1))
+                                          ++ "' to '" ++ pshow t2 ++ "'"
+
+castOperand orig@(A.LocalReference t _) TypeFloat | t == toLLVMType TypeFloat = do
+    return orig
+castOperand orig@(A.LocalReference t _) TypeDouble | t == toLLVMType TypeDouble = do
+    return orig
+castOperand orig@(A.LocalReference t _) TypeDouble | t == toLLVMType TypeFloat = do
+    label <- addInstr $ A.FPExt orig (toLLVMType TypeDouble) []
+    return $ A.LocalReference (toLLVMType TypeDouble) (A.Name label)
+
 castOperand orig@(A.LocalReference (A.PointerType t1 _) _) (TypePtr t2)
     | toLLVMType t2 == t1 = return orig
     | otherwise = throwError $ "Cannot implicitly cast between pointer to '" ++ show t1
@@ -605,8 +692,10 @@ castOperand orig@(A.LocalReference (A.PointerType (A.FunctionType rt1 at1 False)
     | toLLVMType rt2 == rt1 && all (uncurry (==)) (zip at1 (map toLLVMType at2)) = return orig
     | otherwise = throwError $ "Cannot implicitly cast between '" ++ show orig
                                ++ "' and '" ++ pshow t2 ++ "'"
+
 castOperand orig t2 = throwError $ "Cast from '" ++ show orig ++ "' to type '" ++ pshow t2 ++ "' not implemented"
 
+
 castToBool :: A.Operand -> CGMonad A.Operand
 castToBool orig@(A.LocalReference (A.IntegerType 1) _) =
     return orig
@@ -631,6 +720,8 @@ commonType TypeFloat (TypeInt _) = Just TypeFloat
 commonType (TypeInt _) TypeFloat = Just TypeFloat
 commonType TypeDouble (TypeInt _) = Just TypeDouble
 commonType (TypeInt _) TypeDouble = Just TypeDouble
+commonType TypeFloat TypeFloat = Just TypeFloat
+commonType TypeDouble TypeDouble = Just TypeDouble
 commonType TypeFloat TypeDouble = Just TypeDouble
 commonType TypeDouble TypeFloat = Just TypeDouble
 
@@ -716,4 +807,6 @@ toLLVMType TypeVoid = A.VoidType
 initializerFor :: Type -> A.C.Constant
 initializerFor (TypeInt s) = A.C.Int (fromIntegral s) 0
 initializerFor (TypeUInt s) = A.C.Int (fromIntegral s) 0
+initializerFor TypeFloat = A.C.Float (A.F.Single 0)
+initializerFor TypeDouble = A.C.Float (A.F.Double 0)
 initializerFor _ = undefined
diff --git a/nl/mandel.nl b/nl/mandel.nl
new file mode 100644
index 0000000..cef9eb2
--- /dev/null
+++ b/nl/mandel.nl
@@ -0,0 +1,69 @@
+type int = i32;
+type char = i8;
+type string = ptr(char);
+
+extern func void(int) putchar;
+
+void printnum(int n) {
+	if (n < 0) {
+		putchar('-');
+		n = -n;
+	}
+	if (n == 0) {
+		putchar('0');
+		return;
+	}
+	while (n > 0) {
+		putchar('0' + n % 10);
+		n = n / 10;
+	}
+}
+
+int maxiter;
+double lbound;
+double rbound;
+double tbound;
+double bbound;
+double hincr;
+double vincr;
+
+int mandeliter(double x, double y) {
+	double a = x;
+	double b = y;
+	double a2 = a * a;
+	double b2 = b * b;
+	int n = 0;
+	while (n < maxiter && a2 + b2 < 4) {
+		b = 2 * a * b + y;
+		a = a2 - b2 + x;
+		a2 = a * a;
+		b2 = b * b;
+		n = n + 1;
+	}
+	return n;
+}
+
+int main() {
+	maxiter = 32;
+	lbound = -2.0;
+	rbound = 1.0;
+	tbound = 1.5;
+	bbound = -1.5;
+	// hincr = 0.03125;
+	hincr = 0.0625;
+	vincr = 0.0625;
+
+	double y = tbound;
+	while (y >= bbound) {
+		double x = lbound;
+		while (x <= rbound) {
+			int niter = mandeliter(x, y);
+			printnum(niter);
+			putchar(' ');
+			x = x + hincr;
+		}
+		putchar('\n');
+		y = y - vincr;
+	}
+	return 0;
+}
diff --git a/parser.hs b/parser.hs
index 1b103d4..3ba5e18 100644
--- a/parser.hs
+++ b/parser.hs
@@ -112,8 +112,8 @@ pParenExpr = do
     return e
 
 pLiteral :: Parser Literal
-pLiteral = (LitInt <$> pInteger) <|> (LitInt <$> pCharStr) <|> (LitString <$> pString)
-           <|> try pLitCall <|> (LitVar <$> pName)
+pLiteral = (LitFloat <$> pFloat) <|> (LitInt <$> pInteger) <|> (LitInt <$> pCharStr)
+           <|> (LitString <$> pString) <|> try pLitCall <|> (LitVar <$> pName)
 
 pLitCall :: Parser Literal
 pLitCall = do
@@ -183,8 +183,8 @@ pStReturn = do
 
 primitiveTypes :: Map.Map String Type
 primitiveTypes = Map.fromList
-    [("i1", TypeInt 1), ("i8", TypeInt 8), ("i16", TypeInt 16), ("i32", TypeInt 32), ("i64", TypeInt 64),
-     ("u8", TypeUInt 8), ("u16", TypeUInt 16), ("u32", TypeUInt 32), ("u64", TypeUInt 64),
+    [("i8", TypeInt 8), ("i16", TypeInt 16), ("i32", TypeInt 32), ("i64", TypeInt 64),
+     ("u1", TypeUInt 1), ("u8", TypeUInt 8), ("u16", TypeUInt 16), ("u32", TypeUInt 32), ("u64", TypeUInt 64),
      ("float", TypeFloat), ("double", TypeDouble)]
 
 findPrimType :: String -> Type
@@ -231,7 +231,25 @@ pName = ((:) <$> pFirstChar <*> many pOtherChar) << pWhiteComment
           pOtherChar = satisfy (isAlpha .||. isDigit .||. (=='_'))
 
 pInteger :: Parser Integer
-pInteger = (read <$> many1 (satisfy isDigit)) << pWhiteComment
+pInteger = (read <$> many1 digit) << pWhiteComment
+
+pFloat :: Parser Double
+pFloat = try $ do
+    pre <- many1 digit
+    post <- choice [pExponent,
+                    (do
+                        void $ char '.'
+                        s <- many1 digit
+                        ex <- option "" pExponent
+                        return $ '.' : s ++ ex)]
+    pWhiteComment
+    return $ read $ pre ++ post
+  where
+    pExponent = do
+        c <- choice [char 'e', char 'E']
+        pm <- option "" $ choice [string "+", string "-"]
+        val <- many1 digit
+        return $ c : pm ++ val
 
 pString :: Parser String
 pString = do
@@ -264,7 +282,7 @@ pEscapeHex = do
     return $ chr $ 16 * c1 + c2
   where
     pHexChar :: Parser Int
-    pHexChar = (liftM (\c -> ord c - ord '0') (satisfy isDigit))
+    pHexChar = (liftM (\c -> ord c - ord '0') digit)
                <|> (liftM (\c -> ord c - ord 'a' + 10) (oneOf "abcdef"))
                <|> (liftM (\c -> ord c - ord 'A' + 10) (oneOf "ABCDEF"))
 
diff --git a/pshow.hs b/pshow.hs
index 64fbab1..6fba9ff 100644
--- a/pshow.hs
+++ b/pshow.hs
@@ -13,6 +13,8 @@ pprint = putStrLn . pshow
 instance PShow String where {pshow = show}
 instance PShow Int where {pshow = show}
 instance PShow Integer where {pshow = show}
+instance PShow Float where {pshow = show}
+instance PShow Double where {pshow = show}
 
 instance (PShow a, PShow b) => PShow (a, b) where
     pshow (a, b) = "(" ++ pshow a ++ "," ++ pshow b ++ ")"