Proper struct assignment and optimisations

9 files changed, 100 insertions, 50 deletions

diff --git a/AST.hs b/AST.hs
index b42f1af..43cca5f 100644
--- a/AST.hs
+++ b/AST.hs
@@ -131,7 +131,7 @@ instance Pretty DVar where
 instance Pretty DFunc where
     prettyI i (DFunc mt n al b) =
         "func" ++ maybe "" ((' ' :) . prettyI i) mt ++ " " ++ n ++ "(" ++
-            intercalate ","
+            intercalate ", "
                 (map (\(at,an) -> prettyI i at ++ " " ++ an) al) ++
             ") " ++ prettyI i b
  
diff --git a/BuildIR.hs b/BuildIR.hs
index f40e141..c70d538 100644
--- a/BuildIR.hs
+++ b/BuildIR.hs
@@ -14,6 +14,7 @@ import Defs
 import Intermediate
 import Pretty
 import TypeRules
+import Utils
 
 
 type Scope = Map.Map Name (Ref, Type)
@@ -49,6 +50,15 @@ genTemp sz = liftM (Temp sz) genId
 genStructTemp :: Size -> BuildM Ref
 genStructTemp sz = liftM (StructTemp sz) genId
 
+genTempForType :: Type -> BuildM Ref
+genTempForType t@(TStruct _) = genStructTemp (sizeof t)
+genTempForType t = genTemp (sizeof t)
+
+genTempLike :: Ref -> BuildM Ref
+genTempLike (Temp sz _) = genTemp sz
+genTempLike (StructTemp sz _) = genStructTemp sz
+genTempLike _ = undefined
+
 newBlock :: BuildM Id
 newBlock = do
     i <- genId
@@ -125,7 +135,7 @@ internString :: String -> BuildM Ref
 internString str = do
     i <- genId
     let n = "__str_cnst_" ++ show i
-    ref <- genTemp (sizeof TInt)
+    ref <- genTempForType TInt
     addIns $ ILea ref n
     state $ \s -> (ref, s {internedStrings = internedStrings s ++ [(n, str)]})
 
@@ -180,7 +190,7 @@ convertStatement :: Statement -> Id -> BuildM ()
 convertStatement (SDecl t n e) nextnext = do
     endid <- newBlockNoSwitch
     ref <- convertExpression e endid
-    varref <- genTemp (sizeof t)
+    varref <- genTempForType t
     scopeInsert n varref t
     switchBlock endid
     addIns $ IMov varref ref
@@ -235,12 +245,12 @@ convertStatement SDebugger nextnext = do
 
 convertExpression :: Expression -> Id -> BuildM Ref
 convertExpression (ELit (LInt n) _) nextnext = do
-    ref <- genTemp (sizeof TInt)
+    ref <- genTempForType TInt
     addIns $ IMov ref (Constant (sizeof TInt) (fromInteger n))
     setTerm $ IJmp nextnext
     return ref
 convertExpression (ELit (LChar c) _) nextnext = do
-    ref <- genTemp (sizeof TChar)
+    ref <- genTempForType TChar
     addIns $ IMov ref (Constant (sizeof TChar) (fromIntegral $ ord c))
     setTerm $ IJmp nextnext
     return ref
@@ -248,7 +258,7 @@ convertExpression (ELit (LVar n) _) nextnext = do
     mres <- findVar n
     case mres of
         Just (_, (r, t)) -> do
-            ref <- genTemp (sizeof t)
+            ref <- genTempForType t
             addIns $ IMov ref r
             setTerm $ IJmp nextnext
             return ref
@@ -264,7 +274,7 @@ convertExpression (ELit (LCall n al) mrt) nextnext = do
             addIns $ ICall n refs
             return $ Temp 0 (-1)
         Just typ -> do
-            r <- genTemp (sizeof typ)
+            r <- genTempForType typ
             addIns $ ICallr r n refs
             return r
     setTerm $ IJmp nextnext
@@ -283,7 +293,7 @@ convertExpression (ELit (LStruct ms) stype) nextnext = do
     setTerm $ IJmp nextnext
     return ref
 convertExpression (EBin BOAnd e1 e2 _) nextnext = do
