From 19c70b8eaa1126f1648b009d99092432a5c88059 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Fri, 1 Sep 2017 18:14:43 +0200
Subject: Structs + typedefs

---
 AST.hs           |  80 ++++++++++++++++++++++++++++++-----
 BuildIR.hs       |  49 +++++++++++++++++-----
 CodeGen.hs       | 124 ++++++++++++++++++++++++++++++++++++++++++-------------
 Defs.hs          |   1 +
 Intermediate.hs  |  12 +++++-
 Main.hs          |   3 +-
 Makefile         |   2 +-
 Optimiser.hs     |  51 +++++++++--------------
 ProgramParser.hs | 107 +++++++++++++++++++++++++++++------------------
 ReplaceRefs.hs   |  40 +++++++++++++++++-
 TypeCheck.hs     |  99 +++++++++++++++++++++++++++++++++++---------
 TypeRules.hs     |   3 ++
 Utils.hs         |   3 ++
 X64.hs           |   6 ++-
 X64Optimiser.hs  |  18 ++++----
 bf.lang          |  20 +++------
 graph.png        | Bin 166622 -> 0 bytes
 liblang.asm      |   3 +-
 struct.lang      |  19 +++++++++
 19 files changed, 472 insertions(+), 168 deletions(-)
 delete mode 100644 graph.png
 create mode 100644 struct.lang

diff --git a/AST.hs b/AST.hs
index dae2631..ccad05d 100644
--- a/AST.hs
+++ b/AST.hs
@@ -1,12 +1,17 @@
 module AST where
 
 import Data.List
+import Data.Maybe
 
 import Defs
 import Pretty
+import Utils
 
 
-data Program = Program [DVar] [DFunc]
+data Program = Program [DTypedef] [DVar] [DFunc]
+  deriving (Show, Eq)
+
+data DTypedef = DTypedef Name Type
   deriving (Show, Eq)
 
 data DVar = DVar Type Name Expression
@@ -16,8 +21,9 @@ data DFunc = DFunc (Maybe Type) Name [(Type, Name)] Block
   deriving (Show, Eq)
 
 data Type
-    = TInt | TChar | TArr Type (Maybe Size)
-  deriving (Show, Eq)
+    = TInt | TChar | TArr Type (Maybe Size) | TStruct [(Type, Name)]
+    | TName Name
+  deriving (Show, Eq, Ord)
 
 data Block = Block [Statement]
   deriving (Show, Eq)
@@ -43,6 +49,7 @@ data Expression
     | EUn UnaryOp Expression (Maybe Type)
     | ELit Literal (Maybe Type)
     | ESubscript Expression Expression (Maybe Type)
+    | EGet Expression Name (Maybe Type)
     | ECast Type Expression
     | ENew Type Expression
   deriving (Show, Eq)
@@ -64,6 +71,7 @@ data Literal
     | LVar Name
     | LCall Name [Expression]
     | LStr String
+    | LStruct [(Name, Expression)]
   deriving (Show, Eq)
 
 
@@ -71,15 +79,50 @@ sizeof :: Type -> Size
 sizeof TInt = 8
 sizeof TChar = 1
 sizeof (TArr _ _) = 8
+sizeof (TStruct []) = 0
+sizeof st@(TStruct ms) =
+    roundUp (sum (layoutStruct st) + sizeof (fst $ last ms)) (foldl1 lcm $ 8 : map (alignmentof . fst) ms)
+sizeof t@(TName _) = error $ "sizeof on " ++ show t
+
+alignmentof :: Type -> Offset
+alignmentof TInt = 8
+alignmentof TChar = 1
+alignmentof (TArr _ _) = 8
+alignmentof (TStruct []) = 1
+alignmentof (TStruct ((t,_):_)) = alignmentof t
+alignmentof (TName _) = undefined
+
+layoutStruct :: Type -> [Offset]
+layoutStruct (TStruct ms) = go ms 0
+  where
+    go :: [(Type, Name)] -> Offset -> [Offset]
+    go [] _ = []
+    go ((t,_) : rest) start =
+        let o = roundUp start (alignmentof t)
+        in o : go rest (o + sizeof t)
+layoutStruct _ = undefined
+
+offsetInStruct :: Type -> Name -> Offset
+offsetInStruct st@(TStruct ms) name = layoutStruct st !! (fromJust $ findIndex ((==name) . snd) ms)
+offsetInStruct _ _ = undefined
+
+structMemberType :: Type -> Name -> Type
+structMemberType (TStruct ms) name = fst $ fromJust $ find ((==name) . snd) ms
+structMemberType _ _ = undefined
 
 
 instance Pretty Program where
-    prettyI i (Program vars funcs) =
-        intercalate ("\n" ++ indent i) (map (prettyI i) vars ++ map (prettyI i) funcs)
+    prettyI i (Program tds vars funcs) =
+        intercalate ("\n" ++ indent i)
+                (map (prettyI i) tds ++ map (prettyI i) vars ++ map (prettyI i) funcs)
             ++ "\n"
       where
         indent n = replicate (2*n) ' '
 
+instance Pretty DTypedef where
+    prettyI i (DTypedef n t) =
+        "type " ++ n ++ " := " ++ prettyI i t ++ ";"
+
 instance Pretty DVar where
     prettyI i (DVar t n e) =
         prettyI i t ++ " " ++ n ++ " := " ++ prettyI i e ++ ";"
@@ -96,6 +139,10 @@ instance Pretty Type where
     prettyI _ TChar = "char"
     prettyI _ (TArr t Nothing) = pretty t ++ "[]"
     prettyI _ (TArr t (Just sz)) = pretty t ++ "[" ++ show sz ++ "]"
+    prettyI _ (TStruct []) = "struct {}"
+    prettyI _ (TStruct ms) =
+        "struct {" ++ intercalate " " [pretty t ++ " " ++ n ++ ";" | (t,n) <- ms] ++ "}"
+    prettyI _ (TName n) = n
 
 instance Pretty Block where
     prettyI _ (Block []) = "{}"
@@ -111,8 +158,10 @@ instance Pretty Statement where
         prettyI i t ++ " " ++ n ++ " := " ++ prettyI i e ++ ";"
     prettyI i (SAs target e) =
         prettyI i target ++ " = " ++ prettyI i e ++ ";"
+    prettyI i (SIf c b (Block [])) =
+        "if (" ++ prettyI i c ++ ") " ++ prettyI i b
     prettyI i (SIf c b1 b2) =
-        "if " ++ prettyI i c ++ " " ++ prettyI i b1 ++ " else " ++ prettyI i b2
+        "if (" ++ prettyI i c ++ ") " ++ prettyI i b1 ++ " else " ++ prettyI i b2
     prettyI i (SWhile c b) =
         "while " ++ prettyI i c ++ " " ++ prettyI i b
     prettyI _ (SBreak 0) =
@@ -138,12 +187,20 @@ instance Pretty Expression where
         prettyI i uo ++ "(" ++ prettyI i e ++ ")"
     prettyI i (ELit l (Just t)) =
         "(" ++ prettyI i (ELit l Nothing) ++ " :: " ++ prettyI i t ++ ")"
-    prettyI i (ELit l Nothing) = prettyI i l
+    prettyI i (ELit l Nothing) =
+        prettyI i l
     prettyI i (ESubscript a b (Just t)) =
         "(" ++ prettyI i (ESubscript a b Nothing) ++ " :: " ++ prettyI i t ++ ")"
-    prettyI i (ESubscript a b Nothing) = "(" ++ prettyI i a ++ ")[" ++ prettyI i b ++ "]"
-    prettyI i (ECast t e) = prettyI i t ++ "(" ++ prettyI i e ++ ")"
-    prettyI i (ENew t e) = "new " ++ prettyI i t ++ "[" ++ prettyI i e ++ "]"
+    prettyI i (ESubscript a b Nothing) =
+        "(" ++ prettyI i a ++ ")[" ++ prettyI i b ++ "]"
+    prettyI i (EGet e n Nothing) =
+        "(" ++ prettyI i e ++ ")." ++ n
+    prettyI i (EGet e n (Just t)) =
+        "(" ++ prettyI i (EGet e n Nothing) ++ " :: " ++ prettyI i t ++ ")"
+    prettyI i (ECast t e) =
+        prettyI i t ++ "(" ++ prettyI i e ++ ")"
+    prettyI i (ENew t e) =
+        "new " ++ prettyI i t ++ "[" ++ prettyI i e ++ "]"
 
 instance Pretty AsExpression where
     prettyI i (AEVar n (Just t)) =
