Generate code for global variables

4 files changed, 438 insertions, 376 deletions

diff --git a/check.hs b/check.hs
new file mode 100644
index 0000000..5f7dd12
--- /dev/null
+++ b/check.hs
@@ -0,0 +1,380 @@
+module Check(checkProgram) where
+
+import Control.Monad
+import Data.Maybe
+import qualified Data.Map.Strict as Map
+--import Debug.Trace
+
+import AST
+import PShow
+
+
+type Error a = Either String a
+
+
+checkProgram :: Program -> Error Program
+checkProgram prog = do
+    let processed = replaceTypes prog
+    checkUndefinedTypes processed
+    typeCheck processed >>= bundleVarDecls
+
+
+replaceTypes :: Program -> Program
+replaceTypes prog@(Program decls) = mapProgram' filtered mapper
+    where
+        filtered = Program $ filter notTypedef decls
+        mapper = defaultPM' {typeHandler' = typeReplacer (findTypeRenames prog)}
+
+        notTypedef :: Declaration -> Bool
+        notTypedef (DecTypedef _ _) = False
+        notTypedef _ = True
+
+        typeReplacer :: Map.Map Name Type -> Type -> Type
+        typeReplacer m t@(TypeName n) = maybe t id $ Map.lookup n m
+        typeReplacer _ t = t
+
+        findTypeRenames :: Program -> Map.Map Name Type
+        findTypeRenames (Program d) = foldl go Map.empty d
+            where
+                go :: Map.Map Name Type -> Declaration -> Map.Map Name Type
+                go m (DecTypedef t n) = Map.insert n t m
+                go m _ = m
+
+
+checkUndefinedTypes :: Program -> Error ()
+checkUndefinedTypes prog = fmap (const ()) $ mapProgram prog $ defaultPM {typeHandler = check}
+  where
+    check :: MapperHandler Type
+    check (TypeName n) = Left $ "Undefined type name '" ++ n ++ "'"
+    check t = Right t
+
+
+typeCheck :: Program -> Error Program
+typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls
+  where
+    topLevelNames :: Map.Map Name Type
+    topLevelNames = foldr (uncurry Map.insert) Map.empty pairs
+        where pairs = map ((,) <$> nameOf <*> typeOf) $ filter isVarDecl decls
+
+    functionTypes :: Map.Map Name (Type,[Type])
+    functionTypes = foldr (uncurry Map.insert) Map.empty pairs
+        where pairs = map ((,) <$> nameOf <*> getTypes) $ filter isFunctionDecl decls
+              getTypes (DecFunction rt _ args _) = (rt, map fst args)
+              getTypes _ = undefined
+
+    isVarDecl (DecVariable {}) = True
+    isVarDecl _ = False
+
+    isFunctionDecl (DecFunction {}) = True
+    isFunctionDecl _ = False
+
+    goD :: Map.Map Name Type -> Declaration -> Error Declaration
+    goD names (DecFunction frt name args body) = do
+        newbody <- goB frt (foldr (\(t,n) m -> Map.insert n t m) names args) body
+        return $ DecFunction frt name args newbody
+    goD _ dec = return dec
+
+    goB :: Type  -- function return type
+        -> Map.Map Name Type -> Block -> Error Block
+    goB frt names (Block stmts) = Block . snd <$> foldl foldfunc (return (names, [])) stmts
+      where
+        foldfunc :: Error (Map.Map Name Type, [Statement]) -> Statement -> Error (Map.Map Name Type, [Statement])
+        foldfunc ep st = do
+            (names', lst) <- ep
+            (newnames', newst) <- goS frt names' st
+            return (newnames', lst ++ [newst])  -- TODO: fix slow tail-append
+
+    goS :: Type  -- function return type
+        -> Map.Map Name Type -> Statement -> Error (Map.Map Name Type, Statement)
+    goS _ names st@(StVarDeclaration t n Nothing) = return (Map.insert n t names, st)
+    goS frt names (StVarDeclaration t n (Just e)) = do
+        (newnames, _) <- goS frt names (StVarDeclaration t n Nothing)
+        (_, StAssignment _ newe) <- goS frt newnames (StAssignment n e)
+        return (newnames, StVarDeclaration t n (Just newe))
+    goS _ names (StAssignment n e) = maybe (Left $ "Undefined variable '" ++ n ++ "'") go (Map.lookup n names)
+      where go dsttype = do
+              re <- goE names e
+              let (Just extype) = exTypeOf re
+              if canConvert extype dsttype
+                  then return (names, StAssignment n re)
+                  else Left $ "Cannot convert type '" ++ pshow extype ++ "' to '"
+                              ++ pshow dsttype ++ "' in assignment to variable '" ++ n ++ "'"
+    goS _ names st@StEmpty = return (names, st)
+    goS frt names (StBlock bl) = do
+        newbl <- goB frt names bl
+        return (names, StBlock newbl)
+    goS _ names (StExpr e) = do
+        re <- goE names e
+        return (names, StExpr re)
+    goS frt names (StIf e s1 s2) = do
+        re <- goE names e
+        (_, rs1) <- goS frt names s1
+        (_, rs2) <- goS frt names s2
+        return (names, StIf re rs1 rs2)
+    goS frt names (StWhile e s) = do
+        re <- goE names e
+        (_, rs) <- goS frt names s
+        return (names, StWhile re rs)
+    goS frt names (StReturn e) = do
+        re <- goE names e
+        let (Just extype) = exTypeOf re
+        if canConvert extype frt
+            then return (names, StReturn re)
+            else Left $ "Cannot convert type '" ++ pshow extype ++ "' to '"
+                        ++ pshow frt ++ "' in return statement"
+
+    -- 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@(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)
+    goE names (ExLit l@(LitCall n args) _) = do
+        ft <- maybe (Left $ "Unknown function '" ++ n ++ "'") return $ Map.lookup n functionTypes
+        rargs <- mapM (goE names) args
+        when (length rargs /= length (snd ft))
+            $ Left ("Expected " ++ show (length (snd ft)) ++ "arguments to "
+                    ++ "function '" ++ n ++ "', but got " ++ show (length rargs))
+              >> return ()
+        flip mapM_ rargs $
+            \a -> let argtype = fromJust (exTypeOf a)
+                  in if canConvert argtype (fst ft)
+                      then return a
+                      else Left $ "Cannot convert type '" ++ pshow argtype ++ "' to '" ++ pshow (fst ft)
+                                  ++ "' in call of function '" ++ pshow n ++ "'"
+        return $ ExLit l (Just (fst ft))
+    goE names (ExBinOp bo e1 e2 _) = do
+        re1 <- goE names e1
+        re2 <- goE names e2
+        maybe (Left $ "Cannot use operator '" ++ pshow bo ++ "' with argument types '"
+                      ++ pshow (fromJust $ exTypeOf re1) ++ "' and '" ++ pshow (fromJust $ exTypeOf re2) ++ "'")
+              (return . ExBinOp bo re1 re2 . Just)
+              $ typeCompatibleBO bo (fromJust $ exTypeOf re1) (fromJust $ exTypeOf re2)
+    goE names (ExUnOp uo e _) = do
+        re <- goE names e
+        maybe (Left $ "Cannot use operator '" ++ pshow uo ++ "' with argument type '" ++ pshow (fromJust $ exTypeOf re))
+              (return . ExUnOp uo re . Just)
+              $ typeCompatibleUO uo (fromJust $ exTypeOf re)
+
+
+bundleVarDecls :: Program -> Error Program
+bundleVarDecls prog = mapProgram prog $ defaultPM {blockHandler = goBlock}
+  where
+    goBlock :: MapperHandler Block
+    goBlock (Block stmts) =
+        let isVarDecl (StVarDeclaration {}) = True
+            isVarDecl _ = False
+
+            removeDecls [] = []
+            removeDecls ((StVarDeclaration _ n (Just ex)):rest) = StAssignment n ex : removeDecls rest
+            removeDecls ((StVarDeclaration _ _ Nothing):rest) = removeDecls rest
+            removeDecls (st:rest) = st : removeDecls rest
+
+            onlyDecl (StVarDeclaration t n _) = StVarDeclaration t n Nothing
+            onlyDecl _ = undefined
+
+            vdecls = map onlyDecl $ filter isVarDecl stmts
+        in return $ Block $ vdecls ++ removeDecls stmts
+
+
+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 TypeFloat TypeDouble = True
+canConvert _ _ = False
+
+arithBO, compareBO, logicBO, complogBO :: [BinaryOperator]
+arithBO = [Plus, Minus, Times, Divide, Modulo]
+compareBO = [Equal, Unequal, Greater, Less, GEqual, LEqual]
+logicBO = [BoolAnd, BoolOr]
+complogBO = compareBO ++ logicBO
+
+typeCompatibleBO :: BinaryOperator -> Type -> Type -> Maybe Type
+typeCompatibleBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeInt 1
+typeCompatibleBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeInt 1
+typeCompatibleBO _ (TypePtr _) _ = Nothing
+typeCompatibleBO _ _ (TypePtr _) = Nothing
+
+typeCompatibleBO bo (TypeInt s1) (TypeInt s2) | bo `elem` arithBO = Just $ TypeInt (max s1 s2)
+typeCompatibleBO bo (TypeInt _) (TypeInt _) | bo `elem` complogBO = Just $ TypeInt 1
+
+typeCompatibleBO bo (TypeUInt s1) (TypeUInt s2) | bo `elem` arithBO = Just $ TypeUInt (max s1 s2)
+typeCompatibleBO bo (TypeUInt _) (TypeUInt _) | bo `elem` complogBO = Just $ TypeInt 1
+
+typeCompatibleBO bo t1 t2 | bo `elem` complogBO && t1 == t2 = Just $ TypeInt 1
+
+typeCompatibleBO bo TypeFloat (TypeInt s) | s <= 24  = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
+typeCompatibleBO bo (TypeInt s) TypeFloat | s <= 24  = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
+typeCompatibleBO bo TypeDouble (TypeInt s) | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
+typeCompatibleBO bo (TypeInt s) TypeDouble | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
+typeCompatibleBO bo TypeFloat TypeDouble = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
+typeCompatibleBO bo TypeDouble TypeFloat = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
+
+typeCompatibleBO _ _ _ = Nothing
+
+typeCompatibleUO :: UnaryOperator -> Type -> Maybe Type
+typeCompatibleUO Not _ = Just $ TypeInt 1
+typeCompatibleUO Address t = Just $ TypePtr t
+typeCompatibleUO uo t@(TypeInt _) | uo `elem` [Negate, Invert] = Just t
+typeCompatibleUO uo t@(TypeUInt _) | uo `elem` [Negate, Invert] = Just t
+typeCompatibleUO Negate TypeFloat = Just TypeFloat
+typeCompatibleUO Negate TypeDouble = Just TypeDouble
+typeCompatibleUO Dereference t@(TypePtr _) = Just t
+typeCompatibleUO _ _ = Nothing
+
+smallestIntType :: Integer -> 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
+
+-- 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
+
+
+type MapperHandler a = a -> Error a
+
+data ProgramMapper = ProgramMapper
+    {declarationHandler :: MapperHandler Declaration
+    ,blockHandler :: MapperHandler Block
+    ,typeHandler :: MapperHandler Type
+    ,literalHandler :: MapperHandler Literal
+    ,binOpHandler :: MapperHandler BinaryOperator
+    ,unOpHandler :: MapperHandler UnaryOperator
+    ,expressionHandler :: MapperHandler Expression
+    ,statementHandler :: MapperHandler Statement
+    ,nameHandler :: MapperHandler Name}
+
+type MapperHandler' a = a -> a
+
+data ProgramMapper' = ProgramMapper'
+    {declarationHandler' :: MapperHandler' Declaration
+    ,blockHandler' :: MapperHandler' Block
+    ,typeHandler' :: MapperHandler' Type
+    ,literalHandler' :: MapperHandler' Literal
+    ,binOpHandler' :: MapperHandler' BinaryOperator
+    ,unOpHandler' :: MapperHandler' UnaryOperator
+    ,expressionHandler' :: MapperHandler' Expression
+    ,statementHandler' :: MapperHandler' Statement
+    ,nameHandler' :: MapperHandler' Name}
+
+defaultPM :: ProgramMapper
+defaultPM = ProgramMapper return return return return return return return return return
+
+defaultPM' :: ProgramMapper'
+defaultPM' = ProgramMapper' id id id id id id id id id
+
+mapProgram' :: Program -> ProgramMapper' -> Program
+mapProgram' prog mapper = (\(Right r) -> r) $ mapProgram prog $ ProgramMapper
+    {declarationHandler = return . declarationHandler' mapper
+    ,blockHandler       = return . blockHandler' mapper
+    ,typeHandler        = return . typeHandler' mapper
+    ,literalHandler     = return . literalHandler' mapper
+    ,binOpHandler       = return . binOpHandler' mapper
+    ,unOpHandler        = return . unOpHandler' mapper
+    ,expressionHandler  = return . expressionHandler' mapper
+    ,statementHandler   = return . statementHandler' mapper
+    ,nameHandler        = return . nameHandler' mapper}
+
+mapProgram :: Program -> ProgramMapper -> Error Program
+mapProgram prog mapper = goP prog
+    where
+        h_d = declarationHandler mapper
+        h_b = blockHandler mapper
+        h_t = typeHandler mapper
+        h_l = literalHandler mapper
+        h_bo = binOpHandler mapper
+        h_uo = unOpHandler mapper
+        h_e = expressionHandler mapper
+        h_s = statementHandler mapper
+        h_n = nameHandler mapper
+
+        goP :: MapperHandler Program
+        goP (Program decls) = Program <$> sequence (map (\d -> goD d >>= h_d) decls)
+
+        goD :: MapperHandler Declaration
+        goD (DecFunction t n a b) = do
+            rt <- goT t
+            rn <- goN n
+            ra <- sequence $ map (\(at,an) -> (,) <$> goT at <*> goN an) a
+            rb <- goB b
+            h_d $ DecFunction rt rn ra rb
+        goD (DecVariable t n mv) = do
+            rt <- goT t
+            rn <- goN n
+            rmv <- sequence $ fmap goE mv
+            h_d $ DecVariable rt rn rmv
+        goD (DecTypedef t n) = do
+            rt <- goT t
+            rn <- goN n
+            h_d $ DecTypedef rt rn
+
+        goT :: MapperHandler Type
+        goT (TypePtr t) = goT t >>= (h_t . TypePtr)
+        goT (TypeName n) = goN n >>= (h_t . TypeName)
+        goT t = h_t t
+
+        goN :: MapperHandler Name
+        goN = h_n
+
+        goB :: MapperHandler Block
+        goB (Block sts) = (Block <$> sequence (map goS sts)) >>= h_b
+
+        goE :: MapperHandler Expression
+        goE (ExLit l mt) = do
+            rl <- goL l
+            h_e $ ExLit rl mt
+        goE (ExBinOp bo e1 e2 mt) = do
+            rbo <- goBO bo
+            re1 <- goE e1
+            re2 <- goE e2
+            h_e $ ExBinOp rbo re1 re2 mt
+        goE (ExUnOp uo e mt) = do
+            ruo <- goUO uo
+            re <- goE e
+            h_e $ ExUnOp ruo re mt
+
+        goS :: MapperHandler Statement
+        goS StEmpty = h_s StEmpty
+        goS (StBlock b) = goB b >>= (h_s . StBlock)
+        goS (StExpr e) = goE e >>= (h_s . StExpr)
+        goS (StVarDeclaration t n me) = do
+            rt <- goT t
+            rn <- goN n
+            rme <- sequence $ fmap goE me
+            h_s $ StVarDeclaration rt rn rme
+        goS (StAssignment n e) = do
+            rn <- goN n
+            re <- goE e
+            h_s $ StAssignment rn re
+        goS (StIf e s1 s2) = do
+            re <- goE e
+            rs1 <- goS s1
+            rs2 <- goS s2
+            h_s $ StIf re rs1 rs2
+        goS (StWhile e s) = do
+            re <- goE e
+            rs <- goS s
+            h_s $ StWhile re rs
+        goS (StReturn e) = goE e >>= (h_s . StReturn)
+
+        goL :: MapperHandler Literal
+        goL l@(LitString _) = h_l l
+        goL l@(LitInt _) = h_l l
+        goL (LitVar n) = goN n >>= (h_l . LitVar)
+        goL (LitCall n a) = do
+            rn <- goN n
+            ra <- sequence $ map goE a
+            h_l $ LitCall rn ra
+
+        goBO :: MapperHandler BinaryOperator
+        goBO = h_bo
+
+        goUO :: MapperHandler UnaryOperator
+        goUO = h_uo
diff --git a/codegen.hs b/codegen.hs
index f314c63..1a7a907 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -1,19 +1,18 @@
-module Codegen(codegen, A.Module) where
-
-import Control.Monad
-import Data.Maybe
-import qualified Data.Map.Strict as Map
--- import qualified LLVM.General.AST.Type as A
--- import qualified LLVM.General.AST.Global as A
--- import qualified LLVM.General.AST.Constant as A.C
+module Codegen(codegen) where
+
+-- import Control.Monad
+-- import Data.Maybe
+-- import qualified Data.Map.Strict as Map
+import qualified LLVM.General.AST.Type as A
+import qualified LLVM.General.AST.Global as A.G
+import qualified LLVM.General.AST.Constant as A.C
 -- import qualified LLVM.General.AST.Operand as A
 -- import qualified LLVM.General.AST.Name as A
 -- import qualified LLVM.General.AST.Instruction as A
 import qualified LLVM.General.AST as A
-import Debug.Trace
+-- import Debug.Trace
 
 import AST
-import PShow
 
 
 type Error a = Either String a
@@ -24,378 +23,46 @@ codegen :: Program  -- Program to compile
         -> String   -- File name of source
         -> Error A.Module
 codegen prog name fname = do
-    defs <- generateDefs (preprocess prog)
+    defs <- generateDefs prog
     return $ A.defaultModule {
             A.moduleName = name,
             A.moduleSourceFileName = fname,
             A.moduleDefinitions = defs
         }
 
-preprocess :: Program -> Program
-preprocess prog@(Program decls) = mapProgram' filtered mapper
-    where
-        filtered = Program $ filter notTypedef decls
-        mapper = defaultPM' {typeHandler' = typeReplacer (findTypeRenames prog)}
-
-        notTypedef :: Declaration -> Bool
-        notTypedef (DecTypedef _ _) = False
-        notTypedef _ = True
-
-        typeReplacer :: Map.Map Name Type -> Type -> Type
-        typeReplacer m t@(TypeName n) = maybe t id $ Map.lookup n m
-        typeReplacer _ t = t
-
-        findTypeRenames :: Program -> Map.Map Name Type
-        findTypeRenames (Program d) = foldl go Map.empty d
-            where
-                go :: Map.Map Name Type -> Declaration -> Map.Map Name Type
-                go m (DecTypedef t n) = Map.insert n t m
-                go m _ = m
-
 
 generateDefs :: Program -> Error [A.Definition]
 generateDefs prog = do
-    checkUndefinedTypes prog
-    checked <- typeCheck prog
-    collected <- collectVarDecls checked
-    void $ trace "Collected:" $ return []
-    void $ trace (pshow collected) $ return []
-    void $ fail "TODO"
-    return []
-
-checkUndefinedTypes :: Program -> Error ()
-checkUndefinedTypes prog = fmap (const ()) $ mapProgram prog $ defaultPM {typeHandler = check}
-  where
-    check :: MapperHandler Type
-    check (TypeName n) = Left $ "Undefined type name '" ++ n ++ "'"
-    check t = Right t
-
-
-typeCheck :: Program -> Error Program
-typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls
-  where
-    topLevelNames :: Map.Map Name Type
-    topLevelNames = foldr (uncurry Map.insert) Map.empty pairs
-        where pairs = map ((,) <$> nameOf <*> typeOf) $ filter isVarDecl decls
-
-    functionTypes :: Map.Map Name (Type,[Type])
-    functionTypes = foldr (uncurry Map.insert) Map.empty pairs
-        where pairs = map ((,) <$> nameOf <*> getTypes) $ filter isFunctionDecl decls
-              getTypes (DecFunction rt _ args _) = (rt, map fst args)
-              getTypes _ = undefined
-
-    isVarDecl (DecVariable {}) = True
-    isVarDecl _ = False
-
-    isFunctionDecl (DecFunction {}) = True
-    isFunctionDecl _ = False
+    vardecls <- genGlobalVars prog
+    return vardecls
 
-    goD :: Map.Map Name Type -> Declaration -> Error Declaration
-    goD names (DecFunction frt name args body) = do
-        newbody <- goB frt (foldr (\(t,n) m -> Map.insert n t m) names args) body
-        return $ DecFunction frt name args newbody
-    goD _ dec = return dec
-
-    goB :: Type  -- function return type
-        -> Map.Map Name Type -> Block -> Error Block
-    goB frt names (Block stmts) = Block . snd <$> foldl foldfunc (return (names, [])) stmts
-      where
-        foldfunc :: Error (Map.Map Name Type, [Statement]) -> Statement -> Error (Map.Map Name Type, [Statement])
-        foldfunc ep st = do
-            (names', lst) <- ep
-            (newnames', newst) <- goS frt names' st
-            return (newnames', lst ++ [newst])  -- TODO: fix slow tail-append
-
-    goS :: Type  -- function return type
-        -> Map.Map Name Type -> Statement -> Error (Map.Map Name Type, Statement)
-    goS _ names st@(StVarDeclaration t n Nothing) = return (Map.insert n t names, st)
-    goS frt names (StVarDeclaration t n (Just e)) = do
-        (newnames, _) <- goS frt names (StVarDeclaration t n Nothing)
-        goS frt newnames (StAssignment n e)
-    goS _ names (StAssignment n e) = maybe (Left $ "Undefined variable '" ++ n ++ "'") go (Map.lookup n names)
-      where go dsttype = do
-              re <- goE names e
-              let (Just extype) = exTypeOf re
-              if canConvert extype dsttype
-                  then return (names, StAssignment n re)
-                  else Left $ "Cannot convert type '" ++ pshow extype ++ "' to '"
-                              ++ pshow dsttype ++ "' in assignment to variable '" ++ n ++ "'"
-    goS _ names st@StEmpty = return (names, st)
-    goS frt names (StBlock bl) = do
-        newbl <- goB frt names bl
-        return (names, StBlock newbl)
-    goS _ names (StExpr e) = do
-        re <- goE names e
-        return (names, StExpr re)
-    goS frt names (StIf e s1 s2) = do
-        re <- goE names e
-        (_, rs1) <- goS frt names s1
-        (_, rs2) <- goS frt names s2
-        return (names, StIf re rs1 rs2)
-    goS frt names (StWhile e s) = do
-        re <- goE names e
-        (_, rs) <- goS frt names s
-        return (names, StWhile re rs)
-    goS frt names (StReturn e) = do
-        re <- goE names e
-        let (Just extype) = exTypeOf re
-        if canConvert extype frt
-            then return (names, StReturn re)
-            else Left $ "Cannot convert type '" ++ pshow extype ++ "' to '"
-                        ++ pshow frt ++ "' in return statement"
-
-    -- 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@(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)
-    goE names (ExLit l@(LitCall n args) _) = do
-        ft <- maybe (Left $ "Unknown function '" ++ n ++ "'") return $ Map.lookup n functionTypes
-        rargs <- mapM (goE names) args
-        when (length rargs /= length (snd ft))
-            $ Left ("Expected " ++ show (length (snd ft)) ++ "arguments to "
-                    ++ "function '" ++ n ++ "', but got " ++ show (length rargs))
-              >> return ()
-        flip mapM_ rargs $
-            \a -> let argtype = fromJust (exTypeOf a)
-                  in if canConvert argtype (fst ft)
-                      then return a
-                      else Left $ "Cannot convert type '" ++ pshow argtype ++ "' to '" ++ pshow (fst ft)
-                                  ++ "' in call of function '" ++ pshow n ++ "'"
-        return $ ExLit l (Just (fst ft))
-    goE names (ExBinOp bo e1 e2 _) = do
-        re1 <- goE names e1
-        re2 <- goE names e2
-        maybe (Left $ "Cannot use operator '" ++ pshow bo ++ "' with argument types '"
-                      ++ pshow (fromJust $ exTypeOf re1) ++ "' and '" ++ pshow (fromJust $ exTypeOf re2) ++ "'")
-              (return . ExBinOp bo re1 re2 . Just)
-              $ typeCompatibleBO bo (fromJust $ exTypeOf re1) (fromJust $ exTypeOf re2)
-    goE names (ExUnOp uo e _) = do
-        re <- goE names e
-        maybe (Left $ "Cannot use operator '" ++ pshow uo ++ "' with argument type '" ++ pshow (fromJust $ exTypeOf re))
-              (return . ExUnOp uo re . Just)
-              $ typeCompatibleUO uo (fromJust $ exTypeOf re)
-
-
-collectVarDecls :: Program -> Error Program
-collectVarDecls prog = mapProgram prog $ defaultPM {blockHandler = goBlock}
+genGlobalVars :: Program -> Error [A.Definition]
+genGlobalVars (Program decs) = mapM gen $ filter isDecVariable decs
   where
-    goBlock :: MapperHandler Block
-    goBlock (Block stmts) =
-        let isVarDecl (StVarDeclaration {}) = True
-            isVarDecl _ = False
-
-            removeDecls [] = []
-            removeDecls ((StVarDeclaration _ n (Just ex)):rest) = StAssignment n ex : removeDecls rest
-            removeDecls ((StVarDeclaration _ _ Nothing):rest) = removeDecls rest
-            removeDecls (st:rest) = st : removeDecls rest
-
-            onlyDecl (StVarDeclaration t n _) = StVarDeclaration t n Nothing
-            onlyDecl _ = undefined
-
-            vdecls = map onlyDecl $ filter isVarDecl stmts
-        in return $ Block $ vdecls ++ removeDecls stmts
-
-
-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 TypeFloat TypeDouble = True
-canConvert _ _ = False
-
-arithBO, compareBO, logicBO, complogBO :: [BinaryOperator]
-arithBO = [Plus, Minus, Times, Divide, Modulo]
-compareBO = [Equal, Unequal, Greater, Less, GEqual, LEqual]
-logicBO = [BoolAnd, BoolOr]
-complogBO = compareBO ++ logicBO
-
-typeCompatibleBO :: BinaryOperator -> Type -> Type -> Maybe Type
-typeCompatibleBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeInt 1
-typeCompatibleBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeInt 1
-typeCompatibleBO _ (TypePtr _) _ = Nothing
-typeCompatibleBO _ _ (TypePtr _) = Nothing
-
-typeCompatibleBO bo (TypeInt s1) (TypeInt s2) | bo `elem` arithBO = Just $ TypeInt (max s1 s2)
-typeCompatibleBO bo (TypeInt _) (TypeInt _) | bo `elem` complogBO = Just $ TypeInt 1
-
-typeCompatibleBO bo (TypeUInt s1) (TypeUInt s2) | bo `elem` arithBO = Just $ TypeUInt (max s1 s2)
-typeCompatibleBO bo (TypeUInt _) (TypeUInt _) | bo `elem` complogBO = Just $ TypeInt 1
-
-typeCompatibleBO bo t1 t2 | bo `elem` complogBO && t1 == t2 = Just $ TypeInt 1
-
-typeCompatibleBO bo TypeFloat (TypeInt s) | s <= 24  = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-typeCompatibleBO bo (TypeInt s) TypeFloat | s <= 24  = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-typeCompatibleBO bo TypeDouble (TypeInt s) | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
-typeCompatibleBO bo (TypeInt s) TypeDouble | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
-typeCompatibleBO bo TypeFloat TypeDouble = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-typeCompatibleBO bo TypeDouble TypeFloat = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-
-typeCompatibleBO _ _ _ = Nothing
-
-typeCompatibleUO :: UnaryOperator -> Type -> Maybe Type
-typeCompatibleUO Not _ = Just $ TypeInt 1
-typeCompatibleUO Address t = Just $ TypePtr t
-typeCompatibleUO uo t@(TypeInt _) | uo `elem` [Negate, Invert] = Just t
-typeCompatibleUO uo t@(TypeUInt _) | uo `elem` [Negate, Invert] = Just t
-typeCompatibleUO Negate TypeFloat = Just TypeFloat
-typeCompatibleUO Negate TypeDouble = Just TypeDouble
-typeCompatibleUO Dereference t@(TypePtr _) = Just t
-typeCompatibleUO _ _ = Nothing
-
-smallestIntType :: Integer -> 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
-
--- 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
-
-
-type MapperHandler a = a -> Error a
-
-data ProgramMapper = ProgramMapper
-    {declarationHandler :: MapperHandler Declaration
-    ,blockHandler :: MapperHandler Block
-    ,typeHandler :: MapperHandler Type
-    ,literalHandler :: MapperHandler Literal
-    ,binOpHandler :: MapperHandler BinaryOperator
-    ,unOpHandler :: MapperHandler UnaryOperator
-    ,expressionHandler :: MapperHandler Expression
-    ,statementHandler :: MapperHandler Statement
-    ,nameHandler :: MapperHandler Name}
-
-type MapperHandler' a = a -> a
-
-data ProgramMapper' = ProgramMapper'
-    {declarationHandler' :: MapperHandler' Declaration
-    ,blockHandler' :: MapperHandler' Block
-    ,typeHandler' :: MapperHandler' Type
-    ,literalHandler' :: MapperHandler' Literal
-    ,binOpHandler' :: MapperHandler' BinaryOperator
-    ,unOpHandler' :: MapperHandler' UnaryOperator
-    ,expressionHandler' :: MapperHandler' Expression
-    ,statementHandler' :: MapperHandler' Statement
-    ,nameHandler' :: MapperHandler' Name}
-
-defaultPM :: ProgramMapper
-defaultPM = ProgramMapper return return return return return return return return return
-
-defaultPM' :: ProgramMapper'
-defaultPM' = ProgramMapper' id id id id id id id id id
-
-mapProgram' :: Program -> ProgramMapper' -> Program
-mapProgram' prog mapper = (\(Right r) -> r) $ mapProgram prog $ ProgramMapper
-    {declarationHandler = return . declarationHandler' mapper
-    ,blockHandler       = return . blockHandler' mapper
-    ,typeHandler        = return . typeHandler' mapper
-    ,literalHandler     = return . literalHandler' mapper
-    ,binOpHandler       = return . binOpHandler' mapper
-    ,unOpHandler        = return . unOpHandler' mapper
-    ,expressionHandler  = return . expressionHandler' mapper
-    ,statementHandler   = return . statementHandler' mapper
-    ,nameHandler        = return . nameHandler' mapper}
-
-mapProgram :: Program -> ProgramMapper -> Error Program
-mapProgram prog mapper = goP prog
-    where
-        h_d = declarationHandler mapper
-        h_b = blockHandler mapper
-        h_t = typeHandler mapper
-        h_l = literalHandler mapper
-        h_bo = binOpHandler mapper
-        h_uo = unOpHandler mapper
-        h_e = expressionHandler mapper
-        h_s = statementHandler mapper
-        h_n = nameHandler mapper
-
-        goP :: MapperHandler Program
-        goP (Program decls) = Program <$> sequence (map (\d -> goD d >>= h_d) decls)
-
-        goD :: MapperHandler Declaration
-        goD (DecFunction t n a b) = do
-            rt <- goT t
-            rn <- goN n
-            ra <- sequence $ map (\(at,an) -> (,) <$> goT at <*> goN an) a
-            rb <- goB b
-            h_d $ DecFunction rt rn ra rb
-        goD (DecVariable t n mv) = do
-            rt <- goT t
-            rn <- goN n
-            rmv <- sequence $ fmap goE mv
-            h_d $ DecVariable rt rn rmv
-        goD (DecTypedef t n) = do
-            rt <- goT t
-            rn <- goN n
-            h_d $ DecTypedef rt rn
-
-        goT :: MapperHandler Type
-        goT (TypePtr t) = goT t >>= (h_t . TypePtr)
-        goT (TypeName n) = goN n >>= (h_t . TypeName)
-        goT t = h_t t
-
-        goN :: MapperHandler Name
-        goN = h_n
-
-        goB :: MapperHandler Block
-        goB (Block sts) = (Block <$> sequence (map goS sts)) >>= h_b
-
-        goE :: MapperHandler Expression
-        goE (ExLit l mt) = do
-            rl <- goL l
-            h_e $ ExLit rl mt
-        goE (ExBinOp bo e1 e2 mt) = do
-            rbo <- goBO bo
-            re1 <- goE e1
-            re2 <- goE e2
-            h_e $ ExBinOp rbo re1 re2 mt
-        goE (ExUnOp uo e mt) = do
-            ruo <- goUO uo
-            re <- goE e
-            h_e $ ExUnOp ruo re mt
-
-        goS :: MapperHandler Statement
-        goS StEmpty = h_s StEmpty
-        goS (StBlock b) = goB b >>= (h_s . StBlock)
-        goS (StExpr e) = goE e >>= (h_s . StExpr)
-        goS (StVarDeclaration t n me) = do
-            rt <- goT t
-            rn <- goN n
-            rme <- sequence $ fmap goE me
-            h_s $ StVarDeclaration rt rn rme
-        goS (StAssignment n e) = do
-            rn <- goN n
-            re <- goE e
-            h_s $ StAssignment rn re
-        goS (StIf e s1 s2) = do
-            re <- goE e
-            rs1 <- goS s1
-            rs2 <- goS s2
-            h_s $ StIf re rs1 rs2
-        goS (StWhile e s) = do
-            re <- goE e
-            rs <- goS s
-            h_s $ StWhile re rs
-        goS (StReturn e) = goE e >>= (h_s . StReturn)
-
-        goL :: MapperHandler Literal
-        goL l@(LitString _) = h_l l
-        goL l@(LitInt _) = h_l l
-        goL (LitVar n) = goN n >>= (h_l . LitVar)
-        goL (LitCall n a) = do
-            rn <- goN n
-            ra <- sequence $ map goE a
-            h_l $ LitCall rn ra
-
-        goBO :: MapperHandler BinaryOperator
-        goBO = h_bo
-
-        goUO :: MapperHandler UnaryOperator
-        goUO = h_uo
+    gen (DecVariable t n Nothing) = return $ A.GlobalDefinition $
+            A.globalVariableDefaults {
+                A.G.name = A.Name n,
+                A.G.type' = toLLVMType t,
+                A.G.initializer = Just $ initializerFor t
+            }
+    gen (DecVariable _ _ (Just _)) = Left $ "Initialised global variables not supported yet"
+    gen _ = undefined
+
+
+toLLVMType :: Type -> A.Type
+toLLVMType (TypeInt s) = A.IntegerType $ fromIntegral s
+toLLVMType (TypeUInt s) = A.IntegerType $ fromIntegral s
+toLLVMType TypeFloat = A.float
+toLLVMType TypeDouble = A.double
+toLLVMType (TypePtr t) = A.ptr $ toLLVMType t
+toLLVMType (TypeName _) = undefined
+
+initializerFor :: Type -> A.C.Constant
+initializerFor (TypeInt s) = A.C.Int (fromIntegral s) 0
+initializerFor (TypeUInt s) = A.C.Int (fromIntegral s) 0
+initializerFor _ = undefined
+
+
+isDecVariable :: Declaration -> Bool
+isDecVariable (DecVariable {}) = True
+isDecVariable _ = False
diff --git a/main.hs b/main.hs
index 962a01d..7828034 100644
--- a/main.hs
+++ b/main.hs
@@ -5,6 +5,7 @@ import Data.Either
 import System.Environment
 import System.Exit
 
+import Check
 import Codegen
 import Parser
 import PShow
@@ -33,7 +34,12 @@ main = do
     when (isLeft parseResult) $ dieShow $ fromLeft parseResult
     
     let ast = fromRight parseResult
-    -- print ast
     putStrLn $ pshow ast
 
-    either die print $ codegen ast "Module" fname
+    checked <- either die return $ checkProgram ast
+    putStrLn "After checking:"
+    putStrLn $ pshow checked
+
+    llvmMod <- either die return $ codegen checked "Module" fname
+    putStrLn "Module:"
+    print llvmMod
diff --git a/simple.nl b/simple.nl
new file mode 100644
index 0000000..c45e2ca
--- /dev/null
+++ b/simple.nl
@@ -0,0 +1,9 @@
+type int = i32;
+type char = i8;
+
+int g_var;
+
+int main(i32 argc, ptr(ptr(i8)) argv) {
+	int i = g_var;
+	int a = i + 2;
+}