-    destref <- genTemp (sizeof TInt)
+    destref <- genTempForType TInt
     bl2 <- newBlockNoSwitch
     blTryR <- newBlockNoSwitch
     bl3 <- newBlockNoSwitch
@@ -317,7 +327,7 @@ convertExpression (EBin bo e1 e2 _) nextnext = do
     bl3 <- newBlockNoSwitch
     ref2 <- convertExpression e2 bl3
     switchBlock bl3
-    ref <- genTemp (sizeof $ fromJust $ retTypeBO bo (fromJust $ typeof e1) (fromJust $ typeof e2))
+    ref <- genTempForType (fromJust $ retTypeBO bo (fromJust $ typeof e1) (fromJust $ typeof e2))
     case bo of
         BOAdd -> addIns $ IAri AAdd ref ref1 ref2
         BOSub -> addIns $ IAri ASub ref ref1 ref2
@@ -343,7 +353,7 @@ convertExpression (EUn UONot e mt) nextnext =
 convertExpression (EUn UONeg e mt) nextnext =
     convertExpression (EBin BOSub (ELit (LInt 0) (typeof e)) e mt) nextnext
 convertExpression (ESubscript arr sub t) nextnext = do
-    let elemsz = sizeof $ fromJust t
+    let elemtype = fromJust t
     bl2 <- newBlockNoSwitch
     arrref <- convertExpression arr bl2
     switchBlock bl2
@@ -352,8 +362,8 @@ convertExpression (ESubscript arr sub t) nextnext = do
     switchBlock bl3
     offref <- genTemp (refSize subref)
     elemptr <- genTemp (refSize arrref)
-    arrszptr <- genTemp (sizeof TInt)
-    arrsz <- genTemp (sizeof TInt)
+    arrszptr <- genTempForType TInt
+    arrsz <- genTempForType TInt
 
     errbl <- gets errorBlock
 
@@ -363,21 +373,19 @@ convertExpression (ESubscript arr sub t) nextnext = do
     setTerm $ IJcc CUGeq subref arrsz errbl bl4
 
     switchBlock bl4
-    addIns $ IAri AMul offref subref (Constant (refSize subref) (fromIntegral elemsz))
+    addIns $ IAri AMul offref subref (Constant (refSize subref) (fromIntegral $ sizeof elemtype))
     addIns $ IAri AAdd elemptr arrref offref
-    ref <- genTemp elemsz
+    ref <- genTempForType elemtype
     addIns $ ILoad ref elemptr
     setTerm $ IJmp nextnext
     return ref
 convertExpression (EGet st n t) nextnext = do
-    let elemsz = sizeof $ fromJust t
+    let elemtype = fromJust t
+    assertM $ structMemberType (fromJust $ typeof st) n == elemtype
     bl2 <- newBlockNoSwitch
     stref <- convertExpression st bl2
     switchBlock bl2
-    let subtype = structMemberType (fromJust $ typeof st) n
-    eref <- case subtype of
-        TStruct _ -> genStructTemp elemsz
-        _ -> genTemp elemsz
+    eref <- genTempForType elemtype
     addIns $ IGet eref stref (offsetInStruct (fromJust $ typeof st) n)
     setTerm $ IJmp nextnext
     return eref
@@ -391,7 +399,7 @@ convertExpression (ECast dt e) nextnext = do
             when (not $ isIntegralType typ && isIntegralType dt) $
                 error $ "convertExpression: unimplemented cast from " ++ pretty typ ++
                         " to " ++ pretty dt
-            ref <- genTemp (sizeof dt)
+            ref <- genTempForType dt
             bl <- newBlockNoSwitch
             eref <- convertExpression e bl
             switchBlock bl
@@ -404,10 +412,10 @@ convertExpression (ENew t sze) nextnext = do
     bl2 <- newBlockNoSwitch
     szref <- convertExpression sze bl2
     switchBlock bl2