@@ -172,7 +229,6 @@ instance Pretty BinaryOp where
     prettyI _ BOBitOr = "|"
     prettyI _ BOBitXor = "^"
 
-
 instance Pretty UnaryOp where
     prettyI _ UONot = "!"
     prettyI _ UONeg = "-"
@@ -184,3 +240,5 @@ instance Pretty Literal where
     prettyI i (LCall n al) =
         n ++ "(" ++ intercalate ", " (map (prettyI i) al) ++ ")"
     prettyI _ (LStr s) = show s
+    prettyI i (LStruct ms) =
+        "{" ++ intercalate ", " (map (\(n,e) -> n ++ " = " ++ prettyI i e) ms) ++ "}"
diff --git a/BuildIR.hs b/BuildIR.hs
index 9eb4d62..028c649 100644
--- a/BuildIR.hs
+++ b/BuildIR.hs
@@ -46,6 +46,9 @@ genId = state $ \s -> (nextId s, s {nextId = nextId s + 1})
 genTemp :: Size -> BuildM Ref
 genTemp sz = liftM (Temp sz) genId
 
+genStructTemp :: Size -> BuildM Ref
+genStructTemp sz = liftM (StructTemp sz) genId
+
 newBlock :: BuildM Id
 newBlock = do
     i <- genId
@@ -128,7 +131,7 @@ internString str = do
 
 
 buildIR :: Program -> Error IRProgram
-buildIR (Program vars funcs) =
+buildIR (Program [] vars funcs) =
     runExcept $ evalStateT (unBuildM result) initBuildState
   where
     goDFunc :: DFunc -> BuildM IRFunc
@@ -163,6 +166,7 @@ buildIR (Program vars funcs) =
                             let t = TArr TChar (Just $ fromIntegral $ length str)
                             in DVar t n (ELit (LStr str) (Just t))
             return $ IRProgram (vars ++ strvars) funcs'
+buildIR _ = undefined
 
 convertBlock :: Block -> Id -> BuildM ()
 convertBlock (Block sts) nextnext = do
@@ -269,6 +273,15 @@ convertExpression (ELit (LStr s) _) nextnext = do
     ref <- internString s
     setTerm $ IJmp nextnext
     return ref
+convertExpression (ELit (LStruct ms) stype) nextnext = do
+    ref <- genStructTemp (sizeof $ fromJust stype)
+    forM_ ms $ \(n,e) -> do
+        bl <- newBlockNoSwitch
+        r <- convertExpression e bl
+        switchBlock bl
+        addIns $ ISet ref (offsetInStruct (fromJust stype) n) r
+    setTerm $ IJmp nextnext
+    return ref
 convertExpression (EBin BOAnd e1 e2 _) nextnext = do
     destref <- genTemp (sizeof TInt)
     bl2 <- newBlockNoSwitch
@@ -356,19 +369,35 @@ convertExpression (ESubscript arr sub t) nextnext = do
     addIns $ ILoad ref elemptr
     setTerm $ IJmp nextnext
     return ref
+convertExpression (EGet st n t) nextnext = do
+    let elemsz = sizeof $ fromJust t
+    bl2 <- newBlockNoSwitch
+    stref <- convertExpression st bl2
+    switchBlock bl2
+    let subtype = structMemberType (fromJust $ typeof st) n
+    eref <- case subtype of
+        TStruct _ -> genStructTemp elemsz
+        _ -> genTemp elemsz
+    addIns $ IGet eref stref (offsetInStruct (fromJust $ typeof st) n)
+    setTerm $ IJmp nextnext
+    return eref
 convertExpression (ECast dt e) nextnext = do
     let typ = case typeof e of
                   Nothing -> error $ "Cast subject " ++ show e ++ " has Nothing type"
                   Just t -> t
-    when (not $ isIntegralType typ && isIntegralType dt) $
-        error $ "convertExpression: unimplemented cast from " ++ pretty typ ++ " to " ++ pretty dt
-    ref <- genTemp (sizeof dt)
-    bl <- newBlockNoSwitch
-    eref <- convertExpression e bl
-    switchBlock bl
-    addIns $ IResize ref eref
-    setTerm $ IJmp nextnext
-    return ref
+    if typ == dt
+        then convertExpression e nextnext
+        else do
+            when (not $ isIntegralType typ && isIntegralType dt) $
+                error $ "convertExpression: unimplemented cast from " ++ pretty typ ++
+                        " to " ++ pretty dt
+            ref <- genTemp (sizeof dt)
+            bl <- newBlockNoSwitch
+            eref <- convertExpression e bl
+            switchBlock bl
+            addIns $ IResize ref eref
+            setTerm $ IJmp nextnext
+            return ref
 convertExpression (ENew t sze) nextnext = do
     when (not $ isBasicType t) $
         throwError $ "Array element type in 'new' expression is not a basic type (" ++ pretty t ++ ")"
diff --git a/CodeGen.hs b/CodeGen.hs
index bf3e477..450f887 100644
--- a/CodeGen.hs
+++ b/CodeGen.hs
@@ -17,6 +17,7 @@ import Defs
 import Intermediate
 import qualified LifetimeAnalysis as LA
 import RegAlloc
+import ReplaceRefs
 import Utils
 import X64 (Register(..), CondCode(..), XRef(..), Ins(..), xref)
 import qualified X64 as X64
@@ -95,12 +96,16 @@ codegenFunc (IRFunc _ name al bbs sid) = do
         aliascandidates = findAliasCandidates bbs :: [(Ref, Ref)]
 
         gpRegs = [R8, R9, R10, R11, R12, R13, R14, R15]
+        -- gpRegs = [R8]
         allocation = regalloc lifespans gpRegs aliascandidates :: Map.Map Ref (Allocation Register)
 
         spillrefs = map fst $ filter (isAllocMem . snd) $ Map.toList allocation
         (spilloffsets, spillsz) = initLast $ scanl (+) 0 $ map refSize spillrefs
         spilloffsetmap = Map.fromList $ zip spillrefs spilloffsets
 
+        structrefs = filter isStructTemp $ findAllRefsBBList bbs
+        structspace = sum $ map refSize structrefs
+
         usedregs = uniq $ sort $ catMaybes $ flip map (Map.toList allocation) $ \(_, a) -> case a of
             AllocReg reg -> Just reg
             AllocMem -> Nothing
@@ -110,31 +115,52 @@ codegenFunc (IRFunc _ name al bbs sid) = do
     traceM $ "ALLOCATION: " ++ show allocation
 
     let nsaves = length usedregs
-        alignoff = if odd nsaves then 8 else 0
+        framesize' = 8 {- ret addr -} + 8 {- rbp -} + 8 * nsaves +
+                        fromIntegral structspace + fromIntegral spillsz
+        alignoff = roundUp framesize' 16 - framesize'
+        framesize = framesize' + alignoff
         allocationXref = flip Map.mapWithKey allocation $ \ref alloc -> case alloc of
             AllocReg reg -> XReg (fromIntegral $ refSize ref) reg
             AllocMem -> XMem (fromIntegral $ refSize ref)
                              (Just RSP) (0, RAX) Nothing
                              (fromIntegral $ spilloffsetmap ! ref)
