Initial -- dump of stuff

12 files changed, 944 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..aea9637
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,7 @@
+*.hi
+*.o
+main
+
+ll/gen
+ll/test.s
+ll/test
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..cb0faab
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,18 @@
+GHC = ghc
+GHCFLAGS = -Wall -O3
+
+TARGET = main
+
+.PHONY: all clean remake
+
+all: $(TARGET)
+
+clean:
+	rm -f $(TARGET) *.o *.hi
+
+remake: clean
+	make all
+
+
+$(TARGET): *.hs
+	$(GHC) $(GHCFLAGS) $^ -o $@
diff --git a/ast.hs b/ast.hs
new file mode 100644
index 0000000..bd845df
--- /dev/null
+++ b/ast.hs
@@ -0,0 +1,148 @@
+module AST(
+    Name,
+    Program(..), Declaration(..), Block(..), Type(..), Literal(..),
+    BinaryOperator(..), UnaryOperator(..), Expression(..), Statement(..)) where
+
+import Data.List
+
+import PShow
+
+
+type Name = String
+
+data Program = Program [Declaration]
+  deriving (Show)
+
+data Declaration
+    = DecFunction {typeOf :: Type
+                  ,nameOf :: Name
+                  ,argumentsOf :: [(Type, Name)]
+                  ,bodyOf :: Block}
+    | DecVariable {typeOf :: Type
+                  ,nameOf :: Name
+                  ,valueOf :: Maybe Expression}
+    | DecTypedef {typeOf :: Type
+                 ,nameOf :: Name}
+  deriving (Show)
+
+data Block = Block [Statement]
+  deriving (Show)
+
+data Type = TypeInt Int
+          | TypeUInt Int
+          | TypeFloat
+          | TypeDouble
+          | TypePtr Type
+          | TypeName Name
+  deriving (Show, Eq)
+
+data Literal = LitInt Integer
+             | LitString String
+             | LitVar Name
+             | LitCall Name [Expression]
+  deriving (Show)
+
+data BinaryOperator
+    = Plus | Minus | Times | Divide | Modulo
+    | Equal | Unequal | Greater | Less | GEqual | LEqual
+    | BoolAnd | BoolOr
+  deriving (Show, Eq)
+
+data UnaryOperator
+    = Negate | Not | Invert | Dereference | Address
+  deriving (Show, Eq)
+
+data Expression
+    = ExLit Literal
+    | ExBinOp BinaryOperator Expression Expression
+    | ExUnOp UnaryOperator Expression
+  deriving (Show)
+
+data Statement
+    = StEmpty
+    | StBlock Block
+    | StExpr Expression
+    | StVarDeclaration Type Name (Maybe Expression)
+    | StAssignment Name Expression
+    | StIf Expression Statement Statement
+    | StWhile Expression Statement
+    | StReturn Expression
+  deriving (Show)
+
+
+indent :: Int -> String -> String
+indent sz str = intercalate "\n" $ map (prefix++) $ lines str
+    where prefix = replicate sz ' '
+
+
+instance PShow Program where
+    pshow (Program decls) = intercalate "\n" (map pshow decls)
+
+instance PShow Declaration where
+    pshow (DecFunction t n a b) =
+        concat [pshow t, " ", n, "(", intercalate ", " (map pshowArg a), ") ", pshow b]
+      where pshowArg (argt, argn) = concat [pshow argt, " ", argn]
+    pshow (DecVariable t n Nothing) =
+        concat [pshow t, " ", n, ";"]
+    pshow (DecVariable t n (Just e)) =
+        concat [pshow t, " ", n, " = ", pshow e, ";"]
+    pshow (DecTypedef t n) =
+        concat ["type ", n, " = ", pshow t, ";"]
+
+instance PShow Block where
+    pshow (Block []) = "{}"
+    pshow (Block stmts) = concat ["{\n", indent 4 $ intercalate "\n" (map pshow stmts), "\n}"]
+
+instance PShow Type where
+    pshow (TypeInt sz) = 'i' : pshow sz
+    pshow (TypeUInt sz) = 'u' : pshow sz
+    pshow TypeFloat = "float"
+    pshow TypeDouble = "double"
+    pshow (TypePtr t) = concat ["ptr(", pshow t, ")"]
+    pshow (TypeName n) = n
+
+instance PShow Literal where
+    pshow (LitInt i) = pshow i
+    pshow (LitString s) = pshow s
+    pshow (LitVar n) = n
+    pshow (LitCall n a) = concat [n, "(", intercalate ", " (map pshow a), ")"]
+
+instance PShow BinaryOperator where
+    pshow Plus = "+"
+    pshow Minus = "-"
+    pshow Times = "*"
+    pshow Divide = "/"
+    pshow Modulo = "%"
+    pshow Equal = "=="
+    pshow Unequal = "!="
+    pshow Greater = ">"
+    pshow Less = "<"
+    pshow GEqual = ">="
+    pshow LEqual = "<="
+    pshow BoolAnd = "&&"
+    pshow BoolOr = "||"
+
+instance PShow UnaryOperator where
+    pshow Negate = "-"
+    pshow Not = "!"
+    pshow Invert = "~"
+    pshow Dereference = "*"
+    pshow Address = "&"
+
+instance PShow Expression where
+    pshow (ExLit lit) = pshow lit
+    pshow (ExBinOp op a b) = concat [pshow a, " ", pshow op, " ", pshow b]
+    pshow (ExUnOp op a) = concat [pshow op, pshow a]
+
+instance PShow Statement where
+    pshow StEmpty = ";"
+    pshow (StBlock bl) = pshow bl
+    pshow (StExpr e) = pshow e ++ ";"
+    pshow (StVarDeclaration t n Nothing) = concat [pshow t, " ", n, ";"]
+    pshow (StVarDeclaration t n (Just e)) = concat [pshow t, " ", n, " = ", pshow e, ";"]
+    pshow (StAssignment n e) = concat [n, " = ", pshow e, ";"]
+    pshow (StIf c t StEmpty) = concat ["if (", pshow c, ") ", pshow t]
+    pshow (StIf c t@(StBlock _) e) = concat ["if (", pshow c, ") ", pshow t, " else ", pshow e]
+    pshow (StIf c t e) = concat ["if (", pshow c, ") ", pshow t, "\nelse ", pshow e]
+    pshow (StWhile c s) = concat ["while (", pshow c, ") ", pshow s]
+    pshow (StReturn e) = concat ["return ", pshow e, ";"]
diff --git a/codegen.hs b/codegen.hs
new file mode 100644
index 0000000..f2c35b4
--- /dev/null
+++ b/codegen.hs
@@ -0,0 +1,238 @@
+module Codegen(module Codegen, A.Module) where
+
+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
+-- 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 AST
+
+
+type Error a = Either String a
+
+
+codegen :: Program  -- Program to compile
+        -> String   -- Module name
+        -> String   -- File name of source
+        -> Error A.Module
+codegen prog name fname = do
+    defs <- generateDefs (preprocess 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
+    checkUndefinedVars prog
+    fail "TODO"
+    return []
+
+checkUndefinedTypes :: Program -> Error ()
+checkUndefinedTypes prog = fmap (const ()) $ mapProgram prog $ defaultPM {typeHandler = check}
+    where
+        check :: Type -> Error Type
+        check (TypeName n) = Left $ "Undefined type name '" ++ n ++ "'"
+        check t = Right t
+
+-- checkUndefinedVars :: Program -> Error ()
+-- checkUndefinedVars prog = do
+
+
+-- mapTypes' :: Program -> (Type -> Type) -> Program
+-- mapTypes' prog f = (\(Right res) -> res) $ mapTypes prog (return . f)
+
+-- mapTypes :: Program -> (Type -> Error Type) -> Error Program
+-- mapTypes (Program decls) f = Program <$> sequence (map goD decls)
+--     where
+--         handler :: Type -> Error Type
+--         handler (TypePtr t) = f t >>= f . TypePtr
+--         handler t = f t
+
+--         goD :: Declaration -> Error Declaration
+--         goD (DecFunction t n a b) = do
+--             rt <- handler t
+--             ra <- sequence $ map (\(at,an) -> (\art -> (art,an)) <$> handler at) a
+--             rb <- goB b
+--             return $ DecFunction rt n ra rb
+--         goD (DecVariable t n v) = (\rt -> DecVariable rt n v) <$> handler t
+--         goD (DecTypedef t n) = (\rt -> DecTypedef rt n) <$> handler t
+
+--         goB :: Block -> Error Block
+--         goB (Block stmts) = Block <$> sequence (map goS stmts)
+
+--         goS :: Statement -> Error Statement
+--         goS (StBlock bl) = StBlock <$> goB bl
+--         goS (StVarDeclaration t n e) = (\rt -> StVarDeclaration rt n e) <$> handler t
+--         goS (StIf c t e) = do
+--             rt <- goS t
+--             re <- goS e
+--             return $ StIf c rt re
+--         goS (StWhile c b) = StWhile c <$> goS b
+--         goS s = return s
+
+
+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 :: Program -> Error Program
+        goP (Program decls) = Program <$> sequence (map (\d -> goD d >>= h_d) decls)
+
+        goD :: Declaration -> Error 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 :: Type -> Error Type
+        goT (TypePtr t) = goT t >>= (h_t . TypePtr)
+        goT (TypeName n) = goN n >>= (h_t . TypeName)
+        goT t = h_t t
+
+        goN :: Name -> Error Name
+        goN = h_n
+
+        goB :: Block -> Error Block
+        goB (Block sts) = (Block <$> sequence (map goS sts)) >>= h_b
+
+        goE :: Expression -> Error Expression
+        goE (ExLit l) = goL l >>= (h_e . ExLit)
+        goE (ExBinOp bo e1 e2) = do
+            rbo <- goBO bo
+            re1 <- goE e1
+            re2 <- goE e2
+            h_e $ ExBinOp rbo re1 re2
+        goE (ExUnOp uo e) = do
+            ruo <- goUO uo
+            re <- goE e
+            h_e $ ExUnOp ruo re
+
+        goS :: Statement -> Error 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 :: Literal -> Error Literal
+        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 :: BinaryOperator -> Error BinaryOperator
+        goBO = h_bo
+
+        goUO :: UnaryOperator -> Error UnaryOperator
+        goUO = h_uo
diff --git a/ll/Makefile b/ll/Makefile
new file mode 100644
index 0000000..f19648f
--- /dev/null
+++ b/ll/Makefile
@@ -0,0 +1,16 @@
+.PHONY: all clean remake
+
+all: test
+
+clean:
+	rm test test.s
+
+remake: clean
+	make all
+
+
+test: test.s
+	clang -Wall -Wextra $< -o $@
+
+test.s: test.ll
+	llc -W $< -o $@
diff --git a/ll/ding.c b/ll/ding.c
new file mode 100644
index 0000000..b6b4bf2
--- /dev/null
+++ b/ll/ding.c
@@ -0,0 +1,30 @@
+#include <stdio.h>
+
+int mandeliter(double x,double y){
+	double a=x,b=y;
+	int n=0;
+	while(n<256){
+		double na=a*a-b*b+x;
+		double nb=2*a*b+y;
+		a=na;
+		b=nb;
+		if(a*a+b*b>4)break;
+		n++;
+	}
+	return n;
+}
+
+int main(void){
+	double x,y;
+	y=1.5;
+	while(y>=-1.5){
+		x=-2;
+		while(x<=1){
+			int n=mandeliter(x,y);
+			printf("%3d ",n);
+			x+=0.0625;
+		}
+		y-=0.125;
+		putchar('\n');
+	}
+}
diff --git a/ll/gen.hs b/ll/gen.hs
new file mode 100644
index 0000000..907a489
--- /dev/null
+++ b/ll/gen.hs
@@ -0,0 +1,57 @@
+import qualified LLVM.General.AST.Type as AST
+import qualified LLVM.General.AST.Global as AST
+import qualified LLVM.General.AST.Constant as AST.C
+import qualified LLVM.General.AST.Operand as AST
+import qualified LLVM.General.AST.Name as AST
+import qualified LLVM.General.AST.Instruction as AST
+import qualified LLVM.General.AST as AST
+import qualified LLVM.General as General
+import qualified LLVM.General.Context as General
+import qualified LLVM.General.Target as General
+import Control.Monad.Except
+import qualified Data.ByteString as BS
+import System.Exit
+
+
+bb1 :: AST.BasicBlock
+bb1 = AST.BasicBlock (AST.Name "bb1")
+                     [AST.Name "s" AST.:= AST.Add False False
+                                                  (AST.LocalReference AST.i32 (AST.Name "argc"))
+                                                  (AST.ConstantOperand (AST.C.Int 32 1))
+                                                  []]
+                     (AST.Do $ AST.Ret (Just $ AST.LocalReference AST.i32 (AST.Name "s")) [])
+
+func :: AST.Global
+func = AST.functionDefaults {
+        AST.returnType = AST.i32,
+        AST.name = AST.Name "main",
+        AST.parameters =
+            ([AST.Parameter AST.i32 (AST.Name "argc") [],
+              AST.Parameter (AST.ptr (AST.ptr AST.i8)) (AST.Name "argv") []],
+             False),
+        AST.basicBlocks = [bb1]
+    }
+
+topmod :: AST.Module
+topmod = AST.defaultModule {AST.moduleDefinitions = [AST.GlobalDefinition func]}
+
+
+assert :: ExceptT String IO a -> IO a
+assert ex = do
+    e <- runExceptT ex
+    either die return e >> (return $ (\(Right r) -> r) e)
+
+main :: IO ()
+main = do
+    General.withContext $ \context -> do
+        assert $ General.withModuleFromAST context topmod $ \genmod -> do
+            llvmasm <- General.moduleLLVMAssembly genmod
+            putStr llvmasm
+            putStrLn ""
+            assert $ General.withHostTargetMachine $ \machine -> do
+                General.getTargetMachineTriple machine >>= putStrLn
+                putStrLn ""
+                assert (General.moduleTargetAssembly machine genmod)
+                    >>= putStr
+                bs <- assert $ General.moduleObject machine genmod
+                BS.writeFile "output_gen.o" bs
diff --git a/ll/test.ll b/ll/test.ll
new file mode 100644
index 0000000..8da7408
--- /dev/null
+++ b/ll/test.ll
@@ -0,0 +1,104 @@
+declare i32 @printf(i8*, ...)
+declare void @putchar(i32)
+
+
+@maxiter = internal constant i32 32
+@lbound = internal constant double -2.0
+@rbound = internal constant double 1.0
+@tbound = internal constant double 1.5
+@bbound = internal constant double -1.5
+@hincr = internal constant double 0.03125
+@vincr = internal constant double 0.0625
+
+
+define internal i32 @mandeliter(double %x, double %y) {
+entry:
+	br label %loopbody
+
+loopbody:
+	%a = phi double [%x, %entry], [%na, %increment]
+	%b = phi double [%y, %entry], [%nb, %increment]
+	%n = phi i32 [0, %entry], [%nn, %increment]
+
+	%a2 = fmul double %a, %a
+	%b2 = fmul double %b, %b
+	%a2mb2 = fsub double %a2, %b2
+	%na = fadd double %a2mb2, %x
+
+	%ab = fmul double %a, %b
+	%ab2 = fadd double %ab, %ab
+	%nb = fadd double %ab2, %y
+
+	%norm = fadd double %a2, %b2
+	%cmp = fcmp ogt double %norm, 4.0
+	br i1 %cmp, label %afterloop, label %increment
+
+increment:
+	%nn = add i32 %n, 1
+	%maxiter = load i32, i32* @maxiter
+	%icmp = icmp slt i32 %nn, %maxiter
+	br i1 %icmp, label %loopbody, label %afterloop
+
+afterloop:
+	%retn = phi i32 [%n, %loopbody], [%nn, %increment]
+	ret i32 %retn
+}
+
+
+@num_formatstr = internal constant [4 x i8] c"%d \00"
+
+define internal void @printnum32(i32 %n) {
+entry:
+	%f = getelementptr [4 x i8], [4 x i8]* @num_formatstr, i64 0, i32 0
+	call i32(i8*, ...) @printf(i8* %f, i32 %n)
+	ret void
+}
+
+define internal void @printnum8(i8 %n) {
+entry:
+	%n32 = sext i8 %n to i32
+	tail call void @printnum32(i32 %n32)
+	ret void
+}
+
+
+@shadestr = internal constant [10 x i8] c" .,-:!%@#\00"
+
+
+define i32 @main() {
+entry:
+	%lbound = load double, double* @lbound
+	%rbound = load double, double* @rbound
+	%tbound = load double, double* @tbound
+	%bbound = load double, double* @bbound
+	%hincr = load double, double* @hincr
+	%vincr = load double, double* @vincr
+	br label %yloop
+
+yloop:
+	%y = phi double [%tbound, %entry], [%ny, %yloop2]
+	br label %xloop
+
+xloop:
+	%x = phi double [%lbound, %yloop], [%nx, %xloop]
+	%n = call i32 @mandeliter(double %x, double %y)
+	%nL = mul i32 %n, 8
+	%maxiter = load i32, i32* @maxiter
+	%nLdM = sdiv i32 %nL, %maxiter
+	%shadechrp = getelementptr [10 x i8], [10 x i8]* @shadestr, i64 0, i32 %nLdM
+	%shadechr = load i8, i8* %shadechrp
+	%shadeint = sext i8 %shadechr to i32
+	call void @putchar(i32 %shadeint)
+	%nx = fadd double %x, %hincr
+	%xcmp = fcmp ole double %nx, %rbound
+	br i1 %xcmp, label %xloop, label %yloop2
+
+yloop2:
+	%ny = fsub double %y, %vincr
+	call void @putchar(i32 10)
+	%ycmp = fcmp oge double %ny, %bbound
+	br i1 %ycmp, label %yloop, label %return
+
+return:
+	ret i32 0
+}
diff --git a/main.hs b/main.hs
new file mode 100644
index 0000000..e1b975a
--- /dev/null
+++ b/main.hs
@@ -0,0 +1,38 @@
+module Main where
+
+import Control.Monad
+import Data.Either
+import System.Environment
+import System.Exit
+
+import Codegen
+import Parser
+import PShow
+
+
+fromLeft :: Either a b -> a
+fromLeft (Left a) = a
+fromLeft (Right _) = error "Either is not a Left"
+
+fromRight :: Either a b -> b
+fromRight (Right b) = b
+fromRight (Left _) = error "Either is not a Right"
+
+dieShow :: (Show a) => a -> IO ()
+dieShow = die . show
+
+
+main :: IO ()
+main = do
+    args <- getArgs
+    when (length args /= 1) $ die "Pass NL file name as a command-line parameter"
+
+    let fname = args !! 0
+    parseResult <- (\file -> parseProgram file fname) <$> readFile fname
+
+    when (isLeft parseResult) $ dieShow $ fromLeft parseResult
+    
+    let ast = fromRight parseResult
+    pprint ast
+
+    either die print $ codegen ast "Module" fname
diff --git a/parser.hs b/parser.hs
new file mode 100644
index 0000000..7359ccf
--- /dev/null
+++ b/parser.hs
@@ -0,0 +1,252 @@
+module Parser(parseProgram) where
+
+import Control.Monad
+import Data.Char
+import Data.Functor.Identity
+import Data.Maybe
+import qualified Data.Map.Strict as Map
+import Text.Parsec
+import qualified Text.Parsec.Expr as E
+
+import AST
+
+
+type Parser = Parsec String ()
+
+
+(<<) :: (Monad m) => m a -> m b -> m a
+(<<) = (<*)
+
+
+parseProgram :: String -> String -> Either ParseError Program
+parseProgram source fname = parse pProgram fname source
+
+-- parse' :: Parser a -> String -> Either ParseError a
+-- parse' p s = parse p "" s
+
+pProgram :: Parser Program
+pProgram = pWhiteComment >> (Program <$> many1 pDeclaration)
+
+pDeclaration :: Parser Declaration
+pDeclaration = pDecTypedef <|> do
+    t <- pType
+    n <- pName
+    pDecFunction' t n <|> pDecVariable' t n
+
+pDecTypedef :: Parser Declaration
+pDecTypedef = do
+    symbol "type"
+    n <- pName
+    symbol "="
+    t <- pType
+    symbol ";"
+    return $ DecTypedef t n
+
+pDecFunction' :: Type -> Name -> Parser Declaration
+pDecFunction' t n = do
+    symbol "("
+    a <- sepBy ((,) <$> pType <*> pName) (symbol ",")
+    symbol ")"
+    b <- pBlock
+    return $ DecFunction t n a b
+
+pDecVariable' :: Type -> Name -> Parser Declaration
+pDecVariable' t n = do
+    e <- (Just <$> (symbol "=" >> pExpression)) <|> return Nothing
+    symbol ";"
+    return $ DecVariable t n e
+
+pBlock :: Parser Block
+pBlock = do
+    symbol "{"
+    s <- many pStatement
+    symbol "}"
+    return $ Block s
+
+
+exprTable :: (E.OperatorTable String () Identity) Expression
+exprTable =
+    [[prefix "-" Negate,
+      prefix "!" Not,
+      prefix "~" Invert,
+      prefix "*" Dereference,
+      prefix "&" Address],
+     [binary "*" Times E.AssocLeft,
+      binary "/" Divide E.AssocLeft,
+      binary "%" Modulo E.AssocLeft],
+     [binary "+" Plus E.AssocLeft,
+      binary "-" Minus E.AssocLeft],
+     [binary ">" Greater E.AssocNone,
+      binary "<" Less E.AssocNone,
+      binary ">=" GEqual E.AssocNone,
+      binary "<=" LEqual E.AssocNone],
+     [binary "==" Equal E.AssocNone,
+      binary "!=" Unequal E.AssocNone],
+     [binary "&&" BoolAnd E.AssocLeft,
+      binary "||" BoolOr E.AssocLeft]]
+  where
+    binary name op assoc = E.Infix (ExBinOp op <$ symbol name) assoc
+    prefix name op = E.Prefix (ExUnOp op <$ symbol name)
+
+pExpression :: Parser Expression
+pExpression = E.buildExpressionParser exprTable pExLit
+
+pExLit :: Parser Expression
+pExLit = ExLit <$> pLiteral
+
+pLiteral :: Parser Literal
+pLiteral = (LitInt <$> pInteger) <|> (LitString <$> pString)
+           <|> try pLitCall <|> (LitVar <$> pName)
+
+pLitCall :: Parser Literal
+pLitCall = do
+    n <- pName
+    symbol "("
+    a <- sepBy pExpression (symbol ",")
+    symbol ")"
+    return $ LitCall n a
+
+
+pStatement :: Parser Statement
+pStatement = pStEmpty <|> pStIf <|> pStWhile <|> pStReturn <|> pStBlock
+             <|> try pStAssignment <|> pStVarDeclaration <|> pStExpr
+
+pStEmpty :: Parser Statement
+pStEmpty = symbol ";" >> return StEmpty
+
+pStBlock :: Parser Statement
+pStBlock = StBlock <$> pBlock
+
+pStVarDeclaration :: Parser Statement
+pStVarDeclaration = do
+    t <- pType
+    n <- pName
+    e <- optionMaybe (symbol "=" >> pExpression)
+    symbol ";"
+    return $ StVarDeclaration t n e
+
+pStExpr :: Parser Statement
+pStExpr = (StExpr <$> pExpression) << symbol ";"
+
+pStAssignment :: Parser Statement
+pStAssignment = do
+    n <- pName
+    symbol "="
+    e <- pExpression
+    symbol ";"
+    return $ StAssignment n e
+
+pStIf :: Parser Statement
+pStIf = do
+    symbol "if"
+    symbol "("
+    c <- pExpression
+    symbol ")"
+    t <- pStatement
+    e <- (symbol "else" >> pStatement) <|> return StEmpty
+    return $ StIf c t e
+
+pStWhile :: Parser Statement
+pStWhile = do
+    symbol "while"
+    symbol "("
+    c <- pExpression
+    symbol ")"
+    b <- pStatement
+    return $ StWhile c b
+
+pStReturn :: Parser Statement
+pStReturn = do
+    symbol "return"
+    e <- pExpression
+    symbol ";"
+    return $ StReturn e
+
+
+primitiveTypes :: Map.Map String Type
+primitiveTypes = Map.fromList
+    [("i8", TypeInt 8), ("i16", TypeInt 16), ("i32", TypeInt 32), ("i64", TypeInt 64),
+     ("u8", TypeUInt 8), ("u16", TypeUInt 16), ("u32", TypeUInt 32), ("u64", TypeUInt 64),
+     ("float", TypeFloat), ("double", TypeDouble)]
+
+findPrimType :: String -> Type
+findPrimType s = fromJust $ Map.lookup s primitiveTypes
+
+pType :: Parser Type
+pType = pPrimType <|> pPtrType <|> pTypeName
+
+pPrimType :: Parser Type
+pPrimType = findPrimType <$> choice (map symbol' $ Map.keys primitiveTypes)
+
+pPtrType :: Parser Type
+pPtrType = do
+    symbol "ptr"
+    symbol "("
+    t <- pType
+    symbol ")"
+    return $ TypePtr t
+
+pTypeName :: Parser Type
+pTypeName = TypeName <$> pName
+
+
+pName :: Parser Name
+pName = ((:) <$> pFirstChar <*> many pOtherChar) << pWhiteComment
+    where pFirstChar = satisfy (isLower .||. (=='_'))
+          pOtherChar = satisfy (isLower .||. isDigit .||. (=='_'))
+
+pInteger :: Parser Integer
+pInteger = (read <$> many1 (satisfy isDigit)) << pWhiteComment
+
+pString :: Parser String
+pString = do
+    void $ char '"'
+    s <- many (pEscape <|> anyChar)
+    symbol "\""
+    return s
+  where
+    pEscape :: Parser Char
+    pEscape = char '\\' >> (pEscapeN <|> pEscapeR <|> pEscapeT <|> pEscapeHex)
+
+    pEscapeN, pEscapeR, pEscapeT :: Parser Char
+    pEscapeN = '\n' <$ char 'n'
+    pEscapeR = '\r' <$ char 'r'
+    pEscapeT = '\t' <$ char 't'
+
+    pEscapeHex :: Parser Char
+    pEscapeHex = do
+        void $ char 'x'
+        c1 <- pHexChar
+        c2 <- pHexChar
+        return $ chr $ 16 * c1 + c2
+
+    pHexChar :: Parser Int
+    pHexChar = (liftM (\c -> ord c - ord '0') (satisfy isDigit))
+               <|> (liftM (\c -> ord c - ord 'a' + 10) (oneOf "abcdef"))
+               <|> (liftM (\c -> ord c - ord 'A' + 10) (oneOf "ABCDEF"))
+
+symbol :: String -> Parser ()
+symbol s = try (string s) >> pWhiteComment
+
+symbol' :: String -> Parser String
+symbol' s = try (string s) << pWhiteComment
+
+pWhiteComment :: Parser ()
+pWhiteComment = sepBy pWhitespace pComment >> return ()
+
+pWhitespace :: Parser ()
+pWhitespace = many (oneOf " \t\n") >> return ()
+
+pComment :: Parser ()
+pComment = pLineComment <|> pBlockComment
+
+pLineComment :: Parser ()
+pLineComment = try (string "//") >> manyTill anyChar (char '\n') >> return ()
+
+pBlockComment :: Parser ()
+pBlockComment = try (string "/*") >> manyTill anyChar (try (string "*/")) >> return ()
+
+
+infixr 2 .||.
+(.||.) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
+f .||. g = \x -> f x || g x
diff --git a/pshow.hs b/pshow.hs
new file mode 100644
index 0000000..64fbab1
--- /dev/null
+++ b/pshow.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+module PShow(PShow(..), pprint) where
+
+
+class PShow a where
+    pshow :: a -> String
+
+
+pprint :: (PShow a) => a -> IO ()
+pprint = putStrLn . pshow
+
+
+instance PShow String where {pshow = show}
+instance PShow Int where {pshow = show}
+instance PShow Integer where {pshow = show}
+
+instance (PShow a, PShow b) => PShow (a, b) where
+    pshow (a, b) = "(" ++ pshow a ++ "," ++ pshow b ++ ")"
diff --git a/test.nl b/test.nl
new file mode 100644
index 0000000..99786fc
--- /dev/null
+++ b/test.nl
@@ -0,0 +1,18 @@
+type int = i32;
+type char = i8;
+
+int glob = 10;
+
+int main(int argc, ptr(char) argv) {
+	int kaas = glob + 2;
+	glob = 2 > 1 || 1 == 1 % 10;
+	while (glob < 20) {
+		if (kaas == 12) glob = glob + 3 / 2;
+		else glob = glob - 1;
+		if (glob < -10) return glob;
+		if (glob < -12) {
+			return glob;
+		} else {}
+	}
+	return kaas;
+}