-    ref' <- genTemp (sizeof $ TArr t Nothing)
-    ref <- genTemp (sizeof $ TArr t Nothing)
-    argref' <- genTemp (sizeof TInt)
-    argref <- genTemp (sizeof TInt)
+    ref' <- genTempForType (TArr t Nothing)
+    ref <- genTempForType (TArr t Nothing)
+    argref' <- genTempForType TInt
+    argref <- genTempForType TInt
     addIns $ IAri AMul argref' szref (Constant (sizeof TInt) (fromIntegral $ sizeof t))
     addIns $ IAri AAdd argref argref' (Constant (sizeof TInt) (fromIntegral $ sizeof TInt))
     addIns $ ICallr ref' "_builtin_malloc" [argref]
@@ -433,7 +441,7 @@ convertAsExpression topae@(AEGet _ _ _) valueref nextnext = do
             addIns $ ISet vref offset valueref
         aesubscript@(AESubscript _ _ _) -> do
             elemptr <- getAESubscriptStoreRef aesubscript
-            fieldptr <- genTemp (refSize elemptr)
+            fieldptr <- genTempLike elemptr
             addIns $ IAri AAdd fieldptr elemptr (Constant (refSize elemptr) (fromIntegral offset))
             addIns $ IStore fieldptr valueref
         AEGet _ _ _ -> undefined
@@ -461,10 +469,10 @@ getAESubscriptStoreRef (AESubscript ae2 expr mrt) = do
     bl2 <- newBlockNoSwitch
     subref <- convertExpression expr bl2
     switchBlock bl2
-    offref <- genTemp (sizeof TInt)
-    elemptr <- genTemp (sizeof TInt)
-    arrszptr <- genTemp (sizeof TInt)
-    arrsz <- genTemp (sizeof TInt)
+    offref <- genTempForType TInt
+    elemptr <- genTempForType TInt
+    arrszptr <- genTempForType TInt
+    arrsz <- genTempForType TInt
 
     errbl <- gets errorBlock
 
@@ -486,19 +494,19 @@ getAESubscriptStoreRef (AESubscript ae2 expr mrt) = do
                         Just (_, (r, t)) -> return (r, t)
                         Nothing -> throwError $ "Undefined variable '" ++ n ++ "'" ++
                                                 " used in assignment expression"