-        allocmap = foldl inserter allocationXref (zip al [0::Int ..])
+        allocmap' = fst $ foldl arginserter (allocationXref, 0) al
+          where
+            arginserter (m, off) (t, n) =
+                (Map.insert (Argument (sizeof t) n)
+                            (XMem (fromIntegral $ sizeof t)
+                                  (Just RSP) (0, RAX) Nothing
+                                  (fromIntegral framesize + off))
+                            m,
+                 off + fromIntegral (sizeof t))
+
+        allocmap = fst $ foldl structinserter (allocmap', spillsz) structrefs
           where
-            inserter m ((t, n), i) =
-                let offset = fromIntegral spillsz + alignoff + 8 * nsaves +
-                                8 {- rbp -} + 8 {- ret addr -} + 8 * i
-                in Map.insert (Argument (sizeof t) n)
-                              (XMem (fromIntegral $ sizeof t)
-                                    (Just RSP) (0, RAX) Nothing
-                                    (fromIntegral offset))
-                              m
+            structinserter (m, off) temp@(StructTemp sz _) =
+                (Map.insert temp
+                            (XMem (fromIntegral sz)
+                                  (Just RSP) (0, RAX) Nothing
+                                  (fromIntegral off))
+                            m,
+                 off + sz)
+            structinserter _ _ = undefined
+
+    traceM $ "nsaves = " ++ show nsaves
+    traceM $ "structspace = " ++ show structspace
+    traceM $ "spillsz = " ++ show spillsz
+    traceM $ "framesize' = " ++ show framesize'
+    traceM $ "alignoff = " ++ show alignoff
+    traceM $ "framesize = " ++ show framesize
 
     newLabel name
     addIns $ PUSH (xref $ XReg 8 RBP)
     addIns $ MOV (xref $ XReg 8 RBP) (xref $ XReg 8 RSP)
     forM_ usedregs $ \reg -> addIns $ PUSH (xref $ XReg 8 reg)
-    when (odd $ length usedregs) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm 8)
-    when (spillsz /= 0) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral spillsz)
+    let stackspill = spillsz + structspace + fromIntegral alignoff
+    when (stackspill /= 0) $
+        addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral stackspill)
     setRegsToRestore usedregs
-    setSpillSize spillsz
+    setSpillSize stackspill
 
     let ([startbb], rest) = partition (\(BB i _ _) -> i == sid) bbs
     codegenBB allocmap startbb
@@ -192,6 +218,20 @@ mkmov a@(XMem _ _ _ _ _) b@(XImm v) | v < 2 ^ (32 :: Int) = MOV (xref a) (xref b
 mkmov a b = CALL $ "Invalid mkmov: " ++ show a ++ "; " ++ show b
 -- mkmov a b = error $ "Invalid mkmov: " ++ show a ++ "; " ++ show b
 
+emitmemcpy :: XRef -> XRef -> CGMonad ()
+emitmemcpy dst@(XMem sz _ _ _ _) src@(XMem sz2 _ _ _ _)
+    | sz /= sz2 = error $ "Inconsistent sizes in emitmemcpy: " ++ show dst ++ "; " ++ show src
+    | sz `elem` [1, 2, 4, 8] = do
+        addIns $ mkmov (XReg sz RAX) src
+        addIns $ mkmov dst (XReg sz RAX)
+    | sz > 8 = do
+        addIns $ mkmov (XReg 8 RAX) (X64.xrefSetSize 8 src)
+        addIns $ mkmov (X64.xrefSetSize 8 dst) (XReg 8 RAX)
+        emitmemcpy (X64.offsetXMem 8 $ X64.xrefSetSize (sz - 8) dst)
+                   (X64.offsetXMem 8 $ X64.xrefSetSize (sz - 8) src)
+    | otherwise = error $ "Invalid size in emitmemcpy: " ++ show dst ++ "; " ++ show src
+emitmemcpy _ _ = undefined
+
 mkcmp :: XRef -> XRef -> X64.Ins
 mkcmp a b@(XImm _) = CMPi (xref a) (xref b)
 mkcmp a b = CMP (xref a) (xref b)
@@ -244,6 +284,24 @@ codegenIns m (ILoad d s) = do
   where dm = mkxref d m
         sm = mkxref s m
         sz = fromIntegral $ refSize d
+codegenIns m (ISet d off s)
+    | X64.isXMem sm = do
+        addIns $ mkmov (XReg sz RAX) sm
+        addIns $ mkmov dm (XReg sz RAX)
+    | otherwise = do
+        addIns $ mkmov dm sm
+  where dm = X64.xrefSetSize sz $ X64.offsetXMem (fromIntegral off) $ mkxref d m
+        sm = mkxref s m
+        sz = fromIntegral $ refSize s
+codegenIns m (IGet d s off)
+    | X64.isXMem dm = do
+        addIns $ mkmov (XReg sz RAX) sm
+        addIns $ mkmov dm (XReg sz RAX)
+    | otherwise = do
+        addIns $ mkmov dm sm
+  where dm = mkxref d m
+        sm = X64.xrefSetSize sz $ X64.offsetXMem (fromIntegral off) $ mkxref s m
+        sz = fromIntegral $ refSize d
 codegenIns m (IAri AMul d s1 s2) = do
     let sz = fromIntegral $ refSize d
     addIns $ mkmov (XReg sz RAX) (mkxref s1 m)
@@ -275,7 +333,7 @@ codegenIns m (IAri at d s1 s2) = case arithTypeToCondCode at of
         addIns $ SETCC cc (xref $ X64.xrefSetSize 1 dm)
         addIns $ AND (xref $ X64.xrefSetSize 4 dm) (xref $ XImm 0xff)
     Nothing -> do
-        (_, s1m', s2', s2m') <-
+        (s1', s1m', s2', s2m') <-
             if dm == s2m
                 then if dm == s1m
                         then return (s1, s1m, s2, s2m)
@@ -289,27 +347,35 @@ codegenIns m (IAri at d s1 s2) = case arithTypeToCondCode at of
                         addIns $ mkmov (XReg (fromIntegral $ refSize s2') RAX) s2m'
                         return $ XReg (fromIntegral $ refSize s2') RAX
                     else return s2m'
-        when (dm /= s1m') $ addIns $ mkmov dm s1m'
+        when (dm /= s1m') $ if X64.isXMem dm && X64.isXMem s1m'
+            then do
+                addIns $ mkmov (XReg (fromIntegral $ refSize s1') RBX) s1m'
+                addIns $ mkmov dm (XReg (fromIntegral $ refSize s1') RBX)
+            else do
+                addIns $ mkmov dm s1m'
         addIns $ fromJust (arithTypeToIns at) dm arg2
   where dm = mkxref d m
         s1m = mkxref s1 m
         s2m = mkxref s2 m
 codegenIns m (ICall n rs) = do
-    when (odd $ length rs) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm 8)
-    forM_ (zip (reverse rs) [1::Int ..]) $ \(r, i) ->
+    let sizes = map (flip roundUp 8 . refSize) rs
+        offsets = init $ scanl (+) 0 $ reverse sizes
+        totalsize = sum sizes
+        alignment = roundUp totalsize 16 - totalsize
+    forM_ (zip rs offsets) $ \(r, off) ->
         let sz = fromIntegral $ refSize r
-            src = (mkxref r m)
-            dst = (XMem sz (Just RSP) (0, RAX) Nothing (fromIntegral $ (-8) * i))
-        in if X64.isXMem (mkxref r m)
+            src = mkxref r m
+            dst = XMem sz (Just RSP) (0, RAX) Nothing (fromIntegral $ off - alignment - totalsize)
+        in if X64.isXMem src
             then do
-                addIns $ mkmov (XReg sz RAX) src
-                addIns $ mkmov dst (XReg sz RAX)
-            else do
-                addIns $ mkmov dst src
-    when (length rs > 0) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm (fromIntegral $ 8 * length rs))
+                traceM $ "call stuff with dst = " ++ show dst ++ ", src = " ++ show src
+                emitmemcpy dst src
+            else addIns $ mkmov dst src
+    when (alignment /= 0) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral alignment)
+    when (length rs > 0) $ addIns $ SUB (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral totalsize)
     addIns $ CALL n
-    when (length rs > 0) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm (fromIntegral $ 8 * length rs))
-    when (odd $ length rs) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm 8)
+    when (length rs > 0) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral totalsize)
+    when (alignment /= 0) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral alignment)
 codegenIns m (ICallr d n rs) = do
     codegenIns m (ICall n rs)
     addIns $ mkmov (mkxref d m) (XReg (fromIntegral $ refSize d) RAX)
@@ -386,7 +452,6 @@ codegenTerm _ IRet = do
     spillsz <- gets spillSize
     when (spillsz /= 0) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral spillsz)
     usedregs <- gets regsToRestore
-    when (odd $ length usedregs) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm 8)
     forM_ (reverse usedregs) $ \reg -> addIns $ POP (xref $ XReg 8 reg)
     addIns $ mkmov (XReg 8 RSP) (XReg 8 RBP)
     addIns $ POP (xref $ XReg 8 RBP)
@@ -396,7 +461,6 @@ codegenTerm m (IRetr r) = do
     spillsz <- gets spillSize
     when (spillsz /= 0) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm $ fromIntegral spillsz)
     usedregs <- gets regsToRestore
-    when (odd $ length usedregs) $ addIns $ ADD (xref $ XReg 8 RSP) (xref $ XImm 8)
     forM_ (reverse usedregs) $ \reg -> addIns $ POP (xref $ XReg 8 reg)
     addIns $ mkmov (XReg 8 RSP) (XReg 8 RBP)
     addIns $ POP (xref $ XReg 8 RBP)
@@ -417,6 +481,8 @@ collectTempRefs bbs =
     listRefsIns (ILea a _) = [[LA.Write a]]
     listRefsIns (IStore a b) = [[LA.Read a, LA.Read b]]
     listRefsIns (ILoad a b) = [[LA.Read b], [LA.Write a]]
+    listRefsIns (ISet a _ b) = [[LA.Read b, LA.Write a]]
+    listRefsIns (IGet a b _) = [[LA.Read b, LA.Write a]]
     listRefsIns (IAri at a b c)
             -- if not commutative, we don't want to have to xchg the operands
         | isCommutative at = [[LA.Read b, LA.Read c], [LA.Write a]]
diff --git a/Defs.hs b/Defs.hs
index 4203a82..057fc22 100644
--- a/Defs.hs
+++ b/Defs.hs
@@ -6,5 +6,6 @@ import Data.Int
 type Name = String
 type Id = Int
 type Size = Integer
+type Offset = Integer
 type Value = Int64
 type Error = Either String
diff --git a/Intermediate.hs b/Intermediate.hs
index d2ac549..dde941d 100644
--- a/Intermediate.hs
+++ b/Intermediate.hs
@@ -12,7 +12,7 @@ import Pretty
 data BB = BB Id [IRIns] IRTerm
   deriving (Show, Eq)
 
-data Ref = Temp Size Int | Argument Size Name | Global Size Name | Constant Size Value
+data Ref = Temp Size Int | StructTemp Size Int | Argument Size Name | Global Size Name | Constant Size Value
   deriving (Show, Eq, Ord)
 
 data IRProgram = IRProgram [DVar] [IRFunc]
@@ -26,6 +26,8 @@ data IRIns
     | ILea Ref Name
     | IStore Ref Ref
     | ILoad Ref Ref
+    | ISet Ref Offset Ref
+    | IGet Ref Ref Offset
     | IAri ArithType Ref Ref Ref  -- destination, operand 1, operand 2
     | ICall Name [Ref]
     | ICallr Ref Name [Ref]
@@ -66,6 +68,7 @@ instance Pretty BB where
 
 instance Pretty Ref where
     prettyI _ (Temp sz k) = "t" ++ show k ++ pretty_sizeSuffix sz
+    prettyI _ (StructTemp sz k) = "s" ++ show k ++ "{" ++ show sz ++ "}"
     prettyI _ (Argument sz n) = "a" ++ n ++ pretty_sizeSuffix sz
     prettyI _ (Global sz n) = "g" ++ n ++ pretty_sizeSuffix sz
     prettyI _ (Constant sz n) = show n ++ pretty_sizeSuffix sz
@@ -103,6 +106,8 @@ instance Pretty IRIns where
     prettyI _ (ILea d s) = "lea " ++ pretty d ++ " <- &[" ++ s ++ "]"
     prettyI _ (IStore d s) = "store *" ++ pretty d ++ " <- " ++ pretty s
     prettyI _ (ILoad d s) = "load " ++ pretty d ++ " <- *" ++ pretty s
+    prettyI _ (ISet d off s) = "set " ++ pretty d ++ ".[" ++ show off ++ "] <- " ++ pretty s
+    prettyI _ (IGet d s off) = "get " ++ pretty d ++ " <- " ++ pretty s ++ ".[" ++ show off ++ "]"
     prettyI _ (IAri at d s1 s2) =
         pretty at ++ " " ++ pretty d ++ " <- " ++ pretty s1 ++ ", " ++ pretty s2
     prettyI _ (ICall n al) =
@@ -156,10 +161,15 @@ blockIdOf (BB bid _ _) = bid
 
 refSize :: Ref -> Size
 refSize (Temp sz _) = sz
+refSize (StructTemp sz _) = sz
 refSize (Argument sz _) = sz
 refSize (Global sz _) = sz
 refSize (Constant sz _) = sz
 
+isStructTemp :: Ref -> Bool
+isStructTemp (StructTemp _ _) = True
+isStructTemp _ = False
+
 isConstant :: Ref -> Bool
 isConstant (Constant _ _) = True
 isConstant _ = False
diff --git a/Main.hs b/Main.hs
index b8c50e6..a31c79d 100644
--- a/Main.hs
+++ b/Main.hs
@@ -32,10 +32,11 @@ performCompile :: String -> IO ()
 performCompile source = do
     let eres = return source
                  >>= parseProgram <?> "Parse error"
+                 >>= return . tracePrettyId
                  >>= typeCheck <?> "Type error"
                  >>= buildIR <?> "IR building error"
                  >>= optimise <?> "Error while optimising"
-                 >>= return . traceShowId
+                 -- >>= return . traceShowId
                  >>= verify <?> "Verify error"
                  >>= return . tracePrettyId
                  >>= codegen <?> "Codegen error"
diff --git a/Makefile b/Makefile
index 0d7bf09..5602120 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
 RUNFLAGS =
-GHCFLAGS = -Wall -Widentities -Wno-unused-imports -odir obj -hidir obj -j2
+GHCFLAGS = -Wall -Widentities -Wno-unused-imports -odir obj -hidir obj -j4
 ifneq ($(PROFILE),)
 	RUNFLAGS += +RTS -xc
 	GHCFLAGS += -prof -fprof-auto
diff --git a/Optimiser.hs b/Optimiser.hs
index cea0601..408bd24 100644
--- a/Optimiser.hs
+++ b/Optimiser.hs
@@ -149,7 +149,7 @@ identityOps (IRFunc rt name al bbs sid) = IRFunc rt name al (map go bbs) sid
 constantPropagate :: FuncOptimisation
 constantPropagate (IRFunc rt name al bbs sid) = IRFunc rt name al bbs' sid
   where
-    alltemps = findAllTemps' bbs
+    alltemps = findAllTempsBBList bbs
     consttemps = catMaybes $ flip map alltemps $ \ref ->
         let locs = findMutations' bbs ref
             loc = head locs
@@ -214,6 +214,14 @@ movPush (IRFunc rt name al bbs sid) = IRFunc rt name al (map goBB bbs) sid
         | d' == d = ILoad d' (replaceRef d s s') : go rest term
         | d' == s = IMov d s : ILoad d' (replaceRef d s s') : go rest term
         | otherwise = ILoad d' (replaceRef d s s') : push mov rest term
+    push mov@(d, s) (ISet d' n' s' : rest) term
+        | d' == d = ISet d' n' (replaceRef d s s') : go rest term
+        | d' == s = IMov d s : ISet d' n' s' : go rest term
+        | otherwise = ISet d' n' (replaceRef d s s') : push mov rest term
+    push mov@(d, s) (IGet d' s' n' : rest) term
+        | d' == d = IGet d' (replaceRef d s s') n' : go rest term
+        | d' == s = IMov d s : IGet d' s' n' : go rest term
+        | otherwise = IGet d' (replaceRef d s s') n' : push mov rest term
     push mov@(d, s) (IAri at d' s1' s2' : rest) term
         | d' == d = IAri at d' (replaceRef d s s1') (replaceRef d s s2') : go rest term
         | d' == s = IMov d s : IAri at d' (replaceRef d s s1') (replaceRef d s s2') : go rest term
@@ -294,6 +302,12 @@ arithPush (IRFunc rt name al allbbs sid) = IRFunc rt name al resbbs sid
     propagate ari@(_, d, s1, s2) (Left ins@(ILoad md _) : rest)
         | d /= md && md /= s1 && md /= s2 = fmap (Left ins :) $ propagate ari rest
         | otherwise = (False, Left ins : rest)
+    propagate ari@(_, d, s1, s2) (Left ins@(ISet md _ _) : rest)
+        | d /= md && md /= s1 && md /= s2 = fmap (Left ins :) $ propagate ari rest
+        | otherwise = (False, Left ins : rest)
+    propagate ari@(_, d, s1, s2) (Left ins@(IGet md _ _) : rest)
+        | d /= md && md /= s1 && md /= s2 = fmap (Left ins :) $ propagate ari rest
+        | otherwise = (False, Left ins : rest)
     propagate ari@(at, d, s1, s2) (Left ins@(IAri mat md ms1 ms2) : rest)
         | d /= md && (at, s1, s2) == (mat, ms1, ms2) = fmap (Left (IMov md d) :) $ propagate ari rest
         | d /= md && md /= s1 && md /= s2 = fmap (Left ins :) $ propagate ari rest
@@ -398,6 +412,8 @@ removeUnusedInstructions (IRFunc rt name al bbs sid) = IRFunc rt name al (map go
     goI ins@(ILea d _) = pureInstruction d ins
     goI ins@(IStore _ _) = Just ins
     goI ins@(ILoad d _) = pureInstruction d ins
+    goI ins@(ISet _ _ _) = Just ins
+    goI ins@(IGet d _ _) = pureInstruction d ins
     goI ins@(IAri _ d _ _) = pureInstruction d ins
     goI ins@(ICall _ _) = Just ins
     goI ins@(ICallr _ _ _) = Just ins
@@ -559,39 +575,10 @@ findMentions' bbs ref =
 -- findMentionsIns' :: [BB] -> Ref -> [IRIns]
 -- findMentionsIns' bbs ref = concatMap (flip findMentionsIns ref) bbs
 
-findAllRefs :: BB -> [Ref]
-findAllRefs (BB _ inss _) = findAllRefsInss inss
-
-findAllRefsInss :: [IRIns] -> [Ref]
-findAllRefsInss inss = uniq $ sort $ concatMap findAllRefsIns inss
-
-findAllRefsIns :: IRIns -> [Ref]
-findAllRefsIns (IMov a b) = [a, b]
-findAllRefsIns (ILea a _) = [a]
-findAllRefsIns (IStore a b) = [a, b]
-findAllRefsIns (ILoad a b) = [a, b]
-findAllRefsIns (IAri _ a b c) = [a, b, c]
-findAllRefsIns (ICall _ al) = al
-findAllRefsIns (ICallr a _ al) = a : al
-findAllRefsIns (IResize a b) = [a, b]
-findAllRefsIns IDebugger = []
-findAllRefsIns INop = []
-
-findAllRefsTerm :: IRTerm -> [Ref]
-findAllRefsTerm (IJcc _ a b _ _) = [a, b]
-findAllRefsTerm (IJmp _) = []
-findAllRefsTerm IRet = []
-findAllRefsTerm (IRetr a) = [a]
-findAllRefsTerm IUnreachable = []
-findAllRefsTerm ITermNone = undefined
-
--- findAllRefs' :: [BB] -> [Ref]
--- findAllRefs' = uniq . sort . concatMap findAllRefs
-
 findAllTemps :: BB -> [Ref]
 findAllTemps bb = flip filter (findAllRefs bb) $ \ref -> case ref of
     (Temp _ _) -> True
     _ -> False
 
-findAllTemps' :: [BB] -> [Ref]
-findAllTemps' = concatMap findAllTemps
+findAllTempsBBList :: [BB] -> [Ref]
+findAllTempsBBList = concatMap findAllTemps
diff --git a/ProgramParser.hs b/ProgramParser.hs
index a71d07e..411e063 100644
--- a/ProgramParser.hs
+++ b/ProgramParser.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TupleSections #-}
+
 module ProgramParser(parseProgram) where
 
 import Control.Monad
@@ -19,20 +21,32 @@ parseProgram s = case parse pProgram "" s of
     Right p -> Right p
 
 pProgram :: Parser Program
-pProgram = do
-    pWhiteComment
-    decls <- many pDecl
-    eof
-    return $ Program (lefts decls) (rights decls)
-
-pDecl :: Parser (Either DVar DFunc)
-pDecl = (Right <$> pDFunc) <|> (Left <$> pDVar)
+pProgram = between pWhiteComment eof go
+  where
+    go :: Parser Program
+    go = (pDTypedef >>= \d -> addTypedef d <$> go) <|>
+         (pDFunc >>= \d -> addFunc d <$> go) <|>
+         (pDVar >>= \d -> addVar d <$> go) <|>
+         return (Program [] [] [])
+
+    addTypedef d (Program a b c) = Program (d:a) b c
+    addVar d (Program a b c) = Program a (d:b) c
+    addFunc d (Program a b c) = Program a b (d:c)
+
+pDTypedef :: Parser DTypedef
+pDTypedef = do
+    symbol "type"
+    n <- pName
+    symbol ":="
+    t <- pType
+    symbol ";"
+    return $ DTypedef n t
 
 pDFunc :: Parser DFunc
 pDFunc = do
     symbol "func"
-    rt <- (Just <$> pType) <|> return Nothing
-    n <- pName
+    (rt,n) <- (try $ pType >>= \t -> (Just t,) <$> pName) <|>
+              ((Nothing,) <$> pName)
     symbol "("
     args <- sepBy pTypeAndName (symbol ",")
     symbol ")"
@@ -41,8 +55,7 @@ pDFunc = do
 
 pDVar :: Parser DVar
 pDVar = do
-    t <- pType
-    n <- pName
+    (t,n) <- try pTypeAndName
     symbol ":="
     e <- pExpression
     symbol ";"
@@ -52,16 +65,27 @@ pTypeAndName :: Parser (Type, Name)
 pTypeAndName = (,) <$> pType <*> pName
 
 pType :: Parser Type
-pType = do
-    t <- pBasicType
-    (do
-        symbol "["
-        msz <- optionMaybe pInteger
-        symbol "]"
-        return $ TArr t msz) <|> return t
+pType = (flip label "type") $
+    pStruct <|> do
+        t <- pBasicType
+        (do
+            symbol "["
+            msz <- optionMaybe pInteger
+            symbol "]"
+            return $ TArr t msz) <|> return t
+
+pStruct :: Parser Type
+pStruct = do
+    symbol "struct"
+    symbol "{"
+    ms <- many $ pTypeAndName <* symbol ";"
+    symbol "}"
+    return $ TStruct ms
 
 pBasicType :: Parser Type
-pBasicType = (symbol "int" >> return TInt) <|> (symbol "char" >> return TChar)
+pBasicType = (symbol "int" >> return TInt) <|>
+             (symbol "char" >> return TChar) <|>
+             (TName <$> pName)
 
 pBlock :: Parser Block
 pBlock = do
@@ -134,7 +158,7 @@ pSExpr = do
     return $ SExpr e
 
 pExpression :: Parser Expression
-pExpression = E.buildExpressionParser optable litparser
+pExpression = E.buildExpressionParser optable litparser <?> "expression"
   where
     optable =
         [[E.Infix (symbol "**" >> return (mkEBin BOPow)) E.AssocRight],
@@ -163,11 +187,14 @@ pExpression = E.buildExpressionParser optable litparser
 
     litparser :: Parser Expression
     litparser = do
-        pops <- many pPrefixOp
-        e <- pParenExpr <|> pENew <|> pCastExpr <|> (mkELit <$> pLiteral)
-        subs <- many $ between (symbol "[") (symbol "]") pExpression
-        let e' = foldl (\ex sub -> ESubscript ex sub Nothing) e subs
-            e'' = foldl (\ex pop -> EUn pop ex Nothing) e' pops
+        preops <- many pPrefixOp
+        e <- pParenExpr <|> pENew <|> (mkELit <$> pLiteral)
+        postops <- many pPostfixOp
+        let e' = foldl (\ex op -> case op of
+                            Left sub -> ESubscript ex sub Nothing
+                            Right n -> EGet ex n Nothing)
+                       e postops
+            e'' = foldl (\ex pop -> EUn pop ex Nothing) e' preops
         return e''
 
 pAsExpression :: Parser AsExpression
@@ -180,6 +207,12 @@ pPrefixOp :: Parser UnaryOp
 pPrefixOp = (symbol "!" >> return UONot) <|>
             (symbol "-" >> return UONeg)
 
+-- Left: subscript; Right: dot-index
+pPostfixOp :: Parser (Either Expression Name)
+pPostfixOp =
+    (Left <$> between (symbol "[") (symbol "]") pExpression) <|>
+    (Right <$> (symbol "." >> pName))
+
 pParenExpr :: Parser Expression
 pParenExpr = do
     symbol "("
@@ -187,13 +220,6 @@ pParenExpr = do
     symbol ")"
     return e
 
-pCastExpr :: Parser Expression
-pCastExpr = do
-    t <- try $ pType <* symbol "("
-    e <- pExpression
-    symbol ")"
-    return $ ECast t e
-
 pENew :: Parser Expression
 pENew = do
     symbol "new"
@@ -206,7 +232,7 @@ pENew = do
 pLiteral :: Parser Literal
 pLiteral =
     (LInt <$> pInteger) <|> (LChar <$> pCharLit) <|> (LStr <$> pString) <|>
-    pLCall <|> (LVar <$> pName)
+    pLStruct <|> pLCall <|> (LVar <$> pName)
 
 pCharLit :: Parser Char
 pCharLit = do
@@ -237,6 +263,13 @@ pString = do
     void $ char '"'
     return s
 
+pLStruct :: Parser Literal
+pLStruct = do
+    symbol "{"
+    ms <- sepBy (pName >>= \n -> symbol "=" >> pExpression >>= \e -> return (n,e)) (symbol ",")
+    symbol "}"
+    return $ LStruct ms
+
 pLCall :: Parser Literal
 pLCall = do
     n <- try $ pName <* symbol "("
@@ -310,9 +343,3 @@ pBlockComment = do
     void $ sepEndBy (manyTill anyToken (lookAhead $ try (string "/*") <|> try (string "*/")))
                     pBlockComment
     void $ string "*/"
-
-lefts :: [Either a b] -> [a]
-lefts = foldr (\e l -> either (:l) (const l) e) []
-
-rights :: [Either a b] -> [b]
-rights = foldr (\e l -> either (const l) (:l) e) []
diff --git a/ReplaceRefs.hs b/ReplaceRefs.hs
index 6e10c90..5886937 100644
--- a/ReplaceRefs.hs
+++ b/ReplaceRefs.hs
@@ -1,8 +1,12 @@
 module ReplaceRefs
-    (replaceRef, replaceRefsIns, replaceRefsTerm, replaceRefsBB, replaceRefsBBList)
+    (replaceRef, replaceRefsIns, replaceRefsTerm, replaceRefsBB, replaceRefsBBList,
+     findAllRefs, findAllRefsInss, findAllRefsIns, findAllRefsTerm, findAllRefsBBList)
     where
 
+import Data.List
+
 import Intermediate
+import Utils
 
 
 replaceRef :: Ref -> Ref -> Ref -> Ref
@@ -13,6 +17,8 @@ replaceRefsIns from to (IMov a b) = IMov (trans from to a) (trans from to b)
 replaceRefsIns from to (ILea a n) = ILea (trans from to a) n
 replaceRefsIns from to (IStore a b) = IStore (trans from to a) (trans from to b)
 replaceRefsIns from to (ILoad a b) = ILoad (trans from to a) (trans from to b)
+replaceRefsIns from to (ISet a n b) = ISet (trans from to a) n (trans from to b)
+replaceRefsIns from to (IGet a b n) = IGet (trans from to a) (trans from to b) n
 replaceRefsIns from to (IAri at a b c) = IAri at (trans from to a) (trans from to b) (trans from to c)
 replaceRefsIns from to (ICall n al) = ICall n (map (trans from to) al)
 replaceRefsIns from to (ICallr a n al) = ICallr (trans from to a) n (map (trans from to) al)
@@ -40,3 +46,35 @@ trans :: Ref -> Ref -> Ref -> Ref
 trans from to ref
     | ref == from = to
     | otherwise = ref
+
+
+findAllRefs :: BB -> [Ref]
+findAllRefs (BB _ inss _) = findAllRefsInss inss
+
+findAllRefsInss :: [IRIns] -> [Ref]
+findAllRefsInss inss = uniq $ sort $ concatMap findAllRefsIns inss
+
+findAllRefsIns :: IRIns -> [Ref]
+findAllRefsIns (IMov a b) = [a, b]
+findAllRefsIns (ILea a _) = [a]
+findAllRefsIns (IStore a b) = [a, b]
+findAllRefsIns (ILoad a b) = [a, b]
+findAllRefsIns (ISet a _ b) = [a, b]
+findAllRefsIns (IGet a b _) = [a, b]
+findAllRefsIns (IAri _ a b c) = [a, b, c]
+findAllRefsIns (ICall _ al) = al
+findAllRefsIns (ICallr a _ al) = a : al
+findAllRefsIns (IResize a b) = [a, b]
+findAllRefsIns IDebugger = []
+findAllRefsIns INop = []
+
+findAllRefsTerm :: IRTerm -> [Ref]
+findAllRefsTerm (IJcc _ a b _ _) = [a, b]
+findAllRefsTerm (IJmp _) = []
+findAllRefsTerm IRet = []
+findAllRefsTerm (IRetr a) = [a]
+findAllRefsTerm IUnreachable = []
+findAllRefsTerm ITermNone = undefined
+
+findAllRefsBBList :: [BB] -> [Ref]
+findAllRefsBBList = uniq . sort . concatMap findAllRefs
diff --git a/TypeCheck.hs b/TypeCheck.hs
index 922731d..2b05df1 100644
--- a/TypeCheck.hs
+++ b/TypeCheck.hs
@@ -1,6 +1,9 @@
+{-# LANGUAGE TupleSections #-}
+
 module TypeCheck(typeCheck) where
 
 import Control.Monad
+import Data.List
 import Data.Maybe
 import qualified Data.Map.Strict as Map
 
@@ -10,7 +13,7 @@ import Pretty
 import TypeRules
 
 
-data DBItem = DBVar Type | DBFunc (Maybe Type) [Type]
+data DBItem = DBVar Type | DBFunc (Maybe Type) [Type] | DBType Type
 
 type TypeDB = [Map.Map Name DBItem]
 
@@ -34,56 +37,79 @@ emptyDB = [Map.fromList
      ("putint", DBFunc Nothing [TInt]),
      ("getc", DBFunc (Just TInt) []),
      ("exit", DBFunc Nothing [TInt]),
-     ("_builtin_malloc", DBFunc (Just $ TArr TChar Nothing) [TInt])]]
+     ("_builtin_malloc", DBFunc (Just $ TArr TChar Nothing) [TInt]),
+     ("char", DBType TChar),
+     ("int", DBType TInt)]]
 
 withScope :: TypeDB -> (TypeDB -> a) -> a
 withScope db f = f (Map.empty : db)
 
 
 typeCheck :: Program -> Error Program
-typeCheck (Program vars funcs) = do
-    db <- foldM registerDVar emptyDB vars
-            >>= \db' -> foldM registerDFunc db' funcs
+typeCheck (Program tdefs vars funcs) = do
+    -- case topologicalSort 
+    db <- foldM registerDTypedef emptyDB tdefs
+            >>= (\db' -> foldM registerDTypedefResolve db' tdefs)
+            >>= (\db' -> foldM registerDVar db' vars)
+            >>= (\db' -> foldM registerDFunc db' funcs)
     vars' <- mapM (annotateDVar db) vars
     funcs' <- mapM (annotateDFunc db) funcs
-    return $ Program vars' funcs'
+    return $ Program [] vars' funcs'
+
+
+registerDTypedef :: TypeDB -> DTypedef -> Error TypeDB
+registerDTypedef db (DTypedef n t) = case dbFind db n of
+    Nothing -> return $ dbSet db n (DBType t)
+    Just _ -> Left $ "Duplicate top-level name '" ++ n ++ "'"
 
+registerDTypedefResolve :: TypeDB -> DTypedef -> Error TypeDB
+registerDTypedefResolve db (DTypedef n t) = do
+    t' <- resolveType db t
+    return $ dbSet db n (DBType t')
 
 registerDVar :: TypeDB -> DVar -> Error TypeDB
 registerDVar db (DVar t n _) = case dbFind db n of
-    Nothing -> return $ dbSet db n (DBVar t)
+    Nothing -> do
+        t' <- resolveType db t
+        return $ dbSet db n (DBVar t')
     Just _ -> Left $ "Duplicate top-level name '" ++ n ++ "'"
 
 registerDFunc :: TypeDB -> DFunc -> Error TypeDB
 registerDFunc db (DFunc rt n al _) = case dbFind db n of
-    Nothing -> return $ dbSet db n (DBFunc rt (map fst al))
+    Nothing -> do
+        rt' <- sequence $ fmap (resolveType db) rt
+        al' <- forM al $ \(at,an) -> (,an) <$> resolveType db at
+        return $ dbSet db n (DBFunc rt' (map fst al'))
     Just _ -> Left $ "Duplicate top-level name '" ++ n ++ "'"
 
 
 annotateDVar :: TypeDB -> DVar -> Error DVar
 annotateDVar db (DVar toptype name expr) = do
+    toptype' <- resolveType db toptype
     expr' <- annotateExpr db expr
     when (isNothing (typeof expr')) $
         Left $ "Cannot assign void value in global declaration of " ++ name
     let typ = fromJust $ typeof expr'
-    if canCoerce typ toptype
-        then return $ DVar toptype name expr'
+    if canCoerce typ toptype'
+        then return $ DVar toptype' name expr'
         else Left $ "Cannot assign a value of type " ++ pretty typ ++
-                    " to a variable of type " ++ pretty toptype
+                    " to a variable of type " ++ pretty toptype'
 
 data State = State {stDfunc :: DFunc, stLoopDepth :: Int}
   deriving Show
 
 annotateDFunc :: TypeDB -> DFunc -> Error DFunc
 annotateDFunc db dfunc@(DFunc rettype name arglist block) = do
-    when (name == "main" && rettype /= Just TInt) $
+    rettype' <- sequence $ fmap (resolveType db) rettype
+    arglist' <- forM arglist $ \(at,an) -> (,an) <$> resolveType db at
+    when (name == "main" && rettype' /= Just TInt) $
         Left $ "Function 'main' should return an int"
-    let db' = foldl registerArg db arglist
+    db' <- foldM registerArg db arglist'
     block' <- annotateBlock (State dfunc 0) db' block
-    return $ DFunc rettype name arglist block'
+    return $ DFunc rettype' name arglist' block'
   where
-    registerArg :: TypeDB -> (Type, Name) -> TypeDB
-    registerArg db' (t, n) = dbSet db' n (DBVar t)
+    registerArg :: TypeDB -> (Type, Name) -> Error TypeDB
+    registerArg db' (t, n) = dbSet db' n . DBVar <$> resolveType db' t
 
 annotateBlock :: State -> TypeDB -> Block -> Error Block
 annotateBlock state db (Block sts) =
@@ -93,16 +119,17 @@ annotateBlock state db (Block sts) =
 
 annotateStatement :: State -> TypeDB -> Statement -> Error (TypeDB, Statement)
 annotateStatement _ db (SDecl toptype name expr) = do
+    toptype' <- resolveType db toptype
     expr' <- annotateExpr db expr
     when (isNothing (typeof expr')) $
         Left $ "Cannot assign void value in declaration of " ++ name
     when (isJust (dbFindTop db name)) $
         Left $ "Duplicate declaration of variable " ++ name
     let typ = fromJust $ typeof expr'
-    if canCoerce typ toptype
-        then return $ (dbSet db name (DBVar toptype), SDecl toptype name expr')
+    if canCoerce typ toptype'
+        then return $ (dbSet db name (DBVar toptype'), SDecl toptype' name expr')
         else Left $ "Cannot assign a value of type " ++ pretty typ ++
-                    " to a variable of type " ++ pretty toptype
+                    " to a variable of type " ++ pretty toptype'
 annotateStatement _ db (SAs ae expr) = do
     ae' <- annotateAsExpr db ae
     expr' <- annotateExpr db expr
@@ -182,6 +209,7 @@ annotateExpr db (ELit lit@(LVar n) _) = case dbFind db n of
     Nothing -> Left $ "Use of undeclared variable " ++ n ++ " in expression"
     Just (DBVar t) -> return $ ELit lit (Just t)
     Just (DBFunc _ _) -> Left $ "Cannot use function " ++ n ++ " in expression"
+    Just (DBType _) -> Left $ "Cannot use type " ++ n ++ " as value in expression"
 annotateExpr db (ELit (LCall n as) _) = do
     as' <- mapM (annotateExpr db) as
     case dbFind db n of
@@ -200,17 +228,38 @@ annotateExpr db (ELit (LCall n as) _) = do
                                 " but value of type " ++ pretty (fromJust $ typeof arg) ++
                                 " was given"
             return $ ELit (LCall n as') mrt
+        Just (DBType t) -> case as of
+            [a] -> annotateExpr db (ECast t a)
+            _ -> Left $ "Cannot call type " ++ pretty t ++ " as function with " ++
+                        show (length as) ++ " arguments"
 annotateExpr _ (ELit lit@(LStr s) _) =
     return $ ELit lit (Just $ TArr TChar (Just $ fromIntegral $ length s))
+annotateExpr db (ELit (LStruct ms) _) = do
+    ms' <- forM ms $ \(n,e) -> (n,) <$> annotateExpr db e
+    types <- forM ms' $ \(n,e) -> case typeof e of
+                Nothing -> Left $ "Use of void value in struct literal item '" ++ n ++ "'"
+                Just t -> return t
+    return $ ELit (LStruct ms') (Just $ TStruct $ zip types (map fst ms'))
 annotateExpr db (ESubscript arr sub _) = do
     arr' <- annotateExpr db arr
     sub' <- annotateExpr db sub
+    when (isNothing (typeof sub')) $
+        Left $ "Use of void value as subscripted expression"
     let subtyp = fromJust (typeof sub')
     when (subtyp /= TInt) $
         Left $ "Type of array subscript should be int, but is " ++ pretty subtyp
     case fromJust (typeof arr') of
         TArr et _ -> return $ ESubscript arr' sub' (Just et)
         _ -> Left $ "Subscripted expression is not an array: " ++ pretty arr
+annotateExpr db (EGet st n _) = do
+    st' <- annotateExpr db st
+    case typeof st' of
+        Nothing -> Left $ "Use of void value as dot-indexed expression"
+        Just stt@(TStruct ms) -> case find ((==n) . snd) ms of
+            Nothing -> Left $ "Struct of type " ++ pretty stt ++
+                              " has no member named '" ++ n ++ "'"
+            Just (t, _) -> return $ EGet st' n (Just t)
+        Just stt -> Left $ "Use of non-struct type " ++ pretty stt ++ " as dot-indexed expression"
 annotateExpr db (ECast t e) = do
     e' <- annotateExpr db e
     let typ = fromJust (typeof e')
@@ -232,6 +281,7 @@ annotateAsExpr db (AEVar n _) = case dbFind db n of
     Nothing -> Left $ "Use of undeclared variable " ++ n ++ " in assignment expression"
     Just (DBVar t) -> return $ AEVar n (Just t)
     Just (DBFunc _ _) -> Left $ "Cannot use function " ++ n ++ " in assignment expression"
+    Just (DBType _) -> Left $ "Cannot use type " ++ n ++ " as variable in assignment expression"
 annotateAsExpr db (AESubscript ae expr _) = do
     ae' <- annotateAsExpr db ae
     expr' <- annotateExpr db expr
@@ -243,3 +293,14 @@ annotateAsExpr db (AESubscript ae expr _) = do
         TArr t _ -> return $ AESubscript ae' expr' (Just t)
         t -> Left $ "Indexed expression '" ++ pretty ae ++ "' has non-array type " ++ pretty t ++
                     " in assignment expression"
+
+
+resolveType :: TypeDB -> Type -> Error Type
+resolveType _ TInt = return TInt
+resolveType _ TChar = return TChar
+resolveType db (TArr t sz) = liftM (\t' -> TArr t' sz) $ resolveType db t
+resolveType db (TStruct ms) = TStruct <$> mapM (\(t,n) -> liftM (,n) $ resolveType db t) ms
+resolveType db (TName n) = case dbFind db n of
+    Nothing -> Left $ "Type name '" ++ n ++ "' not defined"
+    Just (DBType t) -> return t
+    Just _ -> Left $ "Name '" ++ n ++ "' used as type is not a type"
diff --git a/TypeRules.hs b/TypeRules.hs
index 2bafe63..b73daf2 100644
--- a/TypeRules.hs
+++ b/TypeRules.hs
@@ -1,5 +1,7 @@
 module TypeRules where
 
+import Data.List
+
 import AST
 
 
@@ -53,6 +55,7 @@ instance TypeOf Expression where
     typeof (EUn _ _ mt) = mt
     typeof (ELit _ mt) = mt
     typeof (ESubscript _ _ mt) = mt
+    typeof (EGet _ _ mt) = mt
     typeof (ECast t _) = Just t
     typeof (ENew t _) = Just $ TArr t Nothing
 
diff --git a/Utils.hs b/Utils.hs
index 60f8ff5..51eecf8 100644
--- a/Utils.hs
+++ b/Utils.hs
@@ -11,3 +11,6 @@ uniq l = l
 
 contains :: Eq a => [a] -> a -> Bool
 contains l v = isJust $ find (== v) l
+
+roundUp :: Integral a => a -> a -> a
+roundUp n sz = (n + sz - 1) `div` sz * sz
diff --git a/X64.hs b/X64.hs
index 26c35dd..0cbf4fc 100644
--- a/X64.hs
+++ b/X64.hs
@@ -190,7 +190,7 @@ instance Stringifiable XRef where
         szword 2 = "word"
         szword 4 = "dword"
         szword 8 = "qword"
-        szword _ = undefined
+        szword s = error $ "Invalid (szword " ++ show s ++ ") in stringify XMem"
 
     stringify (XImm imm) = show imm
 
@@ -283,6 +283,10 @@ xrefSetSize sz (XReg _ r) = XReg sz r
 xrefSetSize sz (XMem _ a b c d) = XMem sz a b c d
 xrefSetSize _ x@(XImm _) = x
 
+offsetXMem :: Offset -> XRef -> XRef
+offsetXMem off (XMem sz mr tup lbl o) = XMem sz mr tup lbl (o + off)
+offsetXMem _ _ = undefined
+
 isXReg :: XRef -> Bool
 isXReg (XReg _ _) = True
 isXReg _ = False
diff --git a/X64Optimiser.hs b/X64Optimiser.hs
index 195389f..206529f 100644
--- a/X64Optimiser.hs
+++ b/X64Optimiser.hs
@@ -3,7 +3,7 @@ module X64Optimiser(x64Optimise) where
 import Data.List
 import Data.Maybe
 
-import Defs
+import Defs hiding (Offset)
 import X64
 
 
@@ -88,17 +88,21 @@ optDoubleAdd (name, inss) = (name, go inss)
   where
     go :: [Ins] -> [Ins]
     go [] = []
-    go (add@(ADD (RegMem xreg@(XReg _ xregReg)) (RegMemImm (XImm _))) : rest) =
+    go (add@(ADD (RegMem xreg@(XReg _ xregReg)) (RegMemImm (XImm _))) : rest) = start xreg xregReg add rest
+    go (sub@(SUB (RegMem xreg@(XReg _ xregReg)) (RegMemImm (XImm _))) : rest) = start xreg xregReg sub rest
+    go (ins : rest) = ins : go rest
+
+    start :: XRef -> Register -> Ins -> [Ins] -> [Ins]
+    start xreg xregReg addsub rest =
         let midx = flip findIndex rest $ \ins -> case ins of
                 ADD (RegMem xreg2@(XReg _ _)) (RegMemImm (XImm _)) | xreg == xreg2 -> True
                 SUB (RegMem xreg2@(XReg _ _)) (RegMemImm (XImm _)) | xreg == xreg2 -> True
                 _ -> False
         in case midx of
-                Nothing -> add : go rest
+                Nothing -> addsub : go rest
                 Just idx -> if all (canSkip xregReg) (take idx rest)
-                    then go $ merge add (rest !! idx) : take idx rest ++ drop (idx + 1) rest
-                    else add : go rest
-    go (ins : rest) = ins : go rest
+                    then go $ merge addsub (rest !! idx) : take idx rest ++ drop (idx + 1) rest
+                    else addsub : go rest
 
     canSkip :: Register -> Ins -> Bool
     canSkip _ (CALL _) = False
@@ -121,7 +125,7 @@ optDoubleAdd (name, inss) = (name, go inss)
             dst1 = destOf ins1
             dst2 = destOf ins2
         in if dst1 == dst2
-            then ADD (RegMem dst1) (RegMemImm $ XImm $ e1 + e2)
+            then (if e1 + e2 < 0 then SUB else ADD) (RegMem dst1) (RegMemImm $ XImm $ abs $ e1 + e2)
             else undefined
 
     effectOf :: Ins -> Offset
diff --git a/bf.lang b/bf.lang
index c42f73d..0ce6389 100644
--- a/bf.lang
+++ b/bf.lang
@@ -1,3 +1,5 @@
+type byte := char;
+
 func putstr(char[] str) {
 	int i := 0;
 	while (str[i] != '\0') {
@@ -6,16 +8,6 @@ func putstr(char[] str) {
 	}
 }
 
-func int strlen(char[] str) {
-	int i := 0;
-	char c := str[i];
-	while (c != '\0') {
-		i = i + 1;
-		c = str[i];
-	}
-	return i;
-}
-
 func int[] makejumpmap(char[] src, int srclen) {
 	int[] jm := new int[srclen];
 	int[] stack := new int[srclen];
@@ -51,18 +43,18 @@ func int[] makejumpmap(char[] src, int srclen) {
 
 func interpret(char[] src, int srclen) {
 	int[] jm := makejumpmap(src, srclen);
-	char[] mem := new char[4088];
+	byte[] mem := new char[4088];
 	int ip := 0;
 	int memp := 0;
 	while (src[ip] != '\0') {
 		// putint(ip); putc('\n');
 		char c := src[ip];
-		if (c == '+') {mem[memp] = mem[memp] + char(1);}
-		if (c == '-') {mem[memp] = mem[memp] - char(1);}
+		if (c == '+') {mem[memp] = mem[memp] + byte(1);}
+		if (c == '-') {mem[memp] = mem[memp] - byte(1);}
 		if (c == '>') {memp = memp + 1;}
 		if (c == '<') {memp = memp - 1;}
 		if (c == '.') {putc(mem[memp]);}
-		if (c == ',') {mem[memp] = char(getc());}
+		if (c == ',') {mem[memp] = byte(getc());}
 		if (c == '[') {
 			if (mem[memp] == '\0') {
 				ip = jm[ip];
diff --git a/graph.png b/graph.png
deleted file mode 100644
index 0356b69..0000000
Binary files a/graph.png and /dev/null differ
diff --git a/liblang.asm b/liblang.asm
index 9cd905c..8502d55 100644
--- a/liblang.asm
+++ b/liblang.asm
@@ -158,7 +158,8 @@ getc:
 	syscall
 	cmp rax, 1
 	jne .fail
-	mov rax, [rsp]
+	xor eax, eax
+	mov al, [rsp]
 .finish:
 	pop r11
 	pop rcx
diff --git a/struct.lang b/struct.lang
new file mode 100644
index 0000000..3297939
--- /dev/null
+++ b/struct.lang
@@ -0,0 +1,19 @@
+type S := struct {
+	int x;
+	char y;
+};
+
+func f(int iets1, S s, int iets2) {
+	putint(s.x); putc(s.y); putc('\n');
+	putint(iets1); putc(' '); putint(iets2); putc('\n');
+}
+
+func int main() {
+	int a := getc();
+	int b := getc();
+	getc();  // newline
+	S ding := {x = 2*a, y = 'a'};
+	// return ding.x;
+	f(123, ding, 456);
+	return int(ding.y) + a + b;
+}
-- 
cgit v1.2.3-54-g00ecf