-        ref <- genTemp (sizeof t)
+        ref <- genTempForType t
         addIns $ IMov ref vref
         return ref
     goLoad (AESubscript ae expr' _) = do
-        let elemsz = sizeof $ fromJust $ typeof ae
+        let elemtype = fromJust $ typeof ae
         ref <- goLoad ae
         bl2 <- newBlockNoSwitch
         eref <- convertExpression expr' bl2
         switchBlock bl2
-        offref <- genTemp (sizeof TInt)
-        elemptr <- genTemp (sizeof TInt)
-        arrszptr <- genTemp (sizeof TInt)
-        arrsz <- genTemp (sizeof TInt)
+        offref <- genTempForType TInt
+        elemptr <- genTempForType TInt
+        arrszptr <- genTempForType TInt
+        arrsz <- genTempForType TInt
 
         errbl <- gets errorBlock
 
@@ -508,15 +516,15 @@ getAESubscriptStoreRef (AESubscript ae2 expr mrt) = do
         setTerm $ IJcc CUGeq eref arrsz errbl bl3
 
         switchBlock bl3
-        addIns $ IAri AMul offref eref (Constant (sizeof TInt) (fromIntegral elemsz))
+        addIns $ IAri AMul offref eref (Constant (sizeof TInt) (fromIntegral $ sizeof elemtype))
         addIns $ IAri AAdd elemptr ref offref
-        dstref <- genTemp elemsz
+        dstref <- genTempForType elemtype
         addIns $ ILoad dstref elemptr
         return dstref
     goLoad topae@(AEGet topup _ _) = do
         let (core, _, offset) = collectAESets topae
         coreref <- goLoad core
-        ref <- genTemp (sizeof $ fromJust $ typeof topup)
+        ref <- genTempForType (fromJust $ typeof topup)
         addIns $ IGet ref coreref offset
         return ref
 getAESubscriptStoreRef _ = undefined
diff --git a/CodeGen.hs b/CodeGen.hs
index bcc49a0..41f37b2 100644
--- a/CodeGen.hs
+++ b/CodeGen.hs
@@ -255,8 +255,7 @@ codegenIns :: AllocMap -> IRIns -> CGMonad ()
 codegenIns m (IMov d s)
     | dm == sm = return ()
     | X64.isXMem dm && X64.isXMem sm = do
-        addIns $ mkmov (XReg (fromIntegral $ refSize s) RAX) sm
-        addIns $ mkmov dm (XReg (fromIntegral $ refSize d) RAX)
+        emitmemcpy dm sm
     | otherwise = addIns $ mkmov dm sm
   where dm = mkxref d m
         sm = mkxref s m
@@ -320,9 +319,17 @@ codegenIns m (IGet d s off)
 codegenIns m (IAri AMul d s1 s2)
     | X64.isXImm s1m && X64.isXImm s2m = undefined
     | X64.isXImm s1m = codegenIns m (IAri AMul d s2 s1)
+    | dm == s2m =
+        if dm == s1m
+            then if X64.isXMem dm
+                    then do
+                        addIns $ mkmov (XReg sz RAX) dm
+                        addIns $ IMUL (xref $ XReg sz RAX) (xref $ XReg sz RAX)
+                        addIns $ mkmov dm (XReg sz RAX)
+                    else addIns $ IMUL (xref dm) (xref dm)
+            else codegenIns m (IAri AMul d s2 s1)
     | otherwise = do
         -- regmem dm, regmem s1m, regmemimm s2m
-        let sz = fromIntegral $ refSize d
         if X64.isXImm s2m
             then if X64.isXMem dm
                     then do  -- mem dm, regmem s1m, imm s2m
@@ -344,6 +351,7 @@ codegenIns m (IAri AMul d s1 s2)
   where dm = mkxref d m
         s1m = mkxref s1 m
         s2m = mkxref s2 m
+        sz = fromIntegral $ refSize d
 codegenIns m (IAri ADiv d s1 s2) = do
     let sz = fromIntegral $ refSize d
     addIns $ XOR (xref $ XReg 4 RDX) (xref $ XReg 4 RDX)
diff --git a/Intermediate.hs b/Intermediate.hs
index dde941d..d6ad1cd 100644
--- a/Intermediate.hs
+++ b/Intermediate.hs
@@ -92,7 +92,7 @@ instance Pretty IRProgram where
 instance Pretty IRFunc where
     prettyI i (IRFunc mt n al bbs sid) =
         "irfunc" ++ maybe "" ((' ' :) . prettyI i) mt ++ " " ++ n ++ "(" ++
-            intercalate ","
+            intercalate ", "
                 (map (\(at,an) -> prettyI i at ++ " " ++ an) al) ++
             ")\n" ++ indent i ++
             intercalate ("\n" ++ indent i) (map (prettyI i) sorted)
diff --git a/Main.hs b/Main.hs
index a31c79d..eb84072 100644
--- a/Main.hs
+++ b/Main.hs
@@ -32,7 +32,7 @@ performCompile :: String -> IO ()
 performCompile source = do
     let eres = return source
                  >>= parseProgram <?> "Parse error"
-                 >>= return . tracePrettyId
+                 -- >>= return . tracePrettyId
                  >>= typeCheck <?> "Type error"
                  >>= buildIR <?> "IR building error"
                  >>= optimise <?> "Error while optimising"
diff --git a/Optimiser.hs b/Optimiser.hs
index 408bd24..f94441c 100644
--- a/Optimiser.hs
+++ b/Optimiser.hs
@@ -28,6 +28,12 @@ optimise prog =
                 fst $ fromJust $ find (uncurry (==)) $ zip passreslist (tail passreslist)
         else return $ reslist !! 5
   where
+    -- optimisations = map funcopt
+    --     [chainJumps, removeUnusedBlocks]
+    -- optimisations = map funcopt
+    --     [chainJumps, mergeTerminators, looseJumps,
+    --      removeUnusedBlocks,
+    --      constantPropagate, movPush]
     optimisations = map funcopt
         [chainJumps, mergeTerminators, looseJumps,
          removeUnusedBlocks, removeDuplicateBlocks,
@@ -150,16 +156,20 @@ constantPropagate :: FuncOptimisation
 constantPropagate (IRFunc rt name al bbs sid) = IRFunc rt name al bbs' sid
   where
     alltemps = findAllTempsBBList bbs
+    alltempsmuts = Map.fromList $ map (\ref -> (ref, findMutations' bbs ref)) alltemps
     consttemps = catMaybes $ flip map alltemps $ \ref ->
-        let locs = findMutations' bbs ref
+        let locs = fromJust $ Map.lookup ref alltempsmuts
             loc = head locs
             ins = insAt bbs loc
+            usedrefs = findAllRefsIns ins
             readlocs = findMentions' bbs ref \\ locs
             readinss = map (insAt' bbs) readlocs
             allimov = all (maybe False isIMov) readinss
-        in if length locs == 1 && (isIMov ins || ((isILoad ins || isIAri ins || isIResize ins) && allimov))
-               then Just (loc, ins)
-               else Nothing
+        in if length locs == 1 &&  -- check necessary because it shouldn't be 0
+                all (maybe True ((<=1) . length) . flip Map.lookup alltempsmuts) usedrefs &&
+                (isIMov ins || ((isILoad ins || isIAri ins || isIResize ins) && allimov))
+            then Just (loc, ins)
+            else Nothing
 
     bbs' = case consttemps of
                 [] -> bbs
@@ -416,7 +426,7 @@ removeUnusedInstructions (IRFunc rt name al bbs sid) = IRFunc rt name al (map go
     goI ins@(IGet d _ _) = pureInstruction d ins
     goI ins@(IAri _ d _ _) = pureInstruction d ins
     goI ins@(ICall _ _) = Just ins
-    goI ins@(ICallr _ _ _) = Just ins
+    goI ins@(ICallr d f a) = if length (findMentions' bbs d) == 1 then Just (ICall f a) else Just ins
     goI ins@(IResize d _) = pureInstruction d ins
     goI IDebugger = Just IDebugger
     goI INop = Nothing
@@ -537,6 +547,7 @@ findMutations (BB _ inss _) ref =
     catMaybes $ flip map (zip inss [0..]) $ \(ins, idx) -> case ins of
         (IMov r _) | r == ref -> Just idx
         (ILoad r _) | r == ref -> Just idx
+        (ISet r _ _) | r == ref -> Just idx
         (IAri _ r _ _) | r == ref -> Just idx
         (ICallr r _ _) | r == ref -> Just idx
         (IResize r _) | r == ref -> Just idx
diff --git a/Utils.hs b/Utils.hs
index 51eecf8..1d34a5c 100644
--- a/Utils.hs
+++ b/Utils.hs
@@ -14,3 +14,7 @@ contains l v = isJust $ find (== v) l
 
 roundUp :: Integral a => a -> a -> a
 roundUp n sz = (n + sz - 1) `div` sz * sz
+
+assertM :: Monad m => Bool -> m ()
+assertM True = return ()
+assertM False = error "assertM failed"
diff --git a/opttest.lang b/opttest.lang
new file mode 100644
index 0000000..9f87e78
--- /dev/null
+++ b/opttest.lang
@@ -0,0 +1,8 @@
+func int main() {
+	int a := 1;
+	int b := 2;
+	int x := a + b;
+	b = 100;
+	putint(x); putc('\n');
+	return 0;
+}
diff --git a/struct.lang b/struct.lang
index 4f89e52..00b3442 100644
--- a/struct.lang
+++ b/struct.lang
@@ -11,7 +11,7 @@ func f(int iets1, S s, int iets2) {
 }
 
 func int main() {
-	global.x = 3 * global.x + int(global.y);
+	/*global.x = 3 * global.x + int(global.y);
 	putint(global.x + 1); putc(global.y); putc('\n');
 	int a := getc();
 	int b := getc();
@@ -19,5 +19,16 @@ func int main() {
 	S ding := {x = 2*a, y = 'a'};
 	// return ding.x;
 	f(123, ding, 456);
-	return int(ding.y) + a + b;
+	S ding2 := ding;
+	ding2.x = ding2.x;
+	// ding2.y = ding2.y;
+	f(234, ding2, 567);
+	return int(ding.y) + a + b;*/
+
+	int a := getc();
+	getc();  // newline
+	S ding := {x = 2*a, y = 'a'};
+	S ding2 := ding;
+	f(123, ding2, 456);
+	return 0;
 }