From d3a574adcc026dbfcd030525f4e6d95d5d3f00dc Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 27 Feb 2015 23:53:22 +0300
Subject: [PATCH 001/116] Lexer prototype

---
 komarov.andrey/examples/example1.l | 14 ++++++
 komarov.andrey/src/Lexer.x         | 71 ++++++++++++++++++++++++++++++
 komarov.andrey/src/TestLex.hs      |  6 +++
 3 files changed, 91 insertions(+)
 create mode 100644 komarov.andrey/examples/example1.l
 create mode 100644 komarov.andrey/src/Lexer.x
 create mode 100644 komarov.andrey/src/TestLex.hs

diff --git a/komarov.andrey/examples/example1.l b/komarov.andrey/examples/example1.l
new file mode 100644
index 00000000..3e6d18d
--- /dev/null
+++ b/komarov.andrey/examples/example1.l
@@ -0,0 +1,14 @@
+
+int summ(int n)
+{
+    int i;
+    int sum;
+    i = 0;
+    sum = 0;
+    while (i < n)
+    {
+        sum = sum + i;
+        i = i + 1;
+    }
+    return sum;
+}
diff --git a/komarov.andrey/src/Lexer.x b/komarov.andrey/src/Lexer.x
new file mode 100644
index 00000000..1051a95
--- /dev/null
+++ b/komarov.andrey/src/Lexer.x
@@ -0,0 +1,71 @@
+{
+module Lexer (
+       Token(..), scanTokens
+) where
+}
+
+%wrapper "basic"
+
+$digit = 0-9
+$alpha = [a-zA-Z]
+$eol = [\n]
+
+tokens :-
+       $eol                     ;
+       $white+                  ;
+       $digit+                  { \s -> TokenNum (read s) }
+       "("                      { \_ -> TokenLParen }
+       ")"                      { \_ -> TokenRParen }
+       "{"                      { \_ -> TokenLBrace }
+       "}"                      { \_ -> TokenRBrace }
+       "+"                      { \_ -> TokenAdd }
+       "-"                      { \_ -> TokenSub }
+       "*"                      { \_ -> TokenMul }
+       "/"                      { \_ -> TokenDiv }
+       "%"                      { \_ -> TokenMod }
+       "<"                      { \_ -> TokenLess }
+       ">"                      { \_ -> TokenGreater }
+       "=="                     { \_ -> TokenEqual }
+       "<="                     { \_ -> TokenLessEq }
+       ">="                     { \_ -> TokenGreaterEq }
+       "!="                     { \_ -> TokenNotEqual }
+       "&&"                     { \_ -> TokenAnd }
+       "||"                     { \_ -> TokenOr }
+       "="                      { \_ -> TokenAssign }
+       ";"                      { \_ -> TokenSemicolon }
+       "if"                     { \_ -> TokenIf }
+       "while"                  { \_ -> TokenWhile }
+       "return"                 { \_ -> TokenReturn }
+       $alpha+                  { \s -> TokenVar s }
+
+{
+
+data Token = TokenNum Int
+           | TokenVar String
+           | TokenLParen
+           | TokenRParen
+           | TokenLBrace
+           | TokenRBrace
+           | TokenAdd
+           | TokenSub
+           | TokenMul
+           | TokenDiv
+           | TokenMod
+           | TokenLess
+           | TokenGreater
+           | TokenEqual
+           | TokenLessEq
+           | TokenGreaterEq
+           | TokenNotEqual
+           | TokenAnd
+           | TokenOr
+           | TokenAssign
+           | TokenSemicolon
+           | TokenIf
+           | TokenWhile
+           | TokenReturn
+           deriving (Eq, Show)
+
+scanTokens = alexScanTokens
+
+}
diff --git a/komarov.andrey/src/TestLex.hs b/komarov.andrey/src/TestLex.hs
new file mode 100644
index 00000000..2fb595d
--- /dev/null
+++ b/komarov.andrey/src/TestLex.hs
@@ -0,0 +1,6 @@
+import Lexer
+
+main = do
+    input <- getContents
+    putStrLn input
+    print $ scanTokens input

From 679a07a1aa0aad5c4d8991d137623c40b1c0e5c9 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sat, 28 Feb 2015 01:53:40 +0300
Subject: [PATCH 002/116] Parser prototype (not works)

---
 komarov.andrey/examples/example2.l |   1 +
 komarov.andrey/src/AST.hs          |  50 ++++++++++++++
 komarov.andrey/src/Lexer.x         |   8 +++
 komarov.andrey/src/Parser.y        | 105 +++++++++++++++++++++++++++++
 komarov.andrey/src/TestParse.hs    |   7 ++
 5 files changed, 171 insertions(+)
 create mode 100644 komarov.andrey/examples/example2.l
 create mode 100644 komarov.andrey/src/AST.hs
 create mode 100644 komarov.andrey/src/Parser.y
 create mode 100644 komarov.andrey/src/TestParse.hs

diff --git a/komarov.andrey/examples/example2.l b/komarov.andrey/examples/example2.l
new file mode 100644
index 00000000..967c760
--- /dev/null
+++ b/komarov.andrey/examples/example2.l
@@ -0,0 +1 @@
+int lol() {}
diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
new file mode 100644
index 00000000..c44fe24
--- /dev/null
+++ b/komarov.andrey/src/AST.hs
@@ -0,0 +1,50 @@
+module AST (
+  Id, Type,
+  Program(..),
+  FunctionDefinition(..),
+  Statement(..),
+  Expresstion(..)
+  ) where
+
+type Id = String
+
+type Type = String
+
+data Program = Program [FunctionDefinition]
+               deriving (Show, Eq, Ord)
+
+data FunctionDefinition = FunctionDefinition
+                          { functionRetType :: Type
+                          , functionName    :: Id
+                          , functionArgs    :: [(Type, Id)]
+                          , functionBody    :: [Statement]
+                          } deriving (Show, Eq, Ord)
+
+data Statement = Block [Statement]
+               | VariableDeclaration Type [Id]
+               | Assignment Id Expresstion
+               | RawExpression Expresstion
+               | IfThen Expresstion Statement
+               | IfThenElse Expresstion Statement Statement
+               | While Expresstion Statement
+               | Return Expresstion
+               deriving (Show, Eq, Ord)
+
+data Expresstion = EVar Id
+                 | EInt Int
+                 | EBool Bool
+                 | EAdd Expresstion Expresstion
+                 | ESub Expresstion Expresstion
+                 | EMul Expresstion Expresstion
+                 | EDiv Expresstion Expresstion
+                 | EMod Expresstion Expresstion
+                 | ELess Expresstion Expresstion
+                 | EGreater Expresstion Expresstion
+                 | EEqual Expresstion Expresstion
+                 | ELessEq Expresstion Expresstion
+                 | EGreaterEq Expresstion Expresstion
+                 | ENotEqual Expresstion Expresstion
+                 | EAnd Expresstion Expresstion
+                 | EOr Expresstion Expresstion
+                 | ECall Id [Expresstion]
+                 deriving (Show, Eq, Ord)
diff --git a/komarov.andrey/src/Lexer.x b/komarov.andrey/src/Lexer.x
index 1051a95..7b9a97c 100644
--- a/komarov.andrey/src/Lexer.x
+++ b/komarov.andrey/src/Lexer.x
@@ -34,8 +34,12 @@ tokens :-
        "="                      { \_ -> TokenAssign }
        ";"                      { \_ -> TokenSemicolon }
        "if"                     { \_ -> TokenIf }
+       "else"                   { \_ -> TokenElse }
        "while"                  { \_ -> TokenWhile }
        "return"                 { \_ -> TokenReturn }
+       "true"                   { \_ -> TokenTrue }
+       "false"                  { \_ -> TokenFalse }
+       ","                      { \_ -> TokenComma }
        $alpha+                  { \s -> TokenVar s }
 
 {
@@ -62,8 +66,12 @@ data Token = TokenNum Int
            | TokenAssign
            | TokenSemicolon
            | TokenIf
+           | TokenElse
            | TokenWhile
            | TokenReturn
+           | TokenTrue
+           | TokenFalse
+           | TokenComma
            deriving (Eq, Show)
 
 scanTokens = alexScanTokens
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
new file mode 100644
index 00000000..b1a4c8d
--- /dev/null
+++ b/komarov.andrey/src/Parser.y
@@ -0,0 +1,105 @@
+{
+module Parser (
+       parse
+) where
+
+import Lexer
+import AST
+
+}
+
+%name parse
+%tokentype { Token }
+%error { parseError }
+
+%token
+        '('             { TokenLParen }
+        ')'             { TokenRParen }
+        '{'             { TokenLBrace }
+        '}'             { TokenRBrace }
+        '+'             { TokenAdd }
+        '-'             { TokenSub }
+        '*'             { TokenMul }
+        '/'             { TokenDiv }
+        '%'             { TokenMod }
+        '<'             { TokenLess }
+        '>'             { TokenGreater }
+        '=='            { TokenEqual }
+        '<='            { TokenLessEq }
+        '>='            { TokenGreaterEq }
+        '!='            { TokenNotEqual }
+        '&&'            { TokenAnd }
+        '||'            { TokenOr }
+        '='             { TokenAssign }
+        ';'             { TokenSemicolon }
+        if              { TokenIf }
+        else            { TokenElse }
+        while           { TokenWhile }
+        return          { TokenReturn }
+        num             { TokenNum $$ }
+        true            { TokenTrue }
+        false           { TokenFalse }
+        var             { TokenVar $$ }
+        ','             { TokenComma }
+
+%left ','
+%left '||' '&&'
+%left '<' '>' '<=' '>=' '==' '!='
+%left '+' '-'
+%left '*' '/' '%'
+
+%%
+
+Prog            : FuncDefs                      { Program $1 }
+
+Expr            : var                           { EVar $1 }
+                | num                           { EInt $1 }
+                | true                          { EBool True }
+                | false                         { EBool False }
+                | '(' Expr ')'                  { $2 }
+                | Expr '+' Expr                 { EAdd $1 $3 }
+                | Expr '-' Expr                 { ESub $1 $3 }
+                | Expr '*' Expr                 { EMul $1 $3 }
+                | Expr '/' Expr                 { EDiv $1 $3 }
+                | Expr '%' Expr                 { EMod $1 $3 }
+                | Expr '<' Expr                 { ELess $1 $3 }
+                | Expr '>' Expr                 { EGreater $1 $3 }
+                | Expr '==' Expr                { EEqual $1 $3 }
+                | Expr '<=' Expr                { ELessEq $1 $3 }
+                | Expr '>=' Expr                { EGreaterEq $1 $3 }
+                | Expr '!=' Expr                { ENotEqual $1 $3 }
+                | Expr '&&' Expr                { EAnd $1 $3 }
+                | Expr '||' Expr                { EOr $1 $3 }
+                | var '(' FuncCallList ')'      { ECall $1 $3 }
+
+FuncCallList    : {- empty -}                   { [] }
+                | Expr                          { [$1] }
+                | Expr ',' FuncCallList         { $1:$3 }
+
+Stmt            : '{' Stmts '}'                 { Block $2 }
+                | var Vars ';'                  { VariableDeclaration $1 $2 }
+                | var '=' Expr ';'              { Assignment $1 $3}
+                | Expr ';'                      { RawExpression $1 }
+                | if '(' Expr ')' Stmt else Stmt  { IfThenElse $3 $5 $7 }
+                | while '(' Expr ')' Stmt       { While $3 $5 }
+                | return Expr ';'               { Return $2 }
+
+Vars            : var                           { [$1] }
+                | var ',' Vars                  { $1:$3 }
+
+Stmts           : {- empty -}                   { [] }
+                | Stmt ';' Stmts                { $1:$3 }
+
+FuncDef         : var var '(' FuncArgs ')' '{' Stmts '}'        { FunctionDefinition $1 $2 $4 $7 }
+
+FuncArgs        : {- empty -}                   { [] }
+                | var var                       { [($1, $2)] }
+                | var var ',' FuncArgs          { ($1, $2):$4 }
+
+FuncDefs        : FuncDef                       { [$1] }
+                | FuncDef FuncDefs              { $1:$2 }
+
+{
+parseError :: [Token] -> a
+parseError _ = error "Parse error"
+}
diff --git a/komarov.andrey/src/TestParse.hs b/komarov.andrey/src/TestParse.hs
new file mode 100644
index 00000000..47810a9
--- /dev/null
+++ b/komarov.andrey/src/TestParse.hs
@@ -0,0 +1,7 @@
+import Parser
+import Lexer
+
+main = do
+    input <- getContents
+    putStrLn input
+    print $ parse $ scanTokens $ input

From 97695c5e432d8f3e98772d59cfd025313334188e Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sat, 28 Feb 2015 02:01:49 +0300
Subject: [PATCH 003/116] Parser is able to parse simple program

---
 komarov.andrey/src/Makefile     | 5 +++++
 komarov.andrey/src/Parser.y     | 2 +-
 komarov.andrey/src/TestParse.hs | 1 +
 3 files changed, 7 insertions(+), 1 deletion(-)
 create mode 100644 komarov.andrey/src/Makefile

diff --git a/komarov.andrey/src/Makefile b/komarov.andrey/src/Makefile
new file mode 100644
index 00000000..6aae87a
--- /dev/null
+++ b/komarov.andrey/src/Makefile
@@ -0,0 +1,5 @@
+all:
+	alex Lexer.x
+	happy Parser.y
+	ghc TestParse
+
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index b1a4c8d..f813c51 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -88,7 +88,7 @@ Vars            : var                           { [$1] }
                 | var ',' Vars                  { $1:$3 }
 
 Stmts           : {- empty -}                   { [] }
-                | Stmt ';' Stmts                { $1:$3 }
+                | Stmt Stmts                { $1:$2 }
 
 FuncDef         : var var '(' FuncArgs ')' '{' Stmts '}'        { FunctionDefinition $1 $2 $4 $7 }
 
diff --git a/komarov.andrey/src/TestParse.hs b/komarov.andrey/src/TestParse.hs
index 47810a9..6872560 100644
--- a/komarov.andrey/src/TestParse.hs
+++ b/komarov.andrey/src/TestParse.hs
@@ -4,4 +4,5 @@ import Lexer
 main = do
     input <- getContents
     putStrLn input
+    print $ scanTokens $ input
     print $ parse $ scanTokens $ input

From 52bc69ab87e7b4bad2ae75db6eb71a84a75d675d Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 15 Mar 2015 04:00:07 +0300
Subject: [PATCH 004/116] Some attempt for types AST

---
 komarov.andrey/examples/example1.l |  3 +-
 komarov.andrey/src/AST.hs          |  3 --
 komarov.andrey/src/Lexer.x         |  4 --
 komarov.andrey/src/Parser.y        |  6 +--
 komarov.andrey/src/TypedAST.hs     | 63 ++++++++++++++++++++++++++++++
 5 files changed, 65 insertions(+), 14 deletions(-)
 create mode 100644 komarov.andrey/src/TypedAST.hs

diff --git a/komarov.andrey/examples/example1.l b/komarov.andrey/examples/example1.l
index 3e6d18d..b93f494 100644
--- a/komarov.andrey/examples/example1.l
+++ b/komarov.andrey/examples/example1.l
@@ -1,8 +1,7 @@
 
 int summ(int n)
 {
-    int i;
-    int sum;
+    int i, sum;
     i = 0;
     sum = 0;
     while (i < n)
diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index c44fe24..c623015 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -24,7 +24,6 @@ data Statement = Block [Statement]
                | VariableDeclaration Type [Id]
                | Assignment Id Expresstion
                | RawExpression Expresstion
-               | IfThen Expresstion Statement
                | IfThenElse Expresstion Statement Statement
                | While Expresstion Statement
                | Return Expresstion
@@ -36,8 +35,6 @@ data Expresstion = EVar Id
                  | EAdd Expresstion Expresstion
                  | ESub Expresstion Expresstion
                  | EMul Expresstion Expresstion
-                 | EDiv Expresstion Expresstion
-                 | EMod Expresstion Expresstion
                  | ELess Expresstion Expresstion
                  | EGreater Expresstion Expresstion
                  | EEqual Expresstion Expresstion
diff --git a/komarov.andrey/src/Lexer.x b/komarov.andrey/src/Lexer.x
index 7b9a97c..f959b78 100644
--- a/komarov.andrey/src/Lexer.x
+++ b/komarov.andrey/src/Lexer.x
@@ -21,8 +21,6 @@ tokens :-
        "+"                      { \_ -> TokenAdd }
        "-"                      { \_ -> TokenSub }
        "*"                      { \_ -> TokenMul }
-       "/"                      { \_ -> TokenDiv }
-       "%"                      { \_ -> TokenMod }
        "<"                      { \_ -> TokenLess }
        ">"                      { \_ -> TokenGreater }
        "=="                     { \_ -> TokenEqual }
@@ -53,8 +51,6 @@ data Token = TokenNum Int
            | TokenAdd
            | TokenSub
            | TokenMul
-           | TokenDiv
-           | TokenMod
            | TokenLess
            | TokenGreater
            | TokenEqual
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index f813c51..6b9ec13 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -20,8 +20,6 @@ import AST
         '+'             { TokenAdd }
         '-'             { TokenSub }
         '*'             { TokenMul }
-        '/'             { TokenDiv }
-        '%'             { TokenMod }
         '<'             { TokenLess }
         '>'             { TokenGreater }
         '=='            { TokenEqual }
@@ -46,7 +44,7 @@ import AST
 %left '||' '&&'
 %left '<' '>' '<=' '>=' '==' '!='
 %left '+' '-'
-%left '*' '/' '%'
+%left '*'
 
 %%
 
@@ -60,8 +58,6 @@ Expr            : var                           { EVar $1 }
                 | Expr '+' Expr                 { EAdd $1 $3 }
                 | Expr '-' Expr                 { ESub $1 $3 }
                 | Expr '*' Expr                 { EMul $1 $3 }
-                | Expr '/' Expr                 { EDiv $1 $3 }
-                | Expr '%' Expr                 { EMod $1 $3 }
                 | Expr '<' Expr                 { ELess $1 $3 }
                 | Expr '>' Expr                 { EGreater $1 $3 }
                 | Expr '==' Expr                { EEqual $1 $3 }
diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
new file mode 100644
index 00000000..e78b91e
--- /dev/null
+++ b/komarov.andrey/src/TypedAST.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE GADTs, KindSignatures, DataKinds, PolyKinds #-}
+{-# LANGUAGE TypeOperators, RankNTypes, ImpredicativeTypes #-}
+module TypedAST (
+
+  ) where
+
+import qualified Data.Map as M
+
+type Id = String
+
+data Type = TBool
+          | TInt
+          | TString
+          | TVoid
+
+data LiftType :: Type -> * where
+  LiftBool :: LiftType TBool
+  LiftInt :: LiftType TInt
+  LiftString :: LiftType TString
+  LiftVoid :: LiftType TVoid
+
+type Env = Id -> Type
+type Scope = [(Id, Type)]
+
+data TStatement :: Type -> * where
+  TBlock :: TStatement t -> [TStatement t] -> TStatement t
+  TEmpty :: TStatement t
+  TVariableDeclaration :: Type -> [Id] -> TStatement t
+  TAssignment :: Id -> TExpr t' -> TStatement t
+  TRawExpression :: TExpr t' -> TStatement t
+  TIfThenElse :: TExpr TBool -> TStatement t -> TStatement t ->
+                 TStatement t
+  TWhile :: TExpr TBool -> TStatement t -> TStatement t
+  TReturn :: TExpr t -> TStatement t
+  
+
+data TFunction :: [Type] -> Type -> * where
+  TFunction :: Types argTypes -> Scope -> TStatement ret ->
+               TFunction argTypes ret
+
+data TList (f :: k -> *) :: [k] -> * where
+  Nil :: TList f '[]
+  Cons :: f t -> TList f tx -> TList f (t ': tx)
+
+type TExprs = TList TExpr
+type Types = TList LiftType
+
+data TExpr :: Type -> * where
+  TEInt :: Int -> TExpr TInt
+  TEBool :: Bool -> TExpr TBool
+  TEAddInt :: TExpr TInt -> TExpr TInt -> TExpr TInt
+  TESub :: TExpr TInt -> TExpr TInt -> TExpr TInt
+  TEMul :: TExpr TInt -> TExpr TInt -> TExpr TInt
+  TELess :: TExpr TInt -> TExpr TInt -> TExpr TBool
+  TEGreater :: TExpr TInt -> TExpr TInt -> TExpr TBool
+  TELessEq :: TExpr TInt -> TExpr TInt -> TExpr TBool
+  TEGreaterEq :: TExpr TInt -> TExpr TInt -> TExpr TBool
+  TEEqual :: TExpr t -> TExpr t -> TExpr TBool
+  TENotEqual :: TExpr t -> TExpr t -> TExpr TBool
+  TEAnd :: TExpr TBool -> TExpr TBool -> TExpr TBool
+  TEOr :: TExpr TBool -> TExpr TBool -> TExpr TBool
+  TECall :: TFunction args ret -> TExprs args -> TExpr res
+

From 25162a3f46206214542ba1ffdda5f030e36c08ed Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 18 Mar 2015 04:01:56 +0300
Subject: [PATCH 005/116] ARM AST started

---
 komarov.andrey/src/ARM.hs      | 64 ++++++++++++++++++++++++++++++++
 komarov.andrey/src/TypedAST.hs | 68 +++++++++++-----------------------
 2 files changed, 85 insertions(+), 47 deletions(-)
 create mode 100644 komarov.andrey/src/ARM.hs

diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/ARM.hs
new file mode 100644
index 00000000..209dfe2
--- /dev/null
+++ b/komarov.andrey/src/ARM.hs
@@ -0,0 +1,64 @@
+module ARM (
+
+  ) where
+
+import Data.Int
+   
+data Register = R0 | R1 | R2 | R3
+              | R4 | R5 | R6 | R7
+              | R8 | R9 | R10 | R11
+              | R12 | R13 | R14 | R15
+  deriving (Eq, Ord, Show)
+
+bp, sp, lr, pc :: Register
+bp = R11
+sp = R13
+lr = R14
+pc = R15
+
+data Cond = Eq -- Z set
+          | Ne -- Z clear
+          | Cs -- C set
+          | Cc -- C clear
+          | Mi -- N set
+          | Pl -- N clear
+          | Vs -- V set
+          | Vc -- V clear
+          | Hi -- Cs & Zc
+          | Ls -- Cc | Zs
+          | Ge -- (Ns & Vs) | (Nc & Vc)
+          | Lt -- (Ns & Vc) | (Nc & Vs)
+          | Gt -- Zc & Ge
+          | Le -- Zs & Lt
+          | Al -- always
+          | Nv -- reserved
+
+data SetFlags = Update | Ignore
+
+-- TODO добавить barrel shifter
+data Operand2 = Reg Register | Imm Int32
+
+data Width = Word | HalfWord | Byte
+
+data OpCode
+  = ADD SetFlags Register Register Operand2
+  | SUB SetFlags Register Register Operand2
+  | RSB SetFlags Register Register Operand2
+  | MUL SetFlags Register Register Operand2
+  | B Int32
+  | BL Int32
+  | CMP Register Operand2
+  | CMN Register Operand2
+  | TST Register Operand2
+  | TEQ Register Operand2 -- xor
+  | AND SetFlags Register Register Operand2
+  | EOR SetFlags Register Register Operand2
+  | ORR SetFlags Register Register Operand2
+  | BIC SetFlags Register Register Operand2 -- and not
+  | MOV SetFlags Register Operand2
+  | MVN SetFlags Register Operand2
+  | LDR' Register Int32 -- cheats
+  | LDR Width Register Register Operand2
+  | STR Width Register Register Operand2
+  | SWI
+
diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index e78b91e..54e6bb1 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -1,11 +1,19 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE GADTs, KindSignatures, DataKinds, PolyKinds #-}
 {-# LANGUAGE TypeOperators, RankNTypes, ImpredicativeTypes #-}
 module TypedAST (
 
   ) where
 
+import Control.Monad.Reader
+import Control.Monad.Error
+import Control.Applicative
+import Data.List (find)
+
 import qualified Data.Map as M
 
+import qualified AST
+
 type Id = String
 
 data Type = TBool
@@ -13,51 +21,17 @@ data Type = TBool
           | TString
           | TVoid
 
-data LiftType :: Type -> * where
-  LiftBool :: LiftType TBool
-  LiftInt :: LiftType TInt
-  LiftString :: LiftType TString
-  LiftVoid :: LiftType TVoid
-
-type Env = Id -> Type
-type Scope = [(Id, Type)]
-
-data TStatement :: Type -> * where
-  TBlock :: TStatement t -> [TStatement t] -> TStatement t
-  TEmpty :: TStatement t
-  TVariableDeclaration :: Type -> [Id] -> TStatement t
-  TAssignment :: Id -> TExpr t' -> TStatement t
-  TRawExpression :: TExpr t' -> TStatement t
-  TIfThenElse :: TExpr TBool -> TStatement t -> TStatement t ->
-                 TStatement t
-  TWhile :: TExpr TBool -> TStatement t -> TStatement t
-  TReturn :: TExpr t -> TStatement t
-  
-
-data TFunction :: [Type] -> Type -> * where
-  TFunction :: Types argTypes -> Scope -> TStatement ret ->
-               TFunction argTypes ret
-
-data TList (f :: k -> *) :: [k] -> * where
-  Nil :: TList f '[]
-  Cons :: f t -> TList f tx -> TList f (t ': tx)
-
-type TExprs = TList TExpr
-type Types = TList LiftType
-
-data TExpr :: Type -> * where
-  TEInt :: Int -> TExpr TInt
-  TEBool :: Bool -> TExpr TBool
-  TEAddInt :: TExpr TInt -> TExpr TInt -> TExpr TInt
-  TESub :: TExpr TInt -> TExpr TInt -> TExpr TInt
-  TEMul :: TExpr TInt -> TExpr TInt -> TExpr TInt
-  TELess :: TExpr TInt -> TExpr TInt -> TExpr TBool
-  TEGreater :: TExpr TInt -> TExpr TInt -> TExpr TBool
-  TELessEq :: TExpr TInt -> TExpr TInt -> TExpr TBool
-  TEGreaterEq :: TExpr TInt -> TExpr TInt -> TExpr TBool
-  TEEqual :: TExpr t -> TExpr t -> TExpr TBool
-  TENotEqual :: TExpr t -> TExpr t -> TExpr TBool
-  TEAnd :: TExpr TBool -> TExpr TBool -> TExpr TBool
-  TEOr :: TExpr TBool -> TExpr TBool -> TExpr TBool
-  TECall :: TFunction args ret -> TExprs args -> TExpr res
+type Env = [(Id, Type)]
+
+newtype Typecheck a = Typecheck { unTypecheck :: ErrorT String (Reader Env) a }
+                    deriving (Functor, Applicative, Monad, MonadReader Env, MonadError String)
+
+getType :: Id -> Typecheck Type
+getType name = do
+  env <- ask
+  case find ((== name) . fst) env of
+   Nothing -> throwError $ "No such var in env: " ++ name
+   Just t -> return $ snd t
 
+typecheck :: AST.Statement -> Typecheck ()
+typecheck (AST.Block []) = _

From f3850b08e45071ab281586f7655b35c3cf512448 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 18 Mar 2015 04:02:14 +0300
Subject: [PATCH 006/116] gitignore

---
 komarov.andrey/src/.gitignore | 2 ++
 1 file changed, 2 insertions(+)
 create mode 100644 komarov.andrey/src/.gitignore

diff --git a/komarov.andrey/src/.gitignore b/komarov.andrey/src/.gitignore
new file mode 100644
index 00000000..1f94316
--- /dev/null
+++ b/komarov.andrey/src/.gitignore
@@ -0,0 +1,2 @@
+*.o
+*.hi

From ef774e82a76a0155d1d3896802e8521c4cba0ea3 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sat, 21 Mar 2015 15:31:32 +0300
Subject: [PATCH 007/116] Typechecking started

---
 komarov.andrey/src/AST.hs      | 38 ++++++++---------
 komarov.andrey/src/TypedAST.hs | 77 ++++++++++++++++++++++++++++++++--
 2 files changed, 92 insertions(+), 23 deletions(-)

diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index c623015..4d98fde 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -3,7 +3,7 @@ module AST (
   Program(..),
   FunctionDefinition(..),
   Statement(..),
-  Expresstion(..)
+  Expression(..)
   ) where
 
 type Id = String
@@ -22,26 +22,26 @@ data FunctionDefinition = FunctionDefinition
 
 data Statement = Block [Statement]
                | VariableDeclaration Type [Id]
-               | Assignment Id Expresstion
-               | RawExpression Expresstion
-               | IfThenElse Expresstion Statement Statement
-               | While Expresstion Statement
-               | Return Expresstion
+               | Assignment Id Expression
+               | RawExpression Expression
+               | IfThenElse Expression Statement Statement
+               | While Expression Statement
+               | Return Expression
                deriving (Show, Eq, Ord)
 
-data Expresstion = EVar Id
+data Expression = EVar Id
                  | EInt Int
                  | EBool Bool
-                 | EAdd Expresstion Expresstion
-                 | ESub Expresstion Expresstion
-                 | EMul Expresstion Expresstion
-                 | ELess Expresstion Expresstion
-                 | EGreater Expresstion Expresstion
-                 | EEqual Expresstion Expresstion
-                 | ELessEq Expresstion Expresstion
-                 | EGreaterEq Expresstion Expresstion
-                 | ENotEqual Expresstion Expresstion
-                 | EAnd Expresstion Expresstion
-                 | EOr Expresstion Expresstion
-                 | ECall Id [Expresstion]
+                 | EAdd Expression Expression
+                 | ESub Expression Expression
+                 | EMul Expression Expression
+                 | ELess Expression Expression
+                 | EGreater Expression Expression
+                 | EEqual Expression Expression
+                 | ELessEq Expression Expression
+                 | EGreaterEq Expression Expression
+                 | ENotEqual Expression Expression
+                 | EAnd Expression Expression
+                 | EOr Expression Expression
+                 | ECall Id [Expression]
                  deriving (Show, Eq, Ord)
diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index 54e6bb1..847cf7f 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -20,8 +20,9 @@ data Type = TBool
           | TInt
           | TString
           | TVoid
+          deriving (Show, Eq)
 
-type Env = [(Id, Type)]
+type Env = M.Map Id Type
 
 newtype Typecheck a = Typecheck { unTypecheck :: ErrorT String (Reader Env) a }
                     deriving (Functor, Applicative, Monad, MonadReader Env, MonadError String)
@@ -29,9 +30,77 @@ newtype Typecheck a = Typecheck { unTypecheck :: ErrorT String (Reader Env) a }
 getType :: Id -> Typecheck Type
 getType name = do
   env <- ask
-  case find ((== name) . fst) env of
+  case M.lookup name env of
    Nothing -> throwError $ "No such var in env: " ++ name
-   Just t -> return $ snd t
+   Just t -> return $ t
+
+addToEnv :: Type -> Id -> Typecheck Env
+addToEnv ty id = do
+  env <- ask
+  case M.lookup id env of
+   Nothing -> return $ M.insert id ty env
+   Just t2 -> throwError $
+              "Var " ++ id ++ " : " ++ show t2 ++ " already defined"
+
+readType :: AST.Type -> Typecheck Type
+readType "bool" = return TBool
+readType "int" = return TInt
+readType "string" = return TString
+readType "void" = return TVoid
+readType t = throwError $ "Unknown type: " ++ show t
 
 typecheck :: AST.Statement -> Typecheck ()
-typecheck (AST.Block []) = _
+typecheck (AST.Block stmts) = forM_ stmts typecheck
+typecheck (AST.VariableDeclaration ty []) = return ()
+typecheck (AST.VariableDeclaration ty (x:xs)) = do
+  ty' <- readType ty
+  env' <- addToEnv ty' x
+  local (\ _ -> env') $ typecheck (AST.VariableDeclaration ty xs)
+typecheck (AST.Assignment id e) = do
+  tL <- getType id
+  tR <- typecheckE e
+  if tL /= tR
+    then throwError $ "Type mismatch in '(" ++ id ++ " : " ++ show tL ++ ") := (<expr> : " ++ show tR ++ ")'"
+    else return ()
+typecheck (AST.RawExpression e) = void $ typecheckE e
+typecheck (AST.IfThenElse e thn els) = do
+  t <- typecheckE e
+  when (t /= TBool) $ throwError $ "Type mismatch: condition has type " ++ show t
+  typecheck thn
+  typecheck els
+typecheck (AST.While e stmt) = do
+  t <- typecheckE e
+  when (t /= TBool) $ throwError $ "Type mismatch: while condition has type " ++ show t
+  typecheck stmt
+typecheck (AST.Return e) = void $ typecheckE e 
+
+typecheckE :: AST.Expression -> Typecheck Type
+typecheckE (AST.EVar id) = getType id
+typecheckE (AST.EInt i) = return TInt
+typecheckE (AST.EBool b) = return TBool
+typecheckE (AST.EAdd lhs rhs) = do
+  lt <- typecheckE lhs
+  rt <- typecheckE rhs
+  case (lt, rt) of
+   (TInt, TInt) -> return TInt
+   (TString, TString) -> return TString
+   _ -> throwError $ show lt ++ " + " ++ show rt
+typecheckE (AST.ESub lhs rhs) = do
+  lt <- typecheckE lhs
+  when (lt /= TInt) $ throwError $ "lhs of - : " ++ show lhs
+  rt <- typecheckE rhs
+  when (rt /= TInt) $ throwError $ "rhs of - : " ++ show rhs
+  return TInt
+typecheckE (AST.EMul lhs rhs) = do
+  lt <- typecheckE lhs
+  when (lt /= TInt) $ throwError $ "lhs of * : " ++ show lhs
+  rt <- typecheckE rhs
+  when (rt /= TInt) $ throwError $ "rhs of * : " ++ show rhs
+  return TInt
+typecheckE (AST.ELess lhs rhs) = do
+  lt <- typecheckE lhs
+  when (lt /= TInt) $ throwError $ "lhs of < : " ++ show lhs
+  rt <- typecheckE rhs
+  when (rt /= TInt) $ throwError $ "rhs of < : " ++ show rhs
+  return TBool
+typecheckE _ = _

From 14d5fab24fa64eaefb059d5c75f5904cf7108965 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 00:47:05 +0300
Subject: [PATCH 008/116] some more typecheck

---
 komarov.andrey/src/TypedAST.hs | 87 +++++++++++++++++++++++++++-------
 1 file changed, 69 insertions(+), 18 deletions(-)

diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index 847cf7f..47d07de 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -22,26 +22,50 @@ data Type = TBool
           | TVoid
           deriving (Show, Eq)
 
-type Env = M.Map Id Type
+data Env = Env {
+  functions :: M.Map Id (Type, [Type]),
+  variables :: M.Map Id Type
+  }
 
 newtype Typecheck a = Typecheck { unTypecheck :: ErrorT String (Reader Env) a }
                     deriving (Functor, Applicative, Monad, MonadReader Env, MonadError String)
 
 getType :: Id -> Typecheck Type
 getType name = do
-  env <- ask
+  env <- variables <$> ask
   case M.lookup name env of
    Nothing -> throwError $ "No such var in env: " ++ name
-   Just t -> return $ t
+   Just t -> return t
+
+getFunType :: Id -> Typecheck (Type, [Type])
+getFunType name = do
+  funs <- functions <$> ask
+  case M.lookup name funs of
+   Nothing -> throwError $ "No such fun in env: " ++ show name
+   Just t -> return t
 
 addToEnv :: Type -> Id -> Typecheck Env
 addToEnv ty id = do
   env <- ask
-  case M.lookup id env of
-   Nothing -> return $ M.insert id ty env
+  let vars = variables env
+  case M.lookup id vars of
+   Nothing -> return $ env { variables = M.insert id ty vars }
    Just t2 -> throwError $
               "Var " ++ id ++ " : " ++ show t2 ++ " already defined"
 
+addFunsToEnv :: (Id, Type, [Type]) -> Typecheck Env
+addFunsToEnv funcs = do
+  _
+
+addFunToEnv :: Id -> Type -> [Type] -> Typecheck Env
+addFunToEnv name ret args = do
+  env <- ask
+  let funs = functions env
+  case M.lookup name funs of
+   Nothing -> return $ env { functions = M.insert name (ret, args) funs }
+   Just t -> throwError $
+             "Fun " ++ name ++ " : " ++ show t ++ " already defined"
+
 readType :: AST.Type -> Typecheck Type
 readType "bool" = return TBool
 readType "int" = return TInt
@@ -49,6 +73,13 @@ readType "string" = return TString
 readType "void" = return TVoid
 readType t = throwError $ "Unknown type: " ++ show t
 
+typecheckF :: AST.Program -> Typecheck ()
+typecheckF (AST.Program funs) = do
+  let types = [(AST.functionName f, AST.functionRetType f, map fst (AST.functionArgs f)) | f <- funs]
+  _
+  
+  
+
 typecheck :: AST.Statement -> Typecheck ()
 typecheck (AST.Block stmts) = forM_ stmts typecheck
 typecheck (AST.VariableDeclaration ty []) = return ()
@@ -74,6 +105,11 @@ typecheck (AST.While e stmt) = do
   typecheck stmt
 typecheck (AST.Return e) = void $ typecheckE e 
 
+expect :: (Eq a, Show a) => a -> Typecheck a -> Typecheck ()
+expect x tx = do
+  x' <- tx
+  when (x /= x') $ throwError $ "Expected " ++ show x' ++ " to be " ++ show x
+
 typecheckE :: AST.Expression -> Typecheck Type
 typecheckE (AST.EVar id) = getType id
 typecheckE (AST.EInt i) = return TInt
@@ -86,21 +122,36 @@ typecheckE (AST.EAdd lhs rhs) = do
    (TString, TString) -> return TString
    _ -> throwError $ show lt ++ " + " ++ show rt
 typecheckE (AST.ESub lhs rhs) = do
-  lt <- typecheckE lhs
-  when (lt /= TInt) $ throwError $ "lhs of - : " ++ show lhs
-  rt <- typecheckE rhs
-  when (rt /= TInt) $ throwError $ "rhs of - : " ++ show rhs
+  forM [lhs, rhs] $ expect TInt . typecheckE
   return TInt
-typecheckE (AST.EMul lhs rhs) = do
+typecheckE (AST.EMul lhs rhs) =
+  forM [lhs, rhs] (expect TInt . typecheckE) >> return TInt
+typecheckE (AST.ELess lhs rhs) = do
+  forM [lhs, rhs] (expect TInt . typecheckE) >> return TBool
+typecheckE (AST.EGreater lhs rhs) = do
+  forM [lhs, rhs] (expect TInt . typecheckE) >> return TBool
+typecheckE (AST.ELessEq lhs rhs) = do
+  forM [lhs, rhs] (expect TInt . typecheckE) >> return TBool
+typecheckE (AST.EGreaterEq lhs rhs) = do
+  forM [lhs, rhs] (expect TInt . typecheckE) >> return TBool
+typecheckE (AST.EEqual lhs rhs) = do
   lt <- typecheckE lhs
-  when (lt /= TInt) $ throwError $ "lhs of * : " ++ show lhs
   rt <- typecheckE rhs
-  when (rt /= TInt) $ throwError $ "rhs of * : " ++ show rhs
-  return TInt
-typecheckE (AST.ELess lhs rhs) = do
+  when (lt /= rt) $ throwError $ show lt ++ " == " ++ show rt
+  return lt
+typecheckE (AST.ENotEqual lhs rhs) = do
   lt <- typecheckE lhs
-  when (lt /= TInt) $ throwError $ "lhs of < : " ++ show lhs
   rt <- typecheckE rhs
-  when (rt /= TInt) $ throwError $ "rhs of < : " ++ show rhs
-  return TBool
-typecheckE _ = _
+  when (lt /= rt) $ throwError $ show lt ++ " == " ++ show rt
+  return lt
+typecheckE (AST.EAnd lhs rhs) =
+  forM [lhs, rhs] (expect TBool . typecheckE) >> return TBool
+typecheckE (AST.EOr lhs rhs) =
+  forM [lhs, rhs] (expect TBool . typecheckE) >> return TBool
+typecheckE (AST.ECall fun exprs) = do
+  (ret, args) <- getFunType fun
+  forM (zip args exprs) $ \(t, te) -> do
+    e <- typecheckE te
+    when (t /= e) $ throwError $ "Fun arg " ++ show t ++ " /= " ++ show e
+  return ret
+

From 3bcfe48459e902f278bf4b9333cd17434d3d04cf Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 03:49:54 +0300
Subject: [PATCH 009/116] Slight AST change

---
 komarov.andrey/examples/example1.l |  3 ++-
 komarov.andrey/src/AST.hs          | 42 ++++++++++++++++--------------
 komarov.andrey/src/Parser.y        | 36 +++++++++++++++----------
 3 files changed, 46 insertions(+), 35 deletions(-)

diff --git a/komarov.andrey/examples/example1.l b/komarov.andrey/examples/example1.l
index b93f494..3e6d18d 100644
--- a/komarov.andrey/examples/example1.l
+++ b/komarov.andrey/examples/example1.l
@@ -1,7 +1,8 @@
 
 int summ(int n)
 {
-    int i, sum;
+    int i;
+    int sum;
     i = 0;
     sum = 0;
     while (i < n)
diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index 4d98fde..9c7fbfd 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -1,33 +1,35 @@
 module AST (
-  Id, Type,
+  Id,
   Program(..),
-  FunctionDefinition(..),
+  TopLevel(..),
   Statement(..),
   Expression(..)
   ) where
 
 type Id = String
 
-type Type = String
+data Program = Program [TopLevel]
+          deriving (Show)
 
-data Program = Program [FunctionDefinition]
-               deriving (Show, Eq, Ord)
+data TopLevel
+  = VarDecl Id Id
+  | ForwardDecl { name :: Id,
+                  ret :: Id,
+                  argsTypes :: [Id] }
+  | FuncDef { name :: Id,
+              ret :: Id,
+              args :: [(Id, Id)],
+              body :: [Statement]}
+  deriving (Show)
 
-data FunctionDefinition = FunctionDefinition
-                          { functionRetType :: Type
-                          , functionName    :: Id
-                          , functionArgs    :: [(Type, Id)]
-                          , functionBody    :: [Statement]
-                          } deriving (Show, Eq, Ord)
-
-data Statement = Block [Statement]
-               | VariableDeclaration Type [Id]
-               | Assignment Id Expression
-               | RawExpression Expression
-               | IfThenElse Expression Statement Statement
-               | While Expression Statement
-               | Return Expression
-               deriving (Show, Eq, Ord)
+data Statement = SBlock [Statement]
+               | SVarDecl Id Id
+               | SAssignment Id Expression
+               | SRawExpr Expression
+               | SIfThenElse Expression Statement Statement
+               | SWhile Expression Statement
+               | SReturn Expression
+               deriving (Show)
 
 data Expression = EVar Id
                  | EInt Int
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index 6b9ec13..88ffe4d 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -48,7 +48,20 @@ import AST
 
 %%
 
-Prog            : FuncDefs                      { Program $1 }
+Prog            : TopLevelDefs                  { Program $1 }
+
+TopLevelDefs    : {- empty -}                   { [] }
+                | TopLevel TopLevelDefs         { $1:$2 }
+
+TopLevel        : VarDecl                       { $1 }
+                | ForwardDecl                   { $1 }
+                | FuncDef                       { $1 }
+
+VarDecl         : var var ';'                   { VarDecl $1 $2 }
+
+ForwardDecl     : var var '(' Vars ')' ';'      { ForwardDecl $2 $1 $4 }
+
+FuncDef         : var var '(' FuncArgs ')' '{' Stmts '}' { FuncDef $2 $1 $4 $7 }
 
 Expr            : var                           { EVar $1 }
                 | num                           { EInt $1 }
@@ -72,29 +85,24 @@ FuncCallList    : {- empty -}                   { [] }
                 | Expr                          { [$1] }
                 | Expr ',' FuncCallList         { $1:$3 }
 
-Stmt            : '{' Stmts '}'                 { Block $2 }
-                | var Vars ';'                  { VariableDeclaration $1 $2 }
-                | var '=' Expr ';'              { Assignment $1 $3}
-                | Expr ';'                      { RawExpression $1 }
-                | if '(' Expr ')' Stmt else Stmt  { IfThenElse $3 $5 $7 }
-                | while '(' Expr ')' Stmt       { While $3 $5 }
-                | return Expr ';'               { Return $2 }
+Stmt            : '{' Stmts '}'                 { SBlock $2 }
+                | var var ';'                  { SVarDecl $1 $2 }
+                | var '=' Expr ';'              { SAssignment $1 $3}
+                | Expr ';'                      { SRawExpr $1 }
+                | if '(' Expr ')' Stmt else Stmt  { SIfThenElse $3 $5 $7 }
+                | while '(' Expr ')' Stmt       { SWhile $3 $5 }
+                | return Expr ';'               { SReturn $2 }
 
 Vars            : var                           { [$1] }
                 | var ',' Vars                  { $1:$3 }
 
 Stmts           : {- empty -}                   { [] }
-                | Stmt Stmts                { $1:$2 }
-
-FuncDef         : var var '(' FuncArgs ')' '{' Stmts '}'        { FunctionDefinition $1 $2 $4 $7 }
+                | Stmt Stmts                    { $1:$2 }
 
 FuncArgs        : {- empty -}                   { [] }
                 | var var                       { [($1, $2)] }
                 | var var ',' FuncArgs          { ($1, $2):$4 }
 
-FuncDefs        : FuncDef                       { [$1] }
-                | FuncDef FuncDefs              { $1:$2 }
-
 {
 parseError :: [Token] -> a
 parseError _ = error "Parse error"

From 02a6aa4d6dd58a3061595ed96e3daf84b3682bae Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 04:04:52 +0300
Subject: [PATCH 010/116] Typechecker rewriting started

---
 komarov.andrey/src/TypedAST.hs | 138 +++------------------------------
 1 file changed, 9 insertions(+), 129 deletions(-)

diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index 47d07de..812475d 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE GADTs, KindSignatures, DataKinds, PolyKinds #-}
-{-# LANGUAGE TypeOperators, RankNTypes, ImpredicativeTypes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
 module TypedAST (
 
   ) where
@@ -8,7 +8,6 @@ module TypedAST (
 import Control.Monad.Reader
 import Control.Monad.Error
 import Control.Applicative
-import Data.List (find)
 
 import qualified Data.Map as M
 
@@ -22,136 +21,17 @@ data Type = TBool
           | TVoid
           deriving (Show, Eq)
 
+data FType = FType Type [Type]
+
 data Env = Env {
   functions :: M.Map Id (Type, [Type]),
   variables :: M.Map Id Type
   }
 
-newtype Typecheck a = Typecheck { unTypecheck :: ErrorT String (Reader Env) a }
-                    deriving (Functor, Applicative, Monad, MonadReader Env, MonadError String)
-
-getType :: Id -> Typecheck Type
-getType name = do
-  env <- variables <$> ask
-  case M.lookup name env of
-   Nothing -> throwError $ "No such var in env: " ++ name
-   Just t -> return t
-
-getFunType :: Id -> Typecheck (Type, [Type])
-getFunType name = do
-  funs <- functions <$> ask
-  case M.lookup name funs of
-   Nothing -> throwError $ "No such fun in env: " ++ show name
-   Just t -> return t
-
-addToEnv :: Type -> Id -> Typecheck Env
-addToEnv ty id = do
-  env <- ask
-  let vars = variables env
-  case M.lookup id vars of
-   Nothing -> return $ env { variables = M.insert id ty vars }
-   Just t2 -> throwError $
-              "Var " ++ id ++ " : " ++ show t2 ++ " already defined"
-
-addFunsToEnv :: (Id, Type, [Type]) -> Typecheck Env
-addFunsToEnv funcs = do
-  _
-
-addFunToEnv :: Id -> Type -> [Type] -> Typecheck Env
-addFunToEnv name ret args = do
-  env <- ask
-  let funs = functions env
-  case M.lookup name funs of
-   Nothing -> return $ env { functions = M.insert name (ret, args) funs }
-   Just t -> throwError $
-             "Fun " ++ name ++ " : " ++ show t ++ " already defined"
-
-readType :: AST.Type -> Typecheck Type
-readType "bool" = return TBool
-readType "int" = return TInt
-readType "string" = return TString
-readType "void" = return TVoid
-readType t = throwError $ "Unknown type: " ++ show t
-
-typecheckF :: AST.Program -> Typecheck ()
-typecheckF (AST.Program funs) = do
-  let types = [(AST.functionName f, AST.functionRetType f, map fst (AST.functionArgs f)) | f <- funs]
-  _
-  
-  
-
-typecheck :: AST.Statement -> Typecheck ()
-typecheck (AST.Block stmts) = forM_ stmts typecheck
-typecheck (AST.VariableDeclaration ty []) = return ()
-typecheck (AST.VariableDeclaration ty (x:xs)) = do
-  ty' <- readType ty
-  env' <- addToEnv ty' x
-  local (\ _ -> env') $ typecheck (AST.VariableDeclaration ty xs)
-typecheck (AST.Assignment id e) = do
-  tL <- getType id
-  tR <- typecheckE e
-  if tL /= tR
-    then throwError $ "Type mismatch in '(" ++ id ++ " : " ++ show tL ++ ") := (<expr> : " ++ show tR ++ ")'"
-    else return ()
-typecheck (AST.RawExpression e) = void $ typecheckE e
-typecheck (AST.IfThenElse e thn els) = do
-  t <- typecheckE e
-  when (t /= TBool) $ throwError $ "Type mismatch: condition has type " ++ show t
-  typecheck thn
-  typecheck els
-typecheck (AST.While e stmt) = do
-  t <- typecheckE e
-  when (t /= TBool) $ throwError $ "Type mismatch: while condition has type " ++ show t
-  typecheck stmt
-typecheck (AST.Return e) = void $ typecheckE e 
-
-expect :: (Eq a, Show a) => a -> Typecheck a -> Typecheck ()
-expect x tx = do
-  x' <- tx
-  when (x /= x') $ throwError $ "Expected " ++ show x' ++ " to be " ++ show x
+newtype Typechecker a = Typechecker { unCompiler :: ErrorT String (Reader Env) a } deriving (Functor, Applicative, Monad, MonadReader Env, MonadError String)
 
-typecheckE :: AST.Expression -> Typecheck Type
-typecheckE (AST.EVar id) = getType id
-typecheckE (AST.EInt i) = return TInt
-typecheckE (AST.EBool b) = return TBool
-typecheckE (AST.EAdd lhs rhs) = do
-  lt <- typecheckE lhs
-  rt <- typecheckE rhs
-  case (lt, rt) of
-   (TInt, TInt) -> return TInt
-   (TString, TString) -> return TString
-   _ -> throwError $ show lt ++ " + " ++ show rt
-typecheckE (AST.ESub lhs rhs) = do
-  forM [lhs, rhs] $ expect TInt . typecheckE
-  return TInt
-typecheckE (AST.EMul lhs rhs) =
-  forM [lhs, rhs] (expect TInt . typecheckE) >> return TInt
-typecheckE (AST.ELess lhs rhs) = do
-  forM [lhs, rhs] (expect TInt . typecheckE) >> return TBool
-typecheckE (AST.EGreater lhs rhs) = do
-  forM [lhs, rhs] (expect TInt . typecheckE) >> return TBool
-typecheckE (AST.ELessEq lhs rhs) = do
-  forM [lhs, rhs] (expect TInt . typecheckE) >> return TBool
-typecheckE (AST.EGreaterEq lhs rhs) = do
-  forM [lhs, rhs] (expect TInt . typecheckE) >> return TBool
-typecheckE (AST.EEqual lhs rhs) = do
-  lt <- typecheckE lhs
-  rt <- typecheckE rhs
-  when (lt /= rt) $ throwError $ show lt ++ " == " ++ show rt
-  return lt
-typecheckE (AST.ENotEqual lhs rhs) = do
-  lt <- typecheckE lhs
-  rt <- typecheckE rhs
-  when (lt /= rt) $ throwError $ show lt ++ " == " ++ show rt
-  return lt
-typecheckE (AST.EAnd lhs rhs) =
-  forM [lhs, rhs] (expect TBool . typecheckE) >> return TBool
-typecheckE (AST.EOr lhs rhs) =
-  forM [lhs, rhs] (expect TBool . typecheckE) >> return TBool
-typecheckE (AST.ECall fun exprs) = do
-  (ret, args) <- getFunType fun
-  forM (zip args exprs) $ \(t, te) -> do
-    e <- typecheckE te
-    when (t /= e) $ throwError $ "Fun arg " ++ show t ++ " /= " ++ show e
-  return ret
+class Typecheckable a b | a -> b where
+  typecheck :: a -> Typechecker b
 
+instance Typecheckable AST.Expression Type where
+  typecheck _ = _

From f608c54509869da47e43e58982f2a5346b2a4caa Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 04:50:20 +0300
Subject: [PATCH 011/116] Typecheck of expression finished

---
 komarov.andrey/src/TypedAST.hs | 71 ++++++++++++++++++++++++++++++++--
 1 file changed, 68 insertions(+), 3 deletions(-)

diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index 812475d..3be874d 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleContexts #-}
 module TypedAST (
 
   ) where
@@ -24,14 +25,78 @@ data Type = TBool
 data FType = FType Type [Type]
 
 data Env = Env {
-  functions :: M.Map Id (Type, [Type]),
+  functions :: M.Map Id FType,
   variables :: M.Map Id Type
   }
 
-newtype Typechecker a = Typechecker { unCompiler :: ErrorT String (Reader Env) a } deriving (Functor, Applicative, Monad, MonadReader Env, MonadError String)
+data TypecheckError = UnknownVar Id
+                    | UnknownFun Id
+                    | SomethingWentWrong String
+                    | TypeMismatch Type Type
+                    deriving (Show)
+
+instance Error TypecheckError where
+  strMsg = SomethingWentWrong 
+
+newtype Typechecker a = Typechecker { unCompiler :: ErrorT TypecheckError (Reader Env) a } deriving (Functor, Applicative, Monad, MonadReader Env, MonadError TypecheckError)
 
 class Typecheckable a b | a -> b where
   typecheck :: a -> Typechecker b
 
+getVarType :: Id -> Typechecker Type
+getVarType name = do
+  vars <- variables <$> ask
+  case M.lookup name vars of
+   Nothing -> throwError $ UnknownVar name
+   Just t -> return t
+
+getFunType :: Id -> Typechecker FType
+getFunType name = do
+  funs <- functions <$> ask
+  case M.lookup name funs of
+   Nothing -> throwError $ UnknownFun name
+   Just t -> return t
+
+expect :: Typecheckable t Type => Type -> t -> Typechecker ()
+expect x ta = do
+  a <- typecheck ta
+  when (a /= x) $ throwError $ TypeMismatch a x
+
 instance Typecheckable AST.Expression Type where
-  typecheck _ = _
+  typecheck (AST.EVar v) = getVarType v
+  typecheck (AST.EInt _) = return TInt
+  typecheck (AST.EBool _) = return TBool
+  typecheck (AST.EAdd lhs rhs) =
+    expect TInt lhs >> expect TInt rhs >> return TInt
+  typecheck (AST.ESub lhs rhs) =
+    expect TInt lhs >> expect TInt rhs >> return TInt
+  typecheck (AST.EMul lhs rhs) =
+    expect TInt lhs >> expect TInt rhs >> return TInt
+  typecheck (AST.ELess lhs rhs) =
+    expect TInt lhs >> expect TInt rhs >> return TBool
+  typecheck (AST.EGreater lhs rhs) =
+    expect TInt lhs >> expect TInt rhs >> return TBool
+  typecheck (AST.ELessEq lhs rhs) =
+    expect TInt lhs >> expect TInt rhs >> return TBool
+  typecheck (AST.EGreaterEq lhs rhs) =
+    expect TInt lhs >> expect TInt rhs >> return TBool
+  typecheck (AST.EEqual lhs rhs) = do
+    tl <- typecheck lhs
+    tr <- typecheck rhs
+    when (tl /= tr) $ throwError $ TypeMismatch tl tr
+    return TBool
+  typecheck (AST.ENotEqual lhs rhs) = do
+    tl <- typecheck lhs
+    tr <- typecheck rhs
+    when (tl /= tr) $ throwError $ TypeMismatch tl tr
+    return TBool
+  typecheck (AST.EAnd lhs rhs) =
+    expect TBool lhs >> expect TBool rhs >> return TBool
+  typecheck (AST.EOr lhs rhs) =
+    expect TBool lhs >> expect TBool rhs >> return TBool
+  typecheck (AST.ECall name args) = do
+    targs <- forM args typecheck
+    FType ret targs' <- getFunType name
+    forM (zip targs targs') $ \(t, t') ->
+      when (t /= t') $ throwError $ TypeMismatch t t'
+    return ret

From 45e3d99666e25a5051b4602db9b0e7922fb4f1ef Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 05:03:34 +0300
Subject: [PATCH 012/116] Started typecheck of Statement

---
 komarov.andrey/src/TypedAST.hs | 30 +++++++++++++++++++++++++++---
 1 file changed, 27 insertions(+), 3 deletions(-)

diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index 3be874d..2eb4dfa 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -31,8 +31,10 @@ data Env = Env {
 
 data TypecheckError = UnknownVar Id
                     | UnknownFun Id
-                    | SomethingWentWrong String
+                    | UnknownType AST.Id
+                    | AlreadyBound Id
                     | TypeMismatch Type Type
+                    | SomethingWentWrong String
                     deriving (Show)
 
 instance Error TypecheckError where
@@ -45,23 +47,38 @@ class Typecheckable a b | a -> b where
 
 getVarType :: Id -> Typechecker Type
 getVarType name = do
-  vars <- variables <$> ask
+  vars <- asks variables
   case M.lookup name vars of
    Nothing -> throwError $ UnknownVar name
    Just t -> return t
 
 getFunType :: Id -> Typechecker FType
 getFunType name = do
-  funs <- functions <$> ask
+  funs <- asks functions
   case M.lookup name funs of
    Nothing -> throwError $ UnknownFun name
    Just t -> return t
 
+updateVar :: Id -> Type -> Typechecker Env
+updateVar name t = do
+  env <- ask
+  let vars = variables env
+  case M.lookup name vars of
+   Nothing -> return $ env { variables = M.insert name t vars }
+   Just t' -> throwError $ AlreadyBound name
+
 expect :: Typecheckable t Type => Type -> t -> Typechecker ()
 expect x ta = do
   a <- typecheck ta
   when (a /= x) $ throwError $ TypeMismatch a x
 
+parseType :: AST.Id -> Typecheckable Type
+parseType "int" = return TInt
+parseType "bool" = return TBool
+parseType "string" = return TString
+parseType "void" = return TVoid
+parseType t = throwError $ UnknownType t
+
 instance Typecheckable AST.Expression Type where
   typecheck (AST.EVar v) = getVarType v
   typecheck (AST.EInt _) = return TInt
@@ -100,3 +117,10 @@ instance Typecheckable AST.Expression Type where
     forM (zip targs targs') $ \(t, t') ->
       when (t /= t') $ throwError $ TypeMismatch t t'
     return ret
+
+instance Typecheckable AST.Statement () where
+  typecheck (AST.SBlock stmts) = forM_ stmts typecheck
+  typecheck (AST.SVarDecl tp name) = do
+    t <- parseType tp
+    env' <- updateVar name t
+    _

From b35a577e52411590907bad6151bddd60441fd40a Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 05:06:30 +0300
Subject: [PATCH 013/116] Migrate from Reader to State

---
 komarov.andrey/src/TypedAST.hs | 25 ++++++++++++++-----------
 1 file changed, 14 insertions(+), 11 deletions(-)

diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index 2eb4dfa..63275a7 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -6,7 +6,7 @@ module TypedAST (
 
   ) where
 
-import Control.Monad.Reader
+import Control.Monad.State
 import Control.Monad.Error
 import Control.Applicative
 
@@ -40,31 +40,31 @@ data TypecheckError = UnknownVar Id
 instance Error TypecheckError where
   strMsg = SomethingWentWrong 
 
-newtype Typechecker a = Typechecker { unCompiler :: ErrorT TypecheckError (Reader Env) a } deriving (Functor, Applicative, Monad, MonadReader Env, MonadError TypecheckError)
+newtype Typechecker a = Typechecker { unCompiler :: ErrorT TypecheckError (State Env) a } deriving (Functor, Applicative, Monad, MonadState Env, MonadError TypecheckError)
 
 class Typecheckable a b | a -> b where
   typecheck :: a -> Typechecker b
 
 getVarType :: Id -> Typechecker Type
 getVarType name = do
-  vars <- asks variables
+  vars <- gets variables
   case M.lookup name vars of
    Nothing -> throwError $ UnknownVar name
    Just t -> return t
 
 getFunType :: Id -> Typechecker FType
 getFunType name = do
-  funs <- asks functions
+  funs <- gets functions
   case M.lookup name funs of
    Nothing -> throwError $ UnknownFun name
    Just t -> return t
 
-updateVar :: Id -> Type -> Typechecker Env
+updateVar :: Id -> Type -> Typechecker ()
 updateVar name t = do
-  env <- ask
+  env <- get
   let vars = variables env
   case M.lookup name vars of
-   Nothing -> return $ env { variables = M.insert name t vars }
+   Nothing -> put $ env { variables = M.insert name t vars }
    Just t' -> throwError $ AlreadyBound name
 
 expect :: Typecheckable t Type => Type -> t -> Typechecker ()
@@ -72,7 +72,7 @@ expect x ta = do
   a <- typecheck ta
   when (a /= x) $ throwError $ TypeMismatch a x
 
-parseType :: AST.Id -> Typecheckable Type
+parseType :: AST.Id -> Typechecker Type
 parseType "int" = return TInt
 parseType "bool" = return TBool
 parseType "string" = return TString
@@ -119,8 +119,11 @@ instance Typecheckable AST.Expression Type where
     return ret
 
 instance Typecheckable AST.Statement () where
-  typecheck (AST.SBlock stmts) = forM_ stmts typecheck
+  typecheck (AST.SBlock stmts) = do
+    s <- get
+    forM_ stmts typecheck
+    put s
   typecheck (AST.SVarDecl tp name) = do
     t <- parseType tp
-    env' <- updateVar name t
-    _
+    updateVar name t
+    

From 16ebc3d0f264d902e8604b6f3ccba800e7387dfb Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 05:13:38 +0300
Subject: [PATCH 014/116] Typecheck of Statement done

---
 komarov.andrey/src/TypedAST.hs | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index 63275a7..3cdde0e 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -72,6 +72,9 @@ expect x ta = do
   a <- typecheck ta
   when (a /= x) $ throwError $ TypeMismatch a x
 
+ensureSame :: Type -> Type -> Typechecker ()
+ensureSame t1 t2 = when (t1 /= t2) $ throwError $ TypeMismatch t1 t2
+
 parseType :: AST.Id -> Typechecker Type
 parseType "int" = return TInt
 parseType "bool" = return TBool
@@ -100,12 +103,12 @@ instance Typecheckable AST.Expression Type where
   typecheck (AST.EEqual lhs rhs) = do
     tl <- typecheck lhs
     tr <- typecheck rhs
-    when (tl /= tr) $ throwError $ TypeMismatch tl tr
+    ensureSame tl tr
     return TBool
   typecheck (AST.ENotEqual lhs rhs) = do
     tl <- typecheck lhs
     tr <- typecheck rhs
-    when (tl /= tr) $ throwError $ TypeMismatch tl tr
+    ensureSame tl tr
     return TBool
   typecheck (AST.EAnd lhs rhs) =
     expect TBool lhs >> expect TBool rhs >> return TBool
@@ -115,7 +118,7 @@ instance Typecheckable AST.Expression Type where
     targs <- forM args typecheck
     FType ret targs' <- getFunType name
     forM (zip targs targs') $ \(t, t') ->
-      when (t /= t') $ throwError $ TypeMismatch t t'
+      ensureSame t t'
     return ret
 
 instance Typecheckable AST.Statement () where
@@ -126,4 +129,13 @@ instance Typecheckable AST.Statement () where
   typecheck (AST.SVarDecl tp name) = do
     t <- parseType tp
     updateVar name t
-    
+  typecheck (AST.SAssignment name expr) = do
+    tl <- getVarType name
+    tr <- typecheck expr
+    ensureSame tl tr
+  typecheck (AST.SRawExpr e) = void $ typecheck e
+  typecheck (AST.SIfThenElse cond thn els) =
+    expect TBool cond >> typecheck thn >> typecheck els
+  typecheck (AST.SWhile cond body) =
+    expect TBool cond >> typecheck body
+  typecheck (AST.SReturn e) = void $ typecheck e

From 7e5a19557d43f353c4705931f2d7ed78c6966012 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 05:27:15 +0300
Subject: [PATCH 015/116] Finished typechecking

---
 komarov.andrey/src/TypedAST.hs | 47 ++++++++++++++++++++++++++++------
 1 file changed, 39 insertions(+), 8 deletions(-)

diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index 3cdde0e..0c87193 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -3,7 +3,9 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE FlexibleContexts #-}
 module TypedAST (
-
+  Typechecker(..),
+  Typecheckable(..),
+  TypecheckError(..)
   ) where
 
 import Control.Monad.State
@@ -32,7 +34,8 @@ data Env = Env {
 data TypecheckError = UnknownVar Id
                     | UnknownFun Id
                     | UnknownType AST.Id
-                    | AlreadyBound Id
+                    | AlreadyBoundVar Id
+                    | AlreadyBoundFun Id
                     | TypeMismatch Type Type
                     | SomethingWentWrong String
                     deriving (Show)
@@ -65,7 +68,15 @@ updateVar name t = do
   let vars = variables env
   case M.lookup name vars of
    Nothing -> put $ env { variables = M.insert name t vars }
-   Just t' -> throwError $ AlreadyBound name
+   Just t' -> throwError $ AlreadyBoundVar name
+
+updateFun :: Id -> FType -> Typechecker ()
+updateFun name t = do
+  env <- get
+  let funs = functions env
+  case M.lookup name funs of
+   Nothing -> put $ env { functions = M.insert name t funs }
+   Just t' -> throwError $ AlreadyBoundFun name
 
 expect :: Typecheckable t Type => Type -> t -> Typechecker ()
 expect x ta = do
@@ -115,7 +126,7 @@ instance Typecheckable AST.Expression Type where
   typecheck (AST.EOr lhs rhs) =
     expect TBool lhs >> expect TBool rhs >> return TBool
   typecheck (AST.ECall name args) = do
-    targs <- forM args typecheck
+    targs <- mapM typecheck args
     FType ret targs' <- getFunType name
     forM (zip targs targs') $ \(t, t') ->
       ensureSame t t'
@@ -124,11 +135,10 @@ instance Typecheckable AST.Expression Type where
 instance Typecheckable AST.Statement () where
   typecheck (AST.SBlock stmts) = do
     s <- get
-    forM_ stmts typecheck
+    mapM typecheck stmts
     put s
-  typecheck (AST.SVarDecl tp name) = do
-    t <- parseType tp
-    updateVar name t
+  typecheck (AST.SVarDecl tp name) =
+    parseType tp >>= updateVar name
   typecheck (AST.SAssignment name expr) = do
     tl <- getVarType name
     tr <- typecheck expr
@@ -139,3 +149,24 @@ instance Typecheckable AST.Statement () where
   typecheck (AST.SWhile cond body) =
     expect TBool cond >> typecheck body
   typecheck (AST.SReturn e) = void $ typecheck e
+
+instance Typecheckable AST.TopLevel () where
+  typecheck (AST.VarDecl tp name) =
+    parseType tp >>= updateVar name
+  typecheck (AST.ForwardDecl name ret argsTypes) = do
+    tret <- parseType ret
+    targs <- mapM parseType argsTypes
+    updateFun name (FType tret targs)
+  typecheck (AST.FuncDef name ret args body) = do
+    tret <- parseType ret
+    targs <- mapM parseType (map fst args)
+    updateFun name (FType tret targs)
+    env <- get
+    forM (zip targs (map snd args)) $ \(t, name) ->
+      updateVar name t
+    mapM typecheck body
+    put env
+
+instance Typecheckable AST.Program () where
+  typecheck (AST.Program xs) = mapM_ typecheck xs
+

From 53628e31a790969b272fd534860799490ccc65cd Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 12:51:15 +0300
Subject: [PATCH 016/116] Typechecking looks correct

---
 komarov.andrey/examples/example3.l    |  4 ++++
 komarov.andrey/examples/wrongTypes1.l |  5 +++++
 komarov.andrey/src/Makefile           |  2 +-
 komarov.andrey/src/TestTypecheck.hs   | 12 ++++++++++++
 komarov.andrey/src/TypedAST.hs        | 11 +++++++++--
 5 files changed, 31 insertions(+), 3 deletions(-)
 create mode 100644 komarov.andrey/examples/example3.l
 create mode 100644 komarov.andrey/examples/wrongTypes1.l
 create mode 100644 komarov.andrey/src/TestTypecheck.hs

diff --git a/komarov.andrey/examples/example3.l b/komarov.andrey/examples/example3.l
new file mode 100644
index 00000000..00283b2
--- /dev/null
+++ b/komarov.andrey/examples/example3.l
@@ -0,0 +1,4 @@
+int lol() {
+    1;
+}
+
diff --git a/komarov.andrey/examples/wrongTypes1.l b/komarov.andrey/examples/wrongTypes1.l
new file mode 100644
index 00000000..af437bd
--- /dev/null
+++ b/komarov.andrey/examples/wrongTypes1.l
@@ -0,0 +1,5 @@
+int f() {
+    int a;
+    bool b;
+    a == b;
+}
diff --git a/komarov.andrey/src/Makefile b/komarov.andrey/src/Makefile
index 6aae87a..5356a15 100644
--- a/komarov.andrey/src/Makefile
+++ b/komarov.andrey/src/Makefile
@@ -1,5 +1,5 @@
 all:
 	alex Lexer.x
 	happy Parser.y
-	ghc TestParse
+	ghc TestTypecheck
 
diff --git a/komarov.andrey/src/TestTypecheck.hs b/komarov.andrey/src/TestTypecheck.hs
new file mode 100644
index 00000000..cf579a6
--- /dev/null
+++ b/komarov.andrey/src/TestTypecheck.hs
@@ -0,0 +1,12 @@
+import Parser
+import Lexer
+import TypedAST
+
+main = do
+    input <- getContents
+    putStrLn input
+    let tokens = scanTokens input
+    print tokens
+    let ast = parse tokens
+    print ast
+    print $ runTypecheck ast
diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index 0c87193..beb7b5f 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -5,7 +5,8 @@
 module TypedAST (
   Typechecker(..),
   Typecheckable(..),
-  TypecheckError(..)
+  TypecheckError(..),
+  runTypecheck,
   ) where
 
 import Control.Monad.State
@@ -31,6 +32,9 @@ data Env = Env {
   variables :: M.Map Id Type
   }
 
+emptyEnv :: Env
+emptyEnv = Env M.empty M.empty
+
 data TypecheckError = UnknownVar Id
                     | UnknownFun Id
                     | UnknownType AST.Id
@@ -43,7 +47,10 @@ data TypecheckError = UnknownVar Id
 instance Error TypecheckError where
   strMsg = SomethingWentWrong 
 
-newtype Typechecker a = Typechecker { unCompiler :: ErrorT TypecheckError (State Env) a } deriving (Functor, Applicative, Monad, MonadState Env, MonadError TypecheckError)
+newtype Typechecker a = Typechecker { unTypechecker :: ErrorT TypecheckError (State Env) a } deriving (Functor, Applicative, Monad, MonadState Env, MonadError TypecheckError)
+
+runTypecheck :: AST.Program -> Either TypecheckError ()
+runTypecheck prog = evalState (runErrorT $ unTypechecker $ typecheck prog) emptyEnv
 
 class Typecheckable a b | a -> b where
   typecheck :: a -> Typechecker b

From bf03332ff02f2a945c2d9962cf3436b0736b9eb6 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 13:14:17 +0300
Subject: [PATCH 017/116] Added number of arguments check

---
 komarov.andrey/examples/wrongTypes2.l | 9 +++++++++
 komarov.andrey/examples/wrongTypes3.l | 7 +++++++
 komarov.andrey/examples/wrongTypes4.l | 3 +++
 komarov.andrey/examples/wrongTypes5.l | 3 +++
 komarov.andrey/src/Parser.y           | 5 +----
 komarov.andrey/src/TypedAST.hs        | 6 +++++-
 6 files changed, 28 insertions(+), 5 deletions(-)
 create mode 100644 komarov.andrey/examples/wrongTypes2.l
 create mode 100644 komarov.andrey/examples/wrongTypes3.l
 create mode 100644 komarov.andrey/examples/wrongTypes4.l
 create mode 100644 komarov.andrey/examples/wrongTypes5.l

diff --git a/komarov.andrey/examples/wrongTypes2.l b/komarov.andrey/examples/wrongTypes2.l
new file mode 100644
index 00000000..5c34da1
--- /dev/null
+++ b/komarov.andrey/examples/wrongTypes2.l
@@ -0,0 +1,9 @@
+int f(int, int);
+
+void g() {
+    f(0, 1 == 2);
+}
+
+void f(int a, int b) {
+    return a + b;
+}
diff --git a/komarov.andrey/examples/wrongTypes3.l b/komarov.andrey/examples/wrongTypes3.l
new file mode 100644
index 00000000..0eb0f7c
--- /dev/null
+++ b/komarov.andrey/examples/wrongTypes3.l
@@ -0,0 +1,7 @@
+int f(int x);
+
+int f() {
+    return 1;
+}
+
+
diff --git a/komarov.andrey/examples/wrongTypes4.l b/komarov.andrey/examples/wrongTypes4.l
new file mode 100644
index 00000000..1fa4794
--- /dev/null
+++ b/komarov.andrey/examples/wrongTypes4.l
@@ -0,0 +1,3 @@
+int f(int x) {
+    return f(x, x);
+}
diff --git a/komarov.andrey/examples/wrongTypes5.l b/komarov.andrey/examples/wrongTypes5.l
new file mode 100644
index 00000000..d5c7bd1
--- /dev/null
+++ b/komarov.andrey/examples/wrongTypes5.l
@@ -0,0 +1,3 @@
+int f(int x, int y) {
+    return f(x);
+}
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index 88ffe4d..c90165d 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -59,7 +59,7 @@ TopLevel        : VarDecl                       { $1 }
 
 VarDecl         : var var ';'                   { VarDecl $1 $2 }
 
-ForwardDecl     : var var '(' Vars ')' ';'      { ForwardDecl $2 $1 $4 }
+ForwardDecl     : var var '(' FuncArgs ')' ';'      { ForwardDecl $2 $1 (map fst $4) }
 
 FuncDef         : var var '(' FuncArgs ')' '{' Stmts '}' { FuncDef $2 $1 $4 $7 }
 
@@ -93,9 +93,6 @@ Stmt            : '{' Stmts '}'                 { SBlock $2 }
                 | while '(' Expr ')' Stmt       { SWhile $3 $5 }
                 | return Expr ';'               { SReturn $2 }
 
-Vars            : var                           { [$1] }
-                | var ',' Vars                  { $1:$3 }
-
 Stmts           : {- empty -}                   { [] }
                 | Stmt Stmts                    { $1:$2 }
 
diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
index beb7b5f..76dbe19 100644
--- a/komarov.andrey/src/TypedAST.hs
+++ b/komarov.andrey/src/TypedAST.hs
@@ -28,12 +28,13 @@ data Type = TBool
 data FType = FType Type [Type]
 
 data Env = Env {
+  forwardDecls :: M.Map Id FType,
   functions :: M.Map Id FType,
   variables :: M.Map Id Type
   }
 
 emptyEnv :: Env
-emptyEnv = Env M.empty M.empty
+emptyEnv = Env M.empty M.empty M.empty
 
 data TypecheckError = UnknownVar Id
                     | UnknownFun Id
@@ -41,6 +42,7 @@ data TypecheckError = UnknownVar Id
                     | AlreadyBoundVar Id
                     | AlreadyBoundFun Id
                     | TypeMismatch Type Type
+                    | WrongArgsNumber [Type] [Type]
                     | SomethingWentWrong String
                     deriving (Show)
 
@@ -135,6 +137,8 @@ instance Typecheckable AST.Expression Type where
   typecheck (AST.ECall name args) = do
     targs <- mapM typecheck args
     FType ret targs' <- getFunType name
+    when (length targs /= length targs') $
+      throwError $ WrongArgsNumber targs targs'
     forM (zip targs targs') $ \(t, t') ->
       ensureSame t t'
     return ret

From 77046ce61e04f03fd5e2c5119733a63399cc44d7 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 13:15:31 +0300
Subject: [PATCH 018/116] Fix example

---
 komarov.andrey/examples/wrongTypes2.l | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/komarov.andrey/examples/wrongTypes2.l b/komarov.andrey/examples/wrongTypes2.l
index 5c34da1..b8dd7f9 100644
--- a/komarov.andrey/examples/wrongTypes2.l
+++ b/komarov.andrey/examples/wrongTypes2.l
@@ -1,4 +1,4 @@
-int f(int, int);
+int f(int a, int b);
 
 void g() {
     f(0, 1 == 2);

From 455ec33642a6b0c10c80f654fc3fab80a78222f5 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 22 Mar 2015 13:22:20 +0300
Subject: [PATCH 019/116] Rename examples

---
 komarov.andrey/examples/{wrongTypes1.l => wrong1.l} | 0
 komarov.andrey/examples/{wrongTypes2.l => wrong2.l} | 0
 komarov.andrey/examples/{wrongTypes3.l => wrong3.l} | 0
 komarov.andrey/examples/{wrongTypes4.l => wrong4.l} | 0
 komarov.andrey/examples/{wrongTypes5.l => wrong5.l} | 0
 komarov.andrey/examples/wrong6.l                    | 2 ++
 6 files changed, 2 insertions(+)
 rename komarov.andrey/examples/{wrongTypes1.l => wrong1.l} (100%)
 rename komarov.andrey/examples/{wrongTypes2.l => wrong2.l} (100%)
 rename komarov.andrey/examples/{wrongTypes3.l => wrong3.l} (100%)
 rename komarov.andrey/examples/{wrongTypes4.l => wrong4.l} (100%)
 rename komarov.andrey/examples/{wrongTypes5.l => wrong5.l} (100%)
 create mode 100644 komarov.andrey/examples/wrong6.l

diff --git a/komarov.andrey/examples/wrongTypes1.l b/komarov.andrey/examples/wrong1.l
similarity index 100%
rename from komarov.andrey/examples/wrongTypes1.l
rename to komarov.andrey/examples/wrong1.l
diff --git a/komarov.andrey/examples/wrongTypes2.l b/komarov.andrey/examples/wrong2.l
similarity index 100%
rename from komarov.andrey/examples/wrongTypes2.l
rename to komarov.andrey/examples/wrong2.l
diff --git a/komarov.andrey/examples/wrongTypes3.l b/komarov.andrey/examples/wrong3.l
similarity index 100%
rename from komarov.andrey/examples/wrongTypes3.l
rename to komarov.andrey/examples/wrong3.l
diff --git a/komarov.andrey/examples/wrongTypes4.l b/komarov.andrey/examples/wrong4.l
similarity index 100%
rename from komarov.andrey/examples/wrongTypes4.l
rename to komarov.andrey/examples/wrong4.l
diff --git a/komarov.andrey/examples/wrongTypes5.l b/komarov.andrey/examples/wrong5.l
similarity index 100%
rename from komarov.andrey/examples/wrongTypes5.l
rename to komarov.andrey/examples/wrong5.l
diff --git a/komarov.andrey/examples/wrong6.l b/komarov.andrey/examples/wrong6.l
new file mode 100644
index 00000000..1456dc0
--- /dev/null
+++ b/komarov.andrey/examples/wrong6.l
@@ -0,0 +1,2 @@
+int f(int a, int a) {
+}

From cd7c0f2b942d4410bdea9b12e37cb1126a12583a Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Mon, 23 Mar 2015 01:42:48 +0300
Subject: [PATCH 020/116] Compiler started

---
 komarov.andrey/src/ARM.hs      | 16 ++++++++
 komarov.andrey/src/Compiler.hs | 70 ++++++++++++++++++++++++++++++++++
 2 files changed, 86 insertions(+)
 create mode 100644 komarov.andrey/src/Compiler.hs

diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/ARM.hs
index 209dfe2..9e902bc 100644
--- a/komarov.andrey/src/ARM.hs
+++ b/komarov.andrey/src/ARM.hs
@@ -1,4 +1,9 @@
 module ARM (
+  OpCode(..),
+  Cond(..),
+  Assembly(..),
+  Register(..),
+  bp, sp, lr, pc
 
   ) where
 
@@ -32,13 +37,17 @@ data Cond = Eq -- Z set
           | Le -- Zs & Lt
           | Al -- always
           | Nv -- reserved
+          deriving (Show)
 
 data SetFlags = Update | Ignore
+              deriving (Show)
 
 -- TODO добавить barrel shifter
 data Operand2 = Reg Register | Imm Int32
+              deriving (Show)
 
 data Width = Word | HalfWord | Byte
+           deriving (Show)
 
 data OpCode
   = ADD SetFlags Register Register Operand2
@@ -61,4 +70,11 @@ data OpCode
   | LDR Width Register Register Operand2
   | STR Width Register Register Operand2
   | SWI
+  deriving (Show)
 
+data Assembly
+  = OpCode Cond OpCode
+  | Label String
+  | Comment String
+  | EmptyLine
+  deriving (Show)
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
new file mode 100644
index 00000000..c7ee261
--- /dev/null
+++ b/komarov.andrey/src/Compiler.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+
+module Compiler (
+
+  ) where
+
+import Control.Monad.Writer
+import Control.Monad.State
+import Control.Monad.Error
+import Control.Applicative
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+import ARM
+import AST
+
+data Type = TBool
+          | TInt
+          | TString
+          | TVoid
+          deriving (Show, Eq)
+
+data FType = FType Type [Type]
+
+data Env = Env {
+  forwardDecls :: M.Map Id FType,
+  functions :: M.Map Id FType,
+  variables :: M.Map Id Type,
+  labels :: S.Set Id}
+
+emptyEnv :: Env
+emptyEnv = Env M.empty M.empty M.empty S.empty
+
+stdlib :: Env
+stdlib = emptyEnv
+newtype Output = Output { unOutput :: [Assembly] }
+               deriving (Show, Monoid)
+
+data CompileError = CompileError
+                    deriving (Show)
+
+instance Error CompileError where
+  noMsg = CompileError
+
+newtype Compiler a = Compiler {
+  unCompiler ::
+     ErrorT CompileError (
+       WriterT Output (
+          State Env )) a }
+                     deriving (
+  Functor, Applicative, Monad, MonadError CompileError,
+  MonadWriter Output, MonadState Env)
+
+
+runCompiler :: AST.Program -> Either CompileError Output
+runCompiler prog = fmap (const out) e where
+  ((e, out), env) = runState (runWriterT $ runErrorT $ unCompiler $ compile prog) stdlib
+
+class Compilable t ret | t -> ret where
+  compile :: t -> Compiler ret
+
+instance Compilable AST.Program () where
+  compile (AST.Program xs) = mapM_ compile xs
+
+instance Compilable AST.TopLevel () where
+  compile (AST.VarDecl ty name) =
+    parseType tp >>= add

From b1a53d702ca9cc30ce8869d23e0ceb988c69b76a Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Mon, 23 Mar 2015 22:33:57 +0300
Subject: [PATCH 021/116] Compilable instances for Program and TopLevel

---
 komarov.andrey/src/Compiler.hs | 87 ++++++++++++++++++++++++++++++----
 1 file changed, 79 insertions(+), 8 deletions(-)

diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index c7ee261..c015aee 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Compiler (
 
@@ -15,7 +16,8 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 
 import ARM
-import AST
+import AST (Id)
+import qualified AST
 
 data Type = TBool
           | TInt
@@ -24,23 +26,84 @@ data Type = TBool
           deriving (Show, Eq)
 
 data FType = FType Type [Type]
+           deriving (Show, Eq)
+
+data Symbol
+  = GlobalVariable { varType :: Type }
+  | LocalVariable { varType :: Type }
+  | ForwardDecl { funType :: FType }
+  | FunctionDecl { funType :: FType }
+  | Type Type
+  deriving (Show)
+
+newtype SymbolTable =
+  SymbolTable { unSymbolTable :: M.Map Id Symbol}
 
 data Env = Env {
-  forwardDecls :: M.Map Id FType,
-  functions :: M.Map Id FType,
-  variables :: M.Map Id Type,
+  symbols :: SymbolTable,
   labels :: S.Set Id}
 
 emptyEnv :: Env
-emptyEnv = Env M.empty M.empty M.empty S.empty
+emptyEnv = Env (SymbolTable M.empty) S.empty
 
 stdlib :: Env
 stdlib = emptyEnv
+
+symbol :: Id -> Compiler (Maybe Symbol)
+symbol name = do
+  sym <- gets (unSymbolTable . symbols)
+  return $ M.lookup name sym
+
+setSymbol :: Id -> Symbol -> Compiler ()
+setSymbol name s = do
+  env@(Env { symbols = SymbolTable syms }) <- get
+  put $ env { symbols = SymbolTable $ M.insert name s syms }
+
+getVarType :: Id -> Compiler Type
+getVarType name = symbol name >>= \case
+  Nothing -> throwError $ SymbolNotDefined name
+  Just (GlobalVariable t) -> return t
+  Just (LocalVariable t) -> return t
+  Just s -> throwError $ VariableExpected s
+
+getType :: Id -> Compiler Type
+getType name = symbol name >>= \case
+  Nothing -> throwError $ SymbolNotDefined name
+  Just (Type t) -> return t
+  Just s -> throwError $ TypeExpected s
+
+updateVar :: Id -> Symbol -> Compiler ()
+updateVar name s = symbol name >>= \case
+  Nothing -> setSymbol name s
+  Just s' -> throwError $ AlreadyBound name s' s
+
+updateForwardDecl :: Id -> FType -> Compiler ()
+updateForwardDecl name ty = symbol name >>= \case
+  Nothing -> setSymbol name $ ForwardDecl ty
+  Just (ForwardDecl ty') -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
+  Just (FunctionDecl ty') -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
+  Just s -> throwError $ AlreadyBound name s (ForwardDecl ty)
+
+updateFun :: Id -> FType -> Compiler ()
+updateFun name ty = symbol name >>= \case
+  Nothing -> setSymbol name $ FunctionDecl ty
+  Just (ForwardDecl ty') -> do
+    when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
+    setSymbol name $ FunctionDecl ty
+  Just s -> throwError $ AlreadyBound name s (FunctionDecl ty)
+
 newtype Output = Output { unOutput :: [Assembly] }
                deriving (Show, Monoid)
 
-data CompileError = CompileError
-                    deriving (Show)
+data CompileError
+  = CompileError
+  | SymbolNotDefined Id
+  | AlreadyBound Id Symbol Symbol
+  | VariableExpected Symbol
+  | TypeExpected Symbol
+  | FunctionExpected Symbol
+  | ForwardDeclTypeMismatch FType FType
+  deriving (Show)
 
 instance Error CompileError where
   noMsg = CompileError
@@ -67,4 +130,12 @@ instance Compilable AST.Program () where
 
 instance Compilable AST.TopLevel () where
   compile (AST.VarDecl ty name) =
-    parseType tp >>= add
+    getType ty >>= (updateVar name . LocalVariable)
+  compile (AST.ForwardDecl name ret args) = do
+    tret <- getVarType ret
+    targs <- mapM getVarType args
+    updateForwardDecl name (FType tret targs)
+  compile (AST.FuncDef name ret args body) = do
+    tret <- getVarType ret
+    targs <- mapM getVarType (map fst args)
+    updateFun name (FType tret targs)

From f12c19eca8e219b055895263513b2d034656da75 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Mon, 23 Mar 2015 23:08:39 +0300
Subject: [PATCH 022/116] instance Compilable AST.Statement started

---
 komarov.andrey/src/Compiler.hs | 58 ++++++++++++++++++++++++++++------
 1 file changed, 49 insertions(+), 9 deletions(-)

diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index c015aee..b22b5a5 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module Compiler (
 
@@ -12,6 +13,9 @@ import Control.Monad.State
 import Control.Monad.Error
 import Control.Applicative
 
+import Data.List (nub)
+import Data.Maybe (catMaybes)
+
 import qualified Data.Map as M
 import qualified Data.Set as S
 
@@ -25,12 +29,19 @@ data Type = TBool
           | TVoid
           deriving (Show, Eq)
 
+size :: Num a => Type -> a
+size TBool = 4
+size TInt = 4
+size TString = error "lol not implemented yet"
+size TVoid = error "lol void is not instantiable"
+
+
 data FType = FType Type [Type]
            deriving (Show, Eq)
 
 data Symbol
   = GlobalVariable { varType :: Type }
-  | LocalVariable { varType :: Type }
+  | LocalVariable { varType :: Type, varOffset :: Int }
   | ForwardDecl { funType :: FType }
   | FunctionDecl { funType :: FType }
   | Type Type
@@ -41,10 +52,11 @@ newtype SymbolTable =
 
 data Env = Env {
   symbols :: SymbolTable,
-  labels :: S.Set Id}
+  labels :: S.Set Id,
+  offset :: Int}
 
 emptyEnv :: Env
-emptyEnv = Env (SymbolTable M.empty) S.empty
+emptyEnv = Env (SymbolTable M.empty) S.empty 0
 
 stdlib :: Env
 stdlib = emptyEnv
@@ -63,7 +75,7 @@ getVarType :: Id -> Compiler Type
 getVarType name = symbol name >>= \case
   Nothing -> throwError $ SymbolNotDefined name
   Just (GlobalVariable t) -> return t
-  Just (LocalVariable t) -> return t
+  Just (LocalVariable { varType = t } ) -> return t
   Just s -> throwError $ VariableExpected s
 
 getType :: Id -> Compiler Type
@@ -72,10 +84,21 @@ getType name = symbol name >>= \case
   Just (Type t) -> return t
   Just s -> throwError $ TypeExpected s
 
-updateVar :: Id -> Symbol -> Compiler ()
-updateVar name s = symbol name >>= \case
-  Nothing -> setSymbol name s
-  Just s' -> throwError $ AlreadyBound name s' s
+updateGlobalVar :: Id -> Type -> Compiler ()
+updateGlobalVar name t = symbol name >>= \case
+  Nothing -> setSymbol name $ GlobalVariable t
+  Just s' -> throwError $ AlreadyBound name s' $ GlobalVariable t
+
+updateLocalVar :: Id -> Type -> Compiler ()
+updateLocalVar name t = symbol name >>= \case
+  Nothing -> do
+    off <- gets offset
+    let sz = size t
+    modify $ \(env@Env { offset = o }) -> env { offset = o + sz }
+    setSymbol name $ LocalVariable t off
+  Just s' -> throwError $ AlreadyBound name s' $ LocalVariable t 0
+  
+
 
 updateForwardDecl :: Id -> FType -> Compiler ()
 updateForwardDecl name ty = symbol name >>= \case
@@ -103,6 +126,7 @@ data CompileError
   | TypeExpected Symbol
   | FunctionExpected Symbol
   | ForwardDeclTypeMismatch FType FType
+  | InconsistentReturnTypes [Type]
   deriving (Show)
 
 instance Error CompileError where
@@ -130,7 +154,7 @@ instance Compilable AST.Program () where
 
 instance Compilable AST.TopLevel () where
   compile (AST.VarDecl ty name) =
-    getType ty >>= (updateVar name . LocalVariable)
+    getType ty >>= updateLocalVar name
   compile (AST.ForwardDecl name ret args) = do
     tret <- getVarType ret
     targs <- mapM getVarType args
@@ -139,3 +163,19 @@ instance Compilable AST.TopLevel () where
     tret <- getVarType ret
     targs <- mapM getVarType (map fst args)
     updateFun name (FType tret targs)
+
+instance Compilable AST.Statement (Maybe Type) where
+  compile (AST.SBlock stmts) = do
+    env <- get
+    types <- mapM compile stmts
+    put env
+    case nub $ catMaybes types of
+     [] -> return Nothing
+     [t] -> return $ Just t
+     ts -> throwError $ InconsistentReturnTypes ts
+  compile (AST.SVarDecl tp name) =
+    getType tp >>= updateLocalVar name >> return Nothing
+  compile (AST.SAssignment name expr) = do
+    -- TODO generate some assembly here
+    _
+    return Nothing

From d84eb64834be10e32527ea4351d1a1a6fe1c8ce3 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Mon, 23 Mar 2015 23:09:29 +0300
Subject: [PATCH 023/116] Example added

---
 komarov.andrey/examples/example4.l | 9 +++++++++
 1 file changed, 9 insertions(+)
 create mode 100644 komarov.andrey/examples/example4.l

diff --git a/komarov.andrey/examples/example4.l b/komarov.andrey/examples/example4.l
new file mode 100644
index 00000000..442e715
--- /dev/null
+++ b/komarov.andrey/examples/example4.l
@@ -0,0 +1,9 @@
+int f();
+
+int g() {
+    return f() + f();
+}
+
+int f() {
+    return 2;
+}

From 9aca74a7d87137755c0e2bd317fcecdc06a6701e Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 24 Mar 2015 00:53:24 +0300
Subject: [PATCH 024/116] Some examples of ARM assembly

---
 komarov.andrey/asm/Makefile  |  9 ++++++++
 komarov.andrey/asm/example.S | 44 ++++++++++++++++++++++++++++++++++++
 komarov.andrey/asm/hello.c   | 21 +++++++++++++++++
 3 files changed, 74 insertions(+)
 create mode 100644 komarov.andrey/asm/Makefile
 create mode 100644 komarov.andrey/asm/example.S
 create mode 100644 komarov.andrey/asm/hello.c

diff --git a/komarov.andrey/asm/Makefile b/komarov.andrey/asm/Makefile
new file mode 100644
index 00000000..3e277fd
--- /dev/null
+++ b/komarov.andrey/asm/Makefile
@@ -0,0 +1,9 @@
+
+hello: example.o
+	gcc -g hello.c example.o -o hello
+
+example.o: example.S
+	as example.S -o example.o
+
+clean:
+	rm -f *.o hello
diff --git a/komarov.andrey/asm/example.S b/komarov.andrey/asm/example.S
new file mode 100644
index 00000000..cc335f2
--- /dev/null
+++ b/komarov.andrey/asm/example.S
@@ -0,0 +1,44 @@
+.data
+x: .word 0
+
+.text
+
+xx: .word x
+
+.global f
+.global fact
+
+f:
+ldr r1, xx
+ldr r0, [r1]
+add r0, #1
+str r0, [r1]
+mov pc, lr
+
+# fact(r1, r2)
+fact:
+push {fp, lr}   @
+mov fp, sp      @ ENTER
+sub sp, sp, #4 @
+
+mov r2, #0
+teq r0, r2
+beq ret1
+
+str r0, [fp, #-4]
+sub r0, r0, #1
+bl fact
+ldr r1, [fp, #-4]
+mul r0, r1, r0
+b ret
+
+ret1:
+mov r0, #1
+b ret
+
+ret:
+mov sp, fp    @
+pop {fp, lr}  @ EXIT
+mov pc, lr    @
+
+
diff --git a/komarov.andrey/asm/hello.c b/komarov.andrey/asm/hello.c
new file mode 100644
index 00000000..9827dfe
--- /dev/null
+++ b/komarov.andrey/asm/hello.c
@@ -0,0 +1,21 @@
+#include <stdio.h>
+
+int f();
+
+int fact(int x);
+
+int add(int a, int b)
+{
+    int c = a + b;
+    return c;
+}
+
+int main()
+{
+    printf("hello\n");
+    int i;
+    for (i = 0; i < 10; i++)
+        printf("%d ", f());
+    printf("\n");
+    printf("%d\n", fact(5));
+}

From 6ce0ae84f1a523fd0b71b7507083487828f6bb04 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 24 Mar 2015 22:15:46 +0300
Subject: [PATCH 025/116] Labels primitives

---
 komarov.andrey/src/ARM.hs      |  6 +++++-
 komarov.andrey/src/Compiler.hs | 19 +++++++++++++++++--
 2 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/ARM.hs
index 9e902bc..aa94103 100644
--- a/komarov.andrey/src/ARM.hs
+++ b/komarov.andrey/src/ARM.hs
@@ -3,7 +3,8 @@ module ARM (
   Cond(..),
   Assembly(..),
   Register(..),
-  bp, sp, lr, pc
+  bp, sp, lr, pc,
+  Segment(..)
 
   ) where
 
@@ -72,6 +73,9 @@ data OpCode
   | SWI
   deriving (Show)
 
+data Segment = Data | Text
+             deriving (Show, Eq, Ord)
+
 data Assembly
   = OpCode Cond OpCode
   | Label String
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index b22b5a5..019ed4d 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -52,7 +52,7 @@ newtype SymbolTable =
 
 data Env = Env {
   symbols :: SymbolTable,
-  labels :: S.Set Id,
+  labels :: S.Set String,
   offset :: Int}
 
 emptyEnv :: Env
@@ -115,7 +115,21 @@ updateFun name ty = symbol name >>= \case
     setSymbol name $ FunctionDecl ty
   Just s -> throwError $ AlreadyBound name s (FunctionDecl ty)
 
-newtype Output = Output { unOutput :: [Assembly] }
+addLabel :: String -> Compiler ()
+addLabel lab = do
+  env@Env { labels = labels } <- get
+  when (lab `S.member` labels) $ throwError $ LabelAlreadyDeclared lab
+  put $ env { labels = S.insert lab labels }
+
+label :: String -> Compiler String
+label hint = do
+  l <- gets labels
+  let fresh = head $ [x | suf <- "":(map (('_':) . show) [1..]),
+                      let x = hint ++ suf, not (x `S.member` l)]
+  addLabel fresh
+  return fresh
+
+newtype Output = Output { unOutput :: [(Segment, Assembly)] }
                deriving (Show, Monoid)
 
 data CompileError
@@ -127,6 +141,7 @@ data CompileError
   | FunctionExpected Symbol
   | ForwardDeclTypeMismatch FType FType
   | InconsistentReturnTypes [Type]
+  | LabelAlreadyDeclared String
   deriving (Show)
 
 instance Error CompileError where

From 8e5dd9b2afcebb6b11227137a4bbe4515dc9077a Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 24 Mar 2015 23:13:01 +0300
Subject: [PATCH 026/116] Some work with labels

---
 komarov.andrey/src/ARM.hs      | 14 ++++---
 komarov.andrey/src/Compiler.hs | 76 +++++++++++++++++++++++++---------
 2 files changed, 64 insertions(+), 26 deletions(-)

diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/ARM.hs
index aa94103..bc3a778 100644
--- a/komarov.andrey/src/ARM.hs
+++ b/komarov.andrey/src/ARM.hs
@@ -4,7 +4,8 @@ module ARM (
   Assembly(..),
   Register(..),
   bp, sp, lr, pc,
-  Segment(..)
+  Segment(..),
+  AType(..)
 
   ) where
 
@@ -47,9 +48,6 @@ data SetFlags = Update | Ignore
 data Operand2 = Reg Register | Imm Int32
               deriving (Show)
 
-data Width = Word | HalfWord | Byte
-           deriving (Show)
-
 data OpCode
   = ADD SetFlags Register Register Operand2
   | SUB SetFlags Register Register Operand2
@@ -68,17 +66,21 @@ data OpCode
   | MOV SetFlags Register Operand2
   | MVN SetFlags Register Operand2
   | LDR' Register Int32 -- cheats
-  | LDR Width Register Register Operand2
-  | STR Width Register Register Operand2
+  | LDR Register Register Operand2
+  | STR Register Register Operand2
   | SWI
   deriving (Show)
 
 data Segment = Data | Text
              deriving (Show, Eq, Ord)
 
+data AType = Word
+           deriving (Show)
+
 data Assembly
   = OpCode Cond OpCode
   | Label String
+  | Raw AType String
   | Comment String
   | EmptyLine
   deriving (Show)
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 019ed4d..58529b9 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -35,15 +35,22 @@ size TInt = 4
 size TString = error "lol not implemented yet"
 size TVoid = error "lol void is not instantiable"
 
+encode :: Type -> AType
+encode TInt = Word
+encode v = error $ "global " ++ show v ++ " variables are not supported yet!"
 
 data FType = FType Type [Type]
            deriving (Show, Eq)
 
+type Label = String
+
 data Symbol
-  = GlobalVariable { varType :: Type }
+  = GlobalVariable { varType :: Type,
+                     dataLabel :: Label,
+                     textLabel :: Label}
   | LocalVariable { varType :: Type, varOffset :: Int }
   | ForwardDecl { funType :: FType }
-  | FunctionDecl { funType :: FType }
+  | FunctionDecl { funType :: FType, label :: Label }
   | Type Type
   deriving (Show)
 
@@ -52,15 +59,21 @@ newtype SymbolTable =
 
 data Env = Env {
   symbols :: SymbolTable,
-  labels :: S.Set String,
-  offset :: Int}
+  labels :: S.Set Label,
+  offset :: Int,
+  epilogue :: Maybe Label}
 
 emptyEnv :: Env
-emptyEnv = Env (SymbolTable M.empty) S.empty 0
+emptyEnv = Env (SymbolTable M.empty) S.empty 0 Nothing
 
 stdlib :: Env
 stdlib = emptyEnv
 
+setEpilogue :: Label -> Compiler ()
+setEpilogue ep = do
+  env@Env { epilogue = epilogue } <- get
+  put $ env { epilogue = Just ep }
+
 symbol :: Id -> Compiler (Maybe Symbol)
 symbol name = do
   sym <- gets (unSymbolTable . symbols)
@@ -74,8 +87,8 @@ setSymbol name s = do
 getVarType :: Id -> Compiler Type
 getVarType name = symbol name >>= \case
   Nothing -> throwError $ SymbolNotDefined name
-  Just (GlobalVariable t) -> return t
-  Just (LocalVariable { varType = t } ) -> return t
+  Just (GlobalVariable { varType = t }) -> return t
+  Just (LocalVariable { varType = t }) -> return t
   Just s -> throwError $ VariableExpected s
 
 getType :: Id -> Compiler Type
@@ -84,10 +97,20 @@ getType name = symbol name >>= \case
   Just (Type t) -> return t
   Just s -> throwError $ TypeExpected s
 
+assemble :: Segment -> Assembly -> Compiler ()
+assemble seg asm = tell $ Output [(seg, asm)]
+
 updateGlobalVar :: Id -> Type -> Compiler ()
 updateGlobalVar name t = symbol name >>= \case
-  Nothing -> setSymbol name $ GlobalVariable t
-  Just s' -> throwError $ AlreadyBound name s' $ GlobalVariable t
+  Nothing -> do
+             dLabel <- fresh name
+             tLabel <- fresh name
+             setSymbol name $ GlobalVariable t dLabel tLabel
+             assemble Data (Label dLabel)
+             assemble Data (Raw Word "0")
+             assemble Text (Label tLabel)
+             assemble Text (Raw Word dLabel)
+  Just s' -> throwError $ AlreadyBound name s' $ GlobalVariable t "" ""
 
 updateLocalVar :: Id -> Type -> Compiler ()
 updateLocalVar name t = symbol name >>= \case
@@ -104,16 +127,21 @@ updateForwardDecl :: Id -> FType -> Compiler ()
 updateForwardDecl name ty = symbol name >>= \case
   Nothing -> setSymbol name $ ForwardDecl ty
   Just (ForwardDecl ty') -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
-  Just (FunctionDecl ty') -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
+  Just (FunctionDecl { funType = ty' }) -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
   Just s -> throwError $ AlreadyBound name s (ForwardDecl ty)
 
-updateFun :: Id -> FType -> Compiler ()
+updateFun :: Id -> FType -> Compiler Label
 updateFun name ty = symbol name >>= \case
-  Nothing -> setSymbol name $ FunctionDecl ty
+  Nothing -> do
+             lab <- fresh name
+             setSymbol name $ FunctionDecl ty lab
+             return lab
   Just (ForwardDecl ty') -> do
     when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
-    setSymbol name $ FunctionDecl ty
-  Just s -> throwError $ AlreadyBound name s (FunctionDecl ty)
+    lab <- fresh name
+    setSymbol name $ FunctionDecl ty lab
+    return lab
+  Just s -> throwError $ AlreadyBound name s (FunctionDecl ty "")
 
 addLabel :: String -> Compiler ()
 addLabel lab = do
@@ -121,13 +149,13 @@ addLabel lab = do
   when (lab `S.member` labels) $ throwError $ LabelAlreadyDeclared lab
   put $ env { labels = S.insert lab labels }
 
-label :: String -> Compiler String
-label hint = do
+fresh :: String -> Compiler String
+fresh hint = do
   l <- gets labels
-  let fresh = head $ [x | suf <- "":(map (('_':) . show) [1..]),
+  let res = head $ [x | suf <- "":(map (('_':) . show) [1..]),
                       let x = hint ++ suf, not (x `S.member` l)]
-  addLabel fresh
-  return fresh
+  addLabel res
+  return res
 
 newtype Output = Output { unOutput :: [(Segment, Assembly)] }
                deriving (Show, Monoid)
@@ -177,7 +205,15 @@ instance Compilable AST.TopLevel () where
   compile (AST.FuncDef name ret args body) = do
     tret <- getVarType ret
     targs <- mapM getVarType (map fst args)
-    updateFun name (FType tret targs)
+    fname <- updateFun name (FType tret targs)
+    ep <- fresh $ name ++ "_ep"
+    assemble Text EmptyLine
+    assemble Text (Comment $ "function " ++ show name)
+    forM args $ \(t, n) ->
+      assemble Text $ Comment $ "   " ++ show n ++ " : " ++ show n
+    setEpilogue ep
+    mapM compile body
+    assemble Text $ Comment $ "end of " ++ show name
 
 instance Compilable AST.Statement (Maybe Type) where
   compile (AST.SBlock stmts) = do

From 10e68f6d53bd6fbb26f265498181d277b2012203 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 24 Mar 2015 23:42:02 +0300
Subject: [PATCH 027/116] Assembly started

---
 komarov.andrey/src/ARM.hs      | 15 ++++++++-----
 komarov.andrey/src/Compiler.hs | 40 ++++++++++++++++++++++------------
 2 files changed, 36 insertions(+), 19 deletions(-)

diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/ARM.hs
index bc3a778..916dac3 100644
--- a/komarov.andrey/src/ARM.hs
+++ b/komarov.andrey/src/ARM.hs
@@ -3,10 +3,10 @@ module ARM (
   Cond(..),
   Assembly(..),
   Register(..),
-  bp, sp, lr, pc,
+  fp, sp, lr, pc,
   Segment(..),
-  AType(..)
-
+  AType(..),
+  mov
   ) where
 
 import Data.Int
@@ -17,8 +17,8 @@ data Register = R0 | R1 | R2 | R3
               | R12 | R13 | R14 | R15
   deriving (Eq, Ord, Show)
 
-bp, sp, lr, pc :: Register
-bp = R11
+fp, sp, lr, pc :: Register
+fp = R11
 sp = R13
 lr = R14
 pc = R15
@@ -68,9 +68,14 @@ data OpCode
   | LDR' Register Int32 -- cheats
   | LDR Register Register Operand2
   | STR Register Register Operand2
+  | PUSH [Register]
+  | POP [Register]
   | SWI
   deriving (Show)
 
+mov :: Register -> Register -> OpCode
+mov rd rs = MOV Ignore rd $ Reg rs
+
 data Segment = Data | Text
              deriving (Show, Eq, Ord)
 
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 58529b9..6aa7044 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -97,8 +97,8 @@ getType name = symbol name >>= \case
   Just (Type t) -> return t
   Just s -> throwError $ TypeExpected s
 
-assemble :: Segment -> Assembly -> Compiler ()
-assemble seg asm = tell $ Output [(seg, asm)]
+as :: Segment -> Assembly -> Compiler ()
+as seg asm = tell $ Output [(seg, asm)]
 
 updateGlobalVar :: Id -> Type -> Compiler ()
 updateGlobalVar name t = symbol name >>= \case
@@ -106,10 +106,10 @@ updateGlobalVar name t = symbol name >>= \case
              dLabel <- fresh name
              tLabel <- fresh name
              setSymbol name $ GlobalVariable t dLabel tLabel
-             assemble Data (Label dLabel)
-             assemble Data (Raw Word "0")
-             assemble Text (Label tLabel)
-             assemble Text (Raw Word dLabel)
+             as Data (Label dLabel)
+             as Data (Raw Word "0")
+             as Text (Label tLabel)
+             as Text (Raw Word dLabel)
   Just s' -> throwError $ AlreadyBound name s' $ GlobalVariable t "" ""
 
 updateLocalVar :: Id -> Type -> Compiler ()
@@ -207,13 +207,20 @@ instance Compilable AST.TopLevel () where
     targs <- mapM getVarType (map fst args)
     fname <- updateFun name (FType tret targs)
     ep <- fresh $ name ++ "_ep"
-    assemble Text EmptyLine
-    assemble Text (Comment $ "function " ++ show name)
+    as Text EmptyLine
+    as Text (Comment $ "function " ++ show name)
     forM args $ \(t, n) ->
-      assemble Text $ Comment $ "   " ++ show n ++ " : " ++ show n
+      as Text $ Comment $ "   " ++ show n ++ " : " ++ show n
+    as Text $ Label fname
+    as Text $ OpCode Al $ PUSH [fp, lr]
+    as Text $ OpCode Al $ mov fp lr
     setEpilogue ep
     mapM compile body
-    assemble Text $ Comment $ "end of " ++ show name
+    as Text $ Label ep
+    as Text $ OpCode Al $ mov sp fp
+    as Text $ OpCode Al $ POP [fp, lr]
+    as Text $ OpCode Al $ mov pc lr
+    as Text $ Comment $ "end of " ++ show name
 
 instance Compilable AST.Statement (Maybe Type) where
   compile (AST.SBlock stmts) = do
@@ -226,7 +233,12 @@ instance Compilable AST.Statement (Maybe Type) where
      ts -> throwError $ InconsistentReturnTypes ts
   compile (AST.SVarDecl tp name) =
     getType tp >>= updateLocalVar name >> return Nothing
-  compile (AST.SAssignment name expr) = do
-    -- TODO generate some assembly here
-    _
-    return Nothing
+  compile (AST.SAssignment name expr) = symbol name >>= \case
+    Nothing -> throwError $ SymbolNotDefined name
+    Just (LocalVariable tp off) -> do
+      as Text $ Comment $ show name ++ " := " ++ show expr
+      _
+    Just (GlobalVariable tp dLabel tLabel) -> do
+      as Text $ Comment $ show name ++ " := " ++ show expr
+      _
+    Just s -> throwError $ VariableExpected s

From a5d025391a067a0b4bd886585348f4d78a5d4b78 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 25 Mar 2015 00:20:56 +0300
Subject: [PATCH 028/116] Some more assembly

---
 komarov.andrey/src/ARM.hs      | 11 ++++++++---
 komarov.andrey/src/Compiler.hs | 17 +++++++++++++++--
 2 files changed, 23 insertions(+), 5 deletions(-)

diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/ARM.hs
index 916dac3..99d0177 100644
--- a/komarov.andrey/src/ARM.hs
+++ b/komarov.andrey/src/ARM.hs
@@ -6,7 +6,8 @@ module ARM (
   fp, sp, lr, pc,
   Segment(..),
   AType(..),
-  mov
+  Operand2(..),
+  mov, sub
   ) where
 
 import Data.Int
@@ -45,7 +46,7 @@ data SetFlags = Update | Ignore
               deriving (Show)
 
 -- TODO добавить barrel shifter
-data Operand2 = Reg Register | Imm Int32
+data Operand2 = Reg Register | Imm Int
               deriving (Show)
 
 data OpCode
@@ -65,7 +66,7 @@ data OpCode
   | BIC SetFlags Register Register Operand2 -- and not
   | MOV SetFlags Register Operand2
   | MVN SetFlags Register Operand2
-  | LDR' Register Int32 -- cheats
+  | LDR' Register Int -- cheats
   | LDR Register Register Operand2
   | STR Register Register Operand2
   | PUSH [Register]
@@ -76,6 +77,9 @@ data OpCode
 mov :: Register -> Register -> OpCode
 mov rd rs = MOV Ignore rd $ Reg rs
 
+sub :: Register -> Register -> Operand2 -> OpCode
+sub = SUB Ignore
+
 data Segment = Data | Text
              deriving (Show, Eq, Ord)
 
@@ -88,4 +92,5 @@ data Assembly
   | Raw AType String
   | Comment String
   | EmptyLine
+  | Code
   deriving (Show)
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 6aa7044..817a48c 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -118,7 +118,7 @@ updateLocalVar name t = symbol name >>= \case
     off <- gets offset
     let sz = size t
     modify $ \(env@Env { offset = o }) -> env { offset = o + sz }
-    setSymbol name $ LocalVariable t off
+    setSymbol name $ LocalVariable t (off + sz)
   Just s' -> throwError $ AlreadyBound name s' $ LocalVariable t 0
   
 
@@ -169,6 +169,7 @@ data CompileError
   | FunctionExpected Symbol
   | ForwardDeclTypeMismatch FType FType
   | InconsistentReturnTypes [Type]
+  | TypeMismatch Type Type
   | LabelAlreadyDeclared String
   deriving (Show)
 
@@ -213,7 +214,9 @@ instance Compilable AST.TopLevel () where
       as Text $ Comment $ "   " ++ show n ++ " : " ++ show n
     as Text $ Label fname
     as Text $ OpCode Al $ PUSH [fp, lr]
-    as Text $ OpCode Al $ mov fp lr
+    as Text $ OpCode Al $ mov fp sp
+    -- TODO Correct stack frame size
+    as Text $ OpCode Al $ sub sp sp $ Imm 16 
     setEpilogue ep
     mapM compile body
     as Text $ Label ep
@@ -237,8 +240,18 @@ instance Compilable AST.Statement (Maybe Type) where
     Nothing -> throwError $ SymbolNotDefined name
     Just (LocalVariable tp off) -> do
       as Text $ Comment $ show name ++ " := " ++ show expr
+      rhs <- compile expr
+      when (tp /= rhs) $ throwError $ TypeMismatch tp rhs
+      as Text $ OpCode Al $ POP [R0]
+      as Text $ Comment $ "storing to local " ++ name
+      as Text $ OpCode Al $ STR R0 sp (Imm (-off))
       _
     Just (GlobalVariable tp dLabel tLabel) -> do
       as Text $ Comment $ show name ++ " := " ++ show expr
+      rhs <- compile expr
+      when (tp /= rhs) $ throwError $ TypeMismatch tp rhs
       _
     Just s -> throwError $ VariableExpected s
+
+instance Compilable AST.Expression Type where
+  compile _ = _

From 44d567268a1056b0bc3f92c92363986b67e57341 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 25 Mar 2015 00:29:04 +0300
Subject: [PATCH 029/116] Fuck ARM AST

---
 komarov.andrey/src/ARM.hs      | 92 ++--------------------------------
 komarov.andrey/src/Compiler.hs | 44 ++++++++--------
 2 files changed, 24 insertions(+), 112 deletions(-)

diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/ARM.hs
index 99d0177..aad6032 100644
--- a/komarov.andrey/src/ARM.hs
+++ b/komarov.andrey/src/ARM.hs
@@ -1,96 +1,10 @@
 module ARM (
-  OpCode(..),
-  Cond(..),
   Assembly(..),
-  Register(..),
-  fp, sp, lr, pc,
-  Segment(..),
-  AType(..),
-  Operand2(..),
-  mov, sub
+  Segment(..)
   ) where
 
-import Data.Int
-   
-data Register = R0 | R1 | R2 | R3
-              | R4 | R5 | R6 | R7
-              | R8 | R9 | R10 | R11
-              | R12 | R13 | R14 | R15
-  deriving (Eq, Ord, Show)
 
-fp, sp, lr, pc :: Register
-fp = R11
-sp = R13
-lr = R14
-pc = R15
-
-data Cond = Eq -- Z set
-          | Ne -- Z clear
-          | Cs -- C set
-          | Cc -- C clear
-          | Mi -- N set
-          | Pl -- N clear
-          | Vs -- V set
-          | Vc -- V clear
-          | Hi -- Cs & Zc
-          | Ls -- Cc | Zs
-          | Ge -- (Ns & Vs) | (Nc & Vc)
-          | Lt -- (Ns & Vc) | (Nc & Vs)
-          | Gt -- Zc & Ge
-          | Le -- Zs & Lt
-          | Al -- always
-          | Nv -- reserved
-          deriving (Show)
-
-data SetFlags = Update | Ignore
-              deriving (Show)
-
--- TODO добавить barrel shifter
-data Operand2 = Reg Register | Imm Int
-              deriving (Show)
-
-data OpCode
-  = ADD SetFlags Register Register Operand2
-  | SUB SetFlags Register Register Operand2
-  | RSB SetFlags Register Register Operand2
-  | MUL SetFlags Register Register Operand2
-  | B Int32
-  | BL Int32
-  | CMP Register Operand2
-  | CMN Register Operand2
-  | TST Register Operand2
-  | TEQ Register Operand2 -- xor
-  | AND SetFlags Register Register Operand2
-  | EOR SetFlags Register Register Operand2
-  | ORR SetFlags Register Register Operand2
-  | BIC SetFlags Register Register Operand2 -- and not
-  | MOV SetFlags Register Operand2
-  | MVN SetFlags Register Operand2
-  | LDR' Register Int -- cheats
-  | LDR Register Register Operand2
-  | STR Register Register Operand2
-  | PUSH [Register]
-  | POP [Register]
-  | SWI
-  deriving (Show)
-
-mov :: Register -> Register -> OpCode
-mov rd rs = MOV Ignore rd $ Reg rs
-
-sub :: Register -> Register -> Operand2 -> OpCode
-sub = SUB Ignore
+type Assembly = String
 
 data Segment = Data | Text
-             deriving (Show, Eq, Ord)
-
-data AType = Word
-           deriving (Show)
-
-data Assembly
-  = OpCode Cond OpCode
-  | Label String
-  | Raw AType String
-  | Comment String
-  | EmptyLine
-  | Code
-  deriving (Show)
+             deriving (Show)
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 817a48c..ec6e24e 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -35,8 +35,8 @@ size TInt = 4
 size TString = error "lol not implemented yet"
 size TVoid = error "lol void is not instantiable"
 
-encode :: Type -> AType
-encode TInt = Word
+encode :: Type -> String
+encode TInt = "word"
 encode v = error $ "global " ++ show v ++ " variables are not supported yet!"
 
 data FType = FType Type [Type]
@@ -106,10 +106,8 @@ updateGlobalVar name t = symbol name >>= \case
              dLabel <- fresh name
              tLabel <- fresh name
              setSymbol name $ GlobalVariable t dLabel tLabel
-             as Data (Label dLabel)
-             as Data (Raw Word "0")
-             as Text (Label tLabel)
-             as Text (Raw Word dLabel)
+             as Data $ dLabel ++ ": .word 0"
+             as Text $ tLabel ++ ": .word " ++ dLabel
   Just s' -> throwError $ AlreadyBound name s' $ GlobalVariable t "" ""
 
 updateLocalVar :: Id -> Type -> Compiler ()
@@ -208,22 +206,22 @@ instance Compilable AST.TopLevel () where
     targs <- mapM getVarType (map fst args)
     fname <- updateFun name (FType tret targs)
     ep <- fresh $ name ++ "_ep"
-    as Text EmptyLine
-    as Text (Comment $ "function " ++ show name)
+    as Text ""
+    as Text $ "@ function " ++ show name
     forM args $ \(t, n) ->
-      as Text $ Comment $ "   " ++ show n ++ " : " ++ show n
-    as Text $ Label fname
-    as Text $ OpCode Al $ PUSH [fp, lr]
-    as Text $ OpCode Al $ mov fp sp
+      as Text $ "@   " ++ show n ++ " : " ++ show n
+    as Text $ fname ++ ":"
+    as Text $ "push {fp, lr}"
+    as Text $ "mov fp, sp"
     -- TODO Correct stack frame size
-    as Text $ OpCode Al $ sub sp sp $ Imm 16 
+    as Text $ "sub sp, sp, #16"
     setEpilogue ep
     mapM compile body
-    as Text $ Label ep
-    as Text $ OpCode Al $ mov sp fp
-    as Text $ OpCode Al $ POP [fp, lr]
-    as Text $ OpCode Al $ mov pc lr
-    as Text $ Comment $ "end of " ++ show name
+    as Text $ ep ++ ":"
+    as Text $ "mov sp, fp"
+    as Text $ "pop {fp, lr}"
+    as Text $ "mov pc, lr"
+    as Text $ "@ end of " ++ show name
 
 instance Compilable AST.Statement (Maybe Type) where
   compile (AST.SBlock stmts) = do
@@ -239,15 +237,15 @@ instance Compilable AST.Statement (Maybe Type) where
   compile (AST.SAssignment name expr) = symbol name >>= \case
     Nothing -> throwError $ SymbolNotDefined name
     Just (LocalVariable tp off) -> do
-      as Text $ Comment $ show name ++ " := " ++ show expr
+      as Text $ "@ " ++ show name ++ " := " ++ show expr
       rhs <- compile expr
       when (tp /= rhs) $ throwError $ TypeMismatch tp rhs
-      as Text $ OpCode Al $ POP [R0]
-      as Text $ Comment $ "storing to local " ++ name
-      as Text $ OpCode Al $ STR R0 sp (Imm (-off))
+      as Text $ "pop {r0}"
+      as Text $ "@ storing to local " ++ name
+      as Text $ "str r0, [sp, #-" ++ show off ++ "]"
       _
     Just (GlobalVariable tp dLabel tLabel) -> do
-      as Text $ Comment $ show name ++ " := " ++ show expr
+      as Text $ "@ " ++ show name ++ " := " ++ show expr
       rhs <- compile expr
       when (tp /= rhs) $ throwError $ TypeMismatch tp rhs
       _

From 344a5a74c2d6e1946ec26e50e6d9001b13f175ad Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 25 Mar 2015 00:37:59 +0300
Subject: [PATCH 030/116] Compilable AST.Statement ~finished

---
 komarov.andrey/src/Compiler.hs | 21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index ec6e24e..7ea574a 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -243,13 +243,30 @@ instance Compilable AST.Statement (Maybe Type) where
       as Text $ "pop {r0}"
       as Text $ "@ storing to local " ++ name
       as Text $ "str r0, [sp, #-" ++ show off ++ "]"
-      _
+      return Nothing
     Just (GlobalVariable tp dLabel tLabel) -> do
       as Text $ "@ " ++ show name ++ " := " ++ show expr
       rhs <- compile expr
       when (tp /= rhs) $ throwError $ TypeMismatch tp rhs
-      _
+      as Text $ "ldr r1, " ++ tLabel
+      as Text $ "pop {r0}"
+      as Text $ "str r0, [r1]"
+      return Nothing
     Just s -> throwError $ VariableExpected s
+  compile (AST.SRawExpr expr) = do
+    compile expr
+    as Text $ "pop {r0} @ unused"
+    return Nothing
+  compile (AST.SIfThenElse cond thn els) = do
+    undefined -- TODO too hard, skipping
+  compile (AST.SWhile cond body) = do
+    undefined -- TODO too hard, skipping
+  compile (AST.SReturn expr) = do
+    tp <- compile expr
+    as Text $ "pop {r0}"
+    Just ep <- gets epilogue
+    as Text $ "b " ++ ep
+    return $ Just tp
 
 instance Compilable AST.Expression Type where
   compile _ = _

From eab326f8310502b49af789fa279ea9b5561471e4 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 25 Mar 2015 00:49:36 +0300
Subject: [PATCH 031/116] I'm able to compile examples/example2.l !

---
 komarov.andrey/examples/example2.l |  2 +-
 komarov.andrey/src/Compiler.hs     | 24 +++++++++++++++++-------
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/komarov.andrey/examples/example2.l b/komarov.andrey/examples/example2.l
index 967c760..0a9e962 100644
--- a/komarov.andrey/examples/example2.l
+++ b/komarov.andrey/examples/example2.l
@@ -1 +1 @@
-int lol() {}
+int lol() {return 1;}
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 7ea574a..b82b5a7 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 
 module Compiler (
-
+  runCompiler
   ) where
 
 import Control.Monad.Writer
@@ -66,8 +66,14 @@ data Env = Env {
 emptyEnv :: Env
 emptyEnv = Env (SymbolTable M.empty) S.empty 0 Nothing
 
+stdTable :: SymbolTable
+stdTable = SymbolTable $ M.fromList $ [
+  ("int", Type TInt),
+  ("bool", Type TBool),
+  ("void", Type TVoid)]
+
 stdlib :: Env
-stdlib = emptyEnv
+stdlib = emptyEnv { symbols = stdTable }
 
 setEpilogue :: Label -> Compiler ()
 setEpilogue ep = do
@@ -198,12 +204,12 @@ instance Compilable AST.TopLevel () where
   compile (AST.VarDecl ty name) =
     getType ty >>= updateLocalVar name
   compile (AST.ForwardDecl name ret args) = do
-    tret <- getVarType ret
-    targs <- mapM getVarType args
+    tret <- getType ret
+    targs <- mapM getType args
     updateForwardDecl name (FType tret targs)
   compile (AST.FuncDef name ret args body) = do
-    tret <- getVarType ret
-    targs <- mapM getVarType (map fst args)
+    tret <- getType ret
+    targs <- mapM getType (map fst args)
     fname <- updateFun name (FType tret targs)
     ep <- fresh $ name ++ "_ep"
     as Text ""
@@ -269,4 +275,8 @@ instance Compilable AST.Statement (Maybe Type) where
     return $ Just tp
 
 instance Compilable AST.Expression Type where
-  compile _ = _
+  compile (AST.EInt i) = do
+    as Text $ "ldr r0, =" ++ show i
+    as Text $ "push {r0}"
+    return TInt
+  compile _ = undefined

From e497ff43ab27c38d64d5c5ce9f3c7ee139d3609c Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 25 Mar 2015 01:10:51 +0300
Subject: [PATCH 032/116] First compiled program!

---
 komarov.andrey/src/ARM.hs          |  7 ++++++-
 komarov.andrey/src/Compiler.hs     | 18 ++++++++++++++++--
 komarov.andrey/src/TestCompiler.hs | 14 ++++++++++++++
 3 files changed, 36 insertions(+), 3 deletions(-)
 create mode 100644 komarov.andrey/src/TestCompiler.hs

diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/ARM.hs
index aad6032..91864de 100644
--- a/komarov.andrey/src/ARM.hs
+++ b/komarov.andrey/src/ARM.hs
@@ -7,4 +7,9 @@ module ARM (
 type Assembly = String
 
 data Segment = Data | Text
-             deriving (Show)
+             deriving (Eq)
+
+instance Show Segment where
+  show Data = "data"
+  show Text = "text"
+
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index b82b5a7..c9f477e 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -5,7 +5,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 
 module Compiler (
-  runCompiler
+  runCompiler,
+  output
   ) where
 
 import Control.Monad.Writer
@@ -13,7 +14,8 @@ import Control.Monad.State
 import Control.Monad.Error
 import Control.Applicative
 
-import Data.List (nub)
+import Data.List
+import Data.Function
 import Data.Maybe (catMaybes)
 
 import qualified Data.Map as M
@@ -164,6 +166,18 @@ fresh hint = do
 newtype Output = Output { unOutput :: [(Segment, Assembly)] }
                deriving (Show, Monoid)
 
+output :: Output -> String
+output (Output out) =
+  intercalate "\n\n" $ map (uncurry sect) sections where
+    sect :: Segment -> [String] -> String
+    sect seg lines = "@@@@@@@@@@@@@@@\n." ++ show seg ++ "\n\n" ++ intercalate "\n" lines
+
+    toSect :: [(a, b)] -> (a, [b])
+    toSect pairs = let (a:_,b) = unzip pairs in (a, b)
+  
+    sections :: [(Segment, [String])]
+    sections = map toSect $ groupBy ((==) `on` fst) out
+
 data CompileError
   = CompileError
   | SymbolNotDefined Id
diff --git a/komarov.andrey/src/TestCompiler.hs b/komarov.andrey/src/TestCompiler.hs
new file mode 100644
index 00000000..b474d0a
--- /dev/null
+++ b/komarov.andrey/src/TestCompiler.hs
@@ -0,0 +1,14 @@
+import Parser
+import Lexer
+import Compiler
+
+main = do
+    input <- getContents
+    putStrLn input
+    let tokens = scanTokens input
+    print tokens
+    let ast = parse tokens
+    print ast
+    putStrLn $ case runCompiler ast of
+      Left e -> show e
+      Right o -> output o

From 927f41c2cc1bd21fc217af07e6756f4630e8f9b2 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 25 Mar 2015 01:22:01 +0300
Subject: [PATCH 033/116] TestCompiler not outputs trash

---
 komarov.andrey/examples/example2.l | 5 ++++-
 komarov.andrey/src/Compiler.hs     | 2 ++
 komarov.andrey/src/TestCompiler.hs | 6 +++---
 3 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/komarov.andrey/examples/example2.l b/komarov.andrey/examples/example2.l
index 0a9e962..3654127 100644
--- a/komarov.andrey/examples/example2.l
+++ b/komarov.andrey/examples/example2.l
@@ -1 +1,4 @@
-int lol() {return 1;}
+int lol() 
+{
+    return 42;
+}
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index c9f477e..f5e769c 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -141,11 +141,13 @@ updateFun name ty = symbol name >>= \case
   Nothing -> do
              lab <- fresh name
              setSymbol name $ FunctionDecl ty lab
+             as Data $ ".global " ++ name
              return lab
   Just (ForwardDecl ty') -> do
     when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
     lab <- fresh name
     setSymbol name $ FunctionDecl ty lab
+    as Data $ ".global " ++ name
     return lab
   Just s -> throwError $ AlreadyBound name s (FunctionDecl ty "")
 
diff --git a/komarov.andrey/src/TestCompiler.hs b/komarov.andrey/src/TestCompiler.hs
index b474d0a..25c7c80 100644
--- a/komarov.andrey/src/TestCompiler.hs
+++ b/komarov.andrey/src/TestCompiler.hs
@@ -4,11 +4,11 @@ import Compiler
 
 main = do
     input <- getContents
-    putStrLn input
+    -- putStrLn input
     let tokens = scanTokens input
-    print tokens
+    -- print tokens
     let ast = parse tokens
-    print ast
+    --print ast
     putStrLn $ case runCompiler ast of
       Left e -> show e
       Right o -> output o

From 51a10689f44ad723ae63cf8a6e85313d9b500c37 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 25 Mar 2015 23:06:57 +0300
Subject: [PATCH 034/116] "if" works

---
 komarov.andrey/examples/example5.l |  8 +++++++
 komarov.andrey/src/Compiler.hs     | 38 ++++++++++++++++++++++++++----
 2 files changed, 41 insertions(+), 5 deletions(-)
 create mode 100644 komarov.andrey/examples/example5.l

diff --git a/komarov.andrey/examples/example5.l b/komarov.andrey/examples/example5.l
new file mode 100644
index 00000000..7a87fb4
--- /dev/null
+++ b/komarov.andrey/examples/example5.l
@@ -0,0 +1,8 @@
+int ifTest() 
+{
+    if (1 == 2) {
+        return 100;
+    } else {
+        return 200;
+    }
+}
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index f5e769c..405f165 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -165,6 +165,12 @@ fresh hint = do
   addLabel res
   return res
 
+mergeTypes :: [Maybe Type] -> Compiler (Maybe Type)
+mergeTypes types = case nub $ catMaybes types of
+  [] -> return Nothing
+  [t] -> return $ Just t
+  ts -> throwError $ InconsistentReturnTypes ts
+
 newtype Output = Output { unOutput :: [(Segment, Assembly)] }
                deriving (Show, Monoid)
 
@@ -250,10 +256,7 @@ instance Compilable AST.Statement (Maybe Type) where
     env <- get
     types <- mapM compile stmts
     put env
-    case nub $ catMaybes types of
-     [] -> return Nothing
-     [t] -> return $ Just t
-     ts -> throwError $ InconsistentReturnTypes ts
+    mergeTypes types
   compile (AST.SVarDecl tp name) =
     getType tp >>= updateLocalVar name >> return Nothing
   compile (AST.SAssignment name expr) = symbol name >>= \case
@@ -280,7 +283,22 @@ instance Compilable AST.Statement (Maybe Type) where
     as Text $ "pop {r0} @ unused"
     return Nothing
   compile (AST.SIfThenElse cond thn els) = do
-    undefined -- TODO too hard, skipping
+    elseLabel <- fresh "else"
+    endifLabel <- fresh "endif"
+    as Text $ "@ if"
+    t <- compile cond
+    when (t /= TBool) $ throwError $ TypeMismatch t TBool
+    as Text $ "pop {r0}"
+    as Text $ "@ then"
+    as Text $ "teq r0, #0"
+    as Text $ "beq " ++ elseLabel
+    thnType <- compile thn
+    as Text $ "b " ++ endifLabel
+    as Text $ elseLabel ++ ":"
+    elsType <- compile els
+    retType <- mergeTypes [thnType, elsType]
+    as Text $ endifLabel ++ ":"
+    return retType
   compile (AST.SWhile cond body) = do
     undefined -- TODO too hard, skipping
   compile (AST.SReturn expr) = do
@@ -295,4 +313,14 @@ instance Compilable AST.Expression Type where
     as Text $ "ldr r0, =" ++ show i
     as Text $ "push {r0}"
     return TInt
+  compile (AST.EEqual lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= tr) $ throwError $ TypeMismatch tl tr
+    as Text $ "pop {r0, r1}"
+    as Text $ "teq r0, r1"
+    as Text $ "moveq r0, #1"
+    as Text $ "movne r0, #0"
+    as Text $ "push {r0}"
+    return TBool
   compile _ = undefined

From 5345f441c7ff8be50fe545d4433f656ee6800451 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 26 Mar 2015 00:29:32 +0300
Subject: [PATCH 035/116] Factorial successfully compiles

---
 komarov.andrey/asm/example.S       | 10 ++-
 komarov.andrey/asm/hello.c         |  6 ++
 komarov.andrey/examples/fact.l     |  6 ++
 komarov.andrey/src/Compiler.hs     | 98 +++++++++++++++++++++++++++---
 komarov.andrey/src/TestCompiler.hs |  2 +-
 5 files changed, 110 insertions(+), 12 deletions(-)
 create mode 100644 komarov.andrey/examples/fact.l

diff --git a/komarov.andrey/asm/example.S b/komarov.andrey/asm/example.S
index cc335f2..9cfd0af 100644
--- a/komarov.andrey/asm/example.S
+++ b/komarov.andrey/asm/example.S
@@ -7,6 +7,8 @@ xx: .word x
 
 .global f
 .global fact
+.global ret5
+.global ret6
 
 f:
 ldr r1, xx
@@ -15,7 +17,13 @@ add r0, #1
 str r0, [r1]
 mov pc, lr
 
-# fact(r1, r2)
+# calling conv.
+ret5:
+ret6:
+ldr r0, [sp]
+mov pc, lr
+
+# fact(n)
 fact:
 push {fp, lr}   @
 mov fp, sp      @ ENTER
diff --git a/komarov.andrey/asm/hello.c b/komarov.andrey/asm/hello.c
index 9827dfe..dca8272 100644
--- a/komarov.andrey/asm/hello.c
+++ b/komarov.andrey/asm/hello.c
@@ -4,6 +4,10 @@ int f();
 
 int fact(int x);
 
+int ret5(int a, int b, int c, int d, int e);
+
+int ret6(int a, int b, int c, int d, int e, int f);
+
 int add(int a, int b)
 {
     int c = a + b;
@@ -18,4 +22,6 @@ int main()
         printf("%d ", f());
     printf("\n");
     printf("%d\n", fact(5));
+    printf("%d\n", ret5(1, 2, 3, 4, 5));
+    printf("%d\n", ret6(1, 2, 3, 4, 5, 6));
 }
diff --git a/komarov.andrey/examples/fact.l b/komarov.andrey/examples/fact.l
new file mode 100644
index 00000000..a43666e
--- /dev/null
+++ b/komarov.andrey/examples/fact.l
@@ -0,0 +1,6 @@
+int fact(int n) {
+    if (n == 0)
+        return 1;
+    else
+        return n * fact(n - 1);
+}
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 405f165..0b5f414 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -51,7 +51,7 @@ data Symbol
                      dataLabel :: Label,
                      textLabel :: Label}
   | LocalVariable { varType :: Type, varOffset :: Int }
-  | ForwardDecl { funType :: FType }
+  | ForwardDecl { funType :: FType, label :: Label }
   | FunctionDecl { funType :: FType, label :: Label }
   | Type Type
   deriving (Show)
@@ -77,6 +77,12 @@ stdTable = SymbolTable $ M.fromList $ [
 stdlib :: Env
 stdlib = emptyEnv { symbols = stdTable }
 
+setOffset :: Int -> Compiler ()
+setOffset off = modify $ \env -> env { offset = off }
+
+setSymbols :: SymbolTable -> Compiler ()
+setSymbols s = modify $ \env -> env { symbols = s }
+
 setEpilogue :: Label -> Compiler ()
 setEpilogue ep = do
   env@Env { epilogue = epilogue } <- get
@@ -92,6 +98,13 @@ setSymbol name s = do
   env@(Env { symbols = SymbolTable syms }) <- get
   put $ env { symbols = SymbolTable $ M.insert name s syms }
 
+getFun :: Id -> Compiler (FType, Label)
+getFun name = symbol name >>= \case
+  Nothing -> throwError $ SymbolNotDefined name
+  Just (ForwardDecl { funType = t, label = l }) -> return (t, l)
+  Just (FunctionDecl { funType = t, label = l }) -> return (t, l)
+  Just s -> throwError $ FunctionExpected s
+
 getVarType :: Id -> Compiler Type
 getVarType name = symbol name >>= \case
   Nothing -> throwError $ SymbolNotDefined name
@@ -126,15 +139,16 @@ updateLocalVar name t = symbol name >>= \case
     modify $ \(env@Env { offset = o }) -> env { offset = o + sz }
     setSymbol name $ LocalVariable t (off + sz)
   Just s' -> throwError $ AlreadyBound name s' $ LocalVariable t 0
-  
-
 
 updateForwardDecl :: Id -> FType -> Compiler ()
 updateForwardDecl name ty = symbol name >>= \case
-  Nothing -> setSymbol name $ ForwardDecl ty
-  Just (ForwardDecl ty') -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
+  Nothing -> do
+    lab <- fresh name
+    when (lab /= name) $ throwError $ LabelAlreadyDeclared name
+    setSymbol name $ ForwardDecl ty lab
+  Just (ForwardDecl ty' _) -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
   Just (FunctionDecl { funType = ty' }) -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
-  Just s -> throwError $ AlreadyBound name s (ForwardDecl ty)
+  Just s -> throwError $ AlreadyBound name s (ForwardDecl ty "")
 
 updateFun :: Id -> FType -> Compiler Label
 updateFun name ty = symbol name >>= \case
@@ -143,9 +157,8 @@ updateFun name ty = symbol name >>= \case
              setSymbol name $ FunctionDecl ty lab
              as Data $ ".global " ++ name
              return lab
-  Just (ForwardDecl ty') -> do
+  Just (ForwardDecl ty' lab) -> do
     when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
-    lab <- fresh name
     setSymbol name $ FunctionDecl ty lab
     as Data $ ".global " ++ name
     return lab
@@ -197,6 +210,7 @@ data CompileError
   | InconsistentReturnTypes [Type]
   | TypeMismatch Type Type
   | LabelAlreadyDeclared String
+  | WrongArgsNumber [Type] [Type]
   deriving (Show)
 
 instance Error CompileError where
@@ -242,9 +256,24 @@ instance Compilable AST.TopLevel () where
     as Text $ "push {fp, lr}"
     as Text $ "mov fp, sp"
     -- TODO Correct stack frame size
-    as Text $ "sub sp, sp, #16"
+    as Text $ "sub sp, sp, #128"
     setEpilogue ep
+    oldSymbols <- gets symbols
+    let argPairs = zip (map snd args) targs
+    let stackArgs = drop 4 argPairs
+    let registerArgs = take 4 argPairs
+    setOffset $ -(4 * length stackArgs)
+    mapM (uncurry updateLocalVar) argPairs
+    case length registerArgs of
+     0 -> return ()
+     1 -> as Text $ "str r0, [fp, #-4]"
+     2 -> mapM_ (as Text) ["str r0, [fp, #-8]", "str r1, [fp, #-4]"]
+     3 -> mapM_ (as Text) ["str r0, [fp, #-12]", "str r1, [fp, #-8]", "str r2, [fp, #-4]"]
+     4 -> mapM_ (as Text) ["str r0, [fp, #-16]", "str r1, [fp, #-12]", "str r2, [fp, #-8]", "str r3, [fp, #-4]"]
+     n -> error "IMPOSSIBLE"
     mapM compile body
+    setOffset 0
+    setSymbols oldSymbols
     as Text $ ep ++ ":"
     as Text $ "mov sp, fp"
     as Text $ "pop {fp, lr}"
@@ -267,7 +296,7 @@ instance Compilable AST.Statement (Maybe Type) where
       when (tp /= rhs) $ throwError $ TypeMismatch tp rhs
       as Text $ "pop {r0}"
       as Text $ "@ storing to local " ++ name
-      as Text $ "str r0, [sp, #-" ++ show off ++ "]"
+      as Text $ "str r0, [fp, #-" ++ show off ++ "]"
       return Nothing
     Just (GlobalVariable tp dLabel tLabel) -> do
       as Text $ "@ " ++ show name ++ " := " ++ show expr
@@ -309,10 +338,43 @@ instance Compilable AST.Statement (Maybe Type) where
     return $ Just tp
 
 instance Compilable AST.Expression Type where
+  compile (AST.EVar v) = symbol v >>= \case
+    Nothing -> throwError $ SymbolNotDefined v
+    Just (LocalVariable tp off) -> do
+      as Text $ "@ local " ++ show v
+      as Text $ "ldr r0, [fp, #-" ++ show off ++ "]"
+      as Text $ "push {r0}"
+      return tp
+    Just (GlobalVariable tp dLabel tLabel) -> do
+      as Text $ "@ global " ++ show v
+      as Text $ "ldr r0, " ++ tLabel
+      as Text $ "ldr r0, [r0]"
+      as Text $ "push {r0}"
+      return tp
+    Just s -> throwError $ VariableExpected s
+    
   compile (AST.EInt i) = do
     as Text $ "ldr r0, =" ++ show i
     as Text $ "push {r0}"
     return TInt
+  compile (AST.ESub lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
+    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
+    as Text $ "pop {r0, r1}"
+    as Text $ "sub r0, r1, r0"
+    as Text $ "push {r0}"
+    return TInt
+  compile (AST.EMul lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
+    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
+    as Text $ "pop {r0, r1}"
+    as Text $ "mul r0, r1, r0"
+    as Text $ "push {r0}"
+    return TInt
   compile (AST.EEqual lhs rhs) = do
     tl <- compile lhs
     tr <- compile rhs
@@ -323,4 +385,20 @@ instance Compilable AST.Expression Type where
     as Text $ "movne r0, #0"
     as Text $ "push {r0}"
     return TBool
+  compile (AST.ECall name args) = do
+    targs <- reverse <$> (mapM compile $ reverse args)
+    (FType ret targs', label) <- getFun name
+    when (length targs /= length targs') $
+      throwError $ WrongArgsNumber targs targs'
+    forM (zip targs targs') $ \(t, t') ->
+      when (t /= t') $ throwError $ TypeMismatch t t'
+    case (length args) of
+     0 -> as Text $ "@ no args"
+     1 -> as Text $ "pop {r0}"
+     2 -> as Text $ "pop {r0, r1}"
+     3 -> as Text $ "pop {r0, r1, r2}"
+     _ -> as Text $ "pop {r0, r1, r2, r3}"
+    as Text $ "bl " ++ label
+    as Text $ "push {r0}"
+    return ret
   compile _ = undefined
diff --git a/komarov.andrey/src/TestCompiler.hs b/komarov.andrey/src/TestCompiler.hs
index 25c7c80..7173f6d 100644
--- a/komarov.andrey/src/TestCompiler.hs
+++ b/komarov.andrey/src/TestCompiler.hs
@@ -8,7 +8,7 @@ main = do
     let tokens = scanTokens input
     -- print tokens
     let ast = parse tokens
-    --print ast
+    putStrLn $ "@ " ++ show ast
     putStrLn $ case runCompiler ast of
       Left e -> show e
       Right o -> output o

From 3afe37b48bc4124137d42f6d78021f9c873be13c Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 26 Mar 2015 01:33:15 +0300
Subject: [PATCH 036/116] "while" works

---
 komarov.andrey/examples/example6.l  |  7 +++++++
 komarov.andrey/examples/example7.l  | 13 ++++++++++++
 komarov.andrey/examples/whiletrue.l |  5 +++++
 komarov.andrey/src/Compiler.hs      | 32 ++++++++++++++++++++++++++++-
 4 files changed, 56 insertions(+), 1 deletion(-)
 create mode 100644 komarov.andrey/examples/example6.l
 create mode 100644 komarov.andrey/examples/example7.l
 create mode 100644 komarov.andrey/examples/whiletrue.l

diff --git a/komarov.andrey/examples/example6.l b/komarov.andrey/examples/example6.l
new file mode 100644
index 00000000..af529db
--- /dev/null
+++ b/komarov.andrey/examples/example6.l
@@ -0,0 +1,7 @@
+int testLocalVar() {
+    int a;
+    a = 10;
+    int b;
+    b = 20;
+    return a + b * a;
+}
diff --git a/komarov.andrey/examples/example7.l b/komarov.andrey/examples/example7.l
new file mode 100644
index 00000000..4822c9a
--- /dev/null
+++ b/komarov.andrey/examples/example7.l
@@ -0,0 +1,13 @@
+int whileTest(int n)
+{
+    int sum;
+    sum = 0;
+    int i;
+    i = 0;
+    while (i < n) {
+        sum = sum + i;
+        i = i + 1;
+    }
+    return sum;
+}
+
diff --git a/komarov.andrey/examples/whiletrue.l b/komarov.andrey/examples/whiletrue.l
new file mode 100644
index 00000000..fedabc2
--- /dev/null
+++ b/komarov.andrey/examples/whiletrue.l
@@ -0,0 +1,5 @@
+int loop()
+{
+    while(1 == 1)
+    {}
+}
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 0b5f414..cb5be96 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -329,7 +329,17 @@ instance Compilable AST.Statement (Maybe Type) where
     as Text $ endifLabel ++ ":"
     return retType
   compile (AST.SWhile cond body) = do
-    undefined -- TODO too hard, skipping
+    [whileLabel, endWhileLabel] <- mapM fresh ["while", "endwhile"]
+    as Text $ whileLabel ++ ":"
+    tcond <- compile cond
+    when (tcond /= TBool) $ throwError $ TypeMismatch tcond TBool
+    as Text $ "pop {r0}"
+    as Text $ "teq r0, #0"
+    as Text $ "beq " ++ endWhileLabel
+    tret <- compile body
+    as Text $ "b " ++ whileLabel
+    as Text $ endWhileLabel ++ ":"
+    return tret
   compile (AST.SReturn expr) = do
     tp <- compile expr
     as Text $ "pop {r0}"
@@ -357,6 +367,15 @@ instance Compilable AST.Expression Type where
     as Text $ "ldr r0, =" ++ show i
     as Text $ "push {r0}"
     return TInt
+  compile (AST.EAdd lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
+    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
+    as Text $ "pop {r0, r1}"
+    as Text $ "add r0, r1, r0"
+    as Text $ "push {r0}"
+    return TInt
   compile (AST.ESub lhs rhs) = do
     tl <- compile lhs
     tr <- compile rhs
@@ -375,6 +394,17 @@ instance Compilable AST.Expression Type where
     as Text $ "mul r0, r1, r0"
     as Text $ "push {r0}"
     return TInt
+  compile (AST.ELess lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
+    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
+    as Text $ "pop {r0, r1}"
+    as Text $ "cmp r1, r0"
+    as Text $ "movlt r0, #1"
+    as Text $ "movge r0, #0"
+    as Text $ "push {r0}"
+    return TBool
   compile (AST.EEqual lhs rhs) = do
     tl <- compile lhs
     tr <- compile rhs

From 86e2ea7c4fba04c3500e44ac29343e1e6b24eb95 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 26 Mar 2015 02:28:40 +0300
Subject: [PATCH 037/116] "isPrime.l" compiles successfully

---
 komarov.andrey/examples/isPrime.l | 50 +++++++++++++++++++++++++++
 komarov.andrey/examples/sign.l    | 12 +++++++
 komarov.andrey/src/Compiler.hs    | 57 ++++++++++++++++++++++++++-----
 3 files changed, 111 insertions(+), 8 deletions(-)
 create mode 100644 komarov.andrey/examples/isPrime.l
 create mode 100644 komarov.andrey/examples/sign.l

diff --git a/komarov.andrey/examples/isPrime.l b/komarov.andrey/examples/isPrime.l
new file mode 100644
index 00000000..c9f9b53
--- /dev/null
+++ b/komarov.andrey/examples/isPrime.l
@@ -0,0 +1,50 @@
+int div(int a, int b);
+int mod(int a, int b);
+
+bool isPrime(int n)
+{
+    int i;
+    i = 2;
+    while (i * i <= n)
+    {
+        if (mod(n, i) == 0)
+            return false;
+        else {}
+        i = i + 1;
+    }
+    return true;
+}
+
+int numPrimes(int from, int to)
+{
+    int i;
+    i = from;
+    int ans;
+    ans = 0;
+    while (i < to)
+    {
+        if (isPrime(i))
+            ans = ans + 1;
+        else {}
+        i = i + 1;
+    }
+    return ans;
+}
+
+int mod(int a, int b)
+{
+    return a - b * div(a, b);
+}
+
+int div(int a, int b)
+{
+    int c;
+    c = 0;
+    while (a >= 0)
+    {
+        c = c + 1;
+        a = a - b;
+    }
+    return c - 1;
+}
+
diff --git a/komarov.andrey/examples/sign.l b/komarov.andrey/examples/sign.l
new file mode 100644
index 00000000..96b74b3
--- /dev/null
+++ b/komarov.andrey/examples/sign.l
@@ -0,0 +1,12 @@
+int sign(int x)
+{
+    if (x == 0)
+        return 0;
+    else {
+        if (x < 0)
+            return 0-1;
+        else
+            return 1;
+    }
+}
+
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index cb5be96..f3b2631 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -65,6 +65,11 @@ data Env = Env {
   offset :: Int,
   epilogue :: Maybe Label}
 
+put' :: Env -> Compiler ()
+put' env' = do
+  env <- get
+  put $ env' { labels = labels env }
+
 emptyEnv :: Env
 emptyEnv = Env (SymbolTable M.empty) S.empty 0 Nothing
 
@@ -267,9 +272,9 @@ instance Compilable AST.TopLevel () where
     case length registerArgs of
      0 -> return ()
      1 -> as Text $ "str r0, [fp, #-4]"
-     2 -> mapM_ (as Text) ["str r0, [fp, #-8]", "str r1, [fp, #-4]"]
-     3 -> mapM_ (as Text) ["str r0, [fp, #-12]", "str r1, [fp, #-8]", "str r2, [fp, #-4]"]
-     4 -> mapM_ (as Text) ["str r0, [fp, #-16]", "str r1, [fp, #-12]", "str r2, [fp, #-8]", "str r3, [fp, #-4]"]
+     2 -> mapM_ (as Text) ["str r0, [fp, #-4]", "str r1, [fp, #-8]"]
+     3 -> mapM_ (as Text) ["str r0, [fp, #-4]", "str r1, [fp, #-8]", "str r2, [fp, #-12]"]
+     4 -> mapM_ (as Text) ["str r0, [fp, #-4]", "str r1, [fp, #-8]", "str r2, [fp, #-12]", "str r3, [fp, #-16]"]
      n -> error "IMPOSSIBLE"
     mapM compile body
     setOffset 0
@@ -284,7 +289,7 @@ instance Compilable AST.Statement (Maybe Type) where
   compile (AST.SBlock stmts) = do
     env <- get
     types <- mapM compile stmts
-    put env
+    put' env
     mergeTypes types
   compile (AST.SVarDecl tp name) =
     getType tp >>= updateLocalVar name >> return Nothing
@@ -362,7 +367,10 @@ instance Compilable AST.Expression Type where
       as Text $ "push {r0}"
       return tp
     Just s -> throwError $ VariableExpected s
-    
+  compile (AST.EBool b) = do
+    as Text $ "ldr r0, =" ++ show (if b then 1 else 0)
+    as Text $ "push {r0}"
+    return TBool
   compile (AST.EInt i) = do
     as Text $ "ldr r0, =" ++ show i
     as Text $ "push {r0}"
@@ -405,6 +413,39 @@ instance Compilable AST.Expression Type where
     as Text $ "movge r0, #0"
     as Text $ "push {r0}"
     return TBool
+  compile (AST.EGreater lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
+    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
+    as Text $ "pop {r0, r1}"
+    as Text $ "cmp r1, r0"
+    as Text $ "movgt r0, #1"
+    as Text $ "movle r0, #0"
+    as Text $ "push {r0}"
+    return TBool
+  compile (AST.ELessEq lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
+    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
+    as Text $ "pop {r0, r1}"
+    as Text $ "cmp r1, r0"
+    as Text $ "movle r0, #1"
+    as Text $ "movgt r0, #0"
+    as Text $ "push {r0}"
+    return TBool
+  compile (AST.EGreaterEq lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
+    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
+    as Text $ "pop {r0, r1}"
+    as Text $ "cmp r1, r0"
+    as Text $ "movge r0, #1"
+    as Text $ "movlt r0, #0"
+    as Text $ "push {r0}"
+    return TBool
   compile (AST.EEqual lhs rhs) = do
     tl <- compile lhs
     tr <- compile rhs
@@ -425,9 +466,9 @@ instance Compilable AST.Expression Type where
     case (length args) of
      0 -> as Text $ "@ no args"
      1 -> as Text $ "pop {r0}"
-     2 -> as Text $ "pop {r0, r1}"
-     3 -> as Text $ "pop {r0, r1, r2}"
-     _ -> as Text $ "pop {r0, r1, r2, r3}"
+     2 -> mapM_ (as Text) ["pop {r0}", "pop {r1}"]
+     3 -> mapM_ (as Text) ["pop {r2}", "pop {r1}", "pop {r0}"]
+     _ -> mapM_ (as Text) ["pop {r3}", "pop {r2}", "pop {r1}", "pop {r0}"]
     as Text $ "bl " ++ label
     as Text $ "push {r0}"
     return ret

From 611206447057a1a883189b8ada9659a0afb222b4 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 26 Mar 2015 10:41:11 +0300
Subject: [PATCH 038/116] Fixed grouping by segment

---
 komarov.andrey/src/ARM.hs      | 2 +-
 komarov.andrey/src/Compiler.hs | 3 ++-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/ARM.hs
index 91864de..ea0ac98 100644
--- a/komarov.andrey/src/ARM.hs
+++ b/komarov.andrey/src/ARM.hs
@@ -7,7 +7,7 @@ module ARM (
 type Assembly = String
 
 data Segment = Data | Text
-             deriving (Eq)
+             deriving (Eq, Ord)
 
 instance Show Segment where
   show Data = "data"
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index f3b2631..c68da71 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -202,7 +202,8 @@ output (Output out) =
     toSect pairs = let (a:_,b) = unzip pairs in (a, b)
   
     sections :: [(Segment, [String])]
-    sections = map toSect $ groupBy ((==) `on` fst) out
+    sections = map toSect $ groupBy ((==) `on` fst)
+               $ sortBy (compare `on` fst) out
 
 data CompileError
   = CompileError

From 9f88e3c58c3357b933730cfefdf3617cb376f059 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Thu, 26 Mar 2015 18:42:45 +0300
Subject: [PATCH 039/116] Add missing clauses in Compilable Expr

---
 komarov.andrey/src/Compiler.hs | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index c68da71..7333a1e 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -457,6 +457,34 @@ instance Compilable AST.Expression Type where
     as Text $ "movne r0, #0"
     as Text $ "push {r0}"
     return TBool
+  compile (AST.ENotEqual lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= tr) $ throwError $ TypeMismatch tl tr
+    as Text $ "pop {r0, r1}"
+    as Text $ "teq r0, r1"
+    as Text $ "movne r0, #1"
+    as Text $ "moveq r0, #0"
+    as Text $ "push {r0}"
+    return TBool
+  compile (AST.EAnd lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= TBool) $ throwError $ TypeMismatch tl TBool
+    when (tr /= TBool) $ throwError $ TypeMismatch tr TBool
+    as Text $ "pop {r0, r1}"
+    as Text $ "and r0, r1, r0"
+    as Text $ "push {r0}"
+    return TBool
+  compile (AST.EOr lhs rhs) = do
+    tl <- compile lhs
+    tr <- compile rhs
+    when (tl /= TBool) $ throwError $ TypeMismatch tl TBool
+    when (tr /= TBool) $ throwError $ TypeMismatch tr TBool
+    as Text $ "pop {r0, r1}"
+    as Text $ "orr r0, r1, r0"
+    as Text $ "push {r0}"
+    return TBool
   compile (AST.ECall name args) = do
     targs <- reverse <$> (mapM compile $ reverse args)
     (FType ret targs', label) <- getFun name
@@ -473,4 +501,3 @@ instance Compilable AST.Expression Type where
     as Text $ "bl " ++ label
     as Text $ "push {r0}"
     return ret
-  compile _ = undefined

From b005ee9ace1f87d55a3fc363723ad22ca785799b Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Thu, 26 Mar 2015 18:48:17 +0300
Subject: [PATCH 040/116] Fix some warnings

---
 komarov.andrey/src/Compiler.hs | 15 +++++----------
 1 file changed, 5 insertions(+), 10 deletions(-)

diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 7333a1e..4ca1376 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -37,10 +37,6 @@ size TInt = 4
 size TString = error "lol not implemented yet"
 size TVoid = error "lol void is not instantiable"
 
-encode :: Type -> String
-encode TInt = "word"
-encode v = error $ "global " ++ show v ++ " variables are not supported yet!"
-
 data FType = FType Type [Type]
            deriving (Show, Eq)
 
@@ -48,7 +44,6 @@ type Label = String
 
 data Symbol
   = GlobalVariable { varType :: Type,
-                     dataLabel :: Label,
                      textLabel :: Label}
   | LocalVariable { varType :: Type, varOffset :: Int }
   | ForwardDecl { funType :: FType, label :: Label }
@@ -90,7 +85,7 @@ setSymbols s = modify $ \env -> env { symbols = s }
 
 setEpilogue :: Label -> Compiler ()
 setEpilogue ep = do
-  env@Env { epilogue = epilogue } <- get
+  env <- get
   put $ env { epilogue = Just ep }
 
 symbol :: Id -> Compiler (Maybe Symbol)
@@ -131,10 +126,10 @@ updateGlobalVar name t = symbol name >>= \case
   Nothing -> do
              dLabel <- fresh name
              tLabel <- fresh name
-             setSymbol name $ GlobalVariable t dLabel tLabel
+             setSymbol name $ GlobalVariable t tLabel
              as Data $ dLabel ++ ": .word 0"
              as Text $ tLabel ++ ": .word " ++ dLabel
-  Just s' -> throwError $ AlreadyBound name s' $ GlobalVariable t "" ""
+  Just s' -> throwError $ AlreadyBound name s' $ GlobalVariable t ""
 
 updateLocalVar :: Id -> Type -> Compiler ()
 updateLocalVar name t = symbol name >>= \case
@@ -304,7 +299,7 @@ instance Compilable AST.Statement (Maybe Type) where
       as Text $ "@ storing to local " ++ name
       as Text $ "str r0, [fp, #-" ++ show off ++ "]"
       return Nothing
-    Just (GlobalVariable tp dLabel tLabel) -> do
+    Just (GlobalVariable tp tLabel) -> do
       as Text $ "@ " ++ show name ++ " := " ++ show expr
       rhs <- compile expr
       when (tp /= rhs) $ throwError $ TypeMismatch tp rhs
@@ -361,7 +356,7 @@ instance Compilable AST.Expression Type where
       as Text $ "ldr r0, [fp, #-" ++ show off ++ "]"
       as Text $ "push {r0}"
       return tp
-    Just (GlobalVariable tp dLabel tLabel) -> do
+    Just (GlobalVariable tp tLabel) -> do
       as Text $ "@ global " ++ show v
       as Text $ "ldr r0, " ++ tLabel
       as Text $ "ldr r0, [r0]"

From 2ab34ef0dbbed2e6602a7de3b643776c1730006b Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Thu, 26 Mar 2015 20:11:03 +0300
Subject: [PATCH 041/116] Fixed bug with global vars

---
 komarov.andrey/examples/boolTest.l | 14 ++++++++++++++
 komarov.andrey/examples/global.l   |  8 ++++++++
 komarov.andrey/src/Compiler.hs     |  2 +-
 komarov.andrey/src/Makefile        |  2 +-
 4 files changed, 24 insertions(+), 2 deletions(-)
 create mode 100644 komarov.andrey/examples/boolTest.l
 create mode 100644 komarov.andrey/examples/global.l

diff --git a/komarov.andrey/examples/boolTest.l b/komarov.andrey/examples/boolTest.l
new file mode 100644
index 00000000..a722586
--- /dev/null
+++ b/komarov.andrey/examples/boolTest.l
@@ -0,0 +1,14 @@
+
+bool boolTest() {
+  bool ok;
+  ok = true;
+  ok = ok && (true && true);
+  ok = ok && ((true && false) == false);
+  ok = ok && ((false && true) == false);
+  ok = ok && ((false && false) == false);
+  ok = ok && (true || true);
+  ok = ok && (true || false);
+  ok = ok && (false || true);
+  ok = ok && ((false || false) == false);
+  return ok;
+}
diff --git a/komarov.andrey/examples/global.l b/komarov.andrey/examples/global.l
new file mode 100644
index 00000000..5a2f660
--- /dev/null
+++ b/komarov.andrey/examples/global.l
@@ -0,0 +1,8 @@
+
+int v;
+
+int inc()
+{
+  v = v + 1;
+  return v;
+}
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 4ca1376..77954d3 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -239,7 +239,7 @@ instance Compilable AST.Program () where
 
 instance Compilable AST.TopLevel () where
   compile (AST.VarDecl ty name) =
-    getType ty >>= updateLocalVar name
+    getType ty >>= updateGlobalVar name
   compile (AST.ForwardDecl name ret args) = do
     tret <- getType ret
     targs <- mapM getType args
diff --git a/komarov.andrey/src/Makefile b/komarov.andrey/src/Makefile
index 5356a15..6769211 100644
--- a/komarov.andrey/src/Makefile
+++ b/komarov.andrey/src/Makefile
@@ -1,5 +1,5 @@
 all:
 	alex Lexer.x
 	happy Parser.y
-	ghc TestTypecheck
+	ghc TestCompiler
 

From ad4d67a49b3909a8dd830eb84de05156c3e5c7fe Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Thu, 26 Mar 2015 20:34:19 +0300
Subject: [PATCH 042/116] Register args order fixed

---
 komarov.andrey/examples/manyArgs.l |  9 +++++++++
 komarov.andrey/src/Compiler.hs     | 14 +++++++++-----
 2 files changed, 18 insertions(+), 5 deletions(-)
 create mode 100644 komarov.andrey/examples/manyArgs.l

diff --git a/komarov.andrey/examples/manyArgs.l b/komarov.andrey/examples/manyArgs.l
new file mode 100644
index 00000000..d39a925
--- /dev/null
+++ b/komarov.andrey/examples/manyArgs.l
@@ -0,0 +1,9 @@
+int notreallymany(int a, int b, int c, int d)
+{
+  return a * 1 + b * 10 + c * 100 + d * 1000;
+}
+
+int many(int a, int b, int c, int d, int e, int f, int g, int h)
+{
+  return a * 1 + b * 10 + c * 100 + d * 1000 + e * 10000 + f * 100000 + g * 1000000 + h * 10000000;
+}
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 77954d3..03d4e6a 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -244,7 +244,8 @@ instance Compilable AST.TopLevel () where
     tret <- getType ret
     targs <- mapM getType args
     updateForwardDecl name (FType tret targs)
-  compile (AST.FuncDef name ret args body) = do
+  compile (AST.FuncDef name ret args' body) = do
+    let args = reverse args'
     tret <- getType ret
     targs <- mapM getType (map fst args)
     fname <- updateFun name (FType tret targs)
@@ -263,8 +264,11 @@ instance Compilable AST.TopLevel () where
     let argPairs = zip (map snd args) targs
     let stackArgs = drop 4 argPairs
     let registerArgs = take 4 argPairs
-    setOffset $ -(4 * length stackArgs)
-    mapM (uncurry updateLocalVar) argPairs
+    setOffset $ -(4 * length stackArgs + 8)
+    -- TODO incorrect. "push{fp,lr}" splits args to reg/stack groups
+    mapM (uncurry updateLocalVar) stackArgs
+    setOffset 0
+    mapM (uncurry updateLocalVar) registerArgs
     case length registerArgs of
      0 -> return ()
      1 -> as Text $ "str r0, [fp, #-4]"
@@ -491,8 +495,8 @@ instance Compilable AST.Expression Type where
      0 -> as Text $ "@ no args"
      1 -> as Text $ "pop {r0}"
      2 -> mapM_ (as Text) ["pop {r0}", "pop {r1}"]
-     3 -> mapM_ (as Text) ["pop {r2}", "pop {r1}", "pop {r0}"]
-     _ -> mapM_ (as Text) ["pop {r3}", "pop {r2}", "pop {r1}", "pop {r0}"]
+     3 -> mapM_ (as Text) ["pop {r0}", "pop {r1}", "pop {r2}"]
+     _ -> mapM_ (as Text) ["pop {r0}", "pop {r1}", "pop {r2}", "pop {r3}"]
     as Text $ "bl " ++ label
     as Text $ "push {r0}"
     return ret

From bc3c0967352471f7f4151a32bf4e4ae2c41923a3 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Thu, 26 Mar 2015 21:20:11 +0300
Subject: [PATCH 043/116] report stub added

---
 komarov.andrey/report/Makefile   |  7 ++++
 komarov.andrey/report/report.tex | 69 ++++++++++++++++++++++++++++++++
 2 files changed, 76 insertions(+)
 create mode 100644 komarov.andrey/report/Makefile
 create mode 100644 komarov.andrey/report/report.tex

diff --git a/komarov.andrey/report/Makefile b/komarov.andrey/report/Makefile
new file mode 100644
index 00000000..e20da6e
--- /dev/null
+++ b/komarov.andrey/report/Makefile
@@ -0,0 +1,7 @@
+main: show
+
+all: report.tex
+	xelatex report.tex
+
+show: all
+	evince report.pdf
diff --git a/komarov.andrey/report/report.tex b/komarov.andrey/report/report.tex
new file mode 100644
index 00000000..692ec80
--- /dev/null
+++ b/komarov.andrey/report/report.tex
@@ -0,0 +1,69 @@
+\documentclass{article}
+
+\usepackage{syntax}
+
+\begin{document}
+
+\paragraph{Increase the two lengths}
+\setlength{\grammarparsep}{20pt plus 1pt minus 1pt} % increase separation between rules
+\setlength{\grammarindent}{12em} % increase separation between LHS/RHS 
+
+\begin{grammar}
+
+<prog> ::= <toplevel>*
+
+<toplevel> ::= <id> <id> `;'
+\alt <id> <id> `(' <args> `)' `;'
+\alt <id> <id> `(' <args> `)' `{' <stmt>* `}'
+
+<stmt> ::= `{' <stmt>* `}'
+\alt <id> <id> `;'
+\alt <id> `=' <expr> `;'
+\alt <expr> `;'
+\alt `if' `(' <expr> `)' <stmt> `else' <stmt>
+\alt `while' `(' <expr> `)' <stmt>
+\alt `return' <expr> `;'
+
+<expr> ::= <id> 
+\alt <num>
+\alt <bool>
+\alt `(' <expr> `)'
+\alt <expr> `+' <expr>
+\alt <expr> `-' <expr>
+\alt <expr> `*' <expr>
+\alt <expr> `<' <expr>
+\alt <expr> `>' <expr>
+\alt <expr> `==' <expr>
+\alt <expr> `!=' <expr>
+\alt <expr> `<=' <expr>
+\alt <expr> `>=' <expr>
+\alt <expr> `&&' <expr>
+\alt <expr> `||' <expr>
+\alt <id> `(' <ids> `)'
+
+<args> ::= $\varepsilon$
+\alt <id> <id>
+\alt <id> <id> `,' <args>
+
+<ids> ::= $\varepsilon$
+\alt <id>
+\alt <id> `,' <ids>
+
+<bool> ::= `true' | `false'
+
+<id> ::= <alpha>+
+
+<num> ::= <digit>+
+
+\end{grammar}
+
+\paragraph{Лол}
+
+Что хочется сделать дальше:
+\begin{itemize}
+\item Добавить строки (и массивы)
+\item Добавить возможность компилироваться в самостоятельный бинарник
+\item Переписать всё, потому что сейчас мерзко
+\end{itemize}
+
+\end{document}

From 05f2afb84066f76534deee21dd958d780b600767 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 26 Mar 2015 22:10:00 +0300
Subject: [PATCH 044/116] Really fix order of arguments

---
 komarov.andrey/examples/manyArgs.l | 5 +++++
 komarov.andrey/src/Compiler.hs     | 5 ++---
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/komarov.andrey/examples/manyArgs.l b/komarov.andrey/examples/manyArgs.l
index d39a925..26d33ec 100644
--- a/komarov.andrey/examples/manyArgs.l
+++ b/komarov.andrey/examples/manyArgs.l
@@ -7,3 +7,8 @@ int many(int a, int b, int c, int d, int e, int f, int g, int h)
 {
   return a * 1 + b * 10 + c * 100 + d * 1000 + e * 10000 + f * 100000 + g * 1000000 + h * 10000000;
 }
+
+int one()
+{
+  return many(1, 2, 3, 4, 5, 6, 7, 8);
+}
diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
index 03d4e6a..c35a144 100644
--- a/komarov.andrey/src/Compiler.hs
+++ b/komarov.andrey/src/Compiler.hs
@@ -244,8 +244,7 @@ instance Compilable AST.TopLevel () where
     tret <- getType ret
     targs <- mapM getType args
     updateForwardDecl name (FType tret targs)
-  compile (AST.FuncDef name ret args' body) = do
-    let args = reverse args'
+  compile (AST.FuncDef name ret args body) = do
     tret <- getType ret
     targs <- mapM getType (map fst args)
     fname <- updateFun name (FType tret targs)
@@ -266,7 +265,7 @@ instance Compilable AST.TopLevel () where
     let registerArgs = take 4 argPairs
     setOffset $ -(4 * length stackArgs + 8)
     -- TODO incorrect. "push{fp,lr}" splits args to reg/stack groups
-    mapM (uncurry updateLocalVar) stackArgs
+    mapM (uncurry updateLocalVar) $ reverse stackArgs
     setOffset 0
     mapM (uncurry updateLocalVar) registerArgs
     case length registerArgs of

From f439276f7683c0266c12e0f2c56b0e21ba678402 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 26 Mar 2015 22:26:11 +0300
Subject: [PATCH 045/116] demo added

---
 komarov.andrey/demo/Makefile    | 13 +++++++++
 komarov.andrey/demo/call.c      | 14 +++++++++
 komarov.andrey/demo/callc.l     |  6 ++++
 komarov.andrey/demo/fact.c      |  9 ++++++
 komarov.andrey/demo/fact.l      |  6 ++++
 komarov.andrey/demo/global.c    | 12 ++++++++
 komarov.andrey/demo/global.l    |  8 ++++++
 komarov.andrey/demo/isPrime.l   | 50 +++++++++++++++++++++++++++++++++
 komarov.andrey/demo/prime.c     | 15 ++++++++++
 komarov.andrey/examples/callc.l |  6 ++++
 10 files changed, 139 insertions(+)
 create mode 100644 komarov.andrey/demo/Makefile
 create mode 100644 komarov.andrey/demo/call.c
 create mode 100644 komarov.andrey/demo/callc.l
 create mode 100644 komarov.andrey/demo/fact.c
 create mode 100644 komarov.andrey/demo/fact.l
 create mode 100644 komarov.andrey/demo/global.c
 create mode 100644 komarov.andrey/demo/global.l
 create mode 100644 komarov.andrey/demo/isPrime.l
 create mode 100644 komarov.andrey/demo/prime.c
 create mode 100644 komarov.andrey/examples/callc.l

diff --git a/komarov.andrey/demo/Makefile b/komarov.andrey/demo/Makefile
new file mode 100644
index 00000000..45bb875
--- /dev/null
+++ b/komarov.andrey/demo/Makefile
@@ -0,0 +1,13 @@
+all:
+	make -C ../src
+	../src/TestCompiler < callc.l > callc.S
+	../src/TestCompiler < isPrime.l > prime.S
+	../src/TestCompiler < fact.l > fact.S
+	../src/TestCompiler < global.l > global.S
+
+compile:
+	gcc callc.S call.c -o call
+	gcc fact.S fact.c -o fact
+	gcc global.S global.c -o global
+	gcc prime.S prime.c -o prime
+
diff --git a/komarov.andrey/demo/call.c b/komarov.andrey/demo/call.c
new file mode 100644
index 00000000..e97065e
--- /dev/null
+++ b/komarov.andrey/demo/call.c
@@ -0,0 +1,14 @@
+#include <stdio.h>
+
+int add(int a, int b)
+{
+    return a + b;
+}
+
+int f();
+
+int main()
+{
+    printf("%d\n", f());
+}
+
diff --git a/komarov.andrey/demo/callc.l b/komarov.andrey/demo/callc.l
new file mode 100644
index 00000000..55bc32e
--- /dev/null
+++ b/komarov.andrey/demo/callc.l
@@ -0,0 +1,6 @@
+int add(int a, int b);
+
+int f()
+{
+    return add(40, 2);
+}
diff --git a/komarov.andrey/demo/fact.c b/komarov.andrey/demo/fact.c
new file mode 100644
index 00000000..05abbf4
--- /dev/null
+++ b/komarov.andrey/demo/fact.c
@@ -0,0 +1,9 @@
+#include <stdio.h>
+
+int fact(int n);
+
+int main()
+{
+    printf("%d\n", fact(5));
+    return 0;
+}
diff --git a/komarov.andrey/demo/fact.l b/komarov.andrey/demo/fact.l
new file mode 100644
index 00000000..a43666e
--- /dev/null
+++ b/komarov.andrey/demo/fact.l
@@ -0,0 +1,6 @@
+int fact(int n) {
+    if (n == 0)
+        return 1;
+    else
+        return n * fact(n - 1);
+}
diff --git a/komarov.andrey/demo/global.c b/komarov.andrey/demo/global.c
new file mode 100644
index 00000000..7cc6182
--- /dev/null
+++ b/komarov.andrey/demo/global.c
@@ -0,0 +1,12 @@
+#include <stdio.h>
+
+int inc();
+
+int main()
+{
+    int i;
+    for (i = 0; i < 10; i++)
+        printf("%d ", inc());
+    printf("\n");
+    return 0;
+}
diff --git a/komarov.andrey/demo/global.l b/komarov.andrey/demo/global.l
new file mode 100644
index 00000000..5a2f660
--- /dev/null
+++ b/komarov.andrey/demo/global.l
@@ -0,0 +1,8 @@
+
+int v;
+
+int inc()
+{
+  v = v + 1;
+  return v;
+}
diff --git a/komarov.andrey/demo/isPrime.l b/komarov.andrey/demo/isPrime.l
new file mode 100644
index 00000000..c9f9b53
--- /dev/null
+++ b/komarov.andrey/demo/isPrime.l
@@ -0,0 +1,50 @@
+int div(int a, int b);
+int mod(int a, int b);
+
+bool isPrime(int n)
+{
+    int i;
+    i = 2;
+    while (i * i <= n)
+    {
+        if (mod(n, i) == 0)
+            return false;
+        else {}
+        i = i + 1;
+    }
+    return true;
+}
+
+int numPrimes(int from, int to)
+{
+    int i;
+    i = from;
+    int ans;
+    ans = 0;
+    while (i < to)
+    {
+        if (isPrime(i))
+            ans = ans + 1;
+        else {}
+        i = i + 1;
+    }
+    return ans;
+}
+
+int mod(int a, int b)
+{
+    return a - b * div(a, b);
+}
+
+int div(int a, int b)
+{
+    int c;
+    c = 0;
+    while (a >= 0)
+    {
+        c = c + 1;
+        a = a - b;
+    }
+    return c - 1;
+}
+
diff --git a/komarov.andrey/demo/prime.c b/komarov.andrey/demo/prime.c
new file mode 100644
index 00000000..f43cb59
--- /dev/null
+++ b/komarov.andrey/demo/prime.c
@@ -0,0 +1,15 @@
+#include <stdio.h>
+
+int isPrime(int n);
+int numPrimes(int from, int to);
+
+int main()
+{
+    int i;
+    for (i = 2; i < 20; i++)
+    {
+        printf("%d is %s\n", i, isPrime(i) ? "prime" : "not prime");
+    }
+    printf("%d primes between 100 and 2000\n", numPrimes(100, 5000));
+}
+
diff --git a/komarov.andrey/examples/callc.l b/komarov.andrey/examples/callc.l
new file mode 100644
index 00000000..55bc32e
--- /dev/null
+++ b/komarov.andrey/examples/callc.l
@@ -0,0 +1,6 @@
+int add(int a, int b);
+
+int f()
+{
+    return add(40, 2);
+}

From 969f111c03ba2399120d948c5366c7e34a7879d6 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 26 Mar 2015 23:16:27 +0300
Subject: [PATCH 046/116] Report finished

---
 komarov.andrey/demo/prime.c      |  2 +-
 komarov.andrey/report/Makefile   |  6 +--
 komarov.andrey/report/head.tex   | 35 ++++++++++++++
 komarov.andrey/report/report.tex | 79 +++++++++++++++++++++++++++-----
 4 files changed, 106 insertions(+), 16 deletions(-)
 create mode 100644 komarov.andrey/report/head.tex

diff --git a/komarov.andrey/demo/prime.c b/komarov.andrey/demo/prime.c
index f43cb59..1835613 100644
--- a/komarov.andrey/demo/prime.c
+++ b/komarov.andrey/demo/prime.c
@@ -10,6 +10,6 @@ int main()
     {
         printf("%d is %s\n", i, isPrime(i) ? "prime" : "not prime");
     }
-    printf("%d primes between 100 and 2000\n", numPrimes(100, 5000));
+    printf("%d primes between 100 and 5000\n", numPrimes(100, 5000));
 }
 
diff --git a/komarov.andrey/report/Makefile b/komarov.andrey/report/Makefile
index e20da6e..a8132ad 100644
--- a/komarov.andrey/report/Makefile
+++ b/komarov.andrey/report/Makefile
@@ -1,7 +1,7 @@
 main: show
 
-all: report.tex
-	xelatex report.tex
+all: head.tex report.tex
+	xelatex -shell-escape head.tex
 
 show: all
-	evince report.pdf
+	evince head.pdf
diff --git a/komarov.andrey/report/head.tex b/komarov.andrey/report/head.tex
new file mode 100644
index 00000000..4930bae
--- /dev/null
+++ b/komarov.andrey/report/head.tex
@@ -0,0 +1,35 @@
+\documentclass{article}
+\usepackage[cm]{fullpage}
+\usepackage{pdflscape}
+\usepackage{xecyr}
+\usepackage{xltxtra}
+\setmainfont[Mapping=tex-text]{Times New Roman}
+\setmonofont[Scale=MatchLowercase]{Courier New}
+\defaultfontfeatures{Mapping=tex-text}
+\usepackage{polyglossia}
+\setdefaultlanguage{russian}
+\newfontfamily\russianfont{Times New Roman}
+\setotherlanguage{english}
+
+\newfontfamily\cyrillicfont[Script=Cyrillic]{Times New Roman}
+\newfontfamily\cyrillicfontsf[Script=Cyrillic]{Arial}
+\newfontfamily\cyrillicfonttt[Script=Cyrillic]{Courier New}
+
+
+\usepackage{minted}
+\usepackage{amsmath}
+\usepackage{amssymb}
+\usepackage{stmaryrd}
+
+\usepackage{syntax}
+
+\begin{document}
+\title{Компиляторы}
+\author{Андрей Комаров, группа 5539}
+\date{\today}
+\maketitle
+
+\input{report.tex}
+
+
+\end{document}
diff --git a/komarov.andrey/report/report.tex b/komarov.andrey/report/report.tex
index 692ec80..eec035f 100644
--- a/komarov.andrey/report/report.tex
+++ b/komarov.andrey/report/report.tex
@@ -1,10 +1,5 @@
-\documentclass{article}
+\section{Грамматика}
 
-\usepackage{syntax}
-
-\begin{document}
-
-\paragraph{Increase the two lengths}
 \setlength{\grammarparsep}{20pt plus 1pt minus 1pt} % increase separation between rules
 \setlength{\grammarindent}{12em} % increase separation between LHS/RHS 
 
@@ -57,13 +52,73 @@
 
 \end{grammar}
 
-\paragraph{Лол}
+\section{Некоторые факты об этом компиляторе}
+
+Компилируемый язык похож на очень сильно урезанный Си. Компиляция
+однопроходная в том смысле, что нельзя использовать функции до их
+определения. Компилируемая функция добавляется в контекст,
+следовательно, поддерживаются рекурсивные функции. Можно делать
+forward declaration, и, следовательно, косвенную рекурсию. 
+
+Пока есть два типа: \texttt{int} и \texttt{bool}, компилятор проверяет
+типы. Можно создавать локальные и глобальные переменные.
+Глобальные переменные, также, как и функции, нельзя использовать до их
+объявления. 
+
+Конвенция вызова такая же, как в Си: первые четыре аргумента
+передаются в r0--r3, остальные~--- в стеке.
+Скомпилированные функции можно вызывать из Си. 
+Можно вызывать функции из Си.
+
+Скомпилированный код не содержит никаких оптимизаций и содержит
+некоторые деоптимизации (для удобства копирует переданные в регистрах
+аргументы в стек).
+
+Код компилируется в стековую машину: вычисляются подвыражения, их
+результаты снимаются со стека, производится вычисление и результат
+кладётся обратно в стек.
+
+\section{Примеры кода}
+
+Эти примеры содержатся в папке \texttt{demo} в репозитории.
+
+\subsection{Вычисление факториала}
+ 
+\inputminted{c}{../demo/fact.l}
+
+\subsection{Работа с глобальными переменными}
+
+\inputminted{c}{../demo/global.l}
+
+\subsection{Вычисление числа простых чисел на отрезке}
+
+\inputminted{c}{../demo/isPrime.l}
+
+\subsection{Двустороннее взаимодействие с Си}
+
+\inputminted{c}{../demo/callc.l}
+
+Код на Си:
+
+\inputminted{c}{../demo/call.c}
+
+\section{Как запускать}
+
+На \texttt{akomarov.org} на 2222 порту есть машина на ARM-е, на
+которой можно запускать примеры.
 
-Что хочется сделать дальше:
 \begin{itemize}
-\item Добавить строки (и массивы)
-\item Добавить возможность компилироваться в самостоятельный бинарник
-\item Переписать всё, потому что сейчас мерзко
+\item Пользователь: \texttt{user}
+\item Пароль: \texttt{ieti9Vai}
 \end{itemize}
 
-\end{document}
+К сожалению, там установлена старая версия GHC, которой компилятор не
+компилируется, поэтому, получается этакая кросс-компиляция.
+
+\section{Что дальше}
+
+\begin{itemize}
+\item Добавить строки (и массивы).
+\item Добавить возможность компилироваться в самостоятельный бинарник.
+\item Переписать всё, потому что сейчас мерзко.
+\end{itemize}

From 0000000db0b84706af07a899c349dc3cf003115f Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sat, 28 Mar 2015 04:55:04 +0300
Subject: [PATCH 047/116] Remove trash

---
 komarov.andrey/src/Makefile         |  11 +-
 komarov.andrey/src/TestLex.hs       |   6 -
 komarov.andrey/src/TestParse.hs     |   8 --
 komarov.andrey/src/TestTypecheck.hs |  12 --
 komarov.andrey/src/TypedAST.hs      | 183 ----------------------------
 5 files changed, 9 insertions(+), 211 deletions(-)
 delete mode 100644 komarov.andrey/src/TestLex.hs
 delete mode 100644 komarov.andrey/src/TestParse.hs
 delete mode 100644 komarov.andrey/src/TestTypecheck.hs
 delete mode 100644 komarov.andrey/src/TypedAST.hs

diff --git a/komarov.andrey/src/Makefile b/komarov.andrey/src/Makefile
index 6769211..742b968 100644
--- a/komarov.andrey/src/Makefile
+++ b/komarov.andrey/src/Makefile
@@ -1,5 +1,12 @@
-all:
+all: lexer parser TestCompiler.hs Parser.hs Lexer.hs ARM.hs AST.hs
+	ghc TestCompiler
+
+lexer: Lexer.x
 	alex Lexer.x
+
+parser: Parser.y
 	happy Parser.y
-	ghc TestCompiler
+
+clean:
+	rm -f *.o *.hi Lexer.hs Parser.hs TestCompiler
 
diff --git a/komarov.andrey/src/TestLex.hs b/komarov.andrey/src/TestLex.hs
deleted file mode 100644
index 2fb595d..00000000
--- a/komarov.andrey/src/TestLex.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-import Lexer
-
-main = do
-    input <- getContents
-    putStrLn input
-    print $ scanTokens input
diff --git a/komarov.andrey/src/TestParse.hs b/komarov.andrey/src/TestParse.hs
deleted file mode 100644
index 6872560..00000000
--- a/komarov.andrey/src/TestParse.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-import Parser
-import Lexer
-
-main = do
-    input <- getContents
-    putStrLn input
-    print $ scanTokens $ input
-    print $ parse $ scanTokens $ input
diff --git a/komarov.andrey/src/TestTypecheck.hs b/komarov.andrey/src/TestTypecheck.hs
deleted file mode 100644
index cf579a6..00000000
--- a/komarov.andrey/src/TestTypecheck.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-import Parser
-import Lexer
-import TypedAST
-
-main = do
-    input <- getContents
-    putStrLn input
-    let tokens = scanTokens input
-    print tokens
-    let ast = parse tokens
-    print ast
-    print $ runTypecheck ast
diff --git a/komarov.andrey/src/TypedAST.hs b/komarov.andrey/src/TypedAST.hs
deleted file mode 100644
index 76dbe19..00000000
--- a/komarov.andrey/src/TypedAST.hs
+++ /dev/null
@@ -1,183 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE FlexibleContexts #-}
-module TypedAST (
-  Typechecker(..),
-  Typecheckable(..),
-  TypecheckError(..),
-  runTypecheck,
-  ) where
-
-import Control.Monad.State
-import Control.Monad.Error
-import Control.Applicative
-
-import qualified Data.Map as M
-
-import qualified AST
-
-type Id = String
-
-data Type = TBool
-          | TInt
-          | TString
-          | TVoid
-          deriving (Show, Eq)
-
-data FType = FType Type [Type]
-
-data Env = Env {
-  forwardDecls :: M.Map Id FType,
-  functions :: M.Map Id FType,
-  variables :: M.Map Id Type
-  }
-
-emptyEnv :: Env
-emptyEnv = Env M.empty M.empty M.empty
-
-data TypecheckError = UnknownVar Id
-                    | UnknownFun Id
-                    | UnknownType AST.Id
-                    | AlreadyBoundVar Id
-                    | AlreadyBoundFun Id
-                    | TypeMismatch Type Type
-                    | WrongArgsNumber [Type] [Type]
-                    | SomethingWentWrong String
-                    deriving (Show)
-
-instance Error TypecheckError where
-  strMsg = SomethingWentWrong 
-
-newtype Typechecker a = Typechecker { unTypechecker :: ErrorT TypecheckError (State Env) a } deriving (Functor, Applicative, Monad, MonadState Env, MonadError TypecheckError)
-
-runTypecheck :: AST.Program -> Either TypecheckError ()
-runTypecheck prog = evalState (runErrorT $ unTypechecker $ typecheck prog) emptyEnv
-
-class Typecheckable a b | a -> b where
-  typecheck :: a -> Typechecker b
-
-getVarType :: Id -> Typechecker Type
-getVarType name = do
-  vars <- gets variables
-  case M.lookup name vars of
-   Nothing -> throwError $ UnknownVar name
-   Just t -> return t
-
-getFunType :: Id -> Typechecker FType
-getFunType name = do
-  funs <- gets functions
-  case M.lookup name funs of
-   Nothing -> throwError $ UnknownFun name
-   Just t -> return t
-
-updateVar :: Id -> Type -> Typechecker ()
-updateVar name t = do
-  env <- get
-  let vars = variables env
-  case M.lookup name vars of
-   Nothing -> put $ env { variables = M.insert name t vars }
-   Just t' -> throwError $ AlreadyBoundVar name
-
-updateFun :: Id -> FType -> Typechecker ()
-updateFun name t = do
-  env <- get
-  let funs = functions env
-  case M.lookup name funs of
-   Nothing -> put $ env { functions = M.insert name t funs }
-   Just t' -> throwError $ AlreadyBoundFun name
-
-expect :: Typecheckable t Type => Type -> t -> Typechecker ()
-expect x ta = do
-  a <- typecheck ta
-  when (a /= x) $ throwError $ TypeMismatch a x
-
-ensureSame :: Type -> Type -> Typechecker ()
-ensureSame t1 t2 = when (t1 /= t2) $ throwError $ TypeMismatch t1 t2
-
-parseType :: AST.Id -> Typechecker Type
-parseType "int" = return TInt
-parseType "bool" = return TBool
-parseType "string" = return TString
-parseType "void" = return TVoid
-parseType t = throwError $ UnknownType t
-
-instance Typecheckable AST.Expression Type where
-  typecheck (AST.EVar v) = getVarType v
-  typecheck (AST.EInt _) = return TInt
-  typecheck (AST.EBool _) = return TBool
-  typecheck (AST.EAdd lhs rhs) =
-    expect TInt lhs >> expect TInt rhs >> return TInt
-  typecheck (AST.ESub lhs rhs) =
-    expect TInt lhs >> expect TInt rhs >> return TInt
-  typecheck (AST.EMul lhs rhs) =
-    expect TInt lhs >> expect TInt rhs >> return TInt
-  typecheck (AST.ELess lhs rhs) =
-    expect TInt lhs >> expect TInt rhs >> return TBool
-  typecheck (AST.EGreater lhs rhs) =
-    expect TInt lhs >> expect TInt rhs >> return TBool
-  typecheck (AST.ELessEq lhs rhs) =
-    expect TInt lhs >> expect TInt rhs >> return TBool
-  typecheck (AST.EGreaterEq lhs rhs) =
-    expect TInt lhs >> expect TInt rhs >> return TBool
-  typecheck (AST.EEqual lhs rhs) = do
-    tl <- typecheck lhs
-    tr <- typecheck rhs
-    ensureSame tl tr
-    return TBool
-  typecheck (AST.ENotEqual lhs rhs) = do
-    tl <- typecheck lhs
-    tr <- typecheck rhs
-    ensureSame tl tr
-    return TBool
-  typecheck (AST.EAnd lhs rhs) =
-    expect TBool lhs >> expect TBool rhs >> return TBool
-  typecheck (AST.EOr lhs rhs) =
-    expect TBool lhs >> expect TBool rhs >> return TBool
-  typecheck (AST.ECall name args) = do
-    targs <- mapM typecheck args
-    FType ret targs' <- getFunType name
-    when (length targs /= length targs') $
-      throwError $ WrongArgsNumber targs targs'
-    forM (zip targs targs') $ \(t, t') ->
-      ensureSame t t'
-    return ret
-
-instance Typecheckable AST.Statement () where
-  typecheck (AST.SBlock stmts) = do
-    s <- get
-    mapM typecheck stmts
-    put s
-  typecheck (AST.SVarDecl tp name) =
-    parseType tp >>= updateVar name
-  typecheck (AST.SAssignment name expr) = do
-    tl <- getVarType name
-    tr <- typecheck expr
-    ensureSame tl tr
-  typecheck (AST.SRawExpr e) = void $ typecheck e
-  typecheck (AST.SIfThenElse cond thn els) =
-    expect TBool cond >> typecheck thn >> typecheck els
-  typecheck (AST.SWhile cond body) =
-    expect TBool cond >> typecheck body
-  typecheck (AST.SReturn e) = void $ typecheck e
-
-instance Typecheckable AST.TopLevel () where
-  typecheck (AST.VarDecl tp name) =
-    parseType tp >>= updateVar name
-  typecheck (AST.ForwardDecl name ret argsTypes) = do
-    tret <- parseType ret
-    targs <- mapM parseType argsTypes
-    updateFun name (FType tret targs)
-  typecheck (AST.FuncDef name ret args body) = do
-    tret <- parseType ret
-    targs <- mapM parseType (map fst args)
-    updateFun name (FType tret targs)
-    env <- get
-    forM (zip targs (map snd args)) $ \(t, name) ->
-      updateVar name t
-    mapM typecheck body
-    put env
-
-instance Typecheckable AST.Program () where
-  typecheck (AST.Program xs) = mapM_ typecheck xs
-

From 29c7558f7adb0c760ad3e16162acd4180f878781 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sat, 28 Mar 2015 19:09:28 +0300
Subject: [PATCH 048/116] Grammar changed

---
 komarov.andrey/src/AST.hs   | 23 ++++++++++++++++-------
 komarov.andrey/src/Lexer.x  |  9 ++++++++-
 komarov.andrey/src/Parser.y | 30 ++++++++++++++++++++++--------
 3 files changed, 46 insertions(+), 16 deletions(-)

diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index 9c7fbfd..8ab5f96 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -1,5 +1,6 @@
 module AST (
   Id,
+  Type(..),
   Program(..),
   TopLevel(..),
   Statement(..),
@@ -11,20 +12,24 @@ type Id = String
 data Program = Program [TopLevel]
           deriving (Show)
 
+data Type
+  = Simple Id
+  | Pointer Type
+  deriving (Show)
+
 data TopLevel
-  = VarDecl Id Id
+  = VarDecl Type Id
   | ForwardDecl { name :: Id,
-                  ret :: Id,
-                  argsTypes :: [Id] }
+                  ret :: Type,
+                  argsTypes :: [Type] }
   | FuncDef { name :: Id,
-              ret :: Id,
-              args :: [(Id, Id)],
+              ret :: Type,
+              args :: [(Type, Id)],
               body :: [Statement]}
   deriving (Show)
 
 data Statement = SBlock [Statement]
-               | SVarDecl Id Id
-               | SAssignment Id Expression
+               | SVarDecl Type Id
                | SRawExpr Expression
                | SIfThenElse Expression Statement Statement
                | SWhile Expression Statement
@@ -46,4 +51,8 @@ data Expression = EVar Id
                  | EAnd Expression Expression
                  | EOr Expression Expression
                  | ECall Id [Expression]
+                 | EDeref Expression
+                 | EAddr Expression
+                 | EAssign Expression Expression
+                 | EArray Expression Expression
                  deriving (Show, Eq, Ord)
diff --git a/komarov.andrey/src/Lexer.x b/komarov.andrey/src/Lexer.x
index f959b78..4a3a939 100644
--- a/komarov.andrey/src/Lexer.x
+++ b/komarov.andrey/src/Lexer.x
@@ -8,6 +8,7 @@ module Lexer (
 
 $digit = 0-9
 $alpha = [a-zA-Z]
+$alnum = [a-zA-Z0-9_]
 $eol = [\n]
 
 tokens :-
@@ -18,6 +19,8 @@ tokens :-
        ")"                      { \_ -> TokenRParen }
        "{"                      { \_ -> TokenLBrace }
        "}"                      { \_ -> TokenRBrace }
+       "["                      { \_ -> TokenLBracket }
+       "]"                      { \_ -> TokenRBracket }
        "+"                      { \_ -> TokenAdd }
        "-"                      { \_ -> TokenSub }
        "*"                      { \_ -> TokenMul }
@@ -38,7 +41,8 @@ tokens :-
        "true"                   { \_ -> TokenTrue }
        "false"                  { \_ -> TokenFalse }
        ","                      { \_ -> TokenComma }
-       $alpha+                  { \s -> TokenVar s }
+       "&"                      { \_ -> TokenAmp }
+       $alpha $alnum*           { \s -> TokenVar s }
 
 {
 
@@ -48,6 +52,8 @@ data Token = TokenNum Int
            | TokenRParen
            | TokenLBrace
            | TokenRBrace
+           | TokenLBracket
+           | TokenRBracket
            | TokenAdd
            | TokenSub
            | TokenMul
@@ -68,6 +74,7 @@ data Token = TokenNum Int
            | TokenTrue
            | TokenFalse
            | TokenComma
+           | TokenAmp
            deriving (Eq, Show)
 
 scanTokens = alexScanTokens
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index c90165d..d8153c8 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -17,9 +17,12 @@ import AST
         ')'             { TokenRParen }
         '{'             { TokenLBrace }
         '}'             { TokenRBrace }
+        '['             { TokenLBracket }
+        ']'             { TokenRBracket }
         '+'             { TokenAdd }
         '-'             { TokenSub }
         '*'             { TokenMul }
+        '&'             { TokenAmp }
         '<'             { TokenLess }
         '>'             { TokenGreater }
         '=='            { TokenEqual }
@@ -41,10 +44,15 @@ import AST
         ','             { TokenComma }
 
 %left ','
+%right '='
 %left '||' '&&'
-%left '<' '>' '<=' '>=' '==' '!='
+%nonassoc '==' '!='
+%nonassoc '<' '>' '<=' '>='
 %left '+' '-'
 %left '*'
+%left '&' DEREF
+%nonassoc '[' ']'
+
 
 %%
 
@@ -57,11 +65,11 @@ TopLevel        : VarDecl                       { $1 }
                 | ForwardDecl                   { $1 }
                 | FuncDef                       { $1 }
 
-VarDecl         : var var ';'                   { VarDecl $1 $2 }
+VarDecl         : Type var ';'                  { VarDecl $1 $2 }
 
-ForwardDecl     : var var '(' FuncArgs ')' ';'      { ForwardDecl $2 $1 (map fst $4) }
+ForwardDecl     : Type var '(' FuncArgs ')' ';' { ForwardDecl $2 $1 (map fst $4) }
 
-FuncDef         : var var '(' FuncArgs ')' '{' Stmts '}' { FuncDef $2 $1 $4 $7 }
+FuncDef         : Type var '(' FuncArgs ')' '{' Stmts '}' { FuncDef $2 $1 $4 $7 }
 
 Expr            : var                           { EVar $1 }
                 | num                           { EInt $1 }
@@ -80,14 +88,17 @@ Expr            : var                           { EVar $1 }
                 | Expr '&&' Expr                { EAnd $1 $3 }
                 | Expr '||' Expr                { EOr $1 $3 }
                 | var '(' FuncCallList ')'      { ECall $1 $3 }
+                | '&' Expr                      { EAddr $2 }
+                | '*' Expr %prec DEREF          { EDeref $2 }
+                | Expr '[' Expr ']'             { EArray $1 $3 }
+                | Expr '=' Expr                 { EAssign $1 $3 }
 
 FuncCallList    : {- empty -}                   { [] }
                 | Expr                          { [$1] }
                 | Expr ',' FuncCallList         { $1:$3 }
 
 Stmt            : '{' Stmts '}'                 { SBlock $2 }
-                | var var ';'                  { SVarDecl $1 $2 }
-                | var '=' Expr ';'              { SAssignment $1 $3}
+                | Type var ';'                  { SVarDecl $1 $2 }
                 | Expr ';'                      { SRawExpr $1 }
                 | if '(' Expr ')' Stmt else Stmt  { SIfThenElse $3 $5 $7 }
                 | while '(' Expr ')' Stmt       { SWhile $3 $5 }
@@ -97,8 +108,11 @@ Stmts           : {- empty -}                   { [] }
                 | Stmt Stmts                    { $1:$2 }
 
 FuncArgs        : {- empty -}                   { [] }
-                | var var                       { [($1, $2)] }
-                | var var ',' FuncArgs          { ($1, $2):$4 }
+                | Type var                      { [($1, $2)] }
+                | Type var ',' FuncArgs         { ($1, $2):$4 }
+
+Type            : var                           { Simple $1 }
+                | '*' Type                      { Pointer $2 }
 
 {
 parseError :: [Token] -> a

From 0559200cd8020ad348a1472533e9b1beafe9ebfe Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 29 Mar 2015 00:26:27 +0300
Subject: [PATCH 049/116] Stuck with Lexer hack (`(a)*b`)

---
 komarov.andrey/src/AST.hs   | 1 +
 komarov.andrey/src/Parser.y | 3 ++-
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index 8ab5f96..795e8c8 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -55,4 +55,5 @@ data Expression = EVar Id
                  | EAddr Expression
                  | EAssign Expression Expression
                  | EArray Expression Expression
+                 | ECast Type Expression
                  deriving (Show, Eq, Ord)
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index d8153c8..79e3fbb 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -50,7 +50,7 @@ import AST
 %nonassoc '<' '>' '<=' '>='
 %left '+' '-'
 %left '*'
-%left '&' DEREF
+%left '&' DEREF CAST
 %nonassoc '[' ']'
 
 
@@ -92,6 +92,7 @@ Expr            : var                           { EVar $1 }
                 | '*' Expr %prec DEREF          { EDeref $2 }
                 | Expr '[' Expr ']'             { EArray $1 $3 }
                 | Expr '=' Expr                 { EAssign $1 $3 }
+                | '(' Type ')' Expr %prec CAST  { ECast $2 $4 }
 
 FuncCallList    : {- empty -}                   { [] }
                 | Expr                          { [$1] }

From 4469f4ec74c39e529aeb7d5e8d0d0a6fe94122fe Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 29 Mar 2015 03:07:12 +0300
Subject: [PATCH 050/116] Make lexer and parser monadic

---
 komarov.andrey/src/AST.hs   |  2 +-
 komarov.andrey/src/Lexer.x  | 80 ++++++++++++++++++++++---------------
 komarov.andrey/src/Parser.y |  6 ++-
 3 files changed, 53 insertions(+), 35 deletions(-)

diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index 795e8c8..1914213 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -15,7 +15,7 @@ data Program = Program [TopLevel]
 data Type
   = Simple Id
   | Pointer Type
-  deriving (Show)
+  deriving (Show, Eq, Ord)
 
 data TopLevel
   = VarDecl Type Id
diff --git a/komarov.andrey/src/Lexer.x b/komarov.andrey/src/Lexer.x
index 4a3a939..a66f3d8 100644
--- a/komarov.andrey/src/Lexer.x
+++ b/komarov.andrey/src/Lexer.x
@@ -1,10 +1,13 @@
 {
 module Lexer (
-       Token(..), scanTokens
+       Alex(..), runAlex,
+       Token(..), lexer
 ) where
+
+import ParserMonad
 }
 
-%wrapper "basic"
+%wrapper "monadUserState"
 
 $digit = 0-9
 $alpha = [a-zA-Z]
@@ -14,38 +17,49 @@ $eol = [\n]
 tokens :-
        $eol                     ;
        $white+                  ;
-       $digit+                  { \s -> TokenNum (read s) }
-       "("                      { \_ -> TokenLParen }
-       ")"                      { \_ -> TokenRParen }
-       "{"                      { \_ -> TokenLBrace }
-       "}"                      { \_ -> TokenRBrace }
-       "["                      { \_ -> TokenLBracket }
-       "]"                      { \_ -> TokenRBracket }
-       "+"                      { \_ -> TokenAdd }
-       "-"                      { \_ -> TokenSub }
-       "*"                      { \_ -> TokenMul }
-       "<"                      { \_ -> TokenLess }
-       ">"                      { \_ -> TokenGreater }
-       "=="                     { \_ -> TokenEqual }
-       "<="                     { \_ -> TokenLessEq }
-       ">="                     { \_ -> TokenGreaterEq }
-       "!="                     { \_ -> TokenNotEqual }
-       "&&"                     { \_ -> TokenAnd }
-       "||"                     { \_ -> TokenOr }
-       "="                      { \_ -> TokenAssign }
-       ";"                      { \_ -> TokenSemicolon }
-       "if"                     { \_ -> TokenIf }
-       "else"                   { \_ -> TokenElse }
-       "while"                  { \_ -> TokenWhile }
-       "return"                 { \_ -> TokenReturn }
-       "true"                   { \_ -> TokenTrue }
-       "false"                  { \_ -> TokenFalse }
-       ","                      { \_ -> TokenComma }
-       "&"                      { \_ -> TokenAmp }
-       $alpha $alnum*           { \s -> TokenVar s }
+       $digit+                  { \(_, _, _, s) l -> return $ TokenNum (read $ take l s) }
+       "("                      { r TokenLParen }
+       ")"                      { r TokenRParen }
+       "{"                      { r TokenLBrace }
+       "}"                      { r TokenRBrace }
+       "["                      { r TokenLBracket }
+       "]"                      { r TokenRBracket }
+       "+"                      { r TokenAdd }
+       "-"                      { r TokenSub }
+       "*"                      { r TokenMul }
+       "<"                      { r TokenLess }
+       ">"                      { r TokenGreater }
+       "=="                     { r TokenEqual }
+       "<="                     { r TokenLessEq }
+       ">="                     { r TokenGreaterEq }
+       "!="                     { r TokenNotEqual }
+       "&&"                     { r TokenAnd }
+       "||"                     { r TokenOr }
+       "="                      { r TokenAssign }
+       ";"                      { r TokenSemicolon }
+       "if"                     { r TokenIf }
+       "else"                   { r TokenElse }
+       "while"                  { r TokenWhile }
+       "return"                 { r TokenReturn }
+       "true"                   { r TokenTrue }
+       "false"                  { r TokenFalse }
+       ","                      { r TokenComma }
+       "&"                      { r TokenAmp }
+       $alpha $alnum*           { \(_, _, _, s) l -> return $ TokenVar $ take l s }
 
 {
 
+r :: Token -> AlexInput -> Int -> Alex Token
+r t _ _ = return t
+
+data AlexUserState = AlexUserState { wtf :: Int }
+
+alexInitUserState :: AlexUserState
+alexInitUserState = AlexUserState 0
+
+alexEOF :: Alex Token
+alexEOF = return TokenEOF
+
 data Token = TokenNum Int
            | TokenVar String
            | TokenLParen
@@ -75,8 +89,10 @@ data Token = TokenNum Int
            | TokenFalse
            | TokenComma
            | TokenAmp
+           | TokenEOF
            deriving (Eq, Show)
 
-scanTokens = alexScanTokens
+lexer :: (Token -> Alex a) -> Alex a
+lexer cont = (alexMonadScan >>= cont)
 
 }
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index 79e3fbb..c7fe0e8 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -8,6 +8,8 @@ import AST
 
 }
 
+%lexer { lexer } { TokenEOF }
+%monad { Alex } { >>= } { return }
 %name parse
 %tokentype { Token }
 %error { parseError }
@@ -92,7 +94,7 @@ Expr            : var                           { EVar $1 }
                 | '*' Expr %prec DEREF          { EDeref $2 }
                 | Expr '[' Expr ']'             { EArray $1 $3 }
                 | Expr '=' Expr                 { EAssign $1 $3 }
-                | '(' Type ')' Expr %prec CAST  { ECast $2 $4 }
+--              | '(' Type ')' Expr %prec CAST  { ECast $2 $4 }
 
 FuncCallList    : {- empty -}                   { [] }
                 | Expr                          { [$1] }
@@ -116,6 +118,6 @@ Type            : var                           { Simple $1 }
                 | '*' Type                      { Pointer $2 }
 
 {
-parseError :: [Token] -> a
+parseError :: Token -> Alex a
 parseError _ = error "Parse error"
 }

From 763978fb64d5500dda7b4189b817b9c9d037c513 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 29 Mar 2015 12:31:56 +0300
Subject: [PATCH 051/116] Lexer now tracks set of type to deal with `(a)*b`

---
 komarov.andrey/src/Lexer.x  | 19 +++++++++++++++----
 komarov.andrey/src/Parser.y |  7 ++++---
 2 files changed, 19 insertions(+), 7 deletions(-)

diff --git a/komarov.andrey/src/Lexer.x b/komarov.andrey/src/Lexer.x
index a66f3d8..ee21a47 100644
--- a/komarov.andrey/src/Lexer.x
+++ b/komarov.andrey/src/Lexer.x
@@ -4,7 +4,7 @@ module Lexer (
        Token(..), lexer
 ) where
 
-import ParserMonad
+import qualified Data.Set as S
 }
 
 %wrapper "monadUserState"
@@ -45,23 +45,34 @@ tokens :-
        "false"                  { r TokenFalse }
        ","                      { r TokenComma }
        "&"                      { r TokenAmp }
-       $alpha $alnum*           { \(_, _, _, s) l -> return $ TokenVar $ take l s }
+       $alpha $alnum*           { \(_, _, _, s) l -> var $ take l s }
 
 {
 
+var :: String -> Alex Token
+var s = do
+  tp <- isType s
+  return $ (if tp then TokenTyVar else TokenVar) s
+
 r :: Token -> AlexInput -> Int -> Alex Token
 r t _ _ = return t
 
-data AlexUserState = AlexUserState { wtf :: Int }
+data AlexUserState = AlexUserState { types :: S.Set String }
+
+isType :: String -> Alex Bool
+isType s = do
+  AlexUserState {types=t} <- alexGetUserState
+  return $ s `S.member` t
 
 alexInitUserState :: AlexUserState
-alexInitUserState = AlexUserState 0
+alexInitUserState = AlexUserState $ S.fromList ["int", "char", "bool"]
 
 alexEOF :: Alex Token
 alexEOF = return TokenEOF
 
 data Token = TokenNum Int
            | TokenVar String
+           | TokenTyVar String
            | TokenLParen
            | TokenRParen
            | TokenLBrace
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index c7fe0e8..4a32fb0 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -43,6 +43,7 @@ import AST
         true            { TokenTrue }
         false           { TokenFalse }
         var             { TokenVar $$ }
+        tyvar           { TokenTyVar $$ }
         ','             { TokenComma }
 
 %left ','
@@ -94,7 +95,7 @@ Expr            : var                           { EVar $1 }
                 | '*' Expr %prec DEREF          { EDeref $2 }
                 | Expr '[' Expr ']'             { EArray $1 $3 }
                 | Expr '=' Expr                 { EAssign $1 $3 }
---              | '(' Type ')' Expr %prec CAST  { ECast $2 $4 }
+                | '(' Type ')' Expr %prec CAST  { ECast $2 $4 }
 
 FuncCallList    : {- empty -}                   { [] }
                 | Expr                          { [$1] }
@@ -114,10 +115,10 @@ FuncArgs        : {- empty -}                   { [] }
                 | Type var                      { [($1, $2)] }
                 | Type var ',' FuncArgs         { ($1, $2):$4 }
 
-Type            : var                           { Simple $1 }
+Type            : tyvar                         { Simple $1 }
                 | '*' Type                      { Pointer $2 }
 
 {
 parseError :: Token -> Alex a
-parseError _ = error "Parse error"
+parseError t = error $ "Parse error on token " ++ show t
 }

From d66f45b0c3042a8301d2f6d6b641b1e0408c88fc Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 12 Apr 2015 01:49:56 +0300
Subject: [PATCH 052/116] (probably unusable) typecheck stub

---
 komarov.andrey/src/Typecheck.hs | 50 +++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
 create mode 100644 komarov.andrey/src/Typecheck.hs

diff --git a/komarov.andrey/src/Typecheck.hs b/komarov.andrey/src/Typecheck.hs
new file mode 100644
index 00000000..f428144
--- /dev/null
+++ b/komarov.andrey/src/Typecheck.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Typecheck (
+
+  ) where
+
+import Control.Applicative
+import Control.Monad.State
+import Control.Monad.Error
+
+import qualified AST
+
+data Type
+  = TInt
+  | TBool
+  | TChar
+  | TVoid
+  | TPointer Type
+  | TFun Type [Type]
+
+type Id = String
+
+data Arith = Add | Sub | Mul
+
+data Compare = Less | Greater | LessEq | GreaterEq
+
+data BoolOp = Or | And
+
+data Value = L | R
+
+data CompilationError
+  = CompilationError
+  deriving (Show)
+    
+instance Error CompilationError where
+  noMsg = CompilationError
+
+data Env = Env
+
+newtype Typechecker a = Typecheker {
+  runTypechecker ::
+     ErrorT CompilationError (
+       State Env) a }
+                      deriving (
+  Functor, Applicative, Monad, MonadError CompilationError,
+  MonadState Env)
+
+class Typecheckable f t | f -> t where
+  typecheck :: f -> Typechecker t

From 3d028c5e032e27a53e632fed90988bfb1990b998 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 21 Apr 2015 23:56:34 +0300
Subject: [PATCH 053/116] Complete rewriting started

---
 komarov.andrey/src/AST.hs | 76 ++++++++++++++++++++++++---------------
 1 file changed, 48 insertions(+), 28 deletions(-)

diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index 9c7fbfd..49e6d6e 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -8,10 +8,10 @@ module AST (
 
 type Id = String
 
-data Program = Program [TopLevel]
+data Program a = Program [TopLevel a]
           deriving (Show)
 
-data TopLevel
+data TopLevel a
   = VarDecl Id Id
   | ForwardDecl { name :: Id,
                   ret :: Id,
@@ -19,31 +19,51 @@ data TopLevel
   | FuncDef { name :: Id,
               ret :: Id,
               args :: [(Id, Id)],
-              body :: [Statement]}
+              body :: [Statement a]}
   deriving (Show)
 
-data Statement = SBlock [Statement]
-               | SVarDecl Id Id
-               | SAssignment Id Expression
-               | SRawExpr Expression
-               | SIfThenElse Expression Statement Statement
-               | SWhile Expression Statement
-               | SReturn Expression
-               deriving (Show)
-
-data Expression = EVar Id
-                 | EInt Int
-                 | EBool Bool
-                 | EAdd Expression Expression
-                 | ESub Expression Expression
-                 | EMul Expression Expression
-                 | ELess Expression Expression
-                 | EGreater Expression Expression
-                 | EEqual Expression Expression
-                 | ELessEq Expression Expression
-                 | EGreaterEq Expression Expression
-                 | ENotEqual Expression Expression
-                 | EAnd Expression Expression
-                 | EOr Expression Expression
-                 | ECall Id [Expression]
-                 deriving (Show, Eq, Ord)
+data Statement a = SBlock [Statement a]
+                 | SVarDecl Id Id
+                 | SAssignment Id (Tagged Expression a)
+                 | SRawExpr (Tagged Expression a)
+                 | SIfThenElse (Tagged Expression a) (Statement a) (Statement a)
+                 | SWhile (Tagged Expression a) (Statement a)
+                 | SReturn (Tagged Expression a)
+                 deriving (Show)
+
+type Tagged f a = (f a, a)
+
+data ArithBinOp = AddOp | SubOp | MulOp
+                deriving (Eq, Ord)
+data BoolBinOp = OrOp | AndOp | XorOp
+               deriving (Eq, Ord)
+data ArithCmpOp = LessOp | LessEqOp | GreaterOp | GreaterEqOp
+                deriving (Eq, Ord)
+
+instance Show ArithBinOp where
+  show AddOp = "+"
+  show SubOp = "-"
+  show MulOp = "*"
+
+instance Show BoolBinOp where
+  show OrOp = "||"
+  show AndOp = "&&"
+  show XorOp = "^"
+
+instance Show ArithCmpOp where
+  show LessOp = "<"
+  show LessEqOp = "<="
+  show GreaterOp = ">"
+  show GreaterEqOp = ">="
+
+data Expression a = EVar Id
+                  | ELitInt Int
+                  | ELitBool Bool
+                  | EArith ArithBinOp (Tagged Expression a) (Tagged Expression a)
+                  | EBool BoolBinOp (Tagged Expression a) (Tagged Expression a)
+                  | EArithCmpOp ArithCmpOp (Tagged Expression a) (Tagged Expression a)
+                  | EEqual (Tagged Expression a) (Tagged Expression a)
+                  | ENotEqual (Tagged Expression a) (Tagged Expression a)
+                  | ECall Id [(Tagged Expression a)]
+                  deriving (Show, Eq, Ord)
+

From f19066dc495611ed037c7df10ddc4c9a8a593014 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 00:56:28 +0300
Subject: [PATCH 054/116] Uncomment interesting features

---
 komarov.andrey/src/AST.hs   | 4 ++++
 komarov.andrey/src/Parser.y | 8 ++++----
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index ecc36b3..9acfdc4 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -90,4 +90,8 @@ data Expression a = EVar Id
                   | EEqual EqOp (Tagged Expression a) (Tagged Expression a)
                   | ECall Id [(Tagged Expression a)]
                   | EAssign (Tagged Expression a) (Tagged Expression a)
+                  | EDeref (Tagged Expression a)
+                  | EAddr (Tagged Expression a)
+                  | EArray (Tagged Expression a) (Tagged Expression a)
+                  | ECast Type (Tagged Expression a)
                   deriving (Show, Eq, Ord)
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index a04ef82..e782132 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -92,11 +92,11 @@ Expr            : var                           { EVar $1 }
                 | Expr '==' Expr                { EEqual EqOp (notag $1) (notag $3) }
                 | Expr '!=' Expr                { EEqual NeqOp (notag $1) (notag $3) }
                 | var '(' FuncCallList ')'      { ECall $1 (map notag $3) }
---                | '&' Expr                      { EAddr $2 }
---                | '*' Expr %prec DEREF          { EDeref $2 }
---                | Expr '[' Expr ']'             { EArray $1 $3 }
+                | '&' Expr                      { EAddr (notag $2) }
+                | '*' Expr %prec DEREF          { EDeref (notag $2) }
+                | Expr '[' Expr ']'             { EArray (notag $1) (notag $3) }
                 | Expr '=' Expr                 { EAssign (notag $1) (notag $3) }
---                | '(' Type ')' Expr %prec CAST  { ECast $2 $4 }
+                | '(' Type ')' Expr %prec CAST  { ECast $2 (notag $4) }
 
 FuncCallList    :: { [Expression ()] }
 FuncCallList    : {- empty -}                   { [] }

From a72e274d0491ab82b97a721a3d237274be097297 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 02:21:22 +0300
Subject: [PATCH 055/116] Started typechecking

---
 komarov.andrey/src/AST.hs       | 11 +++++--
 komarov.andrey/src/Lexer.x      |  2 +-
 komarov.andrey/src/Parser.y     | 11 ++++---
 komarov.andrey/src/Typecheck.hs | 52 ++++++++++++++++++---------------
 4 files changed, 44 insertions(+), 32 deletions(-)

diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index 9acfdc4..57ff471 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -1,5 +1,6 @@
 module AST (
   Id,
+  Tagged,
   Type(..),
   Program(..),
   TopLevel(..),
@@ -9,7 +10,7 @@ module AST (
   ArithCmpOp(..),
   BoolBinOp(..),
   EqOp(..),
-  notag
+  notag, with
   ) where
 
 type Id = String
@@ -24,12 +25,16 @@ value = fst
 notag :: f () -> Tagged f ()
 notag x = (x, ())
 
+with :: f a -> a -> Tagged f a
+with = (,)
+
 data Program a = Program [TopLevel a]
           deriving (Show)
 
 data Type
-  = Simple Id
-  | Pointer Type
+  = TInt
+  | TBool
+  | TPointer Type
   deriving (Show, Eq, Ord)
 
 data TopLevel a
diff --git a/komarov.andrey/src/Lexer.x b/komarov.andrey/src/Lexer.x
index 7c146e4..99495b9 100644
--- a/komarov.andrey/src/Lexer.x
+++ b/komarov.andrey/src/Lexer.x
@@ -1,6 +1,6 @@
 {
 module Lexer (
-       Alex(..), runAlex,
+       Alex(..), runAlex, alexError,
        Token(..), lexer
 ) where
 
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index e782132..17ea329 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -10,7 +10,7 @@ import AST
 
 %lexer { lexer } { TokenEOF }
 %monad { Alex } { >>= } { return }
-%name parse
+%name parseAlex
 %tokentype { Token }
 %error { parseError }
 
@@ -121,10 +121,13 @@ FuncArgs        : {- empty -}                   { [] }
                 | Type var ',' FuncArgs         { ($1, $2):$4 }
 
 Type            :: { Type }
-Type            : tyvar                         { Simple $1 }
-                | Type '*'                      { Pointer $1 }
+Type            : tyvar                         { case $1 of { "int" -> TInt; "bool" -> TBool; n -> error $ "INTERNAL COMPILER ERROR" ++ n } }
+                | Type '*'                      { TPointer $1 }
 
 {
 parseError :: Token -> Alex a
-parseError t = error $ "Parse error on token " ++ show t
+parseError t = alexError $ "Parse error on token " ++ show t
+
+parse :: String -> Either String (Program ())
+parse s = runAlex s parseAlex
 }
diff --git a/komarov.andrey/src/Typecheck.hs b/komarov.andrey/src/Typecheck.hs
index f428144..ce56c21 100644
--- a/komarov.andrey/src/Typecheck.hs
+++ b/komarov.andrey/src/Typecheck.hs
@@ -7,44 +7,48 @@ module Typecheck (
 
 import Control.Applicative
 import Control.Monad.State
-import Control.Monad.Error
+import Control.Monad.Except
 
-import qualified AST
+import AST
 
-data Type
-  = TInt
-  | TBool
-  | TChar
-  | TVoid
-  | TPointer Type
-  | TFun Type [Type]
-
-type Id = String
-
-data Arith = Add | Sub | Mul
-
-data Compare = Less | Greater | LessEq | GreaterEq
+data Env = Env
 
-data BoolOp = Or | And
+data Value = LValue | RValue
 
-data Value = L | R
+data T = T Value Type
 
 data CompilationError
   = CompilationError
   deriving (Show)
     
-instance Error CompilationError where
-  noMsg = CompilationError
-
-data Env = Env
-
 newtype Typechecker a = Typecheker {
   runTypechecker ::
-     ErrorT CompilationError (
+     ExceptT CompilationError (
        State Env) a }
                       deriving (
   Functor, Applicative, Monad, MonadError CompilationError,
   MonadState Env)
 
 class Typecheckable f t | f -> t where
-  typecheck :: f -> Typechecker t
+  typecheck :: f () -> Typechecker (Tagged f t)
+
+{-
+data Expression a = EVar Id
+                  | ELitInt Int
+                  | ELitBool Bool
+                  | EArith ArithBinOp (Tagged Expression a) (Tagged Expression a)
+                  | EBool BoolBinOp (Tagged Expression a) (Tagged Expression a)
+                  | EArithCmp ArithCmpOp (Tagged Expression a) (Tagged Expression a)
+                  | EEqual EqOp (Tagged Expression a) (Tagged Expression a)
+                  | ECall Id [(Tagged Expression a)]
+                  | EAssign (Tagged Expression a) (Tagged Expression a)
+                  | EDeref (Tagged Expression a)
+                  | EAddr (Tagged Expression a)
+                  | EArray (Tagged Expression a) (Tagged Expression a)
+                  | ECast Type (Tagged Expression a)
+-}
+
+instance Typecheckable Expression T where
+  typecheck (EVar var) = _
+  typecheck (ELitInt i) = return $ (ELitInt i) `with` (T RValue (Simple "int"))
+  typecheck (ELitBool b) = return $ (ELitBool b) `with` (T RValue (Simple "bool"))

From 644574345c76675ea3e168a523ee7d3e6367ce37 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 02:23:24 +0300
Subject: [PATCH 056/116] Slightly change AST

---
 komarov.andrey/src/AST.hs   | 2 +-
 komarov.andrey/src/Parser.y | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/AST.hs
index 57ff471..d6ac3fe 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/AST.hs
@@ -45,7 +45,7 @@ data TopLevel a
   | FuncDef { name :: Id,
               ret :: Type,
               args :: [(Type, Id)],
-              body :: [Statement a]}
+              body :: Statement a}
   deriving (Show)
 
 data Statement a = SBlock [Statement a]
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/Parser.y
index 17ea329..163d538 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/Parser.y
@@ -71,7 +71,7 @@ TopLevelDefs    : {- empty -}                   { [] }
 TopLevel        :: { TopLevel () }
 TopLevel        : Type var ';'                  { VarDecl $1 $2 }
                 | Type var '(' FuncArgs ')' ';' { ForwardDecl $2 $1 (map fst $4) }
-                | Type var '(' FuncArgs ')' '{' Stmts '}' { FuncDef $2 $1 $4 $7 }
+                | Type var '(' FuncArgs ')' '{' Stmts '}' { FuncDef $2 $1 $4 (SBlock $7) }
 
 Expr            :: { Expression () }
 Expr            : var                           { EVar $1 }

From 98ddfe1b47d1e0ab94676498c4f99168b12d3d3b Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 02:40:34 +0300
Subject: [PATCH 057/116] .gitignore

---
 komarov.andrey/.gitignore      | 2 ++
 komarov.andrey/report/Makefile | 3 +++
 komarov.andrey/src/Makefile    | 2 +-
 3 files changed, 6 insertions(+), 1 deletion(-)
 create mode 100644 komarov.andrey/.gitignore

diff --git a/komarov.andrey/.gitignore b/komarov.andrey/.gitignore
new file mode 100644
index 00000000..2f4f2cf
--- /dev/null
+++ b/komarov.andrey/.gitignore
@@ -0,0 +1,2 @@
+arm
+.cabal-sandbox
diff --git a/komarov.andrey/report/Makefile b/komarov.andrey/report/Makefile
index a8132ad..c87c9d8 100644
--- a/komarov.andrey/report/Makefile
+++ b/komarov.andrey/report/Makefile
@@ -5,3 +5,6 @@ all: head.tex report.tex
 
 show: all
 	evince head.pdf
+
+clean:
+	rm -rf *.aux *.log *.pyg *.pdf
diff --git a/komarov.andrey/src/Makefile b/komarov.andrey/src/Makefile
index 7844c96..4bd4cf0 100644
--- a/komarov.andrey/src/Makefile
+++ b/komarov.andrey/src/Makefile
@@ -8,5 +8,5 @@ parser: Parser.y
 	happy Parser.y -ilog
 
 clean:
-	rm -f *.o *.hi Lexer.hs Parser.hs TestCompiler
+	rm -f *.o *.hi log Lexer.hs Parser.hs TestCompiler
 

From c038830923d5ec8be6605e23657bd75caf8b54be Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 02:40:49 +0300
Subject: [PATCH 058/116] cabal init

---
 komarov.andrey/FC.cabal | 23 +++++++++++++++++++++++
 komarov.andrey/Setup.hs |  2 ++
 2 files changed, 25 insertions(+)
 create mode 100644 komarov.andrey/FC.cabal
 create mode 100644 komarov.andrey/Setup.hs

diff --git a/komarov.andrey/FC.cabal b/komarov.andrey/FC.cabal
new file mode 100644
index 00000000..b6f3a1a
--- /dev/null
+++ b/komarov.andrey/FC.cabal
@@ -0,0 +1,23 @@
+name:                FC
+version:             0.1.0.0
+synopsis:            Featherweight C compiler
+-- description:         
+homepage:            https://github.com/vvolochay/Compilers
+license:             PublicDomain
+license-file:        LICENSE
+author:              Andrey Komarov
+maintainer:          taukus@gmail.com
+-- copyright:           
+category:            Language
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+executable FC
+  main-is:             Main.hs
+  other-modules:       Parser, Lexer
+  -- other-extensions:    
+  build-depends:       base >=4.8 && <4.9
+  build-tools:         happy, alex
+  hs-source-dirs:      src
+  default-language:    Haskell2010
\ No newline at end of file
diff --git a/komarov.andrey/Setup.hs b/komarov.andrey/Setup.hs
new file mode 100644
index 00000000..9a994af
--- /dev/null
+++ b/komarov.andrey/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

From d06cc95cccec762cdc3c7ddab6bea77bc5e6df50 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 02:45:40 +0300
Subject: [PATCH 059/116] cabal is able to build something

---
 komarov.andrey/.gitignore       |  2 ++
 komarov.andrey/FC.cabal         |  4 ++--
 komarov.andrey/LICENSE          | 14 ++++++++++++++
 komarov.andrey/src/Main.hs      |  6 ++++++
 komarov.andrey/src/Typecheck.hs |  6 +++++-
 5 files changed, 29 insertions(+), 3 deletions(-)
 create mode 100644 komarov.andrey/LICENSE
 create mode 100644 komarov.andrey/src/Main.hs

diff --git a/komarov.andrey/.gitignore b/komarov.andrey/.gitignore
index 2f4f2cf..ed30ac1 100644
--- a/komarov.andrey/.gitignore
+++ b/komarov.andrey/.gitignore
@@ -1,2 +1,4 @@
 arm
 .cabal-sandbox
+*flymake*
+dist
diff --git a/komarov.andrey/FC.cabal b/komarov.andrey/FC.cabal
index b6f3a1a..518b9e5 100644
--- a/komarov.andrey/FC.cabal
+++ b/komarov.andrey/FC.cabal
@@ -15,9 +15,9 @@ cabal-version:       >=1.10
 
 executable FC
   main-is:             Main.hs
-  other-modules:       Parser, Lexer
+  other-modules:       Parser, Lexer, AST, ARM
   -- other-extensions:    
-  build-depends:       base >=4.8 && <4.9
+  build-depends:       base >=4.8 && <5, array >= 0.5, containers >= 0.5
   build-tools:         happy, alex
   hs-source-dirs:      src
   default-language:    Haskell2010
\ No newline at end of file
diff --git a/komarov.andrey/LICENSE b/komarov.andrey/LICENSE
new file mode 100644
index 00000000..ee7d6a5
--- /dev/null
+++ b/komarov.andrey/LICENSE
@@ -0,0 +1,14 @@
+            DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
+                    Version 2, December 2004
+
+ Copyright (C) 2004 Sam Hocevar <sam@hocevar.net>
+
+ Everyone is permitted to copy and distribute verbatim or modified
+ copies of this license document, and changing it is allowed as long
+ as the name is changed.
+
+            DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. You just DO WHAT THE FUCK YOU WANT TO.
+
diff --git a/komarov.andrey/src/Main.hs b/komarov.andrey/src/Main.hs
new file mode 100644
index 00000000..6773b69
--- /dev/null
+++ b/komarov.andrey/src/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import Parser
+
+main :: IO ()
+main = print "Hello"
diff --git a/komarov.andrey/src/Typecheck.hs b/komarov.andrey/src/Typecheck.hs
index ce56c21..956eb59 100644
--- a/komarov.andrey/src/Typecheck.hs
+++ b/komarov.andrey/src/Typecheck.hs
@@ -11,7 +11,11 @@ import Control.Monad.Except
 
 import AST
 
-data Env = Env
+data Symbol = Symbol
+              deriving (Eq, Ord)
+
+data Env = Env {
+               }
 
 data Value = LValue | RValue
 

From 7820e2a26613343118ac37be5b730cceb8fc2503 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 02:49:01 +0300
Subject: [PATCH 060/116] rename project

---
 komarov.andrey/{FC.cabal => fcc.cabal} | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)
 rename komarov.andrey/{FC.cabal => fcc.cabal} (89%)

diff --git a/komarov.andrey/FC.cabal b/komarov.andrey/fcc.cabal
similarity index 89%
rename from komarov.andrey/FC.cabal
rename to komarov.andrey/fcc.cabal
index 518b9e5..0a1c7ce 100644
--- a/komarov.andrey/FC.cabal
+++ b/komarov.andrey/fcc.cabal
@@ -1,4 +1,4 @@
-name:                FC
+name:                fcc
 version:             0.1.0.0
 synopsis:            Featherweight C compiler
 -- description:         
@@ -13,11 +13,11 @@ build-type:          Simple
 -- extra-source-files:  
 cabal-version:       >=1.10
 
-executable FC
+executable fcc
   main-is:             Main.hs
   other-modules:       Parser, Lexer, AST, ARM
   -- other-extensions:    
   build-depends:       base >=4.8 && <5, array >= 0.5, containers >= 0.5
   build-tools:         happy, alex
   hs-source-dirs:      src
-  default-language:    Haskell2010
\ No newline at end of file
+  default-language:    Haskell2010

From 39897ad1c35a9bda0ae90e4a619b81c32a01482f Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 03:06:18 +0300
Subject: [PATCH 061/116] rename examples

---
 komarov.andrey/examples/{boolTest.l => boolTest.fc}   | 0
 komarov.andrey/examples/{callc.l => callc.fc}         | 0
 komarov.andrey/examples/{example1.l => example1.fc}   | 0
 komarov.andrey/examples/{example2.l => example2.fc}   | 0
 komarov.andrey/examples/{example3.l => example3.fc}   | 0
 komarov.andrey/examples/{example4.l => example4.fc}   | 0
 komarov.andrey/examples/{example5.l => example5.fc}   | 0
 komarov.andrey/examples/{example6.l => example6.fc}   | 0
 komarov.andrey/examples/{example7.l => example7.fc}   | 0
 komarov.andrey/examples/{fact.l => fact.fc}           | 0
 komarov.andrey/examples/{global.l => global.fc}       | 0
 komarov.andrey/examples/{isPrime.l => isPrime.fc}     | 0
 komarov.andrey/examples/{manyArgs.l => manyArgs.fc}   | 0
 komarov.andrey/examples/{sign.l => sign.fc}           | 0
 komarov.andrey/examples/{whiletrue.l => whiletrue.fc} | 0
 komarov.andrey/examples/{wrong1.l => wrong1.fc}       | 0
 komarov.andrey/examples/{wrong2.l => wrong2.fc}       | 0
 komarov.andrey/examples/{wrong3.l => wrong3.fc}       | 0
 komarov.andrey/examples/{wrong4.l => wrong4.fc}       | 0
 komarov.andrey/examples/{wrong5.l => wrong5.fc}       | 0
 komarov.andrey/examples/{wrong6.l => wrong6.fc}       | 0
 21 files changed, 0 insertions(+), 0 deletions(-)
 rename komarov.andrey/examples/{boolTest.l => boolTest.fc} (100%)
 rename komarov.andrey/examples/{callc.l => callc.fc} (100%)
 rename komarov.andrey/examples/{example1.l => example1.fc} (100%)
 rename komarov.andrey/examples/{example2.l => example2.fc} (100%)
 rename komarov.andrey/examples/{example3.l => example3.fc} (100%)
 rename komarov.andrey/examples/{example4.l => example4.fc} (100%)
 rename komarov.andrey/examples/{example5.l => example5.fc} (100%)
 rename komarov.andrey/examples/{example6.l => example6.fc} (100%)
 rename komarov.andrey/examples/{example7.l => example7.fc} (100%)
 rename komarov.andrey/examples/{fact.l => fact.fc} (100%)
 rename komarov.andrey/examples/{global.l => global.fc} (100%)
 rename komarov.andrey/examples/{isPrime.l => isPrime.fc} (100%)
 rename komarov.andrey/examples/{manyArgs.l => manyArgs.fc} (100%)
 rename komarov.andrey/examples/{sign.l => sign.fc} (100%)
 rename komarov.andrey/examples/{whiletrue.l => whiletrue.fc} (100%)
 rename komarov.andrey/examples/{wrong1.l => wrong1.fc} (100%)
 rename komarov.andrey/examples/{wrong2.l => wrong2.fc} (100%)
 rename komarov.andrey/examples/{wrong3.l => wrong3.fc} (100%)
 rename komarov.andrey/examples/{wrong4.l => wrong4.fc} (100%)
 rename komarov.andrey/examples/{wrong5.l => wrong5.fc} (100%)
 rename komarov.andrey/examples/{wrong6.l => wrong6.fc} (100%)

diff --git a/komarov.andrey/examples/boolTest.l b/komarov.andrey/examples/boolTest.fc
similarity index 100%
rename from komarov.andrey/examples/boolTest.l
rename to komarov.andrey/examples/boolTest.fc
diff --git a/komarov.andrey/examples/callc.l b/komarov.andrey/examples/callc.fc
similarity index 100%
rename from komarov.andrey/examples/callc.l
rename to komarov.andrey/examples/callc.fc
diff --git a/komarov.andrey/examples/example1.l b/komarov.andrey/examples/example1.fc
similarity index 100%
rename from komarov.andrey/examples/example1.l
rename to komarov.andrey/examples/example1.fc
diff --git a/komarov.andrey/examples/example2.l b/komarov.andrey/examples/example2.fc
similarity index 100%
rename from komarov.andrey/examples/example2.l
rename to komarov.andrey/examples/example2.fc
diff --git a/komarov.andrey/examples/example3.l b/komarov.andrey/examples/example3.fc
similarity index 100%
rename from komarov.andrey/examples/example3.l
rename to komarov.andrey/examples/example3.fc
diff --git a/komarov.andrey/examples/example4.l b/komarov.andrey/examples/example4.fc
similarity index 100%
rename from komarov.andrey/examples/example4.l
rename to komarov.andrey/examples/example4.fc
diff --git a/komarov.andrey/examples/example5.l b/komarov.andrey/examples/example5.fc
similarity index 100%
rename from komarov.andrey/examples/example5.l
rename to komarov.andrey/examples/example5.fc
diff --git a/komarov.andrey/examples/example6.l b/komarov.andrey/examples/example6.fc
similarity index 100%
rename from komarov.andrey/examples/example6.l
rename to komarov.andrey/examples/example6.fc
diff --git a/komarov.andrey/examples/example7.l b/komarov.andrey/examples/example7.fc
similarity index 100%
rename from komarov.andrey/examples/example7.l
rename to komarov.andrey/examples/example7.fc
diff --git a/komarov.andrey/examples/fact.l b/komarov.andrey/examples/fact.fc
similarity index 100%
rename from komarov.andrey/examples/fact.l
rename to komarov.andrey/examples/fact.fc
diff --git a/komarov.andrey/examples/global.l b/komarov.andrey/examples/global.fc
similarity index 100%
rename from komarov.andrey/examples/global.l
rename to komarov.andrey/examples/global.fc
diff --git a/komarov.andrey/examples/isPrime.l b/komarov.andrey/examples/isPrime.fc
similarity index 100%
rename from komarov.andrey/examples/isPrime.l
rename to komarov.andrey/examples/isPrime.fc
diff --git a/komarov.andrey/examples/manyArgs.l b/komarov.andrey/examples/manyArgs.fc
similarity index 100%
rename from komarov.andrey/examples/manyArgs.l
rename to komarov.andrey/examples/manyArgs.fc
diff --git a/komarov.andrey/examples/sign.l b/komarov.andrey/examples/sign.fc
similarity index 100%
rename from komarov.andrey/examples/sign.l
rename to komarov.andrey/examples/sign.fc
diff --git a/komarov.andrey/examples/whiletrue.l b/komarov.andrey/examples/whiletrue.fc
similarity index 100%
rename from komarov.andrey/examples/whiletrue.l
rename to komarov.andrey/examples/whiletrue.fc
diff --git a/komarov.andrey/examples/wrong1.l b/komarov.andrey/examples/wrong1.fc
similarity index 100%
rename from komarov.andrey/examples/wrong1.l
rename to komarov.andrey/examples/wrong1.fc
diff --git a/komarov.andrey/examples/wrong2.l b/komarov.andrey/examples/wrong2.fc
similarity index 100%
rename from komarov.andrey/examples/wrong2.l
rename to komarov.andrey/examples/wrong2.fc
diff --git a/komarov.andrey/examples/wrong3.l b/komarov.andrey/examples/wrong3.fc
similarity index 100%
rename from komarov.andrey/examples/wrong3.l
rename to komarov.andrey/examples/wrong3.fc
diff --git a/komarov.andrey/examples/wrong4.l b/komarov.andrey/examples/wrong4.fc
similarity index 100%
rename from komarov.andrey/examples/wrong4.l
rename to komarov.andrey/examples/wrong4.fc
diff --git a/komarov.andrey/examples/wrong5.l b/komarov.andrey/examples/wrong5.fc
similarity index 100%
rename from komarov.andrey/examples/wrong5.l
rename to komarov.andrey/examples/wrong5.fc
diff --git a/komarov.andrey/examples/wrong6.l b/komarov.andrey/examples/wrong6.fc
similarity index 100%
rename from komarov.andrey/examples/wrong6.l
rename to komarov.andrey/examples/wrong6.fc

From 61f326a1f0acd4d98e381089b957917dd5fcda9e Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 03:30:27 +0300
Subject: [PATCH 062/116] Tests are starting

---
 komarov.andrey/fcc.cabal              | 23 +++++++++++++++--------
 komarov.andrey/src/{ => FCC}/ARM.hs   |  2 +-
 komarov.andrey/src/{ => FCC}/AST.hs   |  2 +-
 komarov.andrey/src/{ => FCC}/Lexer.x  |  2 +-
 komarov.andrey/src/{ => FCC}/Parser.y |  6 +++---
 komarov.andrey/src/Main.hs            |  2 +-
 komarov.andrey/tests/TestParser.hs    | 25 +++++++++++++++++++++++++
 7 files changed, 47 insertions(+), 15 deletions(-)
 rename komarov.andrey/src/{ => FCC}/ARM.hs (92%)
 rename komarov.andrey/src/{ => FCC}/AST.hs (99%)
 rename komarov.andrey/src/{ => FCC}/Lexer.x (99%)
 rename komarov.andrey/src/{ => FCC}/Parser.y (99%)
 create mode 100644 komarov.andrey/tests/TestParser.hs

diff --git a/komarov.andrey/fcc.cabal b/komarov.andrey/fcc.cabal
index 0a1c7ce..c019319 100644
--- a/komarov.andrey/fcc.cabal
+++ b/komarov.andrey/fcc.cabal
@@ -11,13 +11,20 @@ maintainer:          taukus@gmail.com
 category:            Language
 build-type:          Simple
 -- extra-source-files:  
-cabal-version:       >=1.10
+cabal-version:       >=1.20
 
 executable fcc
-  main-is:             Main.hs
-  other-modules:       Parser, Lexer, AST, ARM
-  -- other-extensions:    
-  build-depends:       base >=4.8 && <5, array >= 0.5, containers >= 0.5
-  build-tools:         happy, alex
-  hs-source-dirs:      src
-  default-language:    Haskell2010
+  main-is:           Main.hs
+  other-modules:     FCC.Parser, FCC.Lexer, FCC.AST, FCC.ARM
+  build-depends:     base >=4.8 && <5, array, containers
+  build-tools:       happy, alex
+  hs-source-dirs:    src
+  default-language:  Haskell2010
+
+test-suite test-parser
+  type:              exitcode-stdio-1.0
+  main-is:           TestParser.hs
+  hs-source-dirs:    src, tests
+  other-modules:     FCC.Parser, FCC.Lexer
+  build-depends:     base >= 4.8 && < 5, directory, array, containers
+  default-language:  Haskell2010
diff --git a/komarov.andrey/src/ARM.hs b/komarov.andrey/src/FCC/ARM.hs
similarity index 92%
rename from komarov.andrey/src/ARM.hs
rename to komarov.andrey/src/FCC/ARM.hs
index ea0ac98..39d3f1d 100644
--- a/komarov.andrey/src/ARM.hs
+++ b/komarov.andrey/src/FCC/ARM.hs
@@ -1,4 +1,4 @@
-module ARM (
+module FCC.ARM (
   Assembly(..),
   Segment(..)
   ) where
diff --git a/komarov.andrey/src/AST.hs b/komarov.andrey/src/FCC/AST.hs
similarity index 99%
rename from komarov.andrey/src/AST.hs
rename to komarov.andrey/src/FCC/AST.hs
index d6ac3fe..1a5bd02 100644
--- a/komarov.andrey/src/AST.hs
+++ b/komarov.andrey/src/FCC/AST.hs
@@ -1,4 +1,4 @@
-module AST (
+module FCC.AST (
   Id,
   Tagged,
   Type(..),
diff --git a/komarov.andrey/src/Lexer.x b/komarov.andrey/src/FCC/Lexer.x
similarity index 99%
rename from komarov.andrey/src/Lexer.x
rename to komarov.andrey/src/FCC/Lexer.x
index 99495b9..4905353 100644
--- a/komarov.andrey/src/Lexer.x
+++ b/komarov.andrey/src/FCC/Lexer.x
@@ -1,5 +1,5 @@
 {
-module Lexer (
+module FCC.Lexer (
        Alex(..), runAlex, alexError,
        Token(..), lexer
 ) where
diff --git a/komarov.andrey/src/Parser.y b/komarov.andrey/src/FCC/Parser.y
similarity index 99%
rename from komarov.andrey/src/Parser.y
rename to komarov.andrey/src/FCC/Parser.y
index 163d538..39ac16b 100644
--- a/komarov.andrey/src/Parser.y
+++ b/komarov.andrey/src/FCC/Parser.y
@@ -1,10 +1,10 @@
 {
-module Parser (
+module FCC.Parser (
        parse
 ) where
 
-import Lexer
-import AST
+import FCC.Lexer
+import FCC.AST
 
 }
 
diff --git a/komarov.andrey/src/Main.hs b/komarov.andrey/src/Main.hs
index 6773b69..04dbbbc 100644
--- a/komarov.andrey/src/Main.hs
+++ b/komarov.andrey/src/Main.hs
@@ -1,6 +1,6 @@
 module Main where
 
-import Parser
+import FCC.Parser
 
 main :: IO ()
 main = print "Hello"
diff --git a/komarov.andrey/tests/TestParser.hs b/komarov.andrey/tests/TestParser.hs
new file mode 100644
index 00000000..cb21b33
--- /dev/null
+++ b/komarov.andrey/tests/TestParser.hs
@@ -0,0 +1,25 @@
+import System.Exit
+import System.Directory
+import Data.List (isPrefixOf, isSuffixOf)
+import Control.Monad (forM_)
+
+import FCC.Parser (parse)
+
+checkFile :: FilePath -> IO ()
+checkFile path = do
+  putStrLn $ "Checking " ++ path
+  contents <- readFile path
+  let res = parse contents
+  print res
+  case ("parseErr" `isPrefixOf` path, res) of
+   (True, Right _) -> exitFailure
+   (False, Left _) -> exitFailure
+   _ -> return ()
+
+
+main :: IO ()
+main = do
+  setCurrentDirectory "examples"
+  files <- getDirectoryContents "."
+  let good = filter (".fc" `isSuffixOf`) files
+  forM_ good checkFile

From d6d5b0e14bd3d7e1552bf78235190447ff9aefd3 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 03:34:28 +0300
Subject: [PATCH 063/116] Test passed

---
 komarov.andrey/src/FCC/AST.hs   | 10 +++++++++-
 komarov.andrey/src/FCC/Lexer.x  |  2 +-
 komarov.andrey/src/FCC/Parser.y |  2 +-
 3 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/komarov.andrey/src/FCC/AST.hs b/komarov.andrey/src/FCC/AST.hs
index 1a5bd02..e2ab1cd 100644
--- a/komarov.andrey/src/FCC/AST.hs
+++ b/komarov.andrey/src/FCC/AST.hs
@@ -10,7 +10,8 @@ module FCC.AST (
   ArithCmpOp(..),
   BoolBinOp(..),
   EqOp(..),
-  notag, with
+  notag, with,
+  toPrimitiveType
   ) where
 
 type Id = String
@@ -34,9 +35,16 @@ data Program a = Program [TopLevel a]
 data Type
   = TInt
   | TBool
+  | TVoid
   | TPointer Type
   deriving (Show, Eq, Ord)
 
+toPrimitiveType :: String -> Type
+toPrimitiveType "int" = TInt
+toPrimitiveType "bool" = TBool
+toPrimitiveType "void" = TVoid
+toPrimitiveType t = error $ "INTERNAL COMPILER ERROR: type <" ++ t ++ "> not recognized"
+
 data TopLevel a
   = VarDecl Type Id
   | ForwardDecl { name :: Id,
diff --git a/komarov.andrey/src/FCC/Lexer.x b/komarov.andrey/src/FCC/Lexer.x
index 4905353..b01e10c 100644
--- a/komarov.andrey/src/FCC/Lexer.x
+++ b/komarov.andrey/src/FCC/Lexer.x
@@ -66,7 +66,7 @@ isType s = do
   return $ s `S.member` t
 
 alexInitUserState :: AlexUserState
-alexInitUserState = AlexUserState $ S.fromList ["int", "char", "bool"]
+alexInitUserState = AlexUserState $ S.fromList ["int", "void", "bool"]
 
 alexEOF :: Alex Token
 alexEOF = return TokenEOF
diff --git a/komarov.andrey/src/FCC/Parser.y b/komarov.andrey/src/FCC/Parser.y
index 39ac16b..e77f6ea 100644
--- a/komarov.andrey/src/FCC/Parser.y
+++ b/komarov.andrey/src/FCC/Parser.y
@@ -121,7 +121,7 @@ FuncArgs        : {- empty -}                   { [] }
                 | Type var ',' FuncArgs         { ($1, $2):$4 }
 
 Type            :: { Type }
-Type            : tyvar                         { case $1 of { "int" -> TInt; "bool" -> TBool; n -> error $ "INTERNAL COMPILER ERROR" ++ n } }
+Type            : tyvar                         { toPrimitiveType $1 }
                 | Type '*'                      { TPointer $1 }
 
 {

From 776ec6136597bfbf0ddce7181464cf95cb2bef22 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 03:42:06 +0300
Subject: [PATCH 064/116] some parser tests

---
 komarov.andrey/examples/parseErrBraces.fc        | 2 ++
 komarov.andrey/examples/parseErrFunctionInt.fc   | 1 +
 komarov.andrey/examples/parseErrGarbage.fc       | 2 ++
 komarov.andrey/examples/parseErrIfWithoutElse.fc | 5 +++++
 komarov.andrey/examples/parseErrVarInt.fc        | 3 +++
 komarov.andrey/examples/parseOkBraces.fc         | 3 +++
 6 files changed, 16 insertions(+)
 create mode 100644 komarov.andrey/examples/parseErrBraces.fc
 create mode 100644 komarov.andrey/examples/parseErrFunctionInt.fc
 create mode 100644 komarov.andrey/examples/parseErrGarbage.fc
 create mode 100644 komarov.andrey/examples/parseErrIfWithoutElse.fc
 create mode 100644 komarov.andrey/examples/parseErrVarInt.fc
 create mode 100644 komarov.andrey/examples/parseOkBraces.fc

diff --git a/komarov.andrey/examples/parseErrBraces.fc b/komarov.andrey/examples/parseErrBraces.fc
new file mode 100644
index 00000000..ef1df9c
--- /dev/null
+++ b/komarov.andrey/examples/parseErrBraces.fc
@@ -0,0 +1,2 @@
+int f() {
+}}
diff --git a/komarov.andrey/examples/parseErrFunctionInt.fc b/komarov.andrey/examples/parseErrFunctionInt.fc
new file mode 100644
index 00000000..28f6c3a
--- /dev/null
+++ b/komarov.andrey/examples/parseErrFunctionInt.fc
@@ -0,0 +1 @@
+int int() {}
diff --git a/komarov.andrey/examples/parseErrGarbage.fc b/komarov.andrey/examples/parseErrGarbage.fc
new file mode 100644
index 00000000..ada0cee
--- /dev/null
+++ b/komarov.andrey/examples/parseErrGarbage.fc
@@ -0,0 +1,2 @@
+adf
+asdf
\ No newline at end of file
diff --git a/komarov.andrey/examples/parseErrIfWithoutElse.fc b/komarov.andrey/examples/parseErrIfWithoutElse.fc
new file mode 100644
index 00000000..fce765d
--- /dev/null
+++ b/komarov.andrey/examples/parseErrIfWithoutElse.fc
@@ -0,0 +1,5 @@
+int f() {
+    if (1 == 2) {
+       return 0;
+    }
+}
diff --git a/komarov.andrey/examples/parseErrVarInt.fc b/komarov.andrey/examples/parseErrVarInt.fc
new file mode 100644
index 00000000..c06e0c6
--- /dev/null
+++ b/komarov.andrey/examples/parseErrVarInt.fc
@@ -0,0 +1,3 @@
+int int;
+
+int f() {}
\ No newline at end of file
diff --git a/komarov.andrey/examples/parseOkBraces.fc b/komarov.andrey/examples/parseOkBraces.fc
new file mode 100644
index 00000000..f68878e
--- /dev/null
+++ b/komarov.andrey/examples/parseOkBraces.fc
@@ -0,0 +1,3 @@
+int f() {
+{}{}{}
+}

From 93a8f6b2c141fc080c671cab947f5499f81c52e3 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 22 Apr 2015 04:08:21 +0300
Subject: [PATCH 065/116] PrettyPrinter started

---
 komarov.andrey/fcc.cabal                |  5 ++--
 komarov.andrey/src/FCC/AST.hs           |  9 +++---
 komarov.andrey/src/FCC/PrettyPrinter.hs | 37 +++++++++++++++++++++++++
 komarov.andrey/src/Main.hs              |  1 +
 4 files changed, 46 insertions(+), 6 deletions(-)
 create mode 100644 komarov.andrey/src/FCC/PrettyPrinter.hs

diff --git a/komarov.andrey/fcc.cabal b/komarov.andrey/fcc.cabal
index c019319..18a70c9 100644
--- a/komarov.andrey/fcc.cabal
+++ b/komarov.andrey/fcc.cabal
@@ -15,8 +15,9 @@ cabal-version:       >=1.20
 
 executable fcc
   main-is:           Main.hs
-  other-modules:     FCC.Parser, FCC.Lexer, FCC.AST, FCC.ARM
-  build-depends:     base >=4.8 && <5, array, containers
+  other-modules:     FCC.Parser, FCC.Lexer, FCC.AST, FCC.ARM,
+                     FCC.PrettyPrinter
+  build-depends:     base >=4.8 && <5, array, containers, mtl
   build-tools:       happy, alex
   hs-source-dirs:    src
   default-language:  Haskell2010
diff --git a/komarov.andrey/src/FCC/AST.hs b/komarov.andrey/src/FCC/AST.hs
index e2ab1cd..f863a09 100644
--- a/komarov.andrey/src/FCC/AST.hs
+++ b/komarov.andrey/src/FCC/AST.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor #-}
 module FCC.AST (
   Id,
   Tagged,
@@ -30,7 +31,7 @@ with :: f a -> a -> Tagged f a
 with = (,)
 
 data Program a = Program [TopLevel a]
-          deriving (Show)
+          deriving (Show, Functor)
 
 data Type
   = TInt
@@ -54,7 +55,7 @@ data TopLevel a
               ret :: Type,
               args :: [(Type, Id)],
               body :: Statement a}
-  deriving (Show)
+  deriving (Show, Functor)
 
 data Statement a = SBlock [Statement a]
                  | SVarDecl Type Id
@@ -63,7 +64,7 @@ data Statement a = SBlock [Statement a]
                  | SIfThenElse (Tagged Expression a) (Statement a) (Statement a)
                  | SWhile (Tagged Expression a) (Statement a)
                  | SReturn (Tagged Expression a)
-                 deriving (Show)
+                 deriving (Show, Functor)
 
 data ArithBinOp = AddOp | SubOp | MulOp
                 deriving (Eq, Ord)
@@ -107,4 +108,4 @@ data Expression a = EVar Id
                   | EAddr (Tagged Expression a)
                   | EArray (Tagged Expression a) (Tagged Expression a)
                   | ECast Type (Tagged Expression a)
-                  deriving (Show, Eq, Ord)
+                  deriving (Show, Eq, Ord, Functor)
diff --git a/komarov.andrey/src/FCC/PrettyPrinter.hs b/komarov.andrey/src/FCC/PrettyPrinter.hs
new file mode 100644
index 00000000..8f98968
--- /dev/null
+++ b/komarov.andrey/src/FCC/PrettyPrinter.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module FCC.PrettyPrinter (
+  ) where
+
+import Control.Monad.RWS
+
+import FCC.AST
+
+type Offset = Int
+type Output = [String]
+newtype Config = Config { offsetStep :: Int }
+
+defaultConfig = Config 4
+
+newtype PrettyPrinter a = PrettyPrinter {
+  runPrettyPrinter :: RWS Config Output Offset a
+  } deriving (
+  Functor, Applicative, Monad, MonadState Offset, MonadWriter Output, MonadReader Config
+  )
+
+ppline :: String -> PrettyPrinter ()
+ppline s = do
+  off <- get
+  tell [(replicate off ' ') ++ s]
+
+scoped :: PrettyPrinter a -> PrettyPrinter a
+scoped p = do
+  add <- asks offsetStep
+  modify (+add)
+  res <- p
+  modify (`subtract` add)
+  return res
+
+class PrettyPrintable t where
+  pprint :: t -> PrettyPrinter ()
+
diff --git a/komarov.andrey/src/Main.hs b/komarov.andrey/src/Main.hs
index 04dbbbc..46604d7 100644
--- a/komarov.andrey/src/Main.hs
+++ b/komarov.andrey/src/Main.hs
@@ -1,6 +1,7 @@
 module Main where
 
 import FCC.Parser
+import FCC.PrettyPrinter
 
 main :: IO ()
 main = print "Hello"

From bf0eb56106fc768bb27c0a8459ceb8e3e2d3c4ad Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 23 Apr 2015 02:20:33 +0300
Subject: [PATCH 066/116] QuickCheck tests are able to start

---
 komarov.andrey/fcc.cabal                  | 10 +++++++
 komarov.andrey/src/FCC/AST.hs             |  4 ++-
 komarov.andrey/src/FCC/PrettyPrinter.hs   | 18 +++++++++++++
 komarov.andrey/tests/TestPrettyPrinter.hs | 32 +++++++++++++++++++++++
 4 files changed, 63 insertions(+), 1 deletion(-)
 create mode 100644 komarov.andrey/tests/TestPrettyPrinter.hs

diff --git a/komarov.andrey/fcc.cabal b/komarov.andrey/fcc.cabal
index 18a70c9..bb90d75 100644
--- a/komarov.andrey/fcc.cabal
+++ b/komarov.andrey/fcc.cabal
@@ -29,3 +29,13 @@ test-suite test-parser
   other-modules:     FCC.Parser, FCC.Lexer
   build-depends:     base >= 4.8 && < 5, directory, array, containers
   default-language:  Haskell2010
+
+test-suite test-pretty-printer
+  type:              exitcode-stdio-1.0
+  main-is:           TestPrettyPrinter.hs
+  hs-source-dirs:    src, tests
+  other-modules:     FCC.PrettyPrinter, FCC.AST
+  build-depends:     base >= 4.8 && < 5, test-framework-quickcheck2,
+                     test-framework-hunit, QuickCheck, test-framework, HUnit,
+                     derive
+  default-language:  Haskell2010
\ No newline at end of file
diff --git a/komarov.andrey/src/FCC/AST.hs b/komarov.andrey/src/FCC/AST.hs
index f863a09..5dfe442 100644
--- a/komarov.andrey/src/FCC/AST.hs
+++ b/komarov.andrey/src/FCC/AST.hs
@@ -11,7 +11,7 @@ module FCC.AST (
   ArithCmpOp(..),
   BoolBinOp(..),
   EqOp(..),
-  notag, with,
+  notag, with, value,
   toPrimitiveType
   ) where
 
@@ -109,3 +109,5 @@ data Expression a = EVar Id
                   | EArray (Tagged Expression a) (Tagged Expression a)
                   | ECast Type (Tagged Expression a)
                   deriving (Show, Eq, Ord, Functor)
+
+  
diff --git a/komarov.andrey/src/FCC/PrettyPrinter.hs b/komarov.andrey/src/FCC/PrettyPrinter.hs
index 8f98968..69634ef 100644
--- a/komarov.andrey/src/FCC/PrettyPrinter.hs
+++ b/komarov.andrey/src/FCC/PrettyPrinter.hs
@@ -1,9 +1,11 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module FCC.PrettyPrinter (
+  ppExpr
   ) where
 
 import Control.Monad.RWS
+import Data.List (intercalate)
 
 import FCC.AST
 
@@ -35,3 +37,19 @@ scoped p = do
 class PrettyPrintable t where
   pprint :: t -> PrettyPrinter ()
 
+ppExpr (EVar var) = var
+ppExpr (ELitInt i) = show i
+ppExpr (ELitBool True) = "true"
+ppExpr (ELitBool False) = "false"
+ppExpr (EArith op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
+ppExpr (EBool op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
+ppExpr (EArithCmp op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
+ppExpr (EEqual op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
+ppExpr (ECall f args) = f ++ "(" ++ (intercalate ", " $ map (ppExpr . value) args) ++ ")"
+ppExpr (EAssign e1 e2) = ppExpr (value e1) ++ " = " ++ ppExpr (value e2)
+ppExpr (EDeref e) = "*" ++ ppExpr (value e)
+ppExpr (EAddr e) = "&" ++ ppExpr (value e)
+ppExpr (EArray a i) = ppExpr (value a) ++ "[" ++ ppExpr (value i) ++ "]"
+ppExpr (ECast t e) = "(" ++ show t ++ ")" ++ ppExpr (value e)
+
+
diff --git a/komarov.andrey/tests/TestPrettyPrinter.hs b/komarov.andrey/tests/TestPrettyPrinter.hs
new file mode 100644
index 00000000..d3a003b
--- /dev/null
+++ b/komarov.andrey/tests/TestPrettyPrinter.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE TemplateHaskell #-}
+import Test.Framework (defaultMain, testGroup)
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
+import Test.QuickCheck
+import Test.HUnit
+
+import Data.List
+
+import Data.DeriveTH
+
+import FCC.AST
+
+derive makeArbitrary ''EqOp
+derive makeArbitrary ''BoolBinOp
+derive makeArbitrary ''ArithCmpOp
+derive makeArbitrary ''ArithBinOp
+derive makeArbitrary ''Type
+derive makeArbitrary ''Expression
+
+main = defaultMain tests
+
+tests = [
+  testGroup "Expression" [
+     testProperty "expr" prop_expr
+     ]
+  ]
+
+prop_expr :: Expression () -> Bool
+prop_expr (EDeref _) = False
+prop_expr _ = True

From 6f001731b36d0a91ed0facd2331bd30a3e993883 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 28 Apr 2015 02:47:26 +0300
Subject: [PATCH 067/116] prettyprinter

---
 komarov.andrey/fcc.cabal                  |  4 +-
 komarov.andrey/src/FCC/AST.hs             | 69 ++++++++++++++++++++---
 komarov.andrey/src/Main.hs                |  8 ++-
 komarov.andrey/tests/TestPrettyPrinter.hs | 37 ++++++++----
 4 files changed, 97 insertions(+), 21 deletions(-)

diff --git a/komarov.andrey/fcc.cabal b/komarov.andrey/fcc.cabal
index bb90d75..7dfcfef 100644
--- a/komarov.andrey/fcc.cabal
+++ b/komarov.andrey/fcc.cabal
@@ -34,8 +34,8 @@ test-suite test-pretty-printer
   type:              exitcode-stdio-1.0
   main-is:           TestPrettyPrinter.hs
   hs-source-dirs:    src, tests
-  other-modules:     FCC.PrettyPrinter, FCC.AST
+  other-modules:     FCC.PrettyPrinter, FCC.AST, FCC.Parser, FCC.Lexer
   build-depends:     base >= 4.8 && < 5, test-framework-quickcheck2,
                      test-framework-hunit, QuickCheck, test-framework, HUnit,
-                     derive
+                     derive, array, containers, directory
   default-language:  Haskell2010
\ No newline at end of file
diff --git a/komarov.andrey/src/FCC/AST.hs b/komarov.andrey/src/FCC/AST.hs
index 5dfe442..c21ccb4 100644
--- a/komarov.andrey/src/FCC/AST.hs
+++ b/komarov.andrey/src/FCC/AST.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE RecordWildCards #-}
 module FCC.AST (
   Id,
   Tagged,
@@ -15,6 +16,8 @@ module FCC.AST (
   toPrimitiveType
   ) where
 
+import Data.List (intercalate)
+
 type Id = String
 type Tagged f a = (f a, a)
 
@@ -31,14 +34,14 @@ with :: f a -> a -> Tagged f a
 with = (,)
 
 data Program a = Program [TopLevel a]
-          deriving (Show, Functor)
+          deriving (Eq, Functor)
 
 data Type
   = TInt
   | TBool
   | TVoid
   | TPointer Type
-  deriving (Show, Eq, Ord)
+  deriving (Eq, Ord)
 
 toPrimitiveType :: String -> Type
 toPrimitiveType "int" = TInt
@@ -55,7 +58,7 @@ data TopLevel a
               ret :: Type,
               args :: [(Type, Id)],
               body :: Statement a}
-  deriving (Show, Functor)
+  deriving (Eq, Functor)
 
 data Statement a = SBlock [Statement a]
                  | SVarDecl Type Id
@@ -64,7 +67,7 @@ data Statement a = SBlock [Statement a]
                  | SIfThenElse (Tagged Expression a) (Statement a) (Statement a)
                  | SWhile (Tagged Expression a) (Statement a)
                  | SReturn (Tagged Expression a)
-                 deriving (Show, Functor)
+                 deriving (Eq, Functor)
 
 data ArithBinOp = AddOp | SubOp | MulOp
                 deriving (Eq, Ord)
@@ -108,6 +111,58 @@ data Expression a = EVar Id
                   | EAddr (Tagged Expression a)
                   | EArray (Tagged Expression a) (Tagged Expression a)
                   | ECast Type (Tagged Expression a)
-                  deriving (Show, Eq, Ord, Functor)
-
-  
+                  deriving (Eq, Ord, Functor)
+
+ppExpr :: Expression a -> String
+ppExpr (EVar var) = var
+ppExpr (ELitInt i) = show i
+ppExpr (ELitBool True) = "true"
+ppExpr (ELitBool False) = "false"
+ppExpr (EArith op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
+ppExpr (EBool op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
+ppExpr (EArithCmp op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
+ppExpr (EEqual op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
+ppExpr (ECall f args) = f ++ "(" ++ (intercalate ", " $ map (ppExpr . value) args) ++ ")"
+ppExpr (EAssign e1 e2) = ppExpr (value e1) ++ " = " ++ ppExpr (value e2)
+ppExpr (EDeref e) = "*" ++ ppExpr (value e)
+ppExpr (EAddr e) = "&" ++ ppExpr (value e)
+ppExpr (EArray a i) = ppExpr (value a) ++ "[" ++ ppExpr (value i) ++ "]"
+ppExpr (ECast t e) = "(" ++ show t ++ ")" ++ ppExpr (value e)
+
+instance Show (Expression a) where
+  show = ppExpr
+
+ppStmt :: Int -> Statement a -> String
+ppStmt off (SBlock stmts) = "{\n" ++ (intercalate "\n" $ map (ppStmt (off + 4)) stmts) ++ "\n}"
+ppStmt off (SVarDecl tp id) = replicate off ' ' ++ show tp ++ " " ++ id ++ ";"
+ppStmt off (SRawExpr e) = replicate off ' ' ++ show (value e) ++ ";"
+ppStmt off (SIfThenElse cond thn els) = if' ++ "\n" ++ then' ++ "\nelse" ++ else' where
+  if' = replicate off ' ' ++ "if (" ++ (show (value cond)) ++ ")"
+  then' = ppStmt (off + 4) thn
+  else' = ppStmt (off + 4) els
+ppStmt off (SWhile cond body) = while' ++ "\n" ++ body' where
+  while' = replicate off ' ' ++ "while (" ++ show (value cond) ++ ")"
+  body' = ppStmt (off + 4) body
+ppStmt off (SReturn ret) = replicate off ' ' ++ show (value ret) ++ ";"
+
+instance Show (Statement a) where
+  show = ppStmt 0
+
+ppTopLevel :: TopLevel a -> String
+ppTopLevel (VarDecl tp id) = show tp ++ " " ++ id ++ ";"
+ppTopLevel ForwardDecl{..} = show ret ++ " " ++ name ++ "(" ++ (intercalate ", " args') ++ ");" where 
+  args' = zipWith (\t i -> show t ++ " arg" ++ show i) argsTypes [1..]
+ppTopLevel FuncDef{..} = show ret ++ " " ++ name ++ "(" ++ (intercalate ", " (map showPair args)) ++ ")" ++ show body where
+  showPair (a, b) = show a ++ " " ++ b
+
+instance Show (TopLevel a) where
+  show = ppTopLevel
+
+instance Show (Program a) where
+  show (Program t) = intercalate "\n\n" $ map show t
+
+instance Show Type where
+  show TInt = "int"
+  show TBool = "bool"
+  show TVoid = "void"
+  show (TPointer t) = show t ++ "*"
diff --git a/komarov.andrey/src/Main.hs b/komarov.andrey/src/Main.hs
index 46604d7..d13a504 100644
--- a/komarov.andrey/src/Main.hs
+++ b/komarov.andrey/src/Main.hs
@@ -1,7 +1,11 @@
 module Main where
 
 import FCC.Parser
-import FCC.PrettyPrinter
 
 main :: IO ()
-main = print "Hello"
+main = do
+  input <- getContents
+  let p = parse input
+  case p of
+   Left e -> putStrLn $ "failed to parse: " ++ show e
+   Right x -> print x
diff --git a/komarov.andrey/tests/TestPrettyPrinter.hs b/komarov.andrey/tests/TestPrettyPrinter.hs
index d3a003b..939e108 100644
--- a/komarov.andrey/tests/TestPrettyPrinter.hs
+++ b/komarov.andrey/tests/TestPrettyPrinter.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
 import Test.Framework (defaultMain, testGroup)
 import Test.Framework.Providers.HUnit
 import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -6,21 +5,19 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck
 import Test.HUnit
 
+import System.Exit
+import System.Directory
+
 import Data.List
 
-import Data.DeriveTH
+import Control.Monad
 
 import FCC.AST
+import FCC.Parser
 
-derive makeArbitrary ''EqOp
-derive makeArbitrary ''BoolBinOp
-derive makeArbitrary ''ArithCmpOp
-derive makeArbitrary ''ArithBinOp
-derive makeArbitrary ''Type
-derive makeArbitrary ''Expression
-
-main = defaultMain tests
+-- main = defaultMain tests
 
+{-
 tests = [
   testGroup "Expression" [
      testProperty "expr" prop_expr
@@ -30,3 +27,23 @@ tests = [
 prop_expr :: Expression () -> Bool
 prop_expr (EDeref _) = False
 prop_expr _ = True
+-}
+
+checkFile :: FilePath -> IO ()
+checkFile path = do
+  putStrLn $ "Checking " ++ path
+  contents <- readFile path
+  let res = parse contents
+  print res
+  case res of
+   Right p -> case parse (show p) of
+     Right p' -> when (show p /= show p') $ print p >> print p' >> exitFailure
+     Left _ -> print p >> exitFailure
+   Left _ -> return ()
+
+main :: IO ()
+main = do
+  setCurrentDirectory "examples"
+  files <- getDirectoryContents "."
+  let good = filter (".fc" `isSuffixOf`) files
+  forM_ good checkFile

From 811f30d76655f06432bf71913111d25428e0f5aa Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 28 Apr 2015 02:53:40 +0300
Subject: [PATCH 068/116] prettyprinter fixes

---
 komarov.andrey/src/FCC/AST.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/komarov.andrey/src/FCC/AST.hs b/komarov.andrey/src/FCC/AST.hs
index c21ccb4..c9db333 100644
--- a/komarov.andrey/src/FCC/AST.hs
+++ b/komarov.andrey/src/FCC/AST.hs
@@ -133,17 +133,17 @@ instance Show (Expression a) where
   show = ppExpr
 
 ppStmt :: Int -> Statement a -> String
-ppStmt off (SBlock stmts) = "{\n" ++ (intercalate "\n" $ map (ppStmt (off + 4)) stmts) ++ "\n}"
+ppStmt off (SBlock stmts) = replicate off ' ' ++ "{\n" ++ (intercalate "\n" $ map (ppStmt (off + 4)) stmts) ++ "\n" ++ replicate off ' ' ++ "}"
 ppStmt off (SVarDecl tp id) = replicate off ' ' ++ show tp ++ " " ++ id ++ ";"
 ppStmt off (SRawExpr e) = replicate off ' ' ++ show (value e) ++ ";"
-ppStmt off (SIfThenElse cond thn els) = if' ++ "\n" ++ then' ++ "\nelse" ++ else' where
+ppStmt off (SIfThenElse cond thn els) = if' ++ "\n" ++ then' ++ "\n" ++ replicate off ' ' ++ "else\n" ++ else' where
   if' = replicate off ' ' ++ "if (" ++ (show (value cond)) ++ ")"
   then' = ppStmt (off + 4) thn
   else' = ppStmt (off + 4) els
 ppStmt off (SWhile cond body) = while' ++ "\n" ++ body' where
   while' = replicate off ' ' ++ "while (" ++ show (value cond) ++ ")"
   body' = ppStmt (off + 4) body
-ppStmt off (SReturn ret) = replicate off ' ' ++ show (value ret) ++ ";"
+ppStmt off (SReturn ret) = replicate off ' ' ++ "return " ++ show (value ret) ++ ";"
 
 instance Show (Statement a) where
   show = ppStmt 0
@@ -152,7 +152,7 @@ ppTopLevel :: TopLevel a -> String
 ppTopLevel (VarDecl tp id) = show tp ++ " " ++ id ++ ";"
 ppTopLevel ForwardDecl{..} = show ret ++ " " ++ name ++ "(" ++ (intercalate ", " args') ++ ");" where 
   args' = zipWith (\t i -> show t ++ " arg" ++ show i) argsTypes [1..]
-ppTopLevel FuncDef{..} = show ret ++ " " ++ name ++ "(" ++ (intercalate ", " (map showPair args)) ++ ")" ++ show body where
+ppTopLevel FuncDef{..} = show ret ++ " " ++ name ++ "(" ++ (intercalate ", " (map showPair args)) ++ ") " ++ show body where
   showPair (a, b) = show a ++ " " ++ b
 
 instance Show (TopLevel a) where

From 86ab7d7ee6fbed9ac311b51d759ef3d3a03bff05 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 28 Apr 2015 02:54:43 +0300
Subject: [PATCH 069/116] Stronger prettyprinter property

---
 komarov.andrey/tests/TestPrettyPrinter.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/komarov.andrey/tests/TestPrettyPrinter.hs b/komarov.andrey/tests/TestPrettyPrinter.hs
index 939e108..068dc62 100644
--- a/komarov.andrey/tests/TestPrettyPrinter.hs
+++ b/komarov.andrey/tests/TestPrettyPrinter.hs
@@ -37,7 +37,7 @@ checkFile path = do
   print res
   case res of
    Right p -> case parse (show p) of
-     Right p' -> when (show p /= show p') $ print p >> print p' >> exitFailure
+     Right p' -> when (p /= p') $ print p >> print p' >> exitFailure
      Left _ -> print p >> exitFailure
    Left _ -> return ()
 

From 3a4347b6b181a93df255050b31c627542974e897 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 13 May 2015 03:48:19 +0300
Subject: [PATCH 070/116] One more attempt started

---
 komarov.andrey/src/FCC/Expr.hs    | 66 +++++++++++++++++++++
 komarov.andrey/src/FCC/Lexer.x    |  2 +
 komarov.andrey/src/FCC/Parser.y   | 97 +++++++++++++++++--------------
 komarov.andrey/src/FCC/Program.hs | 25 ++++++++
 komarov.andrey/src/FCC/Stdlib.hs  | 30 ++++++++++
 komarov.andrey/src/FCC/Type.hs    | 28 +++++++++
 6 files changed, 203 insertions(+), 45 deletions(-)
 create mode 100644 komarov.andrey/src/FCC/Expr.hs
 create mode 100644 komarov.andrey/src/FCC/Program.hs
 create mode 100644 komarov.andrey/src/FCC/Stdlib.hs
 create mode 100644 komarov.andrey/src/FCC/Type.hs

diff --git a/komarov.andrey/src/FCC/Expr.hs b/komarov.andrey/src/FCC/Expr.hs
new file mode 100644
index 00000000..4804a14
--- /dev/null
+++ b/komarov.andrey/src/FCC/Expr.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+module FCC.Expr (
+  Expr(..),
+  declVar,
+  ) where
+
+import FCC.Type
+
+import Control.Monad
+
+import Prelude.Extras
+import Bound
+
+data Expr a
+  = Var a
+  | Lit Int
+  | LitBool Bool
+  | Lam Type (Scope () Expr a)
+  | Empty
+  | Seq (Expr a) (Expr a)
+  | Call (Expr a) [Expr a]
+  | Eq (Expr a) (Expr a) -- костыль во имя нереализации ad-hoc полиморфизма
+  | While (Expr a) (Expr a)
+  | If (Expr a) (Expr a) (Expr a)
+  | Assign (Expr a) (Expr a)
+  | Array (Expr a) (Expr a)
+  | Return (Expr a)
+  | Native [String]
+  deriving (Eq, Ord, Show, Read)
+
+instance Functor Expr where
+  fmap = liftM
+  
+instance Applicative Expr where
+  pure = return
+  (<*>) = ap
+
+instance Monad Expr where
+  return = Var
+  Var a >>= f = f a
+  Lit i >>= _ = Lit i
+  Lam t scope >>= f = Lam t $ scope >>>= f
+  Empty >>= f = Empty
+  Seq e1 e2 >>= f = Seq (e1 >>= f) (e2 >>= f)
+  Call fun args >>= f = Call (fun >>= f) $ fmap (>>= f) args
+  Eq e1 e2 >>= f = Eq (e1 >>= f) (e2 >>= f)
+  While cond e >>= f = While (cond >>= f) (e >>= f)
+  If cond thn els >>= f = If (cond >>= f) (thn >>= f) (els >>= f)
+  Assign dest src >>= f = Assign (dest >>= f) (src >>= f)
+  Array arr ind >>= f = Array (arr >>= f) (ind >>= f)
+  Return e >>= f = Return $ e >>= f
+  Native xs >>= _ = Native xs
+
+declVar :: Eq a => Type -> a -> Expr a -> Expr a
+declVar t x e = Lam t $ abstract1 x e
+
+instance Eq1 Expr where
+  (==#) = (==)
+instance Ord1 Expr where
+  compare1 = compare
+instance Show1 Expr where
+  showsPrec1 = showsPrec
+instance Read1 Expr where
+  readsPrec1 = readsPrec
diff --git a/komarov.andrey/src/FCC/Lexer.x b/komarov.andrey/src/FCC/Lexer.x
index b01e10c..63e5b66 100644
--- a/komarov.andrey/src/FCC/Lexer.x
+++ b/komarov.andrey/src/FCC/Lexer.x
@@ -46,6 +46,7 @@ tokens :-
        "false"                  { r TokenFalse }
        ","                      { r TokenComma }
        "&"                      { r TokenAmp }
+       "!"                      { r TokenNot }
        $alpha $alnum*           { \(_, _, _, s) l -> var $ take l s }
 
 {
@@ -89,6 +90,7 @@ data Token = TokenNum Int
            | TokenLessEq
            | TokenGreaterEq
            | TokenNotEqual
+           | TokenNot
            | TokenAnd
            | TokenOr
            | TokenXor
diff --git a/komarov.andrey/src/FCC/Parser.y b/komarov.andrey/src/FCC/Parser.y
index e77f6ea..e43c4ea 100644
--- a/komarov.andrey/src/FCC/Parser.y
+++ b/komarov.andrey/src/FCC/Parser.y
@@ -4,7 +4,9 @@ module FCC.Parser (
 ) where
 
 import FCC.Lexer
-import FCC.AST
+import FCC.Expr
+import FCC.Program
+import FCC.Type
 
 }
 
@@ -25,6 +27,7 @@ import FCC.AST
         '-'             { TokenSub }
         '*'             { TokenMul }
         '&'             { TokenAmp }
+        '!'             { TokenNot }
         '<'             { TokenLess }
         '>'             { TokenGreater }
         '=='            { TokenEqual }
@@ -55,12 +58,57 @@ import FCC.AST
 %nonassoc '<' '>' '<=' '>='
 %left '+' '-'
 %left '*'
-%left '&' DEREF CAST
+%left '&' DEREF CAST '!'
 %nonassoc '[' ']'
 
 
 %%
 
+Expr            :: { Expr String }
+Expr            : var                           { Var $1 }
+                | num                           { Lit $1 }
+                | true                          { LitBool True }
+                | false                         { LitBool False }
+                | '(' Expr ')'                  { $2 }
+                | Expr '+' Expr                 { Call (Var "_builtin_add") [$1, $3] }
+                | Expr '-' Expr                 { Call (Var "_builtin_sub") [$1, $3] }
+                | Expr '*' Expr                 { Call (Var "_builtin_mul") [$1, $3] }
+                | Expr '||' Expr                { Call (Var "_builtin_or") [$1, $3] }
+                | Expr '&&' Expr                { Call (Var "_builtin_and") [$1, $3] }
+                | Expr '^' Expr                 { Call (Var "_builtin_xor") [$1, $3] }
+                | Expr '<' Expr                 { Call (Var "_builtin_less") [$1, $3] }
+                | Expr '<=' Expr                { Call (Var "_builtin_lesseq") [$1, $3] }
+                | Expr '>' Expr                 { Call (Var "_builtin_greater") [$1, $3] }
+                | Expr '>=' Expr                { Call (Var "_builtin_greatereq") [$1, $3] }
+                | Expr '==' Expr                { Eq $1 $3 }
+                | Expr '!=' Expr                { Call (Var "_builtin_not") [Eq $1 $3] }
+                | var '(' FuncCallList ')'      { Call (Var $1) $3 }
+                | Expr '[' Expr ']'             { Array $1 $3 }
+                | Expr '=' Expr                 { Assign $1 $3 }
+                | '{' Stmts '}'                 { $2 }
+
+Stmt            :: { Expr String }
+                : Expr ';'                      { $1 }
+                | if '(' Expr ')' '{' Stmts '}' else '{' Stmts '}' { If $3 $6 $10 }
+                | while '(' Expr ')' '{' Stmts '}' { While $3 $6 }
+                | return Expr ';'               { Return $2 }
+
+Stmts           :: { Expr String }
+Stmts           : {- empty -}                   { Empty }
+                | Stmt Stmts                    { Seq $1 $2 }
+                | Type var ';' Stmts            { declVar $1 $2 $4 }
+
+FuncCallList    :: { [Expr String] }
+FuncCallList    : {- empty -}                   { [] }
+                | Expr                          { [$1] }
+                | Expr ',' FuncCallList         { $1:$3 }
+
+Type            :: { Type }
+Type            : tyvar                         { toPrimitiveType $1 }
+                | Type '*'                      { TArray $1 }
+
+{-
+
 Prog            :: { Program () }
 Prog            : TopLevelDefs                  { Program $1 }
 
@@ -73,61 +121,20 @@ TopLevel        : Type var ';'                  { VarDecl $1 $2 }
                 | Type var '(' FuncArgs ')' ';' { ForwardDecl $2 $1 (map fst $4) }
                 | Type var '(' FuncArgs ')' '{' Stmts '}' { FuncDef $2 $1 $4 (SBlock $7) }
 
-Expr            :: { Expression () }
-Expr            : var                           { EVar $1 }
-                | num                           { ELitInt $1 }
-                | true                          { ELitBool True }
-                | false                         { ELitBool False }
-                | '(' Expr ')'                  { $2 }
-                | Expr '+' Expr                 { EArith AddOp (notag $1) (notag $3) }
-                | Expr '-' Expr                 { EArith SubOp (notag $1) (notag $3) }
-                | Expr '*' Expr                 { EArith MulOp (notag $1) (notag $3) }
-                | Expr '||' Expr                { EBool OrOp (notag $1) (notag $3) }
-                | Expr '&&' Expr                { EBool AndOp (notag $1) (notag $3) }
-                | Expr '^' Expr                 { EBool XorOp (notag $1) (notag $3) }
-                | Expr '<' Expr                 { EArithCmp LessOp (notag $1) (notag $3) }
-                | Expr '<=' Expr                { EArithCmp LessEqOp (notag $1) (notag $3) }
-                | Expr '>' Expr                 { EArithCmp GreaterOp (notag $1) (notag $3) }
-                | Expr '>=' Expr                { EArithCmp GreaterEqOp (notag $1) (notag $3) }
-                | Expr '==' Expr                { EEqual EqOp (notag $1) (notag $3) }
-                | Expr '!=' Expr                { EEqual NeqOp (notag $1) (notag $3) }
-                | var '(' FuncCallList ')'      { ECall $1 (map notag $3) }
-                | '&' Expr                      { EAddr (notag $2) }
-                | '*' Expr %prec DEREF          { EDeref (notag $2) }
-                | Expr '[' Expr ']'             { EArray (notag $1) (notag $3) }
-                | Expr '=' Expr                 { EAssign (notag $1) (notag $3) }
-                | '(' Type ')' Expr %prec CAST  { ECast $2 (notag $4) }
-
-FuncCallList    :: { [Expression ()] }
-FuncCallList    : {- empty -}                   { [] }
-                | Expr                          { [$1] }
-                | Expr ',' FuncCallList         { $1:$3 }
 
-Stmt            :: { Statement () }
-Stmt            : '{' Stmts '}'                 { SBlock $2 }
-                | Type var ';'                  { SVarDecl $1 $2 }
-                | Expr ';'                      { SRawExpr (notag $1) }
-                | if '(' Expr ')' Stmt else Stmt  { SIfThenElse (notag $3) $5 $7 }
-                | while '(' Expr ')' Stmt       { SWhile (notag $3) $5 }
-                | return Expr ';'               { SReturn (notag $2) }
 
-Stmts           :: { [Statement ()] }
-Stmts           : {- empty -}                   { [] }
-                | Stmt Stmts                    { $1:$2 }
 
 FuncArgs        :: { [(Type, Id)] }
 FuncArgs        : {- empty -}                   { [] }
                 | Type var                      { [($1, $2)] }
                 | Type var ',' FuncArgs         { ($1, $2):$4 }
 
-Type            :: { Type }
-Type            : tyvar                         { toPrimitiveType $1 }
-                | Type '*'                      { TPointer $1 }
+ -}
 
 {
 parseError :: Token -> Alex a
 parseError t = alexError $ "Parse error on token " ++ show t
 
-parse :: String -> Either String (Program ())
+parse :: String -> Either String (Expr String)
 parse s = runAlex s parseAlex
 }
diff --git a/komarov.andrey/src/FCC/Program.hs b/komarov.andrey/src/FCC/Program.hs
new file mode 100644
index 00000000..c8d153f
--- /dev/null
+++ b/komarov.andrey/src/FCC/Program.hs
@@ -0,0 +1,25 @@
+module FCC.Program (
+  Function(..),
+  Program(..),
+  function,
+  ) where
+
+import Data.List (elemIndex)
+import Bound
+
+import FCC.Expr
+import FCC.Type
+
+import qualified Data.Map as M
+
+data Function a =
+  Function { argsTypes :: [Type], retType :: Type, body :: Scope Int Expr a }
+  deriving (Eq, Ord, Show)
+
+data Program a =
+  Program { functions :: M.Map a (Function a), variables :: M.Map a Type }
+  deriving (Eq, Ord, Show)
+
+function :: Eq a => [(a, Type)] -> Type -> Expr a -> Function a
+function args ret body = Function (map snd args) ret $
+                         abstract (`elemIndex` (map fst args)) body
diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
new file mode 100644
index 00000000..d4dfc5e
--- /dev/null
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -0,0 +1,30 @@
+module FCC.Stdlib (
+  builtins
+  ) where
+
+import FCC.Type
+import FCC.Expr
+import FCC.Program
+
+native :: [Type] -> Type -> [String] -> Function String
+native args ret body = function (map (\x -> ("_", x)) args) ret (Native body)
+
+builtins :: [(String, Function String)]
+builtins = [
+  ("_builtin_add", native [TInt, TInt] TInt ["pop r0", "pop r1", "add r0, r0, r1", "push r0"])
+ ]
+
+           {-
+                | Expr '+' Expr                 { Call (Var "_builtin_add") [$1, $3] }
+                | Expr '-' Expr                 { Call (Var "_builtin_sub") [$1, $3] }
+                | Expr '*' Expr                 { Call (Var "_builtin_mul") [$1, $3] }
+                | Expr '||' Expr                { Call (Var "_builtin_or") [$1, $3] }
+                | Expr '&&' Expr                { Call (Var "_builtin_and") [$1, $3] }
+                | Expr '^' Expr                 { Call (Var "_builtin_xor") [$1, $3] }
+                | Expr '<' Expr                 { Call (Var "_builtin_less") [$1, $3] }
+                | Expr '<=' Expr                { Call (Var "_builtin_lesseq") [$1, $3] }
+                | Expr '>' Expr                 { Call (Var "_builtin_greater") [$1, $3] }
+                | Expr '>=' Expr                { Call (Var "_builtin_greatereq") [$1, $3] }
+                | Expr '==' Expr                { Eq $1 $3 }
+                | Expr '!=' Expr                { Call (Var "_builtin_not") (Eq $1 $3) }
+-}
diff --git a/komarov.andrey/src/FCC/Type.hs b/komarov.andrey/src/FCC/Type.hs
new file mode 100644
index 00000000..979f2be
--- /dev/null
+++ b/komarov.andrey/src/FCC/Type.hs
@@ -0,0 +1,28 @@
+module FCC.Type (
+  Type(..),
+  toPrimitiveType,
+  ) where
+
+import Data.List (intercalate)
+
+data Type
+  = TInt
+  | TBool
+  | TArray Type
+  | TTuple [Type]
+  | TFun Type Type
+  deriving (Eq, Ord, Show, Read)
+
+toPrimitiveType :: String -> Type
+toPrimitiveType "int" = TInt
+toPrimitiveType "bool" = TBool
+toPrimitiveType t = error $ "BEDA " ++ t
+
+{-
+instance Show Type where
+  show TInt = "int"
+  show TBool = "bool"
+  show (TArray t) = show t ++ "*"
+  show (TTuple ts) = "(" ++ intercalate ", " (map show ts) ++ ")"
+  show (TFun from to) = "{" ++ show from ++ " -> " ++ show to ++ "}"
+-}

From 547d97a4be8ddab804ee9f5159da3b6579a088e9 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Wed, 13 May 2015 16:16:38 +0300
Subject: [PATCH 071/116] new parser works

---
 komarov.andrey/src/FCC/Expr.hs    |  2 +-
 komarov.andrey/src/FCC/Parser.y   | 51 +++++++++++++------------------
 komarov.andrey/src/FCC/Program.hs | 13 ++++++++
 3 files changed, 36 insertions(+), 30 deletions(-)

diff --git a/komarov.andrey/src/FCC/Expr.hs b/komarov.andrey/src/FCC/Expr.hs
index 4804a14..c3183cd 100644
--- a/komarov.andrey/src/FCC/Expr.hs
+++ b/komarov.andrey/src/FCC/Expr.hs
@@ -51,7 +51,7 @@ instance Monad Expr where
   Assign dest src >>= f = Assign (dest >>= f) (src >>= f)
   Array arr ind >>= f = Array (arr >>= f) (ind >>= f)
   Return e >>= f = Return $ e >>= f
-  Native xs >>= _ = Native xs
+  Native xs >>= f = Native xs
 
 declVar :: Eq a => Type -> a -> Expr a -> Expr a
 declVar t x e = Lam t $ abstract1 x e
diff --git a/komarov.andrey/src/FCC/Parser.y b/komarov.andrey/src/FCC/Parser.y
index e43c4ea..02e1ec9 100644
--- a/komarov.andrey/src/FCC/Parser.y
+++ b/komarov.andrey/src/FCC/Parser.y
@@ -26,7 +26,6 @@ import FCC.Type
         '+'             { TokenAdd }
         '-'             { TokenSub }
         '*'             { TokenMul }
-        '&'             { TokenAmp }
         '!'             { TokenNot }
         '<'             { TokenLess }
         '>'             { TokenGreater }
@@ -58,12 +57,15 @@ import FCC.Type
 %nonassoc '<' '>' '<=' '>='
 %left '+' '-'
 %left '*'
-%left '&' DEREF CAST '!'
+%left '!'
 %nonassoc '[' ']'
 
 
 %%
 
+Prog            :: { Program String }
+Prog            : TopLevels                     { program $1 }
+
 Expr            :: { Expr String }
 Expr            : var                           { Var $1 }
                 | num                           { Lit $1 }
@@ -75,14 +77,15 @@ Expr            : var                           { Var $1 }
                 | Expr '*' Expr                 { Call (Var "_builtin_mul") [$1, $3] }
                 | Expr '||' Expr                { Call (Var "_builtin_or") [$1, $3] }
                 | Expr '&&' Expr                { Call (Var "_builtin_and") [$1, $3] }
-                | Expr '^' Expr                 { Call (Var "_builtin_xor") [$1, $3] }
+                | Expr '^' Expr                 { Call (Var "_builtin_xor") [$1, $3] } 
+                | '!' Expr                      { Call (Var "_builtin_not") [$2] }
                 | Expr '<' Expr                 { Call (Var "_builtin_less") [$1, $3] }
                 | Expr '<=' Expr                { Call (Var "_builtin_lesseq") [$1, $3] }
                 | Expr '>' Expr                 { Call (Var "_builtin_greater") [$1, $3] }
                 | Expr '>=' Expr                { Call (Var "_builtin_greatereq") [$1, $3] }
                 | Expr '==' Expr                { Eq $1 $3 }
                 | Expr '!=' Expr                { Call (Var "_builtin_not") [Eq $1 $3] }
-                | var '(' FuncCallList ')'      { Call (Var $1) $3 }
+                | var '(' FunCallList ')'       { Call (Var $1) $3 }
                 | Expr '[' Expr ']'             { Array $1 $3 }
                 | Expr '=' Expr                 { Assign $1 $3 }
                 | '{' Stmts '}'                 { $2 }
@@ -98,43 +101,33 @@ Stmts           : {- empty -}                   { Empty }
                 | Stmt Stmts                    { Seq $1 $2 }
                 | Type var ';' Stmts            { declVar $1 $2 $4 }
 
-FuncCallList    :: { [Expr String] }
-FuncCallList    : {- empty -}                   { [] }
+FunCallList    :: { [Expr String] }
+FunCallList    : {- empty -}                   { [] }
                 | Expr                          { [$1] }
-                | Expr ',' FuncCallList         { $1:$3 }
+                | Expr ',' FunCallList         { $1:$3 }
 
 Type            :: { Type }
 Type            : tyvar                         { toPrimitiveType $1 }
                 | Type '*'                      { TArray $1 }
 
-{-
-
-Prog            :: { Program () }
-Prog            : TopLevelDefs                  { Program $1 }
-
-TopLevelDefs    :: { [TopLevel ()] }
-TopLevelDefs    : {- empty -}                   { [] }
-                | TopLevel TopLevelDefs         { $1:$2 }
-
-TopLevel        :: { TopLevel () }
-TopLevel        : Type var ';'                  { VarDecl $1 $2 }
-                | Type var '(' FuncArgs ')' ';' { ForwardDecl $2 $1 (map fst $4) }
-                | Type var '(' FuncArgs ')' '{' Stmts '}' { FuncDef $2 $1 $4 (SBlock $7) }
+TopLevel        :: { TopLevel String }
+TopLevel        : Type var ';'                  { DeclVar $1 $2 }
+                | Type var '(' FunArgsList ')' '{' Stmts '}' { DeclFun $2 $1 $4 $7 }
 
+FunArgsList     :: { [(String, Type)] }
+FunArgsList     : {- empty -}                   { [] }
+                | Type var                      { [($2, $1)] }
+                | Type var ',' FunArgsList      { ($2, $1):$4 }
 
-
-
-FuncArgs        :: { [(Type, Id)] }
-FuncArgs        : {- empty -}                   { [] }
-                | Type var                      { [($1, $2)] }
-                | Type var ',' FuncArgs         { ($1, $2):$4 }
-
- -}
+TopLevels       :: { [TopLevel String] }
+TopLevels       : {- empty -}                   { [] }
+                | TopLevel TopLevels            { $1:$2 }
 
 {
 parseError :: Token -> Alex a
 parseError t = alexError $ "Parse error on token " ++ show t
 
-parse :: String -> Either String (Expr String)
+parse :: String -> Either String (Program String)
 parse s = runAlex s parseAlex
+
 }
diff --git a/komarov.andrey/src/FCC/Program.hs b/komarov.andrey/src/FCC/Program.hs
index c8d153f..7cbc5f3 100644
--- a/komarov.andrey/src/FCC/Program.hs
+++ b/komarov.andrey/src/FCC/Program.hs
@@ -1,7 +1,9 @@
 module FCC.Program (
   Function(..),
   Program(..),
+  TopLevel(..),
   function,
+  program,
   ) where
 
 import Data.List (elemIndex)
@@ -23,3 +25,14 @@ data Program a =
 function :: Eq a => [(a, Type)] -> Type -> Expr a -> Function a
 function args ret body = Function (map snd args) ret $
                          abstract (`elemIndex` (map fst args)) body
+
+data TopLevel a
+  = DeclVar Type a
+  | DeclFun a Type [(a, Type)] (Expr a)
+
+-- TODO перестать считать, что всё уникально
+program :: Ord a => [TopLevel a] -> Program a
+program ts = Program funs vars where
+  vars = M.fromList [(a, t) | DeclVar t a <- ts]
+  funs = M.fromList [(name, function args ret body) | DeclFun name ret args body <- ts]
+

From 6a64c5aa462670cab1c5d1556169ee22efb7d827 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Wed, 13 May 2015 16:36:06 +0300
Subject: [PATCH 072/116] typechecking started

---
 komarov.andrey/src/FCC/Typecheck.hs      | 22 ++++++++++++++++++++++
 komarov.andrey/src/FCC/TypecheckError.hs |  7 +++++++
 2 files changed, 29 insertions(+)
 create mode 100644 komarov.andrey/src/FCC/Typecheck.hs
 create mode 100644 komarov.andrey/src/FCC/TypecheckError.hs

diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
new file mode 100644
index 00000000..105a3c8
--- /dev/null
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module FCC.Typecheck (
+
+  ) where
+
+import FCC.Type
+import FCC.TypecheckError
+
+import Control.Monad.Reader
+import Control.Monad.Except
+
+import qualified Data.Map as M
+
+type Context a = M.Map a Type
+
+newtype Typecheck a = Typecheck {
+  runTypecheck :: Except TypecheckError a
+  } deriving (Functor, Applicative, Monad, MonadError TypecheckError)
+
+class Typecheckable (f :: * -> *) where
+  typecheck :: f a -> Typecheck (f a, Type)
diff --git a/komarov.andrey/src/FCC/TypecheckError.hs b/komarov.andrey/src/FCC/TypecheckError.hs
new file mode 100644
index 00000000..f8b3ee3
--- /dev/null
+++ b/komarov.andrey/src/FCC/TypecheckError.hs
@@ -0,0 +1,7 @@
+module FCC.TypecheckError (
+  TypecheckError(..),
+  ) where
+
+data TypecheckError
+  = SomethingWentWrong
+    deriving (Eq, Ord, Show, Read)

From 72059fc41e8e190d41882f3000688bd95d20c4fa Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Wed, 13 May 2015 16:41:53 +0300
Subject: [PATCH 073/116] move Native out from Expr

---
 komarov.andrey/src/FCC/Expr.hs      |  2 --
 komarov.andrey/src/FCC/Program.hs   | 11 ++++++++---
 komarov.andrey/src/FCC/Stdlib.hs    |  2 +-
 komarov.andrey/src/FCC/Typecheck.hs | 21 +++++++++++++++++++++
 4 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/komarov.andrey/src/FCC/Expr.hs b/komarov.andrey/src/FCC/Expr.hs
index c3183cd..2fbe7a2 100644
--- a/komarov.andrey/src/FCC/Expr.hs
+++ b/komarov.andrey/src/FCC/Expr.hs
@@ -27,7 +27,6 @@ data Expr a
   | Assign (Expr a) (Expr a)
   | Array (Expr a) (Expr a)
   | Return (Expr a)
-  | Native [String]
   deriving (Eq, Ord, Show, Read)
 
 instance Functor Expr where
@@ -51,7 +50,6 @@ instance Monad Expr where
   Assign dest src >>= f = Assign (dest >>= f) (src >>= f)
   Array arr ind >>= f = Array (arr >>= f) (ind >>= f)
   Return e >>= f = Return $ e >>= f
-  Native xs >>= f = Native xs
 
 declVar :: Eq a => Type -> a -> Expr a -> Expr a
 declVar t x e = Lam t $ abstract1 x e
diff --git a/komarov.andrey/src/FCC/Program.hs b/komarov.andrey/src/FCC/Program.hs
index 7cbc5f3..af243bf 100644
--- a/komarov.andrey/src/FCC/Program.hs
+++ b/komarov.andrey/src/FCC/Program.hs
@@ -14,8 +14,13 @@ import FCC.Type
 
 import qualified Data.Map as M
 
-data Function a =
-  Function { argsTypes :: [Type], retType :: Type, body :: Scope Int Expr a }
+data FunctionBody a
+  = Inner (Scope Int Expr a)
+  | Native [String]
+  deriving (Eq, Ord, Show)
+
+data Function a
+  = Function { argsTypes :: [Type], retType :: Type, body :: FunctionBody a }
   deriving (Eq, Ord, Show)
 
 data Program a =
@@ -24,7 +29,7 @@ data Program a =
 
 function :: Eq a => [(a, Type)] -> Type -> Expr a -> Function a
 function args ret body = Function (map snd args) ret $
-                         abstract (`elemIndex` (map fst args)) body
+                         Inner $ abstract (`elemIndex` (map fst args)) body
 
 data TopLevel a
   = DeclVar Type a
diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index d4dfc5e..6a10002 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -7,7 +7,7 @@ import FCC.Expr
 import FCC.Program
 
 native :: [Type] -> Type -> [String] -> Function String
-native args ret body = function (map (\x -> ("_", x)) args) ret (Native body)
+native args ret body = Function args ret $ Native body
 
 builtins :: [(String, Function String)]
 builtins = [
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 105a3c8..9e9c14d 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -6,6 +6,7 @@ module FCC.Typecheck (
 
 import FCC.Type
 import FCC.TypecheckError
+import FCC.Expr
 
 import Control.Monad.Reader
 import Control.Monad.Except
@@ -20,3 +21,23 @@ newtype Typecheck a = Typecheck {
 
 class Typecheckable (f :: * -> *) where
   typecheck :: f a -> Typecheck (f a, Type)
+
+instance Typecheckable Expr where
+  typecheck 
+
+{-
+  = Var a
+  | Lit Int
+  | LitBool Bool
+  | Lam Type (Scope () Expr a)
+  | Empty
+  | Seq (Expr a) (Expr a)
+  | Call (Expr a) [Expr a]
+  | Eq (Expr a) (Expr a) -- костыль во имя нереализации ad-hoc полиморфизма
+  | While (Expr a) (Expr a)
+  | If (Expr a) (Expr a) (Expr a)
+  | Assign (Expr a) (Expr a)
+  | Array (Expr a) (Expr a)
+  | Return (Expr a)
+  | Native [String]
+-}

From 1a03e84a7a083bb3deb6d87f7edc73eed337fdf0 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Wed, 13 May 2015 17:59:11 +0300
Subject: [PATCH 074/116] typechecking started

---
 komarov.andrey/src/FCC/Expr.hs           |  3 +-
 komarov.andrey/src/FCC/Type.hs           |  5 ++--
 komarov.andrey/src/FCC/Typecheck.hs      | 38 +++++++++++++-----------
 komarov.andrey/src/FCC/TypecheckError.hs | 13 ++++++--
 4 files changed, 35 insertions(+), 24 deletions(-)

diff --git a/komarov.andrey/src/FCC/Expr.hs b/komarov.andrey/src/FCC/Expr.hs
index 2fbe7a2..0cacf21 100644
--- a/komarov.andrey/src/FCC/Expr.hs
+++ b/komarov.andrey/src/FCC/Expr.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveTraversable #-}
 module FCC.Expr (
   Expr(..),
   declVar,
@@ -27,7 +28,7 @@ data Expr a
   | Assign (Expr a) (Expr a)
   | Array (Expr a) (Expr a)
   | Return (Expr a)
-  deriving (Eq, Ord, Show, Read)
+  deriving (Eq, Ord, Show, Read, Foldable, Traversable)
 
 instance Functor Expr where
   fmap = liftM
diff --git a/komarov.andrey/src/FCC/Type.hs b/komarov.andrey/src/FCC/Type.hs
index 979f2be..d839605 100644
--- a/komarov.andrey/src/FCC/Type.hs
+++ b/komarov.andrey/src/FCC/Type.hs
@@ -8,14 +8,15 @@ import Data.List (intercalate)
 data Type
   = TInt
   | TBool
+  | TVoid
   | TArray Type
-  | TTuple [Type]
-  | TFun Type Type
+  | TFun [Type] Type
   deriving (Eq, Ord, Show, Read)
 
 toPrimitiveType :: String -> Type
 toPrimitiveType "int" = TInt
 toPrimitiveType "bool" = TBool
+toPrimitiveType "void" = TVoid
 toPrimitiveType t = error $ "BEDA " ++ t
 
 {-
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 9e9c14d..96b4835 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -23,21 +23,23 @@ class Typecheckable (f :: * -> *) where
   typecheck :: f a -> Typecheck (f a, Type)
 
 instance Typecheckable Expr where
-  typecheck 
-
-{-
-  = Var a
-  | Lit Int
-  | LitBool Bool
-  | Lam Type (Scope () Expr a)
-  | Empty
-  | Seq (Expr a) (Expr a)
-  | Call (Expr a) [Expr a]
-  | Eq (Expr a) (Expr a) -- костыль во имя нереализации ad-hoc полиморфизма
-  | While (Expr a) (Expr a)
-  | If (Expr a) (Expr a) (Expr a)
-  | Assign (Expr a) (Expr a)
-  | Array (Expr a) (Expr a)
-  | Return (Expr a)
-  | Native [String]
--}
+  typecheck (Var v) = _
+  typecheck (Lit i) = return (Lit i, TInt)
+  typecheck (LitBool b) = return (LitBool b, TBool)
+  typecheck (Lam t s) = _
+  typecheck Empty = return (Empty, TVoid)
+  typecheck (Seq e1 e2) = do
+    (e1', _) <- typecheck e1
+    (e2', _) <- typecheck e2
+    return $ (Seq e1' e2', TVoid)
+  typecheck (Call (Var name) args) = _
+  typecheck (Call f args) = throwError $ NotCallable f
+  typecheck (Eq e1 e2) = _
+  typecheck (While cond body) = _
+  typecheck (If cond thn els) = _
+  typecheck (Assign (Var v) val) = _
+  typecheck (Assign (Array a i) val) = _
+  typecheck (Assign dst val) = throwError $ NotAssignable dst
+  typecheck (Array a i) = _
+  typecheck (Return e) = _
+
diff --git a/komarov.andrey/src/FCC/TypecheckError.hs b/komarov.andrey/src/FCC/TypecheckError.hs
index f8b3ee3..671dbf1 100644
--- a/komarov.andrey/src/FCC/TypecheckError.hs
+++ b/komarov.andrey/src/FCC/TypecheckError.hs
@@ -1,7 +1,14 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
 module FCC.TypecheckError (
   TypecheckError(..),
   ) where
 
-data TypecheckError
-  = SomethingWentWrong
-    deriving (Eq, Ord, Show, Read)
+import FCC.Expr
+
+data TypecheckError where
+  SomethingWentWrong :: TypecheckError
+  NotCallable :: Show a => Expr a -> TypecheckError
+  NotAssignable :: Show a => Expr a -> TypecheckError
+
+deriving instance Show TypecheckError

From b1defc4b7bd604e78eebbbe6fef16c4477b95def Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Wed, 13 May 2015 19:03:19 +0300
Subject: [PATCH 075/116] typecheck almost finished

---
 komarov.andrey/src/FCC/Typecheck.hs      | 82 ++++++++++++++++++++----
 komarov.andrey/src/FCC/TypecheckError.hs | 12 ++++
 2 files changed, 81 insertions(+), 13 deletions(-)

diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 96b4835..7099bac 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FunctionalDependencies #-}
 module FCC.Typecheck (
 
   ) where
@@ -13,17 +14,28 @@ import Control.Monad.Except
 
 import qualified Data.Map as M
 
-type Context a = M.Map a Type
+data Context a = Context {
+  bindings :: M.Map a Type,
+  expectedRetType :: Type
+  }
+
+lookupType :: Ord a => a -> Context a -> Maybe Type
+lookupType v ctx = M.lookup v (bindings ctx)
 
 newtype Typecheck a = Typecheck {
-  runTypecheck :: Except TypecheckError a
-  } deriving (Functor, Applicative, Monad, MonadError TypecheckError)
+  runTypecheck :: ReaderT (Context String) (Except TypecheckError) a
+  } deriving (Functor, Applicative, Monad,
+              MonadError TypecheckError, MonadReader (Context String))
 
 class Typecheckable (f :: * -> *) where
   typecheck :: f a -> Typecheck (f a, Type)
 
 instance Typecheckable Expr where
-  typecheck (Var v) = _
+  typecheck (Var v) = do
+    ctx <- asks $ lookupType v
+    case ctx of
+     Nothing -> throwError $ UnboundVariable v
+     Just t -> return (Var v, t)
   typecheck (Lit i) = return (Lit i, TInt)
   typecheck (LitBool b) = return (LitBool b, TBool)
   typecheck (Lam t s) = _
@@ -32,14 +44,58 @@ instance Typecheckable Expr where
     (e1', _) <- typecheck e1
     (e2', _) <- typecheck e2
     return $ (Seq e1' e2', TVoid)
-  typecheck (Call (Var name) args) = _
+  typecheck (Call f@(Var _) args) = do
+    (f', tf) <- typecheck f
+    args' <- mapM typecheck args
+    let targs = fmap snd args'
+    (tfargs, tfret) <- case tf of
+      TFun ta t -> return (ta, t)
+      t -> throwError $ NotAFunction t f
+    when (targs /= tfargs) $ throwError $ ArgumentsTypesDiffer targs tfargs f
+    return (f', tfret)
   typecheck (Call f args) = throwError $ NotCallable f
-  typecheck (Eq e1 e2) = _
-  typecheck (While cond body) = _
-  typecheck (If cond thn els) = _
-  typecheck (Assign (Var v) val) = _
-  typecheck (Assign (Array a i) val) = _
+  typecheck (Eq e1 e2) = do
+    (e1', te1) <- typecheck e1
+    (e2', te2) <- typecheck e2
+    when (te1 /= te2) $ throwError $ EqTypesDiffer te1 te2 e1 e2
+    let select fname = return (Call (Var fname) [e1', e2'], TBool)
+    case te1 of
+     TInt -> select "_builtin_eq_int"
+     TBool -> select "_builtin_eq_bool"
+     TArray _ -> select "_builtin_eq_ptr"
+     t -> throwError $ UnsupportedTypeForEq te1 e1 e2
+  typecheck (While cond body) = do
+    (cond', tcond) <- typecheck cond
+    (body', tbody) <- typecheck body
+    when (tcond /= TBool) $ throwError $ WhileConditionIsNotBool tcond cond
+    return (While cond' body', TVoid)
+  typecheck (If cond thn els) = do
+    (cond', tcond) <- typecheck cond
+    (thn', tthn) <- typecheck thn
+    (els', tels) <- typecheck els
+    when (tcond /= TBool) $ throwError $ IfConditionIsNotBool tcond cond
+    return (If cond' thn' els', TVoid)
+  typecheck (Assign v@(Var _) val) = do
+    (v', tv) <- typecheck v
+    (val', tval) <- typecheck val
+    when (tv /= tval) $ throwError $ AssignTypeMismatch tv tval v val
+    return (Assign v' val', TVoid)
+  typecheck (Assign ai@(Array _ _) val) = do
+    (ai', tai) <- typecheck ai
+    (val', tval) <- typecheck val
+    when (tai /= tval) $ throwError $ AssignTypeMismatch tai tval ai val
+    return (Assign ai' val', TVoid)
   typecheck (Assign dst val) = throwError $ NotAssignable dst
-  typecheck (Array a i) = _
-  typecheck (Return e) = _
-
+  typecheck (Array a i) = do
+    (a', ta) <- typecheck a
+    (i', ti) <- typecheck i
+    ta' <- case ta of
+      TArray x -> return x
+      t -> throwError $ NotAnArray ta a
+    when (ti /= TInt) $ throwError $ IndexIsNotInt ti i
+    return $ (Array a' i', ta')
+  typecheck (Return e) = do
+    (e', te) <- typecheck e
+    tret <- asks expectedRetType
+    when (te /= tret) $ throwError $ WrongReturnType te tret e
+    return (Return e', TVoid)
diff --git a/komarov.andrey/src/FCC/TypecheckError.hs b/komarov.andrey/src/FCC/TypecheckError.hs
index 671dbf1..9f3fabf 100644
--- a/komarov.andrey/src/FCC/TypecheckError.hs
+++ b/komarov.andrey/src/FCC/TypecheckError.hs
@@ -4,11 +4,23 @@ module FCC.TypecheckError (
   TypecheckError(..),
   ) where
 
+import FCC.Type
 import FCC.Expr
 
 data TypecheckError where
   SomethingWentWrong :: TypecheckError
   NotCallable :: Show a => Expr a -> TypecheckError
   NotAssignable :: Show a => Expr a -> TypecheckError
+  NotAnArray :: Show a => Type -> Expr a -> TypecheckError
+  IndexIsNotInt :: Show a => Type -> Expr a -> TypecheckError
+  WhileConditionIsNotBool :: Show a => Type -> Expr a -> TypecheckError
+  IfConditionIsNotBool :: Show a => Type -> Expr a -> TypecheckError
+  UnboundVariable :: Show a => a -> TypecheckError
+  EqTypesDiffer :: Show a => Type -> Type -> Expr a -> Expr a -> TypecheckError
+  UnsupportedTypeForEq :: Show a => Type -> Expr a -> Expr a -> TypecheckError
+  NotAFunction :: Show a => Type -> Expr a -> TypecheckError
+  ArgumentsTypesDiffer :: Show a => [Type] -> [Type] -> Expr a -> TypecheckError
+  AssignTypeMismatch :: Show a => Type -> Type -> Expr a -> Expr a -> TypecheckError
+  WrongReturnType :: Show a => Type -> Type -> Expr a -> TypecheckError
 
 deriving instance Show TypecheckError

From a61ad6381ae4ce5465f3c44657695eb08db431a7 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Wed, 13 May 2015 19:39:19 +0300
Subject: [PATCH 076/116] idea how to finish typechecker for Expr

---
 komarov.andrey/src/FCC/Typecheck.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 7099bac..d6c4372 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -9,6 +9,7 @@ import FCC.Type
 import FCC.TypecheckError
 import FCC.Expr
 
+import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Except
 
@@ -23,10 +24,12 @@ lookupType :: Ord a => a -> Context a -> Maybe Type
 lookupType v ctx = M.lookup v (bindings ctx)
 
 newtype Typecheck a = Typecheck {
-  runTypecheck :: ReaderT (Context String) (Except TypecheckError) a
+  runTypecheck :: StateT Int (ReaderT (Context String) (Except TypecheckError)) a
   } deriving (Functor, Applicative, Monad,
-              MonadError TypecheckError, MonadReader (Context String))
+              MonadError TypecheckError, MonadReader (Context String), MonadState Int)
 
+-- TODO Сделать слева более предсказуемый тип, для которого можно
+-- генерить свежие имена (да хоть тупо String)
 class Typecheckable (f :: * -> *) where
   typecheck :: f a -> Typecheck (f a, Type)
 

From cbbdb23871f3b95d953becc6eac0d8e268b8b3ff Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 14 May 2015 03:10:45 +0300
Subject: [PATCH 077/116] need to think

---
 komarov.andrey/src/FCC/Typecheck.hs | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index d6c4372..eb0ccfc 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -23,15 +23,19 @@ data Context a = Context {
 lookupType :: Ord a => a -> Context a -> Maybe Type
 lookupType v ctx = M.lookup v (bindings ctx)
 
+fresh :: Typecheck String
+fresh = do
+  cnt <- get
+  modify (+1)
+  return $ "var_" ++ show cnt
+
 newtype Typecheck a = Typecheck {
   runTypecheck :: StateT Int (ReaderT (Context String) (Except TypecheckError)) a
   } deriving (Functor, Applicative, Monad,
               MonadError TypecheckError, MonadReader (Context String), MonadState Int)
 
--- TODO Сделать слева более предсказуемый тип, для которого можно
--- генерить свежие имена (да хоть тупо String)
 class Typecheckable (f :: * -> *) where
-  typecheck :: f a -> Typecheck (f a, Type)
+  typecheck :: f String -> Typecheck (f String, Type)
 
 instance Typecheckable Expr where
   typecheck (Var v) = do
@@ -41,7 +45,12 @@ instance Typecheckable Expr where
      Just t -> return (Var v, t)
   typecheck (Lit i) = return (Lit i, TInt)
   typecheck (LitBool b) = return (LitBool b, TBool)
-  typecheck (Lam t s) = _
+  typecheck (Lam t s) = do
+    var <- fresh
+    _ -- как пробросить тип var вглубь? Не делать же большой мап в
+    -- контексте Может, закодировать тип в имени переменной?
+    -- `Expr (Type, String)`. Будет даже проще. Для кодогенератора
+      -- можно даже кодировать локальная ли переменная и как получать доступ
   typecheck Empty = return (Empty, TVoid)
   typecheck (Seq e1 e2) = do
     (e1', _) <- typecheck e1

From 1fe61834fb427bce54c73a1744621a1731f3d9cb Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Thu, 14 May 2015 18:42:53 +0300
Subject: [PATCH 078/116] Expr's typecheck finished

---
 komarov.andrey/src/FCC/Typecheck.hs | 40 ++++++++++++-----------------
 1 file changed, 17 insertions(+), 23 deletions(-)

diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index eb0ccfc..c10cb9e 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
 module FCC.Typecheck (
 
   ) where
@@ -9,20 +10,18 @@ import FCC.Type
 import FCC.TypecheckError
 import FCC.Expr
 
+import Bound
+
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Except
 
 import qualified Data.Map as M
 
-data Context a = Context {
-  bindings :: M.Map a Type,
+data Context = Context {
   expectedRetType :: Type
   }
 
-lookupType :: Ord a => a -> Context a -> Maybe Type
-lookupType v ctx = M.lookup v (bindings ctx)
-
 fresh :: Typecheck String
 fresh = do
   cnt <- get
@@ -30,27 +29,22 @@ fresh = do
   return $ "var_" ++ show cnt
 
 newtype Typecheck a = Typecheck {
-  runTypecheck :: StateT Int (ReaderT (Context String) (Except TypecheckError)) a
+  runTypecheck :: StateT Int (ReaderT Context (Except TypecheckError)) a
   } deriving (Functor, Applicative, Monad,
-              MonadError TypecheckError, MonadReader (Context String), MonadState Int)
+              MonadError TypecheckError, MonadReader Context, MonadState Int)
 
-class Typecheckable (f :: * -> *) where
-  typecheck :: f String -> Typecheck (f String, Type)
+class Typecheckable (f :: * -> *) t | f -> t where
+  typecheck :: f t -> Typecheck (f t, Type)
 
-instance Typecheckable Expr where
-  typecheck (Var v) = do
-    ctx <- asks $ lookupType v
-    case ctx of
-     Nothing -> throwError $ UnboundVariable v
-     Just t -> return (Var v, t)
+instance Typecheckable Expr (String, Type) where
+  typecheck v@(Var (_, t)) = do
+    return (v, t)
   typecheck (Lit i) = return (Lit i, TInt)
   typecheck (LitBool b) = return (LitBool b, TBool)
   typecheck (Lam t s) = do
     var <- fresh
-    _ -- как пробросить тип var вглубь? Не делать же большой мап в
-    -- контексте Может, закодировать тип в имени переменной?
-    -- `Expr (Type, String)`. Будет даже проще. Для кодогенератора
-      -- можно даже кодировать локальная ли переменная и как получать доступ
+    (e, te) <- typecheck $ instantiate1 (Var (var, t)) s
+    return (Lam t (abstract1 (var, t) e), te)
   typecheck Empty = return (Empty, TVoid)
   typecheck (Seq e1 e2) = do
     (e1', _) <- typecheck e1
@@ -70,11 +64,11 @@ instance Typecheckable Expr where
     (e1', te1) <- typecheck e1
     (e2', te2) <- typecheck e2
     when (te1 /= te2) $ throwError $ EqTypesDiffer te1 te2 e1 e2
-    let select fname = return (Call (Var fname) [e1', e2'], TBool)
+    let select fname t = return (Call (Var (fname, TFun [t, t] TBool)) [e1', e2'], TBool)
     case te1 of
-     TInt -> select "_builtin_eq_int"
-     TBool -> select "_builtin_eq_bool"
-     TArray _ -> select "_builtin_eq_ptr"
+     TInt -> select "_builtin_eq_int" TInt
+     TBool -> select "_builtin_eq_bool" TBool
+     TArray a -> select "_builtin_eq_ptr" (TArray a)
      t -> throwError $ UnsupportedTypeForEq te1 e1 e2
   typecheck (While cond body) = do
     (cond', tcond) <- typecheck cond

From 0326a35f2921e5b792a4eb2d030e947fb36d393c Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Sat, 16 May 2015 18:20:59 +0300
Subject: [PATCH 079/116] typecheck

---
 komarov.andrey/src/FCC/Typecheck.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index c10cb9e..1f46cde 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -9,6 +9,7 @@ module FCC.Typecheck (
 import FCC.Type
 import FCC.TypecheckError
 import FCC.Expr
+import FCC.Program
 
 import Bound
 
@@ -36,6 +37,9 @@ newtype Typecheck a = Typecheck {
 class Typecheckable (f :: * -> *) t | f -> t where
   typecheck :: f t -> Typecheck (f t, Type)
 
+instance Typecheckable Program String where
+  typecheck _ = _
+
 instance Typecheckable Expr (String, Type) where
   typecheck v@(Var (_, t)) = do
     return (v, t)

From 196d79de5561ca46e8ca4b243ade1f03a6484c70 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 17 May 2015 15:19:34 +0300
Subject: [PATCH 080/116] typecheck finished

---
 komarov.andrey/src/FCC/Program.hs   |  1 +
 komarov.andrey/src/FCC/Typecheck.hs | 46 +++++++++++++++++++++++------
 2 files changed, 38 insertions(+), 9 deletions(-)

diff --git a/komarov.andrey/src/FCC/Program.hs b/komarov.andrey/src/FCC/Program.hs
index af243bf..ce6ab48 100644
--- a/komarov.andrey/src/FCC/Program.hs
+++ b/komarov.andrey/src/FCC/Program.hs
@@ -2,6 +2,7 @@ module FCC.Program (
   Function(..),
   Program(..),
   TopLevel(..),
+  FunctionBody(..),
   function,
   program,
   ) where
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 1f46cde..2008645 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -13,11 +13,14 @@ import FCC.Program
 
 import Bound
 
+import Data.Foldable
+import Data.List (elemIndex)
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Except
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 data Context = Context {
   expectedRetType :: Type
@@ -27,7 +30,7 @@ fresh :: Typecheck String
 fresh = do
   cnt <- get
   modify (+1)
-  return $ "var_" ++ show cnt
+  return $ "_var_" ++ show cnt
 
 newtype Typecheck a = Typecheck {
   runTypecheck :: StateT Int (ReaderT Context (Except TypecheckError)) a
@@ -38,7 +41,32 @@ class Typecheckable (f :: * -> *) t | f -> t where
   typecheck :: f t -> Typecheck (f t, Type)
 
 instance Typecheckable Program String where
-  typecheck _ = _
+  typecheck (Program funs vars) = do
+    when (not (S.null unboundVars)) $ throwError $ UnboundVariables (S.toList unboundVars)
+    funs' <- traverse ff funs
+    return $ (Program funs' vars, TVoid)
+    where
+    allFreeVars = S.fromList $ concatMap freeVars $ M.elems funs
+    allBoundVars = S.fromList $ M.keys funs ++ M.keys vars
+    unboundVars = allFreeVars S.\\ allBoundVars
+  
+    freeVars :: Function String -> [String]
+    freeVars f = case body f of
+      Inner s -> toList s
+      Native _ -> []
+
+    ff :: Function String -> Typecheck (Function String)
+    ff f@Function {body = Native{}} = return f
+    ff (Function argTypes ret (Inner s)) = do
+      argNames <- sequence [fresh | _ <- argTypes]
+      let e = instantiate ((map Var argNames) !!) s
+          args = M.fromList $ zip argNames argTypes
+          funs' = fmap (\(Function a r _) -> TFun a r) funs
+          allTypes = args `M.union` funs' `M.union` vars
+      (e', _) <- local (const $ Context ret) $
+                  typecheck $ fmap (\n -> (n, allTypes M.! n)) e
+      let s' = abstract (`elemIndex` argNames) $ fmap fst e'
+      return $ Function argTypes ret (Inner s')
 
 instance Typecheckable Expr (String, Type) where
   typecheck v@(Var (_, t)) = do
@@ -63,7 +91,7 @@ instance Typecheckable Expr (String, Type) where
       t -> throwError $ NotAFunction t f
     when (targs /= tfargs) $ throwError $ ArgumentsTypesDiffer targs tfargs f
     return (f', tfret)
-  typecheck (Call f args) = throwError $ NotCallable f
+  typecheck (Call f _) = throwError $ NotCallable f
   typecheck (Eq e1 e2) = do
     (e1', te1) <- typecheck e1
     (e2', te2) <- typecheck e2
@@ -73,16 +101,16 @@ instance Typecheckable Expr (String, Type) where
      TInt -> select "_builtin_eq_int" TInt
      TBool -> select "_builtin_eq_bool" TBool
      TArray a -> select "_builtin_eq_ptr" (TArray a)
-     t -> throwError $ UnsupportedTypeForEq te1 e1 e2
+     _ -> throwError $ UnsupportedTypeForEq te1 e1 e2
   typecheck (While cond body) = do
     (cond', tcond) <- typecheck cond
-    (body', tbody) <- typecheck body
+    (body', _) <- typecheck body
     when (tcond /= TBool) $ throwError $ WhileConditionIsNotBool tcond cond
     return (While cond' body', TVoid)
   typecheck (If cond thn els) = do
     (cond', tcond) <- typecheck cond
-    (thn', tthn) <- typecheck thn
-    (els', tels) <- typecheck els
+    (thn', _) <- typecheck thn
+    (els', _) <- typecheck els
     when (tcond /= TBool) $ throwError $ IfConditionIsNotBool tcond cond
     return (If cond' thn' els', TVoid)
   typecheck (Assign v@(Var _) val) = do
@@ -95,13 +123,13 @@ instance Typecheckable Expr (String, Type) where
     (val', tval) <- typecheck val
     when (tai /= tval) $ throwError $ AssignTypeMismatch tai tval ai val
     return (Assign ai' val', TVoid)
-  typecheck (Assign dst val) = throwError $ NotAssignable dst
+  typecheck (Assign dst _) = throwError $ NotAssignable dst
   typecheck (Array a i) = do
     (a', ta) <- typecheck a
     (i', ti) <- typecheck i
     ta' <- case ta of
       TArray x -> return x
-      t -> throwError $ NotAnArray ta a
+      _ -> throwError $ NotAnArray ta a
     when (ti /= TInt) $ throwError $ IndexIsNotInt ti i
     return $ (Array a' i', ta')
   typecheck (Return e) = do

From 7cde92461791ac6a84ed563230559123b970df3e Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Sun, 17 May 2015 15:35:36 +0300
Subject: [PATCH 081/116] run typecheck

---
 komarov.andrey/src/FCC/Expr.hs      |  1 +
 komarov.andrey/src/FCC/Typecheck.hs | 11 ++++++++---
 komarov.andrey/src/Main.hs          |  3 ++-
 3 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/komarov.andrey/src/FCC/Expr.hs b/komarov.andrey/src/FCC/Expr.hs
index 0cacf21..1f245e5 100644
--- a/komarov.andrey/src/FCC/Expr.hs
+++ b/komarov.andrey/src/FCC/Expr.hs
@@ -41,6 +41,7 @@ instance Monad Expr where
   return = Var
   Var a >>= f = f a
   Lit i >>= _ = Lit i
+  LitBool b >>= _ = LitBool b
   Lam t scope >>= f = Lam t $ scope >>>= f
   Empty >>= f = Empty
   Seq e1 e2 >>= f = Seq (e1 >>= f) (e2 >>= f)
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 2008645..94c66d9 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -3,13 +3,14 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE FlexibleInstances #-}
 module FCC.Typecheck (
-
+  runTC,
   ) where
 
 import FCC.Type
 import FCC.TypecheckError
 import FCC.Expr
 import FCC.Program
+import FCC.Stdlib
 
 import Bound
 
@@ -37,6 +38,9 @@ newtype Typecheck a = Typecheck {
   } deriving (Functor, Applicative, Monad,
               MonadError TypecheckError, MonadReader Context, MonadState Int)
 
+runTC :: Program String -> Either TypecheckError (Program String)
+runTC prog = fmap (fst . fst) $ runExcept $ runReaderT (runStateT (runTypecheck $ typecheck prog) 0) (Context TVoid)
+
 class Typecheckable (f :: * -> *) t | f -> t where
   typecheck :: f t -> Typecheck (f t, Type)
 
@@ -47,7 +51,7 @@ instance Typecheckable Program String where
     return $ (Program funs' vars, TVoid)
     where
     allFreeVars = S.fromList $ concatMap freeVars $ M.elems funs
-    allBoundVars = S.fromList $ M.keys funs ++ M.keys vars
+    allBoundVars = S.fromList $ M.keys funs ++ M.keys vars ++ map fst builtins
     unboundVars = allFreeVars S.\\ allBoundVars
   
     freeVars :: Function String -> [String]
@@ -61,7 +65,8 @@ instance Typecheckable Program String where
       argNames <- sequence [fresh | _ <- argTypes]
       let e = instantiate ((map Var argNames) !!) s
           args = M.fromList $ zip argNames argTypes
-          funs' = fmap (\(Function a r _) -> TFun a r) funs
+          builtins' = M.fromList builtins
+          funs' = fmap (\(Function a r _) -> TFun a r) $ funs `M.union` builtins'
           allTypes = args `M.union` funs' `M.union` vars
       (e', _) <- local (const $ Context ret) $
                   typecheck $ fmap (\n -> (n, allTypes M.! n)) e
diff --git a/komarov.andrey/src/Main.hs b/komarov.andrey/src/Main.hs
index d13a504..f2f611b 100644
--- a/komarov.andrey/src/Main.hs
+++ b/komarov.andrey/src/Main.hs
@@ -1,6 +1,7 @@
 module Main where
 
 import FCC.Parser
+import FCC.Typecheck
 
 main :: IO ()
 main = do
@@ -8,4 +9,4 @@ main = do
   let p = parse input
   case p of
    Left e -> putStrLn $ "failed to parse: " ++ show e
-   Right x -> print x
+   Right x -> print $ runTC x

From 6a40feae51366adb15a9bde4b3589a5c0d20a914 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Mon, 18 May 2015 01:22:17 +0300
Subject: [PATCH 082/116] codegen started

---
 komarov.andrey/src/FCC/Codegen.hs   | 83 +++++++++++++++++++++++++++++
 komarov.andrey/src/FCC/Expr.hs      |  2 +
 komarov.andrey/src/FCC/Parser.y     |  2 +-
 komarov.andrey/src/FCC/Typecheck.hs |  3 ++
 4 files changed, 89 insertions(+), 1 deletion(-)
 create mode 100644 komarov.andrey/src/FCC/Codegen.hs

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
new file mode 100644
index 00000000..93b8e61
--- /dev/null
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+module FCC.Codegen (
+
+  ) where
+
+import FCC.Expr
+import FCC.Program
+
+import Bound
+
+import Control.Monad.State
+
+impossible = error "Internal compiler error. Please submit a bug-report."
+
+data Binding = Local Int | Global String
+                           deriving (Eq, Ord, Show, Read)
+
+data CodegenState = CodegenState { offset :: Int, counter :: Int }
+
+modifyOffset :: MonadState CodegenState m => (Int -> Int) -> m ()
+modifyOffset f = modify $ \s@(CodegenState{offset = o}) -> s{offset = f o}
+
+newtype Codegen a = Codegen {
+  runCodegen :: State CodegenState a
+  } deriving (Functor, Applicative, Monad, MonadState CodegenState)
+
+fresh :: String -> Codegen String
+fresh pref = do
+  x <- gets counter
+  modify (\s -> s{counter = x + 1})
+  return $ pref ++ show x
+
+freshLabel :: Codegen String
+freshLabel = fresh "_label_"
+
+freshVar :: Codegen String
+freshVar = fresh "_var_"
+
+codegen :: Program a -> [String] 
+codegen = _
+
+compileE :: Expr Binding -> Codegen [String]
+compileE (Var (Local off)) = return ["ldr r0, [fp, #" ++ show off ++"]", "push r0"]
+compileE (Var (Global name)) = return ["ldr r0, " ++ show name, "push r0"]
+compileE (Lit i) = return ["push =" ++ show i]
+compileE (LitBool True) = return ["push #1\t\t@ true"]
+compileE (LitBool False) = return ["push #0\t\t@ false"]
+compileE (Lam t s) = do
+  v <- freshVar
+  off <- gets offset
+  modifyOffset (+4) -- TODO посчитать максимальный offset
+  code <- compileE $ instantiate1 (Var (Local off)) s
+  modifyOffset (-4)
+  return code
+compileE Empty = return []
+compileE (Pop e) = do
+  code <- compileE e
+  return $ code ++ ["pop r0"]
+compileE (Seq e1 e2) = (++) <$> compileE e1 <*> compileE e2
+compileE (Call f args) = _
+compileE (Eq _ _) = impossible
+compileE (While cond body) = _
+compileE (If cont thn els) = _
+compileE (Assign (Var (Local off)) src) = do
+  code <- compileE src
+  return $ code ++ ["pop r0", "str r0, [fp, #" ++ show (off * 4) ++ "]", "push r0"]
+compileE (Assign (Var (Global name)) src) = do
+  code <- compileE src
+  return $ code ++ ["pop r0", "ldr r1, " ++ show name, "str r0, [r1]", "push r0"]
+compileE (Assign (Array a i) src) = do
+  codea <- compileE a
+  codei <- compileE i
+  code <- compileE src
+  return $ codea ++ codei ++ code ++ ["pop r0\t\t@ b", "pop r1\t\t@ i", "pop r2\t\t@ a", "str r0, [r2, r1, LSL #2]", "push r0"]
+compileE (Assign _ _) = impossible
+compileE (Array a i) = do
+  codea <- compileE a
+  codei <- compileE i
+  return $ codea ++ codei ++ ["pop r1", "pop r0", "ldr r0, [r0, r1, LSL #2]", "push r0"]
+compileE (Return e) = do
+  code <- compileE e
+  return $ code ++ ["pop r0", "mov sp, fp", "pop {fp, lr}", "mov pc, lr"]
diff --git a/komarov.andrey/src/FCC/Expr.hs b/komarov.andrey/src/FCC/Expr.hs
index 1f245e5..e48ff6e 100644
--- a/komarov.andrey/src/FCC/Expr.hs
+++ b/komarov.andrey/src/FCC/Expr.hs
@@ -20,6 +20,7 @@ data Expr a
   | LitBool Bool
   | Lam Type (Scope () Expr a)
   | Empty
+  | Pop (Expr a)
   | Seq (Expr a) (Expr a)
   | Call (Expr a) [Expr a]
   | Eq (Expr a) (Expr a) -- костыль во имя нереализации ad-hoc полиморфизма
@@ -44,6 +45,7 @@ instance Monad Expr where
   LitBool b >>= _ = LitBool b
   Lam t scope >>= f = Lam t $ scope >>>= f
   Empty >>= f = Empty
+  Pop e >>= f = Pop $ e >>= f
   Seq e1 e2 >>= f = Seq (e1 >>= f) (e2 >>= f)
   Call fun args >>= f = Call (fun >>= f) $ fmap (>>= f) args
   Eq e1 e2 >>= f = Eq (e1 >>= f) (e2 >>= f)
diff --git a/komarov.andrey/src/FCC/Parser.y b/komarov.andrey/src/FCC/Parser.y
index 02e1ec9..687f646 100644
--- a/komarov.andrey/src/FCC/Parser.y
+++ b/komarov.andrey/src/FCC/Parser.y
@@ -91,7 +91,7 @@ Expr            : var                           { Var $1 }
                 | '{' Stmts '}'                 { $2 }
 
 Stmt            :: { Expr String }
-                : Expr ';'                      { $1 }
+                : Expr ';'                      { Pop $1 }
                 | if '(' Expr ')' '{' Stmts '}' else '{' Stmts '}' { If $3 $6 $10 }
                 | while '(' Expr ')' '{' Stmts '}' { While $3 $6 }
                 | return Expr ';'               { Return $2 }
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 94c66d9..d9dd7a8 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -83,6 +83,9 @@ instance Typecheckable Expr (String, Type) where
     (e, te) <- typecheck $ instantiate1 (Var (var, t)) s
     return (Lam t (abstract1 (var, t) e), te)
   typecheck Empty = return (Empty, TVoid)
+  typecheck (Pop e) = do
+    (e', te) <- typecheck e
+    return (Pop e', te)
   typecheck (Seq e1 e2) = do
     (e1', _) <- typecheck e1
     (e2', _) <- typecheck e2

From c357694ad911b9a64eb7da097da77f2bf37b6230 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Mon, 18 May 2015 23:42:31 +0300
Subject: [PATCH 083/116] codegen for expr finished

---
 komarov.andrey/src/FCC/Codegen.hs | 41 +++++++++++++++++++++++--------
 1 file changed, 31 insertions(+), 10 deletions(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index 93b8e61..d13917d 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -13,13 +13,14 @@ import Control.Monad.State
 
 impossible = error "Internal compiler error. Please submit a bug-report."
 
-data Binding = Local Int | Global String
+data Binding = Local Int | Global String | Arg Int
                            deriving (Eq, Ord, Show, Read)
 
-data CodegenState = CodegenState { offset :: Int, counter :: Int }
+data CodegenState = CodegenState { offset :: Int, counter :: Int, maxOffset :: Int }
 
 modifyOffset :: MonadState CodegenState m => (Int -> Int) -> m ()
-modifyOffset f = modify $ \s@(CodegenState{offset = o}) -> s{offset = f o}
+modifyOffset f = modify $ \s@(CodegenState{maxOffset = m, offset = o})
+                          -> s{maxOffset = m `max` o, offset = f o}
 
 newtype Codegen a = Codegen {
   runCodegen :: State CodegenState a
@@ -41,33 +42,53 @@ codegen :: Program a -> [String]
 codegen = _
 
 compileE :: Expr Binding -> Codegen [String]
-compileE (Var (Local off)) = return ["ldr r0, [fp, #" ++ show off ++"]", "push r0"]
+compileE (Var (Local off)) = return ["ldr r0, [fp, #-" ++ show (off * 4) ++"]", "push r0"]
 compileE (Var (Global name)) = return ["ldr r0, " ++ show name, "push r0"]
+compileE (Var (Arg arg)) = return ["ldr r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push r0"]
 compileE (Lit i) = return ["push =" ++ show i]
 compileE (LitBool True) = return ["push #1\t\t@ true"]
 compileE (LitBool False) = return ["push #0\t\t@ false"]
 compileE (Lam t s) = do
   v <- freshVar
   off <- gets offset
-  modifyOffset (+4) -- TODO посчитать максимальный offset
+  modifyOffset (+1)
   code <- compileE $ instantiate1 (Var (Local off)) s
-  modifyOffset (-4)
+  modifyOffset (-1)
   return code
 compileE Empty = return []
 compileE (Pop e) = do
   code <- compileE e
   return $ code ++ ["pop r0"]
 compileE (Seq e1 e2) = (++) <$> compileE e1 <*> compileE e2
-compileE (Call f args) = _
+compileE (Call (Var (Global fname)) args) = do
+  compiledArgs <- reverse <$> concat <$> mapM compileE args
+  return $ compiledArgs ++ ["bl " ++ fname]
+compileE (Call _ _) = impossible
 compileE (Eq _ _) = impossible
-compileE (While cond body) = _
-compileE (If cont thn els) = _
+compileE (While cond body) = do
+  begin <- freshLabel
+  end <- freshLabel
+  cond' <- compileE cond
+  body' <- compileE body
+  return $ [begin ++ ": @ while"] ++ cond' ++ ["pop r0", "tst r0, r0", "bz " ++ end] ++ body' ++ [end ++ ": @ endwhile"]
+compileE (If cond thn els) = do
+  elseLabel <- freshLabel
+  endIfLabel <- freshLabel
+  cond' <- compileE cond
+  thn' <- compileE thn
+  els' <- compileE els
+  return $ cond' ++ ["pop r0", "tst r0, r0", "bz " ++ elseLabel]
+    ++ thn' ++ ["b " ++ endIfLabel, elseLabel ++ ": @ else:"]
+    ++ els' ++ [endIfLabel ++ ": @ endif"]
 compileE (Assign (Var (Local off)) src) = do
   code <- compileE src
-  return $ code ++ ["pop r0", "str r0, [fp, #" ++ show (off * 4) ++ "]", "push r0"]
+  return $ code ++ ["pop r0", "str r0, [fp, #-" ++ show (off * 4) ++ "]", "push r0"]
 compileE (Assign (Var (Global name)) src) = do
   code <- compileE src
   return $ code ++ ["pop r0", "ldr r1, " ++ show name, "str r0, [r1]", "push r0"]
+compileE (Assign (Var (Arg arg)) src) = do
+  code <- compileE src
+  return $ code ++ ["pop r0", "str r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push r0"]
 compileE (Assign (Array a i) src) = do
   codea <- compileE a
   codei <- compileE i

From 6d9c8fa890c58859847029e928471491123905d9 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 19 May 2015 01:36:53 +0300
Subject: [PATCH 084/116] codegen finished

---
 komarov.andrey/src/FCC/Codegen.hs | 49 +++++++++++++++++++++++++++----
 1 file changed, 44 insertions(+), 5 deletions(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index d13917d..d83a4d9 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -11,17 +11,31 @@ import Bound
 
 import Control.Monad.State
 
+import qualified Data.Map as M
+
 impossible = error "Internal compiler error. Please submit a bug-report."
 
 data Binding = Local Int | Global String | Arg Int
                            deriving (Eq, Ord, Show, Read)
 
-data CodegenState = CodegenState { offset :: Int, counter :: Int, maxOffset :: Int }
+data CodegenState = CodegenState {
+  offset :: Int,
+  counter :: Int,
+  maxOffset :: Int,
+  argumentsCount :: Int }
+
+emptyState = CodegenState 0 0 0 0
 
 modifyOffset :: MonadState CodegenState m => (Int -> Int) -> m ()
 modifyOffset f = modify $ \s@(CodegenState{maxOffset = m, offset = o})
                           -> s{maxOffset = m `max` o, offset = f o}
 
+resetMaxOffset :: MonadState CodegenState m => m ()
+resetMaxOffset = modify $ \s -> s{maxOffset = 0}
+
+setArgumentsCount :: MonadState CodegenState m => Int -> m ()
+setArgumentsCount args = modify $ \s -> s{argumentsCount = args}
+
 newtype Codegen a = Codegen {
   runCodegen :: State CodegenState a
   } deriving (Functor, Applicative, Monad, MonadState CodegenState)
@@ -38,8 +52,32 @@ freshLabel = fresh "_label_"
 freshVar :: Codegen String
 freshVar = fresh "_var_"
 
-codegen :: Program a -> [String] 
-codegen = _
+codegen :: Program String -> [String] 
+codegen p = evalState (runCodegen $ compileP p) emptyState
+
+compileP :: Program String -> Codegen [String]
+compileP (Program funs vars) = do
+  dataSegNames <- sequence [freshVar | _ <- M.keys vars]
+  let dataHead = ["@@@@@@@@@", ".data"]
+      dataBody = [name ++ ": .word 0" | name <- dataSegNames]
+      textVeryHead = ["", "@@@@@@@@@", ".text"]
+      textHead = [realName ++ ": .word " ++ dataName | (realName, dataName) <- zip (M.keys vars) dataSegNames]
+  functions <- mapM f $ M.toList funs
+  return $ dataHead ++ dataBody ++ textVeryHead ++ textHead ++ concat functions
+    where
+    f :: (String, Function String) -> Codegen [String]
+    f (name, fun) = do
+      code <- compileF fun
+      return $ [name ++ ":"] ++ code
+
+compileF :: Function String -> Codegen [String]
+compileF (Function _ _ (Native code)) = return $ code ++ ["mov pc, lr"]
+compileF (Function _ _ (Inner s)) = do
+  let e = instantiate (return . Arg) (Global <$> s)
+  resetMaxOffset
+  code <- compileE e
+  off <- gets maxOffset
+  return $ ["push {fp, lr}", "mov fp, sp", "sub sp, #" ++ show (off * 4)] ++ code
 
 compileE :: Expr Binding -> Codegen [String]
 compileE (Var (Local off)) = return ["ldr r0, [fp, #-" ++ show (off * 4) ++"]", "push r0"]
@@ -53,7 +91,7 @@ compileE (Lam t s) = do
   off <- gets offset
   modifyOffset (+1)
   code <- compileE $ instantiate1 (Var (Local off)) s
-  modifyOffset (-1)
+  modifyOffset (`subtract` 1)
   return code
 compileE Empty = return []
 compileE (Pop e) = do
@@ -101,4 +139,5 @@ compileE (Array a i) = do
   return $ codea ++ codei ++ ["pop r1", "pop r0", "ldr r0, [r0, r1, LSL #2]", "push r0"]
 compileE (Return e) = do
   code <- compileE e
-  return $ code ++ ["pop r0", "mov sp, fp", "pop {fp, lr}", "mov pc, lr"]
+  nargs <- gets argumentsCount
+  return $ code ++ ["pop r0", "mov sp, fp", "pop {fp, lr}", "add sp, #" ++ show (nargs * 4), "push r0", "mov pc, lr"]

From 6a25cfbe4d5ddcc3763a6fba3dfaa970ffdf1699 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 19 May 2015 02:02:17 +0300
Subject: [PATCH 085/116] fixes

---
 komarov.andrey/src/FCC/Codegen.hs   | 10 ++++++----
 komarov.andrey/src/FCC/Stdlib.hs    |  8 +++++++-
 komarov.andrey/src/FCC/Typecheck.hs |  2 +-
 komarov.andrey/src/Main.hs          |  7 ++++++-
 4 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index d83a4d9..db4c398 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -1,14 +1,16 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 module FCC.Codegen (
-
+  codegen,
   ) where
 
 import FCC.Expr
 import FCC.Program
+import FCC.Stdlib
 
 import Bound
 
+import Data.Monoid
 import Control.Monad.State
 
 import qualified Data.Map as M
@@ -62,13 +64,13 @@ compileP (Program funs vars) = do
       dataBody = [name ++ ": .word 0" | name <- dataSegNames]
       textVeryHead = ["", "@@@@@@@@@", ".text"]
       textHead = [realName ++ ": .word " ++ dataName | (realName, dataName) <- zip (M.keys vars) dataSegNames]
-  functions <- mapM f $ M.toList funs
+  functions <- mapM f $ M.toList (funs <> M.fromList builtins)
   return $ dataHead ++ dataBody ++ textVeryHead ++ textHead ++ concat functions
     where
     f :: (String, Function String) -> Codegen [String]
     f (name, fun) = do
       code <- compileF fun
-      return $ [name ++ ":"] ++ code
+      return $ ["", "@@@@@@@", name ++ ":"] ++ code
 
 compileF :: Function String -> Codegen [String]
 compileF (Function _ _ (Native code)) = return $ code ++ ["mov pc, lr"]
@@ -81,7 +83,7 @@ compileF (Function _ _ (Inner s)) = do
 
 compileE :: Expr Binding -> Codegen [String]
 compileE (Var (Local off)) = return ["ldr r0, [fp, #-" ++ show (off * 4) ++"]", "push r0"]
-compileE (Var (Global name)) = return ["ldr r0, " ++ show name, "push r0"]
+compileE (Var (Global name)) = return ["ldr r0, " ++ name, "push r0"]
 compileE (Var (Arg arg)) = return ["ldr r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push r0"]
 compileE (Lit i) = return ["push =" ++ show i]
 compileE (LitBool True) = return ["push #1\t\t@ true"]
diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index 6a10002..d4099ad 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -6,12 +6,18 @@ import FCC.Type
 import FCC.Expr
 import FCC.Program
 
+import Bound
+
 native :: [Type] -> Type -> [String] -> Function String
 native args ret body = Function args ret $ Native body
 
+start :: Function String
+start = Function [] TInt $ Inner $ abstract (const Nothing) $ Call (Var "main") []
+
 builtins :: [(String, Function String)]
 builtins = [
-  ("_builtin_add", native [TInt, TInt] TInt ["pop r0", "pop r1", "add r0, r0, r1", "push r0"])
+  ("_builtin_add", native [TInt, TInt] TInt ["pop r0", "pop r1", "add r0, r0, r1", "push r0"]),
+  ("_start", start)
  ]
 
            {-
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index d9dd7a8..0acb540 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -50,7 +50,7 @@ instance Typecheckable Program String where
     funs' <- traverse ff funs
     return $ (Program funs' vars, TVoid)
     where
-    allFreeVars = S.fromList $ concatMap freeVars $ M.elems funs
+    allFreeVars = S.fromList $ concatMap freeVars $ M.elems funs ++ map snd builtins
     allBoundVars = S.fromList $ M.keys funs ++ M.keys vars ++ map fst builtins
     unboundVars = allFreeVars S.\\ allBoundVars
   
diff --git a/komarov.andrey/src/Main.hs b/komarov.andrey/src/Main.hs
index f2f611b..1745010 100644
--- a/komarov.andrey/src/Main.hs
+++ b/komarov.andrey/src/Main.hs
@@ -2,6 +2,9 @@ module Main where
 
 import FCC.Parser
 import FCC.Typecheck
+import FCC.Codegen
+
+import Data.List (intercalate)
 
 main :: IO ()
 main = do
@@ -9,4 +12,6 @@ main = do
   let p = parse input
   case p of
    Left e -> putStrLn $ "failed to parse: " ++ show e
-   Right x -> print $ runTC x
+   Right x -> case runTC x of
+     Left e' -> putStrLn $ "failed to typecheck: " ++ show e'
+     Right p -> print p >> (putStrLn $ intercalate "\n" $ codegen p)

From 3bf2fef8f2da604a3931c4335bf28d2ffe4c4e8a Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 19 May 2015 02:19:02 +0300
Subject: [PATCH 086/116] remove trash

---
 komarov.andrey/src/FCC/AST.hs            | 168 -----------------------
 komarov.andrey/src/FCC/PrettyPrinter.hs  |  55 --------
 komarov.andrey/src/FCC/TypecheckError.hs |   1 +
 komarov.andrey/src/Makefile              |  12 +-
 4 files changed, 7 insertions(+), 229 deletions(-)
 delete mode 100644 komarov.andrey/src/FCC/AST.hs
 delete mode 100644 komarov.andrey/src/FCC/PrettyPrinter.hs

diff --git a/komarov.andrey/src/FCC/AST.hs b/komarov.andrey/src/FCC/AST.hs
deleted file mode 100644
index c9db333..00000000
--- a/komarov.andrey/src/FCC/AST.hs
+++ /dev/null
@@ -1,168 +0,0 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE RecordWildCards #-}
-module FCC.AST (
-  Id,
-  Tagged,
-  Type(..),
-  Program(..),
-  TopLevel(..),
-  Statement(..),
-  Expression(..),
-  ArithBinOp(..),
-  ArithCmpOp(..),
-  BoolBinOp(..),
-  EqOp(..),
-  notag, with, value,
-  toPrimitiveType
-  ) where
-
-import Data.List (intercalate)
-
-type Id = String
-type Tagged f a = (f a, a)
-
-tag :: Tagged f a -> a
-tag = snd
-
-value :: Tagged f a -> f a
-value = fst
-
-notag :: f () -> Tagged f ()
-notag x = (x, ())
-
-with :: f a -> a -> Tagged f a
-with = (,)
-
-data Program a = Program [TopLevel a]
-          deriving (Eq, Functor)
-
-data Type
-  = TInt
-  | TBool
-  | TVoid
-  | TPointer Type
-  deriving (Eq, Ord)
-
-toPrimitiveType :: String -> Type
-toPrimitiveType "int" = TInt
-toPrimitiveType "bool" = TBool
-toPrimitiveType "void" = TVoid
-toPrimitiveType t = error $ "INTERNAL COMPILER ERROR: type <" ++ t ++ "> not recognized"
-
-data TopLevel a
-  = VarDecl Type Id
-  | ForwardDecl { name :: Id,
-                  ret :: Type,
-                  argsTypes :: [Type] }
-  | FuncDef { name :: Id,
-              ret :: Type,
-              args :: [(Type, Id)],
-              body :: Statement a}
-  deriving (Eq, Functor)
-
-data Statement a = SBlock [Statement a]
-                 | SVarDecl Type Id
-                 | SAssignment Id (Tagged Expression a)
-                 | SRawExpr (Tagged Expression a)
-                 | SIfThenElse (Tagged Expression a) (Statement a) (Statement a)
-                 | SWhile (Tagged Expression a) (Statement a)
-                 | SReturn (Tagged Expression a)
-                 deriving (Eq, Functor)
-
-data ArithBinOp = AddOp | SubOp | MulOp
-                deriving (Eq, Ord)
-data BoolBinOp = OrOp | AndOp | XorOp
-               deriving (Eq, Ord)
-data ArithCmpOp = LessOp | LessEqOp | GreaterOp | GreaterEqOp
-                deriving (Eq, Ord)
-data EqOp = EqOp | NeqOp
-          deriving (Eq, Ord)
-
-instance Show ArithBinOp where
-  show AddOp = "+"
-  show SubOp = "-"
-  show MulOp = "*"
-
-instance Show BoolBinOp where
-  show OrOp = "||"
-  show AndOp = "&&"
-  show XorOp = "^"
-
-instance Show ArithCmpOp where
-  show LessOp = "<"
-  show LessEqOp = "<="
-  show GreaterOp = ">"
-  show GreaterEqOp = ">="
-
-instance Show EqOp where
-  show EqOp = "=="
-  show NeqOp = "!="
-
-data Expression a = EVar Id
-                  | ELitInt Int
-                  | ELitBool Bool
-                  | EArith ArithBinOp (Tagged Expression a) (Tagged Expression a)
-                  | EBool BoolBinOp (Tagged Expression a) (Tagged Expression a)
-                  | EArithCmp ArithCmpOp (Tagged Expression a) (Tagged Expression a)
-                  | EEqual EqOp (Tagged Expression a) (Tagged Expression a)
-                  | ECall Id [(Tagged Expression a)]
-                  | EAssign (Tagged Expression a) (Tagged Expression a)
-                  | EDeref (Tagged Expression a)
-                  | EAddr (Tagged Expression a)
-                  | EArray (Tagged Expression a) (Tagged Expression a)
-                  | ECast Type (Tagged Expression a)
-                  deriving (Eq, Ord, Functor)
-
-ppExpr :: Expression a -> String
-ppExpr (EVar var) = var
-ppExpr (ELitInt i) = show i
-ppExpr (ELitBool True) = "true"
-ppExpr (ELitBool False) = "false"
-ppExpr (EArith op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
-ppExpr (EBool op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
-ppExpr (EArithCmp op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
-ppExpr (EEqual op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
-ppExpr (ECall f args) = f ++ "(" ++ (intercalate ", " $ map (ppExpr . value) args) ++ ")"
-ppExpr (EAssign e1 e2) = ppExpr (value e1) ++ " = " ++ ppExpr (value e2)
-ppExpr (EDeref e) = "*" ++ ppExpr (value e)
-ppExpr (EAddr e) = "&" ++ ppExpr (value e)
-ppExpr (EArray a i) = ppExpr (value a) ++ "[" ++ ppExpr (value i) ++ "]"
-ppExpr (ECast t e) = "(" ++ show t ++ ")" ++ ppExpr (value e)
-
-instance Show (Expression a) where
-  show = ppExpr
-
-ppStmt :: Int -> Statement a -> String
-ppStmt off (SBlock stmts) = replicate off ' ' ++ "{\n" ++ (intercalate "\n" $ map (ppStmt (off + 4)) stmts) ++ "\n" ++ replicate off ' ' ++ "}"
-ppStmt off (SVarDecl tp id) = replicate off ' ' ++ show tp ++ " " ++ id ++ ";"
-ppStmt off (SRawExpr e) = replicate off ' ' ++ show (value e) ++ ";"
-ppStmt off (SIfThenElse cond thn els) = if' ++ "\n" ++ then' ++ "\n" ++ replicate off ' ' ++ "else\n" ++ else' where
-  if' = replicate off ' ' ++ "if (" ++ (show (value cond)) ++ ")"
-  then' = ppStmt (off + 4) thn
-  else' = ppStmt (off + 4) els
-ppStmt off (SWhile cond body) = while' ++ "\n" ++ body' where
-  while' = replicate off ' ' ++ "while (" ++ show (value cond) ++ ")"
-  body' = ppStmt (off + 4) body
-ppStmt off (SReturn ret) = replicate off ' ' ++ "return " ++ show (value ret) ++ ";"
-
-instance Show (Statement a) where
-  show = ppStmt 0
-
-ppTopLevel :: TopLevel a -> String
-ppTopLevel (VarDecl tp id) = show tp ++ " " ++ id ++ ";"
-ppTopLevel ForwardDecl{..} = show ret ++ " " ++ name ++ "(" ++ (intercalate ", " args') ++ ");" where 
-  args' = zipWith (\t i -> show t ++ " arg" ++ show i) argsTypes [1..]
-ppTopLevel FuncDef{..} = show ret ++ " " ++ name ++ "(" ++ (intercalate ", " (map showPair args)) ++ ") " ++ show body where
-  showPair (a, b) = show a ++ " " ++ b
-
-instance Show (TopLevel a) where
-  show = ppTopLevel
-
-instance Show (Program a) where
-  show (Program t) = intercalate "\n\n" $ map show t
-
-instance Show Type where
-  show TInt = "int"
-  show TBool = "bool"
-  show TVoid = "void"
-  show (TPointer t) = show t ++ "*"
diff --git a/komarov.andrey/src/FCC/PrettyPrinter.hs b/komarov.andrey/src/FCC/PrettyPrinter.hs
deleted file mode 100644
index 69634ef..00000000
--- a/komarov.andrey/src/FCC/PrettyPrinter.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module FCC.PrettyPrinter (
-  ppExpr
-  ) where
-
-import Control.Monad.RWS
-import Data.List (intercalate)
-
-import FCC.AST
-
-type Offset = Int
-type Output = [String]
-newtype Config = Config { offsetStep :: Int }
-
-defaultConfig = Config 4
-
-newtype PrettyPrinter a = PrettyPrinter {
-  runPrettyPrinter :: RWS Config Output Offset a
-  } deriving (
-  Functor, Applicative, Monad, MonadState Offset, MonadWriter Output, MonadReader Config
-  )
-
-ppline :: String -> PrettyPrinter ()
-ppline s = do
-  off <- get
-  tell [(replicate off ' ') ++ s]
-
-scoped :: PrettyPrinter a -> PrettyPrinter a
-scoped p = do
-  add <- asks offsetStep
-  modify (+add)
-  res <- p
-  modify (`subtract` add)
-  return res
-
-class PrettyPrintable t where
-  pprint :: t -> PrettyPrinter ()
-
-ppExpr (EVar var) = var
-ppExpr (ELitInt i) = show i
-ppExpr (ELitBool True) = "true"
-ppExpr (ELitBool False) = "false"
-ppExpr (EArith op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
-ppExpr (EBool op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
-ppExpr (EArithCmp op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
-ppExpr (EEqual op e1 e2) = "(" ++ ppExpr (value e1) ++ ") " ++ show op ++ " (" ++ ppExpr (value e2) ++ ")"
-ppExpr (ECall f args) = f ++ "(" ++ (intercalate ", " $ map (ppExpr . value) args) ++ ")"
-ppExpr (EAssign e1 e2) = ppExpr (value e1) ++ " = " ++ ppExpr (value e2)
-ppExpr (EDeref e) = "*" ++ ppExpr (value e)
-ppExpr (EAddr e) = "&" ++ ppExpr (value e)
-ppExpr (EArray a i) = ppExpr (value a) ++ "[" ++ ppExpr (value i) ++ "]"
-ppExpr (ECast t e) = "(" ++ show t ++ ")" ++ ppExpr (value e)
-
-
diff --git a/komarov.andrey/src/FCC/TypecheckError.hs b/komarov.andrey/src/FCC/TypecheckError.hs
index 9f3fabf..266315c 100644
--- a/komarov.andrey/src/FCC/TypecheckError.hs
+++ b/komarov.andrey/src/FCC/TypecheckError.hs
@@ -22,5 +22,6 @@ data TypecheckError where
   ArgumentsTypesDiffer :: Show a => [Type] -> [Type] -> Expr a -> TypecheckError
   AssignTypeMismatch :: Show a => Type -> Type -> Expr a -> Expr a -> TypecheckError
   WrongReturnType :: Show a => Type -> Type -> Expr a -> TypecheckError
+  UnboundVariables :: Show a => [a] -> TypecheckError
 
 deriving instance Show TypecheckError
diff --git a/komarov.andrey/src/Makefile b/komarov.andrey/src/Makefile
index 4bd4cf0..4ae6b82 100644
--- a/komarov.andrey/src/Makefile
+++ b/komarov.andrey/src/Makefile
@@ -1,11 +1,11 @@
-all: lexer parser TestCompiler.hs Parser.hs Lexer.hs ARM.hs AST.hs
-	ghc TestCompiler
+all: lexer parser FCC/Parser.hs FCC/Lexer.hs
+	echo hi
 
-lexer: Lexer.x
-	alex Lexer.x
+lexer: FCC/Lexer.x
+	alex FCC/Lexer.x
 
-parser: Parser.y
-	happy Parser.y -ilog
+parser: FCC/Parser.y
+	happy FCC/Parser.y -ilog
 
 clean:
 	rm -f *.o *.hi log Lexer.hs Parser.hs TestCompiler

From c93d5b3924e580362d3de9004096c967abafb836 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 19 May 2015 02:20:00 +0300
Subject: [PATCH 087/116] even more trash

---
 komarov.andrey/src/Compiler.hs     | 501 -----------------------------
 komarov.andrey/src/TestCompiler.hs |  14 -
 komarov.andrey/src/Typecheck.hs    |  58 ----
 3 files changed, 573 deletions(-)
 delete mode 100644 komarov.andrey/src/Compiler.hs
 delete mode 100644 komarov.andrey/src/TestCompiler.hs
 delete mode 100644 komarov.andrey/src/Typecheck.hs

diff --git a/komarov.andrey/src/Compiler.hs b/komarov.andrey/src/Compiler.hs
deleted file mode 100644
index c35a144..00000000
--- a/komarov.andrey/src/Compiler.hs
+++ /dev/null
@@ -1,501 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE FlexibleInstances #-}
-
-module Compiler (
-  runCompiler,
-  output
-  ) where
-
-import Control.Monad.Writer
-import Control.Monad.State
-import Control.Monad.Error
-import Control.Applicative
-
-import Data.List
-import Data.Function
-import Data.Maybe (catMaybes)
-
-import qualified Data.Map as M
-import qualified Data.Set as S
-
-import ARM
-import AST (Id)
-import qualified AST
-
-data Type = TBool
-          | TInt
-          | TString
-          | TVoid
-          deriving (Show, Eq)
-
-size :: Num a => Type -> a
-size TBool = 4
-size TInt = 4
-size TString = error "lol not implemented yet"
-size TVoid = error "lol void is not instantiable"
-
-data FType = FType Type [Type]
-           deriving (Show, Eq)
-
-type Label = String
-
-data Symbol
-  = GlobalVariable { varType :: Type,
-                     textLabel :: Label}
-  | LocalVariable { varType :: Type, varOffset :: Int }
-  | ForwardDecl { funType :: FType, label :: Label }
-  | FunctionDecl { funType :: FType, label :: Label }
-  | Type Type
-  deriving (Show)
-
-newtype SymbolTable =
-  SymbolTable { unSymbolTable :: M.Map Id Symbol}
-
-data Env = Env {
-  symbols :: SymbolTable,
-  labels :: S.Set Label,
-  offset :: Int,
-  epilogue :: Maybe Label}
-
-put' :: Env -> Compiler ()
-put' env' = do
-  env <- get
-  put $ env' { labels = labels env }
-
-emptyEnv :: Env
-emptyEnv = Env (SymbolTable M.empty) S.empty 0 Nothing
-
-stdTable :: SymbolTable
-stdTable = SymbolTable $ M.fromList $ [
-  ("int", Type TInt),
-  ("bool", Type TBool),
-  ("void", Type TVoid)]
-
-stdlib :: Env
-stdlib = emptyEnv { symbols = stdTable }
-
-setOffset :: Int -> Compiler ()
-setOffset off = modify $ \env -> env { offset = off }
-
-setSymbols :: SymbolTable -> Compiler ()
-setSymbols s = modify $ \env -> env { symbols = s }
-
-setEpilogue :: Label -> Compiler ()
-setEpilogue ep = do
-  env <- get
-  put $ env { epilogue = Just ep }
-
-symbol :: Id -> Compiler (Maybe Symbol)
-symbol name = do
-  sym <- gets (unSymbolTable . symbols)
-  return $ M.lookup name sym
-
-setSymbol :: Id -> Symbol -> Compiler ()
-setSymbol name s = do
-  env@(Env { symbols = SymbolTable syms }) <- get
-  put $ env { symbols = SymbolTable $ M.insert name s syms }
-
-getFun :: Id -> Compiler (FType, Label)
-getFun name = symbol name >>= \case
-  Nothing -> throwError $ SymbolNotDefined name
-  Just (ForwardDecl { funType = t, label = l }) -> return (t, l)
-  Just (FunctionDecl { funType = t, label = l }) -> return (t, l)
-  Just s -> throwError $ FunctionExpected s
-
-getVarType :: Id -> Compiler Type
-getVarType name = symbol name >>= \case
-  Nothing -> throwError $ SymbolNotDefined name
-  Just (GlobalVariable { varType = t }) -> return t
-  Just (LocalVariable { varType = t }) -> return t
-  Just s -> throwError $ VariableExpected s
-
-getType :: Id -> Compiler Type
-getType name = symbol name >>= \case
-  Nothing -> throwError $ SymbolNotDefined name
-  Just (Type t) -> return t
-  Just s -> throwError $ TypeExpected s
-
-as :: Segment -> Assembly -> Compiler ()
-as seg asm = tell $ Output [(seg, asm)]
-
-updateGlobalVar :: Id -> Type -> Compiler ()
-updateGlobalVar name t = symbol name >>= \case
-  Nothing -> do
-             dLabel <- fresh name
-             tLabel <- fresh name
-             setSymbol name $ GlobalVariable t tLabel
-             as Data $ dLabel ++ ": .word 0"
-             as Text $ tLabel ++ ": .word " ++ dLabel
-  Just s' -> throwError $ AlreadyBound name s' $ GlobalVariable t ""
-
-updateLocalVar :: Id -> Type -> Compiler ()
-updateLocalVar name t = symbol name >>= \case
-  Nothing -> do
-    off <- gets offset
-    let sz = size t
-    modify $ \(env@Env { offset = o }) -> env { offset = o + sz }
-    setSymbol name $ LocalVariable t (off + sz)
-  Just s' -> throwError $ AlreadyBound name s' $ LocalVariable t 0
-
-updateForwardDecl :: Id -> FType -> Compiler ()
-updateForwardDecl name ty = symbol name >>= \case
-  Nothing -> do
-    lab <- fresh name
-    when (lab /= name) $ throwError $ LabelAlreadyDeclared name
-    setSymbol name $ ForwardDecl ty lab
-  Just (ForwardDecl ty' _) -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
-  Just (FunctionDecl { funType = ty' }) -> when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
-  Just s -> throwError $ AlreadyBound name s (ForwardDecl ty "")
-
-updateFun :: Id -> FType -> Compiler Label
-updateFun name ty = symbol name >>= \case
-  Nothing -> do
-             lab <- fresh name
-             setSymbol name $ FunctionDecl ty lab
-             as Data $ ".global " ++ name
-             return lab
-  Just (ForwardDecl ty' lab) -> do
-    when (ty /= ty') $ throwError $ ForwardDeclTypeMismatch ty ty'
-    setSymbol name $ FunctionDecl ty lab
-    as Data $ ".global " ++ name
-    return lab
-  Just s -> throwError $ AlreadyBound name s (FunctionDecl ty "")
-
-addLabel :: String -> Compiler ()
-addLabel lab = do
-  env@Env { labels = labels } <- get
-  when (lab `S.member` labels) $ throwError $ LabelAlreadyDeclared lab
-  put $ env { labels = S.insert lab labels }
-
-fresh :: String -> Compiler String
-fresh hint = do
-  l <- gets labels
-  let res = head $ [x | suf <- "":(map (('_':) . show) [1..]),
-                      let x = hint ++ suf, not (x `S.member` l)]
-  addLabel res
-  return res
-
-mergeTypes :: [Maybe Type] -> Compiler (Maybe Type)
-mergeTypes types = case nub $ catMaybes types of
-  [] -> return Nothing
-  [t] -> return $ Just t
-  ts -> throwError $ InconsistentReturnTypes ts
-
-newtype Output = Output { unOutput :: [(Segment, Assembly)] }
-               deriving (Show, Monoid)
-
-output :: Output -> String
-output (Output out) =
-  intercalate "\n\n" $ map (uncurry sect) sections where
-    sect :: Segment -> [String] -> String
-    sect seg lines = "@@@@@@@@@@@@@@@\n." ++ show seg ++ "\n\n" ++ intercalate "\n" lines
-
-    toSect :: [(a, b)] -> (a, [b])
-    toSect pairs = let (a:_,b) = unzip pairs in (a, b)
-  
-    sections :: [(Segment, [String])]
-    sections = map toSect $ groupBy ((==) `on` fst)
-               $ sortBy (compare `on` fst) out
-
-data CompileError
-  = CompileError
-  | SymbolNotDefined Id
-  | AlreadyBound Id Symbol Symbol
-  | VariableExpected Symbol
-  | TypeExpected Symbol
-  | FunctionExpected Symbol
-  | ForwardDeclTypeMismatch FType FType
-  | InconsistentReturnTypes [Type]
-  | TypeMismatch Type Type
-  | LabelAlreadyDeclared String
-  | WrongArgsNumber [Type] [Type]
-  deriving (Show)
-
-instance Error CompileError where
-  noMsg = CompileError
-
-newtype Compiler a = Compiler {
-  unCompiler ::
-     ErrorT CompileError (
-       WriterT Output (
-          State Env )) a }
-                     deriving (
-  Functor, Applicative, Monad, MonadError CompileError,
-  MonadWriter Output, MonadState Env)
-
-
-runCompiler :: AST.Program -> Either CompileError Output
-runCompiler prog = fmap (const out) e where
-  ((e, out), env) = runState (runWriterT $ runErrorT $ unCompiler $ compile prog) stdlib
-
-class Compilable t ret | t -> ret where
-  compile :: t -> Compiler ret
-
-instance Compilable AST.Program () where
-  compile (AST.Program xs) = mapM_ compile xs
-
-instance Compilable AST.TopLevel () where
-  compile (AST.VarDecl ty name) =
-    getType ty >>= updateGlobalVar name
-  compile (AST.ForwardDecl name ret args) = do
-    tret <- getType ret
-    targs <- mapM getType args
-    updateForwardDecl name (FType tret targs)
-  compile (AST.FuncDef name ret args body) = do
-    tret <- getType ret
-    targs <- mapM getType (map fst args)
-    fname <- updateFun name (FType tret targs)
-    ep <- fresh $ name ++ "_ep"
-    as Text ""
-    as Text $ "@ function " ++ show name
-    forM args $ \(t, n) ->
-      as Text $ "@   " ++ show n ++ " : " ++ show n
-    as Text $ fname ++ ":"
-    as Text $ "push {fp, lr}"
-    as Text $ "mov fp, sp"
-    -- TODO Correct stack frame size
-    as Text $ "sub sp, sp, #128"
-    setEpilogue ep
-    oldSymbols <- gets symbols
-    let argPairs = zip (map snd args) targs
-    let stackArgs = drop 4 argPairs
-    let registerArgs = take 4 argPairs
-    setOffset $ -(4 * length stackArgs + 8)
-    -- TODO incorrect. "push{fp,lr}" splits args to reg/stack groups
-    mapM (uncurry updateLocalVar) $ reverse stackArgs
-    setOffset 0
-    mapM (uncurry updateLocalVar) registerArgs
-    case length registerArgs of
-     0 -> return ()
-     1 -> as Text $ "str r0, [fp, #-4]"
-     2 -> mapM_ (as Text) ["str r0, [fp, #-4]", "str r1, [fp, #-8]"]
-     3 -> mapM_ (as Text) ["str r0, [fp, #-4]", "str r1, [fp, #-8]", "str r2, [fp, #-12]"]
-     4 -> mapM_ (as Text) ["str r0, [fp, #-4]", "str r1, [fp, #-8]", "str r2, [fp, #-12]", "str r3, [fp, #-16]"]
-     n -> error "IMPOSSIBLE"
-    mapM compile body
-    setOffset 0
-    setSymbols oldSymbols
-    as Text $ ep ++ ":"
-    as Text $ "mov sp, fp"
-    as Text $ "pop {fp, lr}"
-    as Text $ "mov pc, lr"
-    as Text $ "@ end of " ++ show name
-
-instance Compilable AST.Statement (Maybe Type) where
-  compile (AST.SBlock stmts) = do
-    env <- get
-    types <- mapM compile stmts
-    put' env
-    mergeTypes types
-  compile (AST.SVarDecl tp name) =
-    getType tp >>= updateLocalVar name >> return Nothing
-  compile (AST.SAssignment name expr) = symbol name >>= \case
-    Nothing -> throwError $ SymbolNotDefined name
-    Just (LocalVariable tp off) -> do
-      as Text $ "@ " ++ show name ++ " := " ++ show expr
-      rhs <- compile expr
-      when (tp /= rhs) $ throwError $ TypeMismatch tp rhs
-      as Text $ "pop {r0}"
-      as Text $ "@ storing to local " ++ name
-      as Text $ "str r0, [fp, #-" ++ show off ++ "]"
-      return Nothing
-    Just (GlobalVariable tp tLabel) -> do
-      as Text $ "@ " ++ show name ++ " := " ++ show expr
-      rhs <- compile expr
-      when (tp /= rhs) $ throwError $ TypeMismatch tp rhs
-      as Text $ "ldr r1, " ++ tLabel
-      as Text $ "pop {r0}"
-      as Text $ "str r0, [r1]"
-      return Nothing
-    Just s -> throwError $ VariableExpected s
-  compile (AST.SRawExpr expr) = do
-    compile expr
-    as Text $ "pop {r0} @ unused"
-    return Nothing
-  compile (AST.SIfThenElse cond thn els) = do
-    elseLabel <- fresh "else"
-    endifLabel <- fresh "endif"
-    as Text $ "@ if"
-    t <- compile cond
-    when (t /= TBool) $ throwError $ TypeMismatch t TBool
-    as Text $ "pop {r0}"
-    as Text $ "@ then"
-    as Text $ "teq r0, #0"
-    as Text $ "beq " ++ elseLabel
-    thnType <- compile thn
-    as Text $ "b " ++ endifLabel
-    as Text $ elseLabel ++ ":"
-    elsType <- compile els
-    retType <- mergeTypes [thnType, elsType]
-    as Text $ endifLabel ++ ":"
-    return retType
-  compile (AST.SWhile cond body) = do
-    [whileLabel, endWhileLabel] <- mapM fresh ["while", "endwhile"]
-    as Text $ whileLabel ++ ":"
-    tcond <- compile cond
-    when (tcond /= TBool) $ throwError $ TypeMismatch tcond TBool
-    as Text $ "pop {r0}"
-    as Text $ "teq r0, #0"
-    as Text $ "beq " ++ endWhileLabel
-    tret <- compile body
-    as Text $ "b " ++ whileLabel
-    as Text $ endWhileLabel ++ ":"
-    return tret
-  compile (AST.SReturn expr) = do
-    tp <- compile expr
-    as Text $ "pop {r0}"
-    Just ep <- gets epilogue
-    as Text $ "b " ++ ep
-    return $ Just tp
-
-instance Compilable AST.Expression Type where
-  compile (AST.EVar v) = symbol v >>= \case
-    Nothing -> throwError $ SymbolNotDefined v
-    Just (LocalVariable tp off) -> do
-      as Text $ "@ local " ++ show v
-      as Text $ "ldr r0, [fp, #-" ++ show off ++ "]"
-      as Text $ "push {r0}"
-      return tp
-    Just (GlobalVariable tp tLabel) -> do
-      as Text $ "@ global " ++ show v
-      as Text $ "ldr r0, " ++ tLabel
-      as Text $ "ldr r0, [r0]"
-      as Text $ "push {r0}"
-      return tp
-    Just s -> throwError $ VariableExpected s
-  compile (AST.EBool b) = do
-    as Text $ "ldr r0, =" ++ show (if b then 1 else 0)
-    as Text $ "push {r0}"
-    return TBool
-  compile (AST.EInt i) = do
-    as Text $ "ldr r0, =" ++ show i
-    as Text $ "push {r0}"
-    return TInt
-  compile (AST.EAdd lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
-    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
-    as Text $ "pop {r0, r1}"
-    as Text $ "add r0, r1, r0"
-    as Text $ "push {r0}"
-    return TInt
-  compile (AST.ESub lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
-    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
-    as Text $ "pop {r0, r1}"
-    as Text $ "sub r0, r1, r0"
-    as Text $ "push {r0}"
-    return TInt
-  compile (AST.EMul lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
-    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
-    as Text $ "pop {r0, r1}"
-    as Text $ "mul r0, r1, r0"
-    as Text $ "push {r0}"
-    return TInt
-  compile (AST.ELess lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
-    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
-    as Text $ "pop {r0, r1}"
-    as Text $ "cmp r1, r0"
-    as Text $ "movlt r0, #1"
-    as Text $ "movge r0, #0"
-    as Text $ "push {r0}"
-    return TBool
-  compile (AST.EGreater lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
-    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
-    as Text $ "pop {r0, r1}"
-    as Text $ "cmp r1, r0"
-    as Text $ "movgt r0, #1"
-    as Text $ "movle r0, #0"
-    as Text $ "push {r0}"
-    return TBool
-  compile (AST.ELessEq lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
-    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
-    as Text $ "pop {r0, r1}"
-    as Text $ "cmp r1, r0"
-    as Text $ "movle r0, #1"
-    as Text $ "movgt r0, #0"
-    as Text $ "push {r0}"
-    return TBool
-  compile (AST.EGreaterEq lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= TInt) $ throwError $ TypeMismatch tl TInt
-    when (tr /= TInt) $ throwError $ TypeMismatch tr TInt
-    as Text $ "pop {r0, r1}"
-    as Text $ "cmp r1, r0"
-    as Text $ "movge r0, #1"
-    as Text $ "movlt r0, #0"
-    as Text $ "push {r0}"
-    return TBool
-  compile (AST.EEqual lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= tr) $ throwError $ TypeMismatch tl tr
-    as Text $ "pop {r0, r1}"
-    as Text $ "teq r0, r1"
-    as Text $ "moveq r0, #1"
-    as Text $ "movne r0, #0"
-    as Text $ "push {r0}"
-    return TBool
-  compile (AST.ENotEqual lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= tr) $ throwError $ TypeMismatch tl tr
-    as Text $ "pop {r0, r1}"
-    as Text $ "teq r0, r1"
-    as Text $ "movne r0, #1"
-    as Text $ "moveq r0, #0"
-    as Text $ "push {r0}"
-    return TBool
-  compile (AST.EAnd lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= TBool) $ throwError $ TypeMismatch tl TBool
-    when (tr /= TBool) $ throwError $ TypeMismatch tr TBool
-    as Text $ "pop {r0, r1}"
-    as Text $ "and r0, r1, r0"
-    as Text $ "push {r0}"
-    return TBool
-  compile (AST.EOr lhs rhs) = do
-    tl <- compile lhs
-    tr <- compile rhs
-    when (tl /= TBool) $ throwError $ TypeMismatch tl TBool
-    when (tr /= TBool) $ throwError $ TypeMismatch tr TBool
-    as Text $ "pop {r0, r1}"
-    as Text $ "orr r0, r1, r0"
-    as Text $ "push {r0}"
-    return TBool
-  compile (AST.ECall name args) = do
-    targs <- reverse <$> (mapM compile $ reverse args)
-    (FType ret targs', label) <- getFun name
-    when (length targs /= length targs') $
-      throwError $ WrongArgsNumber targs targs'
-    forM (zip targs targs') $ \(t, t') ->
-      when (t /= t') $ throwError $ TypeMismatch t t'
-    case (length args) of
-     0 -> as Text $ "@ no args"
-     1 -> as Text $ "pop {r0}"
-     2 -> mapM_ (as Text) ["pop {r0}", "pop {r1}"]
-     3 -> mapM_ (as Text) ["pop {r0}", "pop {r1}", "pop {r2}"]
-     _ -> mapM_ (as Text) ["pop {r0}", "pop {r1}", "pop {r2}", "pop {r3}"]
-    as Text $ "bl " ++ label
-    as Text $ "push {r0}"
-    return ret
diff --git a/komarov.andrey/src/TestCompiler.hs b/komarov.andrey/src/TestCompiler.hs
deleted file mode 100644
index 7173f6d..00000000
--- a/komarov.andrey/src/TestCompiler.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-import Parser
-import Lexer
-import Compiler
-
-main = do
-    input <- getContents
-    -- putStrLn input
-    let tokens = scanTokens input
-    -- print tokens
-    let ast = parse tokens
-    putStrLn $ "@ " ++ show ast
-    putStrLn $ case runCompiler ast of
-      Left e -> show e
-      Right o -> output o
diff --git a/komarov.andrey/src/Typecheck.hs b/komarov.andrey/src/Typecheck.hs
deleted file mode 100644
index 956eb59..00000000
--- a/komarov.andrey/src/Typecheck.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Typecheck (
-
-  ) where
-
-import Control.Applicative
-import Control.Monad.State
-import Control.Monad.Except
-
-import AST
-
-data Symbol = Symbol
-              deriving (Eq, Ord)
-
-data Env = Env {
-               }
-
-data Value = LValue | RValue
-
-data T = T Value Type
-
-data CompilationError
-  = CompilationError
-  deriving (Show)
-    
-newtype Typechecker a = Typecheker {
-  runTypechecker ::
-     ExceptT CompilationError (
-       State Env) a }
-                      deriving (
-  Functor, Applicative, Monad, MonadError CompilationError,
-  MonadState Env)
-
-class Typecheckable f t | f -> t where
-  typecheck :: f () -> Typechecker (Tagged f t)
-
-{-
-data Expression a = EVar Id
-                  | ELitInt Int
-                  | ELitBool Bool
-                  | EArith ArithBinOp (Tagged Expression a) (Tagged Expression a)
-                  | EBool BoolBinOp (Tagged Expression a) (Tagged Expression a)
-                  | EArithCmp ArithCmpOp (Tagged Expression a) (Tagged Expression a)
-                  | EEqual EqOp (Tagged Expression a) (Tagged Expression a)
-                  | ECall Id [(Tagged Expression a)]
-                  | EAssign (Tagged Expression a) (Tagged Expression a)
-                  | EDeref (Tagged Expression a)
-                  | EAddr (Tagged Expression a)
-                  | EArray (Tagged Expression a) (Tagged Expression a)
-                  | ECast Type (Tagged Expression a)
--}
-
-instance Typecheckable Expression T where
-  typecheck (EVar var) = _
-  typecheck (ELitInt i) = return $ (ELitInt i) `with` (T RValue (Simple "int"))
-  typecheck (ELitBool b) = return $ (ELitBool b) `with` (T RValue (Simple "bool"))

From 2a3901859416eb0c57cb91a1e8c7caca1448ee94 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Tue, 19 May 2015 03:20:53 +0300
Subject: [PATCH 088/116] cabal fixed

---
 komarov.andrey/fcc.cabal      | 26 ++++----------------------
 komarov.andrey/src/FCC/ARM.hs | 15 ---------------
 2 files changed, 4 insertions(+), 37 deletions(-)
 delete mode 100644 komarov.andrey/src/FCC/ARM.hs

diff --git a/komarov.andrey/fcc.cabal b/komarov.andrey/fcc.cabal
index 7dfcfef..0ec23bd 100644
--- a/komarov.andrey/fcc.cabal
+++ b/komarov.andrey/fcc.cabal
@@ -1,5 +1,5 @@
 name:                fcc
-version:             0.1.0.0
+version:             0.2.0.0
 synopsis:            Featherweight C compiler
 -- description:         
 homepage:            https://github.com/vvolochay/Compilers
@@ -15,27 +15,9 @@ cabal-version:       >=1.20
 
 executable fcc
   main-is:           Main.hs
-  other-modules:     FCC.Parser, FCC.Lexer, FCC.AST, FCC.ARM,
-                     FCC.PrettyPrinter
-  build-depends:     base >=4.8 && <5, array, containers, mtl
+  other-modules:     FCC.Parser, FCC.Lexer, FCC.Expr, FCC.Program,
+                     FCC.Type, FCC.Stdlib, FCC.TypecheckError, FCC.Typecheck
+  build-depends:     base >=4.8 && <5, array, containers, mtl, bound, prelude-extras
   build-tools:       happy, alex
   hs-source-dirs:    src
   default-language:  Haskell2010
-
-test-suite test-parser
-  type:              exitcode-stdio-1.0
-  main-is:           TestParser.hs
-  hs-source-dirs:    src, tests
-  other-modules:     FCC.Parser, FCC.Lexer
-  build-depends:     base >= 4.8 && < 5, directory, array, containers
-  default-language:  Haskell2010
-
-test-suite test-pretty-printer
-  type:              exitcode-stdio-1.0
-  main-is:           TestPrettyPrinter.hs
-  hs-source-dirs:    src, tests
-  other-modules:     FCC.PrettyPrinter, FCC.AST, FCC.Parser, FCC.Lexer
-  build-depends:     base >= 4.8 && < 5, test-framework-quickcheck2,
-                     test-framework-hunit, QuickCheck, test-framework, HUnit,
-                     derive, array, containers, directory
-  default-language:  Haskell2010
\ No newline at end of file
diff --git a/komarov.andrey/src/FCC/ARM.hs b/komarov.andrey/src/FCC/ARM.hs
deleted file mode 100644
index 39d3f1d..00000000
--- a/komarov.andrey/src/FCC/ARM.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module FCC.ARM (
-  Assembly(..),
-  Segment(..)
-  ) where
-
-
-type Assembly = String
-
-data Segment = Data | Text
-             deriving (Eq, Ord)
-
-instance Show Segment where
-  show Data = "data"
-  show Text = "text"
-

From 5284f592fe302ed7b01e6bede92ad25d45dfabc8 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Tue, 19 May 2015 16:11:38 +0300
Subject: [PATCH 089/116] improve stdlib

---
 komarov.andrey/src/FCC/Stdlib.hs    | 16 +++++++++++++---
 komarov.andrey/src/FCC/Typecheck.hs |  8 +++-----
 komarov.andrey/src/Main.hs          |  5 +++--
 3 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index d4099ad..cb11f43 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -1,5 +1,6 @@
 module FCC.Stdlib (
-  builtins
+  builtins,
+  withStdlib
   ) where
 
 import FCC.Type
@@ -8,16 +9,25 @@ import FCC.Program
 
 import Bound
 
+import qualified Data.Map as M
+
+withStdlib :: Program String -> Program String
+withStdlib (Program funs vars) = Program (funs `M.union` (M.fromList builtins)) vars
+
 native :: [Type] -> Type -> [String] -> Function String
 native args ret body = Function args ret $ Native body
 
 start :: Function String
-start = Function [] TInt $ Inner $ abstract (const Nothing) $ Call (Var "main") []
+start = Function [] TInt $ Inner $ abstract (const Nothing) $ Call (Var "_exit") [Call (Var "main") []]
+
+exit :: Function String
+exit = native [TInt] TVoid ["pop r1", "mov r0, #1", "swi"]
 
 builtins :: [(String, Function String)]
 builtins = [
   ("_builtin_add", native [TInt, TInt] TInt ["pop r0", "pop r1", "add r0, r0, r1", "push r0"]),
-  ("_start", start)
+  ("_start", start),
+  ("_exit", exit)
  ]
 
            {-
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 0acb540..4745681 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -10,7 +10,6 @@ import FCC.Type
 import FCC.TypecheckError
 import FCC.Expr
 import FCC.Program
-import FCC.Stdlib
 
 import Bound
 
@@ -50,8 +49,8 @@ instance Typecheckable Program String where
     funs' <- traverse ff funs
     return $ (Program funs' vars, TVoid)
     where
-    allFreeVars = S.fromList $ concatMap freeVars $ M.elems funs ++ map snd builtins
-    allBoundVars = S.fromList $ M.keys funs ++ M.keys vars ++ map fst builtins
+    allFreeVars = S.fromList $ concatMap freeVars $ M.elems funs
+    allBoundVars = S.fromList $ M.keys funs ++ M.keys vars
     unboundVars = allFreeVars S.\\ allBoundVars
   
     freeVars :: Function String -> [String]
@@ -65,8 +64,7 @@ instance Typecheckable Program String where
       argNames <- sequence [fresh | _ <- argTypes]
       let e = instantiate ((map Var argNames) !!) s
           args = M.fromList $ zip argNames argTypes
-          builtins' = M.fromList builtins
-          funs' = fmap (\(Function a r _) -> TFun a r) $ funs `M.union` builtins'
+          funs' = fmap (\(Function a r _) -> TFun a r) $ funs
           allTypes = args `M.union` funs' `M.union` vars
       (e', _) <- local (const $ Context ret) $
                   typecheck $ fmap (\n -> (n, allTypes M.! n)) e
diff --git a/komarov.andrey/src/Main.hs b/komarov.andrey/src/Main.hs
index 1745010..3758a45 100644
--- a/komarov.andrey/src/Main.hs
+++ b/komarov.andrey/src/Main.hs
@@ -3,6 +3,7 @@ module Main where
 import FCC.Parser
 import FCC.Typecheck
 import FCC.Codegen
+import FCC.Stdlib
 
 import Data.List (intercalate)
 
@@ -12,6 +13,6 @@ main = do
   let p = parse input
   case p of
    Left e -> putStrLn $ "failed to parse: " ++ show e
-   Right x -> case runTC x of
+   Right x -> case runTC (withStdlib x) of
      Left e' -> putStrLn $ "failed to typecheck: " ++ show e'
-     Right p -> print p >> (putStrLn $ intercalate "\n" $ codegen p)
+     Right p -> (putStrLn $ "@ " ++ show p) >> (putStrLn $ intercalate "\n" $ codegen p)

From b472425737942d219fd8b04a6423e258e5b1372b Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Tue, 19 May 2015 16:21:42 +0300
Subject: [PATCH 090/116] fix bugs

---
 komarov.andrey/src/FCC/Codegen.hs   | 26 +++++++++++++-------------
 komarov.andrey/src/FCC/Stdlib.hs    |  4 ++--
 komarov.andrey/src/FCC/Typecheck.hs |  2 +-
 3 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index db4c398..0b0a85c 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -60,7 +60,7 @@ codegen p = evalState (runCodegen $ compileP p) emptyState
 compileP :: Program String -> Codegen [String]
 compileP (Program funs vars) = do
   dataSegNames <- sequence [freshVar | _ <- M.keys vars]
-  let dataHead = ["@@@@@@@@@", ".data"]
+  let dataHead = ["@@@@@@@@@", ".data", ".global _start"]
       dataBody = [name ++ ": .word 0" | name <- dataSegNames]
       textVeryHead = ["", "@@@@@@@@@", ".text"]
       textHead = [realName ++ ": .word " ++ dataName | (realName, dataName) <- zip (M.keys vars) dataSegNames]
@@ -82,9 +82,9 @@ compileF (Function _ _ (Inner s)) = do
   return $ ["push {fp, lr}", "mov fp, sp", "sub sp, #" ++ show (off * 4)] ++ code
 
 compileE :: Expr Binding -> Codegen [String]
-compileE (Var (Local off)) = return ["ldr r0, [fp, #-" ++ show (off * 4) ++"]", "push r0"]
-compileE (Var (Global name)) = return ["ldr r0, " ++ name, "push r0"]
-compileE (Var (Arg arg)) = return ["ldr r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push r0"]
+compileE (Var (Local off)) = return ["ldr r0, [fp, #-" ++ show (off * 4) ++"]", "push {r0}"]
+compileE (Var (Global name)) = return ["ldr r0, " ++ name, "push {r0}"]
+compileE (Var (Arg arg)) = return ["ldr r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push {r0}"]
 compileE (Lit i) = return ["push =" ++ show i]
 compileE (LitBool True) = return ["push #1\t\t@ true"]
 compileE (LitBool False) = return ["push #0\t\t@ false"]
@@ -98,7 +98,7 @@ compileE (Lam t s) = do
 compileE Empty = return []
 compileE (Pop e) = do
   code <- compileE e
-  return $ code ++ ["pop r0"]
+  return $ code ++ ["pop {r0}"]
 compileE (Seq e1 e2) = (++) <$> compileE e1 <*> compileE e2
 compileE (Call (Var (Global fname)) args) = do
   compiledArgs <- reverse <$> concat <$> mapM compileE args
@@ -110,36 +110,36 @@ compileE (While cond body) = do
   end <- freshLabel
   cond' <- compileE cond
   body' <- compileE body
-  return $ [begin ++ ": @ while"] ++ cond' ++ ["pop r0", "tst r0, r0", "bz " ++ end] ++ body' ++ [end ++ ": @ endwhile"]
+  return $ [begin ++ ": @ while"] ++ cond' ++ ["pop {r0}", "tst r0, r0", "bz " ++ end] ++ body' ++ [end ++ ": @ endwhile"]
 compileE (If cond thn els) = do
   elseLabel <- freshLabel
   endIfLabel <- freshLabel
   cond' <- compileE cond
   thn' <- compileE thn
   els' <- compileE els
-  return $ cond' ++ ["pop r0", "tst r0, r0", "bz " ++ elseLabel]
+  return $ cond' ++ ["pop {r0}", "tst r0, r0", "bz " ++ elseLabel]
     ++ thn' ++ ["b " ++ endIfLabel, elseLabel ++ ": @ else:"]
     ++ els' ++ [endIfLabel ++ ": @ endif"]
 compileE (Assign (Var (Local off)) src) = do
   code <- compileE src
-  return $ code ++ ["pop r0", "str r0, [fp, #-" ++ show (off * 4) ++ "]", "push r0"]
+  return $ code ++ ["pop {r0}", "str r0, [fp, #-" ++ show (off * 4) ++ "]", "push {r0}"]
 compileE (Assign (Var (Global name)) src) = do
   code <- compileE src
-  return $ code ++ ["pop r0", "ldr r1, " ++ show name, "str r0, [r1]", "push r0"]
+  return $ code ++ ["pop {r0}", "ldr r1, " ++ show name, "str r0, [r1]", "push {r0}"]
 compileE (Assign (Var (Arg arg)) src) = do
   code <- compileE src
-  return $ code ++ ["pop r0", "str r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push r0"]
+  return $ code ++ ["pop {r0}", "str r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push {r0}"]
 compileE (Assign (Array a i) src) = do
   codea <- compileE a
   codei <- compileE i
   code <- compileE src
-  return $ codea ++ codei ++ code ++ ["pop r0\t\t@ b", "pop r1\t\t@ i", "pop r2\t\t@ a", "str r0, [r2, r1, LSL #2]", "push r0"]
+  return $ codea ++ codei ++ code ++ ["pop {r0}\t\t@ b", "pop {r1}\t\t@ i", "pop {r2}\t\t@ a", "str r0, [r2, r1, LSL #2]", "push {r0}"]
 compileE (Assign _ _) = impossible
 compileE (Array a i) = do
   codea <- compileE a
   codei <- compileE i
-  return $ codea ++ codei ++ ["pop r1", "pop r0", "ldr r0, [r0, r1, LSL #2]", "push r0"]
+  return $ codea ++ codei ++ ["pop {r1}", "pop {r0}", "ldr r0, [r0, r1, LSL #2]", "push {r0}"]
 compileE (Return e) = do
   code <- compileE e
   nargs <- gets argumentsCount
-  return $ code ++ ["pop r0", "mov sp, fp", "pop {fp, lr}", "add sp, #" ++ show (nargs * 4), "push r0", "mov pc, lr"]
+  return $ code ++ ["pop {r0}", "mov sp, fp", "pop {fp, lr}", "add sp, #" ++ show (nargs * 4), "push {r0}", "mov pc, lr"]
diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index cb11f43..60e4926 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -21,11 +21,11 @@ start :: Function String
 start = Function [] TInt $ Inner $ abstract (const Nothing) $ Call (Var "_exit") [Call (Var "main") []]
 
 exit :: Function String
-exit = native [TInt] TVoid ["pop r1", "mov r0, #1", "swi"]
+exit = native [TInt] TVoid ["pop {r0}", "mov r7, #1", "swi 0"]
 
 builtins :: [(String, Function String)]
 builtins = [
-  ("_builtin_add", native [TInt, TInt] TInt ["pop r0", "pop r1", "add r0, r0, r1", "push r0"]),
+  ("_builtin_add", native [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "add r0, r0, r1", "push {r0}"]),
   ("_start", start),
   ("_exit", exit)
  ]
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 4745681..8dcdc07 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -96,7 +96,7 @@ instance Typecheckable Expr (String, Type) where
       TFun ta t -> return (ta, t)
       t -> throwError $ NotAFunction t f
     when (targs /= tfargs) $ throwError $ ArgumentsTypesDiffer targs tfargs f
-    return (f', tfret)
+    return (Call f' (map fst args'), tfret)
   typecheck (Call f _) = throwError $ NotCallable f
   typecheck (Eq e1 e2) = do
     (e1', te1) <- typecheck e1

From ede6678a0677e685fe39f417df7bdd078e79edb6 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Tue, 19 May 2015 16:40:11 +0300
Subject: [PATCH 091/116] fix codegen for LitInt

---
 komarov.andrey/src/FCC/Codegen.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index 0b0a85c..eacbfff 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -85,7 +85,7 @@ compileE :: Expr Binding -> Codegen [String]
 compileE (Var (Local off)) = return ["ldr r0, [fp, #-" ++ show (off * 4) ++"]", "push {r0}"]
 compileE (Var (Global name)) = return ["ldr r0, " ++ name, "push {r0}"]
 compileE (Var (Arg arg)) = return ["ldr r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push {r0}"]
-compileE (Lit i) = return ["push =" ++ show i]
+compileE (Lit i) = return ["ldr r0, =" ++ show i, "push {r0}"]
 compileE (LitBool True) = return ["push #1\t\t@ true"]
 compileE (LitBool False) = return ["push #0\t\t@ false"]
 compileE (Lam t s) = do

From 2d91cbc236f8525339f2197c198da4cedc37aa49 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Tue, 19 May 2015 17:48:41 +0300
Subject: [PATCH 092/116] fix order of arguments

---
 komarov.andrey/src/FCC/Codegen.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index eacbfff..29dd5d0 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -101,7 +101,7 @@ compileE (Pop e) = do
   return $ code ++ ["pop {r0}"]
 compileE (Seq e1 e2) = (++) <$> compileE e1 <*> compileE e2
 compileE (Call (Var (Global fname)) args) = do
-  compiledArgs <- reverse <$> concat <$> mapM compileE args
+  compiledArgs <- concat <$> reverse <$> mapM compileE args
   return $ compiledArgs ++ ["bl " ++ fname]
 compileE (Call _ _) = impossible
 compileE (Eq _ _) = impossible

From 3bcec08f516232a362c6380b55d2ca6dec54a9ea Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Tue, 19 May 2015 19:06:27 +0300
Subject: [PATCH 093/116] add _builtin_less

---
 komarov.andrey/src/FCC/Codegen.hs | 8 ++++----
 komarov.andrey/src/FCC/Stdlib.hs  | 1 +
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index 29dd5d0..9c64666 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -86,8 +86,8 @@ compileE (Var (Local off)) = return ["ldr r0, [fp, #-" ++ show (off * 4) ++"]",
 compileE (Var (Global name)) = return ["ldr r0, " ++ name, "push {r0}"]
 compileE (Var (Arg arg)) = return ["ldr r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push {r0}"]
 compileE (Lit i) = return ["ldr r0, =" ++ show i, "push {r0}"]
-compileE (LitBool True) = return ["push #1\t\t@ true"]
-compileE (LitBool False) = return ["push #0\t\t@ false"]
+compileE (LitBool True) = return ["mov r0, #1", "push {r0}\t\t@ true"]
+compileE (LitBool False) = return ["mov r0, #0", "push {r0}\t\t@ false"]
 compileE (Lam t s) = do
   v <- freshVar
   off <- gets offset
@@ -110,14 +110,14 @@ compileE (While cond body) = do
   end <- freshLabel
   cond' <- compileE cond
   body' <- compileE body
-  return $ [begin ++ ": @ while"] ++ cond' ++ ["pop {r0}", "tst r0, r0", "bz " ++ end] ++ body' ++ [end ++ ": @ endwhile"]
+  return $ [begin ++ ": @ while"] ++ cond' ++ ["pop {r0}", "tst r0, r0", "beq " ++ end] ++ body' ++ [end ++ ": @ endwhile"]
 compileE (If cond thn els) = do
   elseLabel <- freshLabel
   endIfLabel <- freshLabel
   cond' <- compileE cond
   thn' <- compileE thn
   els' <- compileE els
-  return $ cond' ++ ["pop {r0}", "tst r0, r0", "bz " ++ elseLabel]
+  return $ cond' ++ ["pop {r0}", "tst r0, r0", "beq " ++ elseLabel]
     ++ thn' ++ ["b " ++ endIfLabel, elseLabel ++ ": @ else:"]
     ++ els' ++ [endIfLabel ++ ": @ endif"]
 compileE (Assign (Var (Local off)) src) = do
diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index 60e4926..40ec2f0 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -26,6 +26,7 @@ exit = native [TInt] TVoid ["pop {r0}", "mov r7, #1", "swi 0"]
 builtins :: [(String, Function String)]
 builtins = [
   ("_builtin_add", native [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "add r0, r0, r1", "push {r0}"]),
+  ("_builtin_less", native [TInt, TInt] TBool ["pop {r1, r2}", "cmp r1, r2", "movlt r0, #1", "movge r0, #0", "push {r0}"]),
   ("_start", start),
   ("_exit", exit)
  ]

From e555b62811d4cacf03fc826ef7dcfc777db724a2 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Tue, 19 May 2015 21:08:30 +0300
Subject: [PATCH 094/116] fix while

---
 komarov.andrey/src/FCC/Codegen.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index 9c64666..aa83531 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -33,7 +33,7 @@ modifyOffset f = modify $ \s@(CodegenState{maxOffset = m, offset = o})
                           -> s{maxOffset = m `max` o, offset = f o}
 
 resetMaxOffset :: MonadState CodegenState m => m ()
-resetMaxOffset = modify $ \s -> s{maxOffset = 0}
+resetMaxOffset = modify $ \s -> s{maxOffset = 1}
 
 setArgumentsCount :: MonadState CodegenState m => Int -> m ()
 setArgumentsCount args = modify $ \s -> s{argumentsCount = args}
@@ -77,6 +77,7 @@ compileF (Function _ _ (Native code)) = return $ code ++ ["mov pc, lr"]
 compileF (Function _ _ (Inner s)) = do
   let e = instantiate (return . Arg) (Global <$> s)
   resetMaxOffset
+  modifyOffset (const 1)
   code <- compileE e
   off <- gets maxOffset
   return $ ["push {fp, lr}", "mov fp, sp", "sub sp, #" ++ show (off * 4)] ++ code
@@ -110,7 +111,7 @@ compileE (While cond body) = do
   end <- freshLabel
   cond' <- compileE cond
   body' <- compileE body
-  return $ [begin ++ ": @ while"] ++ cond' ++ ["pop {r0}", "tst r0, r0", "beq " ++ end] ++ body' ++ [end ++ ": @ endwhile"]
+  return $ [begin ++ ": @ while"] ++ cond' ++ ["pop {r0}", "tst r0, r0", "beq " ++ end] ++ body' ++ ["b " ++ begin, end ++ ": @ endwhile"]
 compileE (If cond thn els) = do
   elseLabel <- freshLabel
   endIfLabel <- freshLabel

From bff2b3c1876cc1b943947d60539234b523d6dc68 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Tue, 19 May 2015 23:49:26 +0300
Subject: [PATCH 095/116] stdlib

---
 komarov.andrey/run.sh            | 7 +++++++
 komarov.andrey/src/FCC/Stdlib.hs | 3 +++
 2 files changed, 10 insertions(+)
 create mode 100755 komarov.andrey/run.sh

diff --git a/komarov.andrey/run.sh b/komarov.andrey/run.sh
new file mode 100755
index 00000000..2111f7e
--- /dev/null
+++ b/komarov.andrey/run.sh
@@ -0,0 +1,7 @@
+#!/bin/bash
+
+cat > prog.fc
+fcc < prog.fc > prog.S
+scp prog.S charmander:~/v2/a.S
+ssh charmander 'cd v2; make'
+
diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index 40ec2f0..461bc94 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -26,7 +26,10 @@ exit = native [TInt] TVoid ["pop {r0}", "mov r7, #1", "swi 0"]
 builtins :: [(String, Function String)]
 builtins = [
   ("_builtin_add", native [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "add r0, r0, r1", "push {r0}"]),
+  ("_builtin_sub", native [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "sub r0, r0, r1", "push {r0}"]),
+  ("_builtin_mul", native [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "mul r2, r0, r1", "push {r2}"]),
   ("_builtin_less", native [TInt, TInt] TBool ["pop {r1, r2}", "cmp r1, r2", "movlt r0, #1", "movge r0, #0", "push {r0}"]),
+  ("_builtin_eq_int", native [TInt, TInt] TBool ["pop {r1, r2}", "teq r1, r2", "moveq r0, #1", "movne r0, #0", "push {r0}"]),
   ("_start", start),
   ("_exit", exit)
  ]

From 966fc115a6295b258dc8db067e3e5244b01ddfaf Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 20 May 2015 01:20:43 +0300
Subject: [PATCH 096/116] new works

---
 komarov.andrey/src/FCC/Codegen.hs        | 2 +-
 komarov.andrey/src/FCC/Expr.hs           | 2 ++
 komarov.andrey/src/FCC/Lexer.x           | 2 ++
 komarov.andrey/src/FCC/Parser.y          | 4 +++-
 komarov.andrey/src/FCC/Stdlib.hs         | 8 +++++++-
 komarov.andrey/src/FCC/Typecheck.hs      | 4 ++++
 komarov.andrey/src/FCC/TypecheckError.hs | 1 +
 7 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index aa83531..57cb032 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -126,7 +126,7 @@ compileE (Assign (Var (Local off)) src) = do
   return $ code ++ ["pop {r0}", "str r0, [fp, #-" ++ show (off * 4) ++ "]", "push {r0}"]
 compileE (Assign (Var (Global name)) src) = do
   code <- compileE src
-  return $ code ++ ["pop {r0}", "ldr r1, " ++ show name, "str r0, [r1]", "push {r0}"]
+  return $ code ++ ["pop {r0}", "ldr r1, " ++ name, "str r0, [r1]", "push {r0}"]
 compileE (Assign (Var (Arg arg)) src) = do
   code <- compileE src
   return $ code ++ ["pop {r0}", "str r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push {r0}"]
diff --git a/komarov.andrey/src/FCC/Expr.hs b/komarov.andrey/src/FCC/Expr.hs
index e48ff6e..9adb9c6 100644
--- a/komarov.andrey/src/FCC/Expr.hs
+++ b/komarov.andrey/src/FCC/Expr.hs
@@ -28,6 +28,7 @@ data Expr a
   | If (Expr a) (Expr a) (Expr a)
   | Assign (Expr a) (Expr a)
   | Array (Expr a) (Expr a)
+  | New Type (Expr a)
   | Return (Expr a)
   deriving (Eq, Ord, Show, Read, Foldable, Traversable)
 
@@ -53,6 +54,7 @@ instance Monad Expr where
   If cond thn els >>= f = If (cond >>= f) (thn >>= f) (els >>= f)
   Assign dest src >>= f = Assign (dest >>= f) (src >>= f)
   Array arr ind >>= f = Array (arr >>= f) (ind >>= f)
+  New t e >>= f = New t $ e >>= f
   Return e >>= f = Return $ e >>= f
 
 declVar :: Eq a => Type -> a -> Expr a -> Expr a
diff --git a/komarov.andrey/src/FCC/Lexer.x b/komarov.andrey/src/FCC/Lexer.x
index 63e5b66..b5e907c 100644
--- a/komarov.andrey/src/FCC/Lexer.x
+++ b/komarov.andrey/src/FCC/Lexer.x
@@ -44,6 +44,7 @@ tokens :-
        "return"                 { r TokenReturn }
        "true"                   { r TokenTrue }
        "false"                  { r TokenFalse }
+       "new"                    { r TokenNew }
        ","                      { r TokenComma }
        "&"                      { r TokenAmp }
        "!"                      { r TokenNot }
@@ -104,6 +105,7 @@ data Token = TokenNum Int
            | TokenFalse
            | TokenComma
            | TokenAmp
+           | TokenNew
            | TokenEOF
            deriving (Eq, Show)
 
diff --git a/komarov.andrey/src/FCC/Parser.y b/komarov.andrey/src/FCC/Parser.y
index 687f646..dbfc7b8 100644
--- a/komarov.andrey/src/FCC/Parser.y
+++ b/komarov.andrey/src/FCC/Parser.y
@@ -42,6 +42,7 @@ import FCC.Type
         else            { TokenElse }
         while           { TokenWhile }
         return          { TokenReturn }
+        new             { TokenNew }
         num             { TokenNum $$ }
         true            { TokenTrue }
         false           { TokenFalse }
@@ -57,7 +58,7 @@ import FCC.Type
 %nonassoc '<' '>' '<=' '>='
 %left '+' '-'
 %left '*'
-%left '!'
+%left '!' new
 %nonassoc '[' ']'
 
 
@@ -88,6 +89,7 @@ Expr            : var                           { Var $1 }
                 | var '(' FunCallList ')'       { Call (Var $1) $3 }
                 | Expr '[' Expr ']'             { Array $1 $3 }
                 | Expr '=' Expr                 { Assign $1 $3 }
+                | new Type '[' Expr ']'         { New $2 $4 }
                 | '{' Stmts '}'                 { $2 }
 
 Stmt            :: { Expr String }
diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index 461bc94..fddf847 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -23,6 +23,11 @@ start = Function [] TInt $ Inner $ abstract (const Nothing) $ Call (Var "_exit")
 exit :: Function String
 exit = native [TInt] TVoid ["pop {r0}", "mov r7, #1", "swi 0"]
 
+new :: Function String
+new = native [TVoid] (TArray TVoid) ["ldr r0, =0", "pop {r1}", "ldr r2, =3",
+                                     "ldr r3, =33", "ldr r4, =0", "ldr r5, =0",
+                                     "ldr r7, =192", "swi 0", "push {r0}"]
+
 builtins :: [(String, Function String)]
 builtins = [
   ("_builtin_add", native [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "add r0, r0, r1", "push {r0}"]),
@@ -31,7 +36,8 @@ builtins = [
   ("_builtin_less", native [TInt, TInt] TBool ["pop {r1, r2}", "cmp r1, r2", "movlt r0, #1", "movge r0, #0", "push {r0}"]),
   ("_builtin_eq_int", native [TInt, TInt] TBool ["pop {r1, r2}", "teq r1, r2", "moveq r0, #1", "movne r0, #0", "push {r0}"]),
   ("_start", start),
-  ("_exit", exit)
+  ("_exit", exit),
+  ("_new", new)
  ]
 
            {-
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 8dcdc07..39425dd 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -138,6 +138,10 @@ instance Typecheckable Expr (String, Type) where
       _ -> throwError $ NotAnArray ta a
     when (ti /= TInt) $ throwError $ IndexIsNotInt ti i
     return $ (Array a' i', ta')
+  typecheck (New t e) = do
+    (e', te) <- typecheck e
+    when (te /= TInt) $ throwError $ NewArraySizeIsNotInt te e
+    return (Call (Var ("_new", TFun [TInt] (TArray t))) [e'], TArray t)
   typecheck (Return e) = do
     (e', te) <- typecheck e
     tret <- asks expectedRetType
diff --git a/komarov.andrey/src/FCC/TypecheckError.hs b/komarov.andrey/src/FCC/TypecheckError.hs
index 266315c..cdd4986 100644
--- a/komarov.andrey/src/FCC/TypecheckError.hs
+++ b/komarov.andrey/src/FCC/TypecheckError.hs
@@ -23,5 +23,6 @@ data TypecheckError where
   AssignTypeMismatch :: Show a => Type -> Type -> Expr a -> Expr a -> TypecheckError
   WrongReturnType :: Show a => Type -> Type -> Expr a -> TypecheckError
   UnboundVariables :: Show a => [a] -> TypecheckError
+  NewArraySizeIsNotInt :: Show a => Type -> Expr a -> TypecheckError
 
 deriving instance Show TypecheckError

From fbd6d3debc0a8c5812d7dea93694f597d3681368 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 20 May 2015 01:25:44 +0300
Subject: [PATCH 097/116] fix mmap

---
 komarov.andrey/src/FCC/Stdlib.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index fddf847..7d37b20 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -24,7 +24,7 @@ exit :: Function String
 exit = native [TInt] TVoid ["pop {r0}", "mov r7, #1", "swi 0"]
 
 new :: Function String
-new = native [TVoid] (TArray TVoid) ["ldr r0, =0", "pop {r1}", "ldr r2, =3",
+new = native [TVoid] (TArray TVoid) ["ldr r0, =0", "pop {r1}", "add r1, r0, r1, LSL#2", "ldr r2, =3",
                                      "ldr r3, =33", "ldr r4, =0", "ldr r5, =0",
                                      "ldr r7, =192", "swi 0", "push {r0}"]
 

From 84f74496642a03dafd01b0abd56ef97cf1df6f37 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 20 May 2015 01:39:14 +0300
Subject: [PATCH 098/116] sieve example

---
 komarov.andrey/examples/sieve.fc | 43 ++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)
 create mode 100644 komarov.andrey/examples/sieve.fc

diff --git a/komarov.andrey/examples/sieve.fc b/komarov.andrey/examples/sieve.fc
new file mode 100644
index 00000000..aee2773
--- /dev/null
+++ b/komarov.andrey/examples/sieve.fc
@@ -0,0 +1,43 @@
+int count(bool* a, int n)
+{
+    int i;
+    i = 0;
+    int res;
+    res = 0;
+    while (i < n)
+    {
+        if (a[i]) { res = res + 1; } else {}
+        i = i + 1;
+    }
+    return res;
+}
+
+bool* sieve(int n)
+{
+    bool* res;
+    res = new bool[n];
+    int i;
+    i = 0;
+    while (i < n) { res[i] = true; i = i + 1; }
+    res[1] = false;
+    res[0] = false;
+    i = 2;
+    while (i < n)
+    {
+        if (res[i]) {
+            int j;
+            j = 2 * i;
+            while (j < n) { res[j] = false; j = j + i; }
+        } else {}
+        i = i + 1;
+    }
+    return res;
+}
+
+int main()
+{
+    int n; n = 1000;
+    bool* a; a = sieve(n);
+    int cnt; cnt = count(a, n);
+    return cnt;
+}

From 70d84d1f7a4a9a54e0c6d327914bbf4230b8640e Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 20 May 2015 02:29:41 +0300
Subject: [PATCH 099/116] shrink unreachable code

---
 komarov.andrey/examples/fact.fc               | 10 ++++--
 komarov.andrey/fcc.cabal                      |  3 +-
 komarov.andrey/src/FCC/Codegen.hs             |  3 +-
 komarov.andrey/src/FCC/Optimize.hs            | 12 +++++++
 .../src/FCC/Optimize/ShrinkUnused.hs          | 33 +++++++++++++++++++
 komarov.andrey/src/Main.hs                    |  3 +-
 6 files changed, 58 insertions(+), 6 deletions(-)
 create mode 100644 komarov.andrey/src/FCC/Optimize.hs
 create mode 100644 komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs

diff --git a/komarov.andrey/examples/fact.fc b/komarov.andrey/examples/fact.fc
index a43666e..dcd5476 100644
--- a/komarov.andrey/examples/fact.fc
+++ b/komarov.andrey/examples/fact.fc
@@ -1,6 +1,12 @@
 int fact(int n) {
-    if (n == 0)
+    if (n == 0) {
         return 1;
-    else
+    } else {
         return n * fact(n - 1);
+    }
+}
+
+int main()
+{
+    return fact(5);
 }
diff --git a/komarov.andrey/fcc.cabal b/komarov.andrey/fcc.cabal
index 0ec23bd..47eea0c 100644
--- a/komarov.andrey/fcc.cabal
+++ b/komarov.andrey/fcc.cabal
@@ -16,7 +16,8 @@ cabal-version:       >=1.20
 executable fcc
   main-is:           Main.hs
   other-modules:     FCC.Parser, FCC.Lexer, FCC.Expr, FCC.Program,
-                     FCC.Type, FCC.Stdlib, FCC.TypecheckError, FCC.Typecheck
+                     FCC.Type, FCC.Stdlib, FCC.TypecheckError, FCC.Typecheck,
+                     FCC.Optimize
   build-depends:     base >=4.8 && <5, array, containers, mtl, bound, prelude-extras
   build-tools:       happy, alex
   hs-source-dirs:    src
diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index 57cb032..a09c583 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -6,7 +6,6 @@ module FCC.Codegen (
 
 import FCC.Expr
 import FCC.Program
-import FCC.Stdlib
 
 import Bound
 
@@ -64,7 +63,7 @@ compileP (Program funs vars) = do
       dataBody = [name ++ ": .word 0" | name <- dataSegNames]
       textVeryHead = ["", "@@@@@@@@@", ".text"]
       textHead = [realName ++ ": .word " ++ dataName | (realName, dataName) <- zip (M.keys vars) dataSegNames]
-  functions <- mapM f $ M.toList (funs <> M.fromList builtins)
+  functions <- mapM f $ M.toList funs
   return $ dataHead ++ dataBody ++ textVeryHead ++ textHead ++ concat functions
     where
     f :: (String, Function String) -> Codegen [String]
diff --git a/komarov.andrey/src/FCC/Optimize.hs b/komarov.andrey/src/FCC/Optimize.hs
new file mode 100644
index 00000000..7b59cc7
--- /dev/null
+++ b/komarov.andrey/src/FCC/Optimize.hs
@@ -0,0 +1,12 @@
+module FCC.Optimize (
+  optimize,
+  ) where
+
+import FCC.Program
+
+import FCC.Optimize.ShrinkUnused
+
+import Data.Maybe
+
+optimize :: Program String -> Program String
+optimize p = fromMaybe p (shrink p)
diff --git a/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs b/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs
new file mode 100644
index 00000000..f97d58e
--- /dev/null
+++ b/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs
@@ -0,0 +1,33 @@
+module FCC.Optimize.ShrinkUnused (
+  shrink,
+  ) where
+
+import FCC.Program
+
+import Data.Foldable
+import Control.Monad.RWS
+
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+start = "_start"
+
+shrink :: Program String -> Maybe (Program String)
+shrink p@(Program funs vars) = if p == p' then Nothing else Just p' where
+  used = fix' (S.singleton start) (upd funs)
+  funs' = M.filterWithKey (\n _ -> n `S.member` used) funs
+  vars' = M.filterWithKey (\n _ -> n `S.member` used) vars
+  p' = Program funs' vars'
+
+   
+fix' :: Eq a => a -> (a -> a) -> a
+fix' init mod = if new == init then init else fix' new mod where
+  new = mod init
+
+upd :: M.Map String (Function String) -> S.Set String -> S.Set String
+upd funs reached = reached `S.union` S.unions [free f | (name, f) <- M.toList funs, name `S.member` reached]
+
+free :: Function String -> S.Set String
+free (Function _ _ (Native _)) = S.empty
+free (Function _ _ (Inner s)) = S.fromList $ toList s
+  
diff --git a/komarov.andrey/src/Main.hs b/komarov.andrey/src/Main.hs
index 3758a45..305035a 100644
--- a/komarov.andrey/src/Main.hs
+++ b/komarov.andrey/src/Main.hs
@@ -4,6 +4,7 @@ import FCC.Parser
 import FCC.Typecheck
 import FCC.Codegen
 import FCC.Stdlib
+import FCC.Optimize
 
 import Data.List (intercalate)
 
@@ -15,4 +16,4 @@ main = do
    Left e -> putStrLn $ "failed to parse: " ++ show e
    Right x -> case runTC (withStdlib x) of
      Left e' -> putStrLn $ "failed to typecheck: " ++ show e'
-     Right p -> (putStrLn $ "@ " ++ show p) >> (putStrLn $ intercalate "\n" $ codegen p)
+     Right p -> let p' = optimize p in (putStrLn $ "@ " ++ show p') >> (putStrLn $ intercalate "\n" $ codegen p')

From ae21de996f75993c191059d7e0aac4bebb4903ba Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 20 May 2015 02:33:17 +0300
Subject: [PATCH 100/116] fix read global var

---
 komarov.andrey/src/FCC/Codegen.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index a09c583..f2f3425 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -83,7 +83,7 @@ compileF (Function _ _ (Inner s)) = do
 
 compileE :: Expr Binding -> Codegen [String]
 compileE (Var (Local off)) = return ["ldr r0, [fp, #-" ++ show (off * 4) ++"]", "push {r0}"]
-compileE (Var (Global name)) = return ["ldr r0, " ++ name, "push {r0}"]
+compileE (Var (Global name)) = return ["ldr r0, " ++ name, "ldr r0, [r0]", "push {r0}"]
 compileE (Var (Arg arg)) = return ["ldr r0, [fp, #" ++ show (arg * 4 + 8) ++ "]", "push {r0}"]
 compileE (Lit i) = return ["ldr r0, =" ++ show i, "push {r0}"]
 compileE (LitBool True) = return ["mov r0, #1", "push {r0}\t\t@ true"]

From 4aed32804ec8a26daac0b1b4f493ec42bfaab72e Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Wed, 20 May 2015 02:35:57 +0300
Subject: [PATCH 101/116] Int -> Int32

---
 komarov.andrey/src/FCC/Expr.hs | 3 ++-
 komarov.andrey/src/FCC/Lexer.x | 3 ++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/komarov.andrey/src/FCC/Expr.hs b/komarov.andrey/src/FCC/Expr.hs
index 9adb9c6..4382561 100644
--- a/komarov.andrey/src/FCC/Expr.hs
+++ b/komarov.andrey/src/FCC/Expr.hs
@@ -11,12 +11,13 @@ import FCC.Type
 
 import Control.Monad
 
+import Data.Int
 import Prelude.Extras
 import Bound
 
 data Expr a
   = Var a
-  | Lit Int
+  | Lit Int32
   | LitBool Bool
   | Lam Type (Scope () Expr a)
   | Empty
diff --git a/komarov.andrey/src/FCC/Lexer.x b/komarov.andrey/src/FCC/Lexer.x
index b5e907c..1727e5d 100644
--- a/komarov.andrey/src/FCC/Lexer.x
+++ b/komarov.andrey/src/FCC/Lexer.x
@@ -4,6 +4,7 @@ module FCC.Lexer (
        Token(..), lexer
 ) where
 
+import Data.Int
 import qualified Data.Set as S
 }
 
@@ -73,7 +74,7 @@ alexInitUserState = AlexUserState $ S.fromList ["int", "void", "bool"]
 alexEOF :: Alex Token
 alexEOF = return TokenEOF
 
-data Token = TokenNum Int
+data Token = TokenNum Int32
            | TokenVar String
            | TokenTyVar String
            | TokenLParen

From c5eebb6c83d29d55d207c23d32d6947cc69ec789 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 21 May 2015 01:19:12 +0300
Subject: [PATCH 102/116] optimization started

---
 komarov.andrey/src/FCC/Codegen.hs             |  2 +-
 komarov.andrey/src/FCC/Eval.hs                | 18 +++++
 komarov.andrey/src/FCC/Optimize.hs            |  1 +
 komarov.andrey/src/FCC/Optimize/CalcPure.hs   | 66 +++++++++++++++++++
 .../src/FCC/Optimize/ShrinkUnused.hs          |  2 +-
 komarov.andrey/src/FCC/Optimize/StdlibEval.hs | 32 +++++++++
 komarov.andrey/src/FCC/Program.hs             |  2 +-
 komarov.andrey/src/FCC/Stdlib.hs              | 26 ++++----
 komarov.andrey/src/FCC/Typecheck.hs           |  2 +-
 9 files changed, 134 insertions(+), 17 deletions(-)
 create mode 100644 komarov.andrey/src/FCC/Eval.hs
 create mode 100644 komarov.andrey/src/FCC/Optimize/CalcPure.hs
 create mode 100644 komarov.andrey/src/FCC/Optimize/StdlibEval.hs

diff --git a/komarov.andrey/src/FCC/Codegen.hs b/komarov.andrey/src/FCC/Codegen.hs
index f2f3425..1f8ef04 100644
--- a/komarov.andrey/src/FCC/Codegen.hs
+++ b/komarov.andrey/src/FCC/Codegen.hs
@@ -72,7 +72,7 @@ compileP (Program funs vars) = do
       return $ ["", "@@@@@@@", name ++ ":"] ++ code
 
 compileF :: Function String -> Codegen [String]
-compileF (Function _ _ (Native code)) = return $ code ++ ["mov pc, lr"]
+compileF (Function _ _ (Native _ code)) = return $ code ++ ["mov pc, lr"]
 compileF (Function _ _ (Inner s)) = do
   let e = instantiate (return . Arg) (Global <$> s)
   resetMaxOffset
diff --git a/komarov.andrey/src/FCC/Eval.hs b/komarov.andrey/src/FCC/Eval.hs
new file mode 100644
index 00000000..c1c1175
--- /dev/null
+++ b/komarov.andrey/src/FCC/Eval.hs
@@ -0,0 +1,18 @@
+module FCC.Eval (
+  Eval(..),
+  Value(..),
+  ) where
+
+import FCC.Expr
+
+import Data.Int
+import qualified Data.Map as M
+
+data Value
+  = VVoid
+  | VInt Int32
+  | VBool Bool
+  | VArray (M.Map Int32 Value)
+
+type Eval = [Value] -> Maybe Value
+
diff --git a/komarov.andrey/src/FCC/Optimize.hs b/komarov.andrey/src/FCC/Optimize.hs
index 7b59cc7..02e9c75 100644
--- a/komarov.andrey/src/FCC/Optimize.hs
+++ b/komarov.andrey/src/FCC/Optimize.hs
@@ -5,6 +5,7 @@ module FCC.Optimize (
 import FCC.Program
 
 import FCC.Optimize.ShrinkUnused
+import FCC.Optimize.CalcPure
 
 import Data.Maybe
 
diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
new file mode 100644
index 00000000..47c33c9
--- /dev/null
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module FCC.Optimize.CalcPure (
+
+  ) where
+
+import FCC.Expr
+import FCC.Eval
+import FCC.Program
+import FCC.Optimize.StdlibEval
+
+import Control.Monad.Except
+import Control.Monad.State
+import Control.Monad.Reader
+
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+timeout = 10000
+impossible = error "FATAL ERROR ¯\\_(ツ)_/¯"
+
+data Context = Context {
+  bindings :: M.Map String Value,
+  counter :: Int }
+
+newtype Evaluator a = Evaluator {
+  runEvaluator :: ExceptT () (StateT Context (Reader (S.Set String))) a
+  } deriving (Functor, Applicative, Monad,
+              MonadError (), MonadReader (S.Set String), MonadState Context)
+
+tick :: Evaluator ()
+tick = do
+  remain <- gets counter
+  when (remain <= 0) $ throwError ()
+  modify $ \c -> c{ counter = remain - 1 }
+
+eval :: Expr String -> Evaluator Value
+eval (Var v) = _
+eval (Lit i) = return $ VInt i
+eval (LitBool b) = return $ VBool b
+eval (Lam t s) = _
+eval Empty = return $ VVoid
+eval (Pop e) = tick >> eval e
+eval (Seq e1 e2) = tick >> eval e1 >> eval e2
+eval (Call f args) = _
+eval (Eq _ _) = impossible
+eval (While cond body) = _
+eval (If cond thn els) = _
+eval (Assign dest src) = _
+eval (Array a i) = _
+eval (New _) = impossible
+eval (Return e) = _
+
+findPure :: Program String -> S.Set String
+findPure (Program funs vars) = undefined where
+  allPure = fix' S.empty (updPure funs)
+
+updPure :: M.Map String (Function String) -> S.Set String -> S.Set String
+updPure funs ctx = ctx `S.union` S.fromList [name | (name, f) <- M.toList funs, isPure ctx f]
+
+isPure :: S.Set String -> Function String -> Bool
+isPure _ (Function _ _ (Native name _)) = name `M.member` builtinsE
+isPure ctx (Function _ _ (Inner s)) = all (`S.member` ctx) s
+
+fix' :: Eq a => a -> (a -> a) -> a
+fix' init mod = if new == init then init else fix' new mod where
+  new = mod init
diff --git a/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs b/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs
index f97d58e..e9e5f5b 100644
--- a/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs
+++ b/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs
@@ -28,6 +28,6 @@ upd :: M.Map String (Function String) -> S.Set String -> S.Set String
 upd funs reached = reached `S.union` S.unions [free f | (name, f) <- M.toList funs, name `S.member` reached]
 
 free :: Function String -> S.Set String
-free (Function _ _ (Native _)) = S.empty
+free (Function _ _ (Native _ _)) = S.empty
 free (Function _ _ (Inner s)) = S.fromList $ toList s
   
diff --git a/komarov.andrey/src/FCC/Optimize/StdlibEval.hs b/komarov.andrey/src/FCC/Optimize/StdlibEval.hs
new file mode 100644
index 00000000..da7d6bb
--- /dev/null
+++ b/komarov.andrey/src/FCC/Optimize/StdlibEval.hs
@@ -0,0 +1,32 @@
+module FCC.Optimize.StdlibEval (
+  builtinsE
+  ) where
+
+import FCC.Eval
+
+import Data.Int
+import qualified Data.Map as M
+
+new :: Eval
+new [VInt size] = Just $ VArray M.empty
+
+liftI2 :: (Int32 -> Int32 -> Int32) -> Eval
+liftI2 op [VInt i1, VInt i2] = Just $ VInt $ i1 `op` i2
+liftI2 _ _ = Nothing
+
+liftI2B :: (Int32 -> Int32 -> Bool) -> Eval
+liftI2B op [VInt i1, VInt i2] = Just $ VBool $ i1 `op` i2
+liftI2B _ _ = Nothing
+
+builtinsE :: M.Map String Eval
+builtinsE = M.fromList $ [
+  ("_new", new), -- какая-то скользкая дорожка. не доверяю вычислятору new
+  ("_builtin_add", liftI2 (+)),
+  ("_builtin_sub", liftI2 (-)),
+  ("_builtin_mul", liftI2 (*)),
+  ("_builtin_less", liftI2B (<)),
+  ("_builtin_eq_int", liftI2B (==)),
+  ("_builtin_eq_bool", liftI2B (==)),
+  ("_builtin_eq_ptr", liftI2B (==))
+ ]
+  
diff --git a/komarov.andrey/src/FCC/Program.hs b/komarov.andrey/src/FCC/Program.hs
index ce6ab48..d082272 100644
--- a/komarov.andrey/src/FCC/Program.hs
+++ b/komarov.andrey/src/FCC/Program.hs
@@ -17,7 +17,7 @@ import qualified Data.Map as M
 
 data FunctionBody a
   = Inner (Scope Int Expr a)
-  | Native [String]
+  | Native String [String]
   deriving (Eq, Ord, Show)
 
 data Function a
diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index 7d37b20..85201b6 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -14,30 +14,30 @@ import qualified Data.Map as M
 withStdlib :: Program String -> Program String
 withStdlib (Program funs vars) = Program (funs `M.union` (M.fromList builtins)) vars
 
-native :: [Type] -> Type -> [String] -> Function String
-native args ret body = Function args ret $ Native body
+native :: String -> [Type] -> Type -> [String] -> (String, Function String)
+native name args ret body = (name, Function args ret $ Native name body)
 
 start :: Function String
 start = Function [] TInt $ Inner $ abstract (const Nothing) $ Call (Var "_exit") [Call (Var "main") []]
 
-exit :: Function String
-exit = native [TInt] TVoid ["pop {r0}", "mov r7, #1", "swi 0"]
+exit :: (String, Function String)
+exit = native "_exit" [TInt] TVoid ["pop {r0}", "mov r7, #1", "swi 0"]
 
-new :: Function String
-new = native [TVoid] (TArray TVoid) ["ldr r0, =0", "pop {r1}", "add r1, r0, r1, LSL#2", "ldr r2, =3",
+new :: (String, Function String)
+new = native "_new" [TVoid] (TArray TVoid) ["ldr r0, =0", "pop {r1}", "add r1, r0, r1, LSL#2", "ldr r2, =3",
                                      "ldr r3, =33", "ldr r4, =0", "ldr r5, =0",
                                      "ldr r7, =192", "swi 0", "push {r0}"]
 
 builtins :: [(String, Function String)]
 builtins = [
-  ("_builtin_add", native [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "add r0, r0, r1", "push {r0}"]),
-  ("_builtin_sub", native [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "sub r0, r0, r1", "push {r0}"]),
-  ("_builtin_mul", native [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "mul r2, r0, r1", "push {r2}"]),
-  ("_builtin_less", native [TInt, TInt] TBool ["pop {r1, r2}", "cmp r1, r2", "movlt r0, #1", "movge r0, #0", "push {r0}"]),
-  ("_builtin_eq_int", native [TInt, TInt] TBool ["pop {r1, r2}", "teq r1, r2", "moveq r0, #1", "movne r0, #0", "push {r0}"]),
+  native "_builtin_add" [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "add r0, r0, r1", "push {r0}"],
+  native "_builtin_sub" [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "sub r0, r0, r1", "push {r0}"],
+  native "_builtin_mul" [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "mul r2, r0, r1", "push {r2}"],
+  native "_builtin_less" [TInt, TInt] TBool ["pop {r1, r2}", "cmp r1, r2", "movlt r0, #1", "movge r0, #0", "push {r0}"],
+  native "_builtin_eq_int" [TInt, TInt] TBool ["pop {r1, r2}", "teq r1, r2", "moveq r0, #1", "movne r0, #0", "push {r0}"],
   ("_start", start),
-  ("_exit", exit),
-  ("_new", new)
+  exit,
+  new
  ]
 
            {-
diff --git a/komarov.andrey/src/FCC/Typecheck.hs b/komarov.andrey/src/FCC/Typecheck.hs
index 39425dd..1182e3f 100644
--- a/komarov.andrey/src/FCC/Typecheck.hs
+++ b/komarov.andrey/src/FCC/Typecheck.hs
@@ -56,7 +56,7 @@ instance Typecheckable Program String where
     freeVars :: Function String -> [String]
     freeVars f = case body f of
       Inner s -> toList s
-      Native _ -> []
+      Native _ _ -> []
 
     ff :: Function String -> Typecheck (Function String)
     ff f@Function {body = Native{}} = return f

From d1794b37e4cbee262fda97c1e64a7ec8d844ecd6 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Thu, 21 May 2015 02:20:52 +0300
Subject: [PATCH 103/116] optimize stuck

---
 komarov.andrey/src/FCC/Optimize/CalcPure.hs | 78 +++++++++++++++++----
 1 file changed, 66 insertions(+), 12 deletions(-)

diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
index 47c33c9..e19b649 100644
--- a/komarov.andrey/src/FCC/Optimize/CalcPure.hs
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -3,11 +3,14 @@ module FCC.Optimize.CalcPure (
 
   ) where
 
+import FCC.Type
 import FCC.Expr
 import FCC.Eval
 import FCC.Program
 import FCC.Optimize.StdlibEval
 
+import Bound
+
 import Control.Monad.Except
 import Control.Monad.State
 import Control.Monad.Reader
@@ -20,35 +23,86 @@ impossible = error "FATAL ERROR ¯\\_(ツ)_/¯"
 
 data Context = Context {
   bindings :: M.Map String Value,
-  counter :: Int }
+  counter :: Int,
+  bound :: Int }
+
+data ROContext = ROContext {
+  pureFunctions :: S.Set String,
+  ctxFunctions :: M.Map String (Function String) }
 
+-- Использовать throwError для сообщения об успехе вместо
+               -- какого-нибудь ContT - фу
 newtype Evaluator a = Evaluator {
-  runEvaluator :: ExceptT () (StateT Context (Reader (S.Set String))) a
+  runEvaluator :: ExceptT (Maybe Value) (StateT Context (Reader ROContext)) a
   } deriving (Functor, Applicative, Monad,
-              MonadError (), MonadReader (S.Set String), MonadState Context)
+              MonadError (Maybe Value), MonadReader ROContext, MonadState Context)
 
 tick :: Evaluator ()
 tick = do
   remain <- gets counter
-  when (remain <= 0) $ throwError ()
+  when (remain <= 0) $ throwError Nothing
   modify $ \c -> c{ counter = remain - 1 }
 
+fresh :: Evaluator String
+fresh = do
+  var <- gets bound
+  modify $ \c -> c{bound = var + 1}
+  return $ "_opt_var_" ++ show var
+
+defaultVal :: Type -> Value
+defaultVal TInt = VInt 0
+defaultVal TBool = VBool False
+defaultVal TVoid = VVoid
+defaultVal (TArray _) = VArray M.empty
+defaultVal (TFun _ _) = impossible
+
+call :: Function String -> [Value] -> Evaluator Value
+call (Function _ _ (Native name _)) args = do
+  tick
+  case (builtinsE M.! name) args of
+   Nothing -> throwError Nothing
+   Just res -> return res
+call (Function _ fargs (Inner s)) args = do
+  _
+
 eval :: Expr String -> Evaluator Value
-eval (Var v) = _
+eval (Var v) = gets $ (M.! v) . bindings
 eval (Lit i) = return $ VInt i
 eval (LitBool b) = return $ VBool b
-eval (Lam t s) = _
+eval (Lam t s) = do
+  v <- fresh
+  modify $ \c -> c{bindings = M.insert v (defaultVal t) (bindings c)}
+  eval $ instantiate1 (Var v) s
 eval Empty = return $ VVoid
 eval (Pop e) = tick >> eval e
 eval (Seq e1 e2) = tick >> eval e1 >> eval e2
-eval (Call f args) = _
+eval (Call (Var fname) args) = do
+  f <- asks $ (M.! fname) . ctxFunctions
+  args' <- mapM eval args
+  call f args'
+eval (Call _ _) = impossible
 eval (Eq _ _) = impossible
-eval (While cond body) = _
-eval (If cond thn els) = _
-eval (Assign dest src) = _
+eval e@(While cond body) = do
+  c <- eval cond
+  case c of
+   VBool b -> if b then eval e else return VVoid
+   _ -> impossible
+eval (If cond thn els) = do
+  c <- eval cond
+  case c of
+   VBool b -> if b then eval thn else eval els
+   _ -> impossible
+eval (Assign (Var v) src) = do
+  src' <- eval src
+  modify $ \c -> c{bindings = M.insert v src' (bindings c)}
+  _
+eval (Assign (Array a i) src) = _ -- TODO ?????? :((((((
+eval (Assign _ _) = impossible
 eval (Array a i) = _
-eval (New _) = impossible
-eval (Return e) = _
+eval (New _ _) = impossible
+eval (Return e) = do
+  e' <- eval e
+  return $ e'
 
 findPure :: Program String -> S.Set String
 findPure (Program funs vars) = undefined where

From e5f31a182fbfc8586ec95002b9efba9cba3e68f0 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Thu, 21 May 2015 16:40:44 +0300
Subject: [PATCH 104/116] cat works!

---
 komarov.andrey/examples/cat.c                 |  9 +++++++++
 komarov.andrey/src/FCC/Optimize.hs            |  2 +-
 komarov.andrey/src/FCC/Optimize/StdlibEval.hs |  8 +++++++-
 komarov.andrey/src/FCC/Stdlib.hs              | 11 +++++++++++
 4 files changed, 28 insertions(+), 2 deletions(-)
 create mode 100644 komarov.andrey/examples/cat.c

diff --git a/komarov.andrey/examples/cat.c b/komarov.andrey/examples/cat.c
new file mode 100644
index 00000000..c0e6df0
--- /dev/null
+++ b/komarov.andrey/examples/cat.c
@@ -0,0 +1,9 @@
+int main() {
+	int c;
+	c = getchar();
+	while (c != 0-1) {
+		putchar(c);
+		c = getchar();
+	}
+	return 0;
+}
diff --git a/komarov.andrey/src/FCC/Optimize.hs b/komarov.andrey/src/FCC/Optimize.hs
index 02e9c75..81a87da 100644
--- a/komarov.andrey/src/FCC/Optimize.hs
+++ b/komarov.andrey/src/FCC/Optimize.hs
@@ -5,7 +5,7 @@ module FCC.Optimize (
 import FCC.Program
 
 import FCC.Optimize.ShrinkUnused
-import FCC.Optimize.CalcPure
+--import FCC.Optimize.CalcPure
 
 import Data.Maybe
 
diff --git a/komarov.andrey/src/FCC/Optimize/StdlibEval.hs b/komarov.andrey/src/FCC/Optimize/StdlibEval.hs
index da7d6bb..2274976 100644
--- a/komarov.andrey/src/FCC/Optimize/StdlibEval.hs
+++ b/komarov.andrey/src/FCC/Optimize/StdlibEval.hs
@@ -18,6 +18,10 @@ liftI2B :: (Int32 -> Int32 -> Bool) -> Eval
 liftI2B op [VInt i1, VInt i2] = Just $ VBool $ i1 `op` i2
 liftI2B _ _ = Nothing
 
+liftB :: (Bool -> Bool) -> Eval
+liftB op [VBool b] = Just $ VBool $ op b
+liftB _ _ = Nothing
+
 builtinsE :: M.Map String Eval
 builtinsE = M.fromList $ [
   ("_new", new), -- какая-то скользкая дорожка. не доверяю вычислятору new
@@ -27,6 +31,8 @@ builtinsE = M.fromList $ [
   ("_builtin_less", liftI2B (<)),
   ("_builtin_eq_int", liftI2B (==)),
   ("_builtin_eq_bool", liftI2B (==)),
-  ("_builtin_eq_ptr", liftI2B (==))
+  ("_builtin_eq_ptr", liftI2B (==)),
+  ("_builtin_not", liftB (not))
+
  ]
   
diff --git a/komarov.andrey/src/FCC/Stdlib.hs b/komarov.andrey/src/FCC/Stdlib.hs
index 85201b6..54a729e 100644
--- a/komarov.andrey/src/FCC/Stdlib.hs
+++ b/komarov.andrey/src/FCC/Stdlib.hs
@@ -28,6 +28,14 @@ new = native "_new" [TVoid] (TArray TVoid) ["ldr r0, =0", "pop {r1}", "add r1, r
                                      "ldr r3, =33", "ldr r4, =0", "ldr r5, =0",
                                      "ldr r7, =192", "swi 0", "push {r0}"]
 
+getchar :: (String, Function String)
+getchar = native "getchar" [] TInt ["ldr r7, =3", "ldr r0, =0", "push {r0}", "mov r1, sp", "ldr r2, =1", "swi 0",
+                                    "ldr r2, =0", "ldr r1, =-1", "cmp r0, r2", "strle r1, [sp]"]
+
+putchar :: (String, Function String)
+putchar = native "putchar" [TInt] TInt ["ldr r7, =4", "ldr r0, =1", "mov r1, sp", "ldr r2, =1", "swi 0",
+                                        "ldr r0, [sp]"]
+
 builtins :: [(String, Function String)]
 builtins = [
   native "_builtin_add" [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "add r0, r0, r1", "push {r0}"],
@@ -35,7 +43,10 @@ builtins = [
   native "_builtin_mul" [TInt, TInt] TInt ["pop {r0}", "pop {r1}", "mul r2, r0, r1", "push {r2}"],
   native "_builtin_less" [TInt, TInt] TBool ["pop {r1, r2}", "cmp r1, r2", "movlt r0, #1", "movge r0, #0", "push {r0}"],
   native "_builtin_eq_int" [TInt, TInt] TBool ["pop {r1, r2}", "teq r1, r2", "moveq r0, #1", "movne r0, #0", "push {r0}"],
+  native "_builtin_not" [TBool] TBool ["pop {r0}", "ldr r1, =1", "sub r0, r1, r0", "push {r0}"],
   ("_start", start),
+  getchar,
+  putchar,
   exit,
   new
  ]

From 0e6059a2919a0cfcd5360000376884cbb9699bd9 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <andkomarov@yandex-team.ru>
Date: Thu, 21 May 2015 19:44:38 +0300
Subject: [PATCH 105/116] cont started

---
 komarov.andrey/src/FCC/Optimize.hs          |  2 +-
 komarov.andrey/src/FCC/Optimize/CalcPure.hs | 76 ++++++++++++---------
 2 files changed, 43 insertions(+), 35 deletions(-)

diff --git a/komarov.andrey/src/FCC/Optimize.hs b/komarov.andrey/src/FCC/Optimize.hs
index 81a87da..02e9c75 100644
--- a/komarov.andrey/src/FCC/Optimize.hs
+++ b/komarov.andrey/src/FCC/Optimize.hs
@@ -5,7 +5,7 @@ module FCC.Optimize (
 import FCC.Program
 
 import FCC.Optimize.ShrinkUnused
---import FCC.Optimize.CalcPure
+import FCC.Optimize.CalcPure
 
 import Data.Maybe
 
diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
index e19b649..d835162 100644
--- a/komarov.andrey/src/FCC/Optimize/CalcPure.hs
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -14,6 +14,7 @@ import Bound
 import Control.Monad.Except
 import Control.Monad.State
 import Control.Monad.Reader
+import Control.Monad.Cont
 
 import qualified Data.Set as S
 import qualified Data.Map as M
@@ -28,22 +29,24 @@ data Context = Context {
 
 data ROContext = ROContext {
   pureFunctions :: S.Set String,
-  ctxFunctions :: M.Map String (Function String) }
+  ctxFunctions :: M.Map String (Function String)
+  }
 
 -- Использовать throwError для сообщения об успехе вместо
                -- какого-нибудь ContT - фу
-newtype Evaluator a = Evaluator {
-  runEvaluator :: ExceptT (Maybe Value) (StateT Context (Reader ROContext)) a
+newtype Evaluator r a = Evaluator {
+  runEvaluator :: ExceptT (Maybe Value) (ContT r (StateT Context (Reader ROContext))) a
   } deriving (Functor, Applicative, Monad,
-              MonadError (Maybe Value), MonadReader ROContext, MonadState Context)
+              MonadError (Maybe Value), MonadReader ROContext,
+              MonadState Context, MonadCont)
 
-tick :: Evaluator ()
+tick :: Evaluator r ()
 tick = do
   remain <- gets counter
   when (remain <= 0) $ throwError Nothing
   modify $ \c -> c{ counter = remain - 1 }
 
-fresh :: Evaluator String
+fresh :: Evaluator r String
 fresh = do
   var <- gets bound
   modify $ \c -> c{bound = var + 1}
@@ -56,6 +59,7 @@ defaultVal TVoid = VVoid
 defaultVal (TArray _) = VArray M.empty
 defaultVal (TFun _ _) = impossible
 
+{-
 call :: Function String -> [Value] -> Evaluator Value
 call (Function _ _ (Native name _)) args = do
   tick
@@ -64,45 +68,49 @@ call (Function _ _ (Native name _)) args = do
    Just res -> return res
 call (Function _ fargs (Inner s)) args = do
   _
+-}
 
-eval :: Expr String -> Evaluator Value
-eval (Var v) = gets $ (M.! v) . bindings
-eval (Lit i) = return $ VInt i
-eval (LitBool b) = return $ VBool b
-eval (Lam t s) = do
+call :: _
+call = _
+
+eval :: _ -> Expr String -> Evaluator r Value
+eval k (Var v) = gets $ (M.! v) . bindings
+eval k (Lit i) = return $ VInt i
+eval k (LitBool b) = return $ VBool b
+eval k (Lam t s) = do
   v <- fresh
   modify $ \c -> c{bindings = M.insert v (defaultVal t) (bindings c)}
-  eval $ instantiate1 (Var v) s
-eval Empty = return $ VVoid
-eval (Pop e) = tick >> eval e
-eval (Seq e1 e2) = tick >> eval e1 >> eval e2
-eval (Call (Var fname) args) = do
+  eval k $ instantiate1 (Var v) s
+eval k Empty = return $ VVoid
+eval k (Pop e) = tick >> eval k e
+eval k (Seq e1 e2) = tick >> eval k e1 >> eval k e2
+eval k (Call (Var fname) args) = do
   f <- asks $ (M.! fname) . ctxFunctions
-  args' <- mapM eval args
+  args' <- mapM (eval k) args
   call f args'
-eval (Call _ _) = impossible
-eval (Eq _ _) = impossible
-eval e@(While cond body) = do
-  c <- eval cond
+eval k (Call _ _) = impossible
+eval k (Eq _ _) = impossible
+eval k e@(While cond body) = do
+  c <- eval k cond
   case c of
-   VBool b -> if b then eval e else return VVoid
+   VBool b -> if b then eval k e else return VVoid
    _ -> impossible
-eval (If cond thn els) = do
-  c <- eval cond
+eval k (If cond thn els) = do
+  c <- eval k cond
   case c of
-   VBool b -> if b then eval thn else eval els
+   VBool b -> if b then eval k thn else eval k els
    _ -> impossible
-eval (Assign (Var v) src) = do
-  src' <- eval src
+eval k (Assign (Var v) src) = do
+  src' <- eval k src
   modify $ \c -> c{bindings = M.insert v src' (bindings c)}
   _
-eval (Assign (Array a i) src) = _ -- TODO ?????? :((((((
-eval (Assign _ _) = impossible
-eval (Array a i) = _
-eval (New _ _) = impossible
-eval (Return e) = do
-  e' <- eval e
-  return $ e'
+eval k (Assign (Array a i) src) = _ -- TODO ?????? :((((((
+eval k (Assign _ _) = impossible
+eval k (Array a i) = _
+eval k (New _ _) = impossible
+eval k (Return e) = do
+  e' <- eval k e
+  k e'
 
 findPure :: Program String -> S.Set String
 findPure (Program funs vars) = undefined where

From 1ecefda3d44a6d5b77f5e044875c6ba078ad2c7f Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 01:16:44 +0300
Subject: [PATCH 106/116] it compiles

---
 komarov.andrey/src/FCC/Evaluator.hs         | 144 ++++++++++++++++++++
 komarov.andrey/src/FCC/Optimize/CalcPure.hs | 134 ++++--------------
 2 files changed, 167 insertions(+), 111 deletions(-)
 create mode 100644 komarov.andrey/src/FCC/Evaluator.hs

diff --git a/komarov.andrey/src/FCC/Evaluator.hs b/komarov.andrey/src/FCC/Evaluator.hs
new file mode 100644
index 00000000..c65c94d
--- /dev/null
+++ b/komarov.andrey/src/FCC/Evaluator.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module FCC.Evaluator (
+  calc,
+  EvalConfig(..),
+  config,
+  ) where
+
+import FCC.Type
+import FCC.Expr
+import FCC.Eval
+import FCC.Program
+import FCC.Optimize.StdlibEval
+
+import Bound
+
+import Control.Monad.Except
+import Control.Monad.State
+import Control.Monad.Reader
+import Control.Monad.Cont
+
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+data Context = Context {
+  bindings :: M.Map String Value,
+  counter :: Int,
+  bound :: Int }
+
+defaultTimeout = 10000
+
+data EvalConfig = EvalConfig {
+  ctxFunctions :: M.Map String (Function String),
+  initialTimeout :: Int
+  }
+
+newtype Evaluator r a = Evaluator {
+  runEvaluator :: ExceptT () (StateT Context (ReaderT EvalConfig (Cont r))) a
+  } deriving (Functor, Applicative, Monad,
+              MonadError (), MonadReader EvalConfig,
+              MonadState Context, MonadCont)
+
+impossible = error "FATAL ERROR ¯\\_(ツ)_/¯"
+
+runE :: Context -> EvalConfig -> Evaluator (Either () a) a -> Either () a
+runE s r e = runCont (runReaderT (runStateT (runExceptT $ runEvaluator e) s) r) fst
+
+calc :: EvalConfig -> Expr String -> Maybe Value
+calc cfg e = case runE (Context M.empty (initialTimeout cfg) 0) cfg (callCC $ \k -> eval k e) of
+  Left _ -> Nothing
+  Right a -> Just a
+
+tick :: Evaluator r ()
+tick = do
+  remain <- gets counter
+  when (remain <= 0) $ throwError ()
+  modify $ \c -> c{ counter = remain - 1 }
+
+fresh :: Evaluator r String
+fresh = do
+  var <- gets bound
+  modify $ \c -> c{bound = var + 1}
+  return $ "_opt_var_" ++ show var
+
+defaultVal :: Type -> Value
+defaultVal TInt = VInt 0
+defaultVal TBool = VBool False
+defaultVal TVoid = VVoid
+defaultVal (TArray _) = VArray M.empty
+defaultVal (TFun _ _) = impossible
+
+call :: Function String -> [Value] -> Evaluator r Value
+call (Function _ _ (Native name _)) args = do
+  tick
+  case (builtinsE M.! name) args of
+   Nothing -> throwError ()
+   Just res -> return res
+call (Function fargs _ (Inner s)) args = do
+  tick
+  names <- sequence [fresh | _ <- fargs]
+  modify (\c -> c{bindings = bindings c `M.union` M.fromList (zip names args)})
+  callCC $ \k -> eval k $ instantiate (Var . (names !!)) s
+
+eval :: (Value -> Evaluator r Value) -> Expr String -> Evaluator r Value
+eval k (Var v) = gets $ (M.! v) . bindings
+eval k (Lit i) = return $ VInt i
+eval k (LitBool b) = return $ VBool b
+--eval k (Lam t s) = do
+--  v <- fresh
+--  modify $ \c -> c{bindings = M.insert v (defaultVal t) (bindings c)}
+--  eval k $ instantiate1 (Var v) s
+eval k Empty = return $ VVoid
+--eval k (Pop e) = tick >> eval k e
+--eval k (Seq e1 e2) = tick >> eval k e1 >> eval k e2
+eval k (Call (Var fname) args) = do
+  f <- asks $ (M.lookup fname) . ctxFunctions
+  case f of
+   Nothing -> throwError ()
+   Just f' -> do
+     args' <- mapM (\x -> callCC $ \r -> eval r x) args
+     call f' args'
+eval k (Call _ _) = impossible
+--eval k (Eq _ _) = impossible
+--eval k e@(While cond body) = do
+--  c <- eval k cond
+--  case c of
+--   VBool b -> if b then eval k e else return VVoid
+--   _ -> impossible
+--eval k (If cond thn els) = do
+--  c <- eval k cond
+--  case c of
+--   VBool b -> if b then eval k thn else eval k els
+--   _ -> impossible
+--eval k (Assign (Var v) src) = do
+--  src' <- eval k src
+--  modify $ \c -> c{bindings = M.insert v src' (bindings c)}
+--  _
+--eval k (Assign (Array a i) src) = _ -- TODO ?????? :((((((
+--eval k (Assign _ _) = impossible
+--eval k (Array a i) = _
+--eval k (New _ _) = impossible
+eval k (Return e) = do
+  e' <- eval k e
+  k e'
+eval _ _ = throwError ()
+
+config :: Program String -> EvalConfig
+config p@(Program funs _) = EvalConfig puM defaultTimeout where
+  puM = M.filterWithKey (\k v -> k `S.member` pu) funs
+  pu = findPure p
+
+findPure :: Program String -> S.Set String
+findPure (Program funs vars) = undefined where
+  allPure = fix' S.empty (updPure funs)
+
+updPure :: M.Map String (Function String) -> S.Set String -> S.Set String
+updPure funs ctx = ctx `S.union` S.fromList [name | (name, f) <- M.toList funs, isPure ctx f]
+
+isPure :: S.Set String -> Function String -> Bool
+isPure _ (Function _ _ (Native name _)) = name `M.member` builtinsE
+isPure ctx (Function _ _ (Inner s)) = all (`S.member` ctx) s
+
+fix' :: Eq a => a -> (a -> a) -> a
+fix' init mod = if new == init then init else fix' new mod where
+  new = mod init
diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
index d835162..402d511 100644
--- a/komarov.andrey/src/FCC/Optimize/CalcPure.hs
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -3,126 +3,38 @@ module FCC.Optimize.CalcPure (
 
   ) where
 
-import FCC.Type
 import FCC.Expr
-import FCC.Eval
 import FCC.Program
 import FCC.Optimize.StdlibEval
+import FCC.Evaluator
 
 import Bound
 
+import Data.Maybe (fromMaybe)
 import Control.Monad.Except
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Cont
 
-import qualified Data.Set as S
-import qualified Data.Map as M
+optP :: Program String -> Maybe (Program String)
+optP p@(Program funs vars) = Nothing where
+
+optF :: Function String -> Function String
+optF f@(Function _ _ (Native{})) = f
+optF f@(Function args _ (Inner s)) = f
+
+opt :: Expr String -> Expr String
+opt e@(Var _) = e
+opt e@(Lit _) = e
+opt e@(LitBool _) = e
+opt Empty = Empty
+opt (Pop e) = Pop $ opt e
+opt (Seq e1 e2) = Seq (opt e1) (opt e2)
+opt e@(Call f args) = e
+opt e@(While cond body) = e
+opt e@(If cond thn els) = e
+opt e@(Assign dst src) = e
+opt e@(Array a i) = e
+opt (Return e) = Return $ opt e
+opt e = e
 
-timeout = 10000
-impossible = error "FATAL ERROR ¯\\_(ツ)_/¯"
-
-data Context = Context {
-  bindings :: M.Map String Value,
-  counter :: Int,
-  bound :: Int }
-
-data ROContext = ROContext {
-  pureFunctions :: S.Set String,
-  ctxFunctions :: M.Map String (Function String)
-  }
-
--- Использовать throwError для сообщения об успехе вместо
-               -- какого-нибудь ContT - фу
-newtype Evaluator r a = Evaluator {
-  runEvaluator :: ExceptT (Maybe Value) (ContT r (StateT Context (Reader ROContext))) a
-  } deriving (Functor, Applicative, Monad,
-              MonadError (Maybe Value), MonadReader ROContext,
-              MonadState Context, MonadCont)
-
-tick :: Evaluator r ()
-tick = do
-  remain <- gets counter
-  when (remain <= 0) $ throwError Nothing
-  modify $ \c -> c{ counter = remain - 1 }
-
-fresh :: Evaluator r String
-fresh = do
-  var <- gets bound
-  modify $ \c -> c{bound = var + 1}
-  return $ "_opt_var_" ++ show var
-
-defaultVal :: Type -> Value
-defaultVal TInt = VInt 0
-defaultVal TBool = VBool False
-defaultVal TVoid = VVoid
-defaultVal (TArray _) = VArray M.empty
-defaultVal (TFun _ _) = impossible
-
-{-
-call :: Function String -> [Value] -> Evaluator Value
-call (Function _ _ (Native name _)) args = do
-  tick
-  case (builtinsE M.! name) args of
-   Nothing -> throwError Nothing
-   Just res -> return res
-call (Function _ fargs (Inner s)) args = do
-  _
--}
-
-call :: _
-call = _
-
-eval :: _ -> Expr String -> Evaluator r Value
-eval k (Var v) = gets $ (M.! v) . bindings
-eval k (Lit i) = return $ VInt i
-eval k (LitBool b) = return $ VBool b
-eval k (Lam t s) = do
-  v <- fresh
-  modify $ \c -> c{bindings = M.insert v (defaultVal t) (bindings c)}
-  eval k $ instantiate1 (Var v) s
-eval k Empty = return $ VVoid
-eval k (Pop e) = tick >> eval k e
-eval k (Seq e1 e2) = tick >> eval k e1 >> eval k e2
-eval k (Call (Var fname) args) = do
-  f <- asks $ (M.! fname) . ctxFunctions
-  args' <- mapM (eval k) args
-  call f args'
-eval k (Call _ _) = impossible
-eval k (Eq _ _) = impossible
-eval k e@(While cond body) = do
-  c <- eval k cond
-  case c of
-   VBool b -> if b then eval k e else return VVoid
-   _ -> impossible
-eval k (If cond thn els) = do
-  c <- eval k cond
-  case c of
-   VBool b -> if b then eval k thn else eval k els
-   _ -> impossible
-eval k (Assign (Var v) src) = do
-  src' <- eval k src
-  modify $ \c -> c{bindings = M.insert v src' (bindings c)}
-  _
-eval k (Assign (Array a i) src) = _ -- TODO ?????? :((((((
-eval k (Assign _ _) = impossible
-eval k (Array a i) = _
-eval k (New _ _) = impossible
-eval k (Return e) = do
-  e' <- eval k e
-  k e'
-
-findPure :: Program String -> S.Set String
-findPure (Program funs vars) = undefined where
-  allPure = fix' S.empty (updPure funs)
-
-updPure :: M.Map String (Function String) -> S.Set String -> S.Set String
-updPure funs ctx = ctx `S.union` S.fromList [name | (name, f) <- M.toList funs, isPure ctx f]
-
-isPure :: S.Set String -> Function String -> Bool
-isPure _ (Function _ _ (Native name _)) = name `M.member` builtinsE
-isPure ctx (Function _ _ (Inner s)) = all (`S.member` ctx) s
-
-fix' :: Eq a => a -> (a -> a) -> a
-fix' init mod = if new == init then init else fix' new mod where
-  new = mod init

From 6fcf7f519986f50f99393d7ed7bced8b30ebcb37 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 01:27:49 +0300
Subject: [PATCH 107/116] optimisations disabled

---
 komarov.andrey/src/FCC/Optimize.hs              | 9 ++++++++-
 komarov.andrey/src/FCC/Optimize/CalcPure.hs     | 9 ++++++---
 komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs | 5 ++---
 3 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/komarov.andrey/src/FCC/Optimize.hs b/komarov.andrey/src/FCC/Optimize.hs
index 02e9c75..7cda145 100644
--- a/komarov.andrey/src/FCC/Optimize.hs
+++ b/komarov.andrey/src/FCC/Optimize.hs
@@ -10,4 +10,11 @@ import FCC.Optimize.CalcPure
 import Data.Maybe
 
 optimize :: Program String -> Program String
-optimize p = fromMaybe p (shrink p)
+optimize p = fix' p upd
+
+upd :: Program String -> Program String
+upd = shrink . calcSubExprs
+
+fix' :: Eq a => a -> (a -> a) -> a
+fix' init mod = if new == init then init else fix' new mod where
+  new = mod init
diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
index 402d511..aa3f1ad 100644
--- a/komarov.andrey/src/FCC/Optimize/CalcPure.hs
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module FCC.Optimize.CalcPure (
-
+  calcSubExprs,
   ) where
 
 import FCC.Expr
@@ -16,8 +16,11 @@ import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Cont
 
-optP :: Program String -> Maybe (Program String)
-optP p@(Program funs vars) = Nothing where
+calcSubExprs :: Program String -> Program String
+calcSubExprs = optP
+
+optP :: Program String -> Program String
+optP p@(Program funs vars) = p where
 
 optF :: Function String -> Function String
 optF f@(Function _ _ (Native{})) = f
diff --git a/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs b/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs
index e9e5f5b..995ccb1 100644
--- a/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs
+++ b/komarov.andrey/src/FCC/Optimize/ShrinkUnused.hs
@@ -12,13 +12,12 @@ import qualified Data.Map as M
 
 start = "_start"
 
-shrink :: Program String -> Maybe (Program String)
-shrink p@(Program funs vars) = if p == p' then Nothing else Just p' where
+shrink :: Program String -> Program String
+shrink p@(Program funs vars) = p' where
   used = fix' (S.singleton start) (upd funs)
   funs' = M.filterWithKey (\n _ -> n `S.member` used) funs
   vars' = M.filterWithKey (\n _ -> n `S.member` used) vars
   p' = Program funs' vars'
-
    
 fix' :: Eq a => a -> (a -> a) -> a
 fix' init mod = if new == init then init else fix' new mod where

From 4d99d66b730d29e0451f47798dbdb6715e0f4086 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 01:42:03 +0300
Subject: [PATCH 108/116] better optimize signature

---
 komarov.andrey/src/FCC/Eval.hs              |  2 -
 komarov.andrey/src/FCC/Optimize/CalcPure.hs | 59 +++++++++++----------
 2 files changed, 32 insertions(+), 29 deletions(-)

diff --git a/komarov.andrey/src/FCC/Eval.hs b/komarov.andrey/src/FCC/Eval.hs
index c1c1175..ef947ef 100644
--- a/komarov.andrey/src/FCC/Eval.hs
+++ b/komarov.andrey/src/FCC/Eval.hs
@@ -3,8 +3,6 @@ module FCC.Eval (
   Value(..),
   ) where
 
-import FCC.Expr
-
 import Data.Int
 import qualified Data.Map as M
 
diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
index aa3f1ad..b246778 100644
--- a/komarov.andrey/src/FCC/Optimize/CalcPure.hs
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -5,39 +5,44 @@ module FCC.Optimize.CalcPure (
 
 import FCC.Expr
 import FCC.Program
-import FCC.Optimize.StdlibEval
 import FCC.Evaluator
 
 import Bound
 
 import Data.Maybe (fromMaybe)
-import Control.Monad.Except
-import Control.Monad.State
 import Control.Monad.Reader
-import Control.Monad.Cont
 
 calcSubExprs :: Program String -> Program String
-calcSubExprs = optP
-
-optP :: Program String -> Program String
-optP p@(Program funs vars) = p where
-
-optF :: Function String -> Function String
-optF f@(Function _ _ (Native{})) = f
-optF f@(Function args _ (Inner s)) = f
-
-opt :: Expr String -> Expr String
-opt e@(Var _) = e
-opt e@(Lit _) = e
-opt e@(LitBool _) = e
-opt Empty = Empty
-opt (Pop e) = Pop $ opt e
-opt (Seq e1 e2) = Seq (opt e1) (opt e2)
-opt e@(Call f args) = e
-opt e@(While cond body) = e
-opt e@(If cond thn els) = e
-opt e@(Assign dst src) = e
-opt e@(Array a i) = e
-opt (Return e) = Return $ opt e
-opt e = e
+calcSubExprs p = runReader (runOptimizer $ optP p) (config p)
+
+newtype Optimizer a = Optimizer {
+  runOptimizer :: Reader EvalConfig a
+  } deriving (Functor, Applicative, Monad, MonadReader EvalConfig)
+
+
+optP :: Program String -> Optimizer (Program String)
+optP p@(Program funs vars) = do
+  funs' <- sequence (fmap optF funs)
+  return $ Program funs' vars
+
+optF :: Function String -> Optimizer (Function String)
+optF f@(Function _ _ (Native{})) = return f
+optF f@(Function args _ (Inner s)) = return f
+
+opt :: Expr String -> Optimizer (Expr String)
+opt e@(Var _) = return e
+opt e@(Lit _) = return e
+opt e@(LitBool _) = return e
+opt Empty = return Empty
+opt (Pop e) = Pop <$> opt e
+opt (Seq Empty e) = opt e
+opt (Seq e Empty) = opt e
+opt (Seq e1 e2) = Seq <$> (opt e1) <*> (opt e2)
+opt e@(Call f args) = return e
+opt e@(While cond body) = return e
+opt e@(If cond thn els) = return e
+opt e@(Assign dst src) = return e
+opt e@(Array a i) = return e
+opt (Return e) = Return <$> opt e
+opt e = return e
 

From 47c816c2391eef1e75fd9240843b82b802be4692 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 02:04:48 +0300
Subject: [PATCH 109/116] trivial optimisations work

---
 komarov.andrey/src/FCC/Evaluator.hs         |  9 +++++--
 komarov.andrey/src/FCC/Optimize/CalcPure.hs | 27 ++++++++++++++++++---
 2 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/komarov.andrey/src/FCC/Evaluator.hs b/komarov.andrey/src/FCC/Evaluator.hs
index c65c94d..407736b 100644
--- a/komarov.andrey/src/FCC/Evaluator.hs
+++ b/komarov.andrey/src/FCC/Evaluator.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module FCC.Evaluator (
-  calc,
+  calc, calcF,
   EvalConfig(..),
   config,
   ) where
@@ -49,6 +49,11 @@ calc cfg e = case runE (Context M.empty (initialTimeout cfg) 0) cfg (callCC $ \k
   Left _ -> Nothing
   Right a -> Just a
 
+calcF :: EvalConfig -> Function String -> [Value] -> Maybe Value
+calcF cfg f args = case runE (Context M.empty (initialTimeout cfg) 0) cfg (call f args) of
+  Left _ -> Nothing
+  Right a -> Just a
+
 tick :: Evaluator r ()
 tick = do
   remain <- gets counter
@@ -129,7 +134,7 @@ config p@(Program funs _) = EvalConfig puM defaultTimeout where
   pu = findPure p
 
 findPure :: Program String -> S.Set String
-findPure (Program funs vars) = undefined where
+findPure (Program funs vars) = allPure where
   allPure = fix' S.empty (updPure funs)
 
 updPure :: M.Map String (Function String) -> S.Set String -> S.Set String
diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
index b246778..d8bd156 100644
--- a/komarov.andrey/src/FCC/Optimize/CalcPure.hs
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -3,15 +3,19 @@ module FCC.Optimize.CalcPure (
   calcSubExprs,
   ) where
 
+import FCC.Eval
 import FCC.Expr
 import FCC.Program
 import FCC.Evaluator
 
 import Bound
 
+import Data.List (elemIndex)
 import Data.Maybe (fromMaybe)
 import Control.Monad.Reader
 
+import qualified Data.Map as M
+
 calcSubExprs :: Program String -> Program String
 calcSubExprs p = runReader (runOptimizer $ optP p) (config p)
 
@@ -19,7 +23,6 @@ newtype Optimizer a = Optimizer {
   runOptimizer :: Reader EvalConfig a
   } deriving (Functor, Applicative, Monad, MonadReader EvalConfig)
 
-
 optP :: Program String -> Optimizer (Program String)
 optP p@(Program funs vars) = do
   funs' <- sequence (fmap optF funs)
@@ -27,7 +30,12 @@ optP p@(Program funs vars) = do
 
 optF :: Function String -> Optimizer (Function String)
 optF f@(Function _ _ (Native{})) = return f
-optF f@(Function args _ (Inner s)) = return f
+optF f@(Function args ret (Inner s)) = do
+  let names = ["_opt_arg_" ++ show i | (i, _) <- zip [0..] args]
+      e = instantiate (Var . (names !!)) s
+  e' <- opt e
+  let s' = abstract (`elemIndex` names) e'
+  return $ Function args ret (Inner s')
 
 opt :: Expr String -> Optimizer (Expr String)
 opt e@(Var _) = return e
@@ -38,7 +46,16 @@ opt (Pop e) = Pop <$> opt e
 opt (Seq Empty e) = opt e
 opt (Seq e Empty) = opt e
 opt (Seq e1 e2) = Seq <$> (opt e1) <*> (opt e2)
-opt e@(Call f args) = return e
+opt e@(Call (Var fname) args) = do
+  cfg <- ask
+  let ok = do
+        args <- sequence $ map (calc cfg) args
+        f <- M.lookup fname (ctxFunctions cfg)
+        v <- calcF cfg f args
+        v2e v
+  case ok of
+   Nothing -> return e
+   Just e' -> return e'
 opt e@(While cond body) = return e
 opt e@(If cond thn els) = return e
 opt e@(Assign dst src) = return e
@@ -46,3 +63,7 @@ opt e@(Array a i) = return e
 opt (Return e) = Return <$> opt e
 opt e = return e
 
+v2e :: Value -> Maybe (Expr a)
+v2e (VInt i) = return $ Lit i
+v2e (VBool b) = return $ LitBool b
+v2e _ = Nothing

From f0ddfa5abadd9febd80667f6aec2466ac0d6ec11 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 02:59:51 +0300
Subject: [PATCH 110/116] it optimizes fact!

---
 komarov.andrey/src/FCC/Eval.hs              |  1 +
 komarov.andrey/src/FCC/Evaluator.hs         | 16 ++++++++--------
 komarov.andrey/src/FCC/Optimize/CalcPure.hs |  5 ++++-
 3 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/komarov.andrey/src/FCC/Eval.hs b/komarov.andrey/src/FCC/Eval.hs
index ef947ef..686bf19 100644
--- a/komarov.andrey/src/FCC/Eval.hs
+++ b/komarov.andrey/src/FCC/Eval.hs
@@ -11,6 +11,7 @@ data Value
   | VInt Int32
   | VBool Bool
   | VArray (M.Map Int32 Value)
+    deriving (Eq, Ord, Show, Read)
 
 type Eval = [Value] -> Maybe Value
 
diff --git a/komarov.andrey/src/FCC/Evaluator.hs b/komarov.andrey/src/FCC/Evaluator.hs
index 407736b..a4ba6da 100644
--- a/komarov.andrey/src/FCC/Evaluator.hs
+++ b/komarov.andrey/src/FCC/Evaluator.hs
@@ -31,7 +31,7 @@ defaultTimeout = 10000
 data EvalConfig = EvalConfig {
   ctxFunctions :: M.Map String (Function String),
   initialTimeout :: Int
-  }
+  } deriving (Eq, Ord, Show)
 
 newtype Evaluator r a = Evaluator {
   runEvaluator :: ExceptT () (StateT Context (ReaderT EvalConfig (Cont r))) a
@@ -95,7 +95,7 @@ eval k (LitBool b) = return $ VBool b
 --  eval k $ instantiate1 (Var v) s
 eval k Empty = return $ VVoid
 --eval k (Pop e) = tick >> eval k e
---eval k (Seq e1 e2) = tick >> eval k e1 >> eval k e2
+eval k (Seq e1 e2) = tick >> eval k e1 >> eval k e2
 eval k (Call (Var fname) args) = do
   f <- asks $ (M.lookup fname) . ctxFunctions
   case f of
@@ -110,11 +110,11 @@ eval k (Call _ _) = impossible
 --  case c of
 --   VBool b -> if b then eval k e else return VVoid
 --   _ -> impossible
---eval k (If cond thn els) = do
---  c <- eval k cond
---  case c of
---   VBool b -> if b then eval k thn else eval k els
---   _ -> impossible
+eval k (If cond thn els) = do
+  c <- eval k cond
+  case c of
+   VBool b -> if b then eval k thn else eval k els
+   _ -> impossible
 --eval k (Assign (Var v) src) = do
 --  src' <- eval k src
 --  modify $ \c -> c{bindings = M.insert v src' (bindings c)}
@@ -138,7 +138,7 @@ findPure (Program funs vars) = allPure where
   allPure = fix' S.empty (updPure funs)
 
 updPure :: M.Map String (Function String) -> S.Set String -> S.Set String
-updPure funs ctx = ctx `S.union` S.fromList [name | (name, f) <- M.toList funs, isPure ctx f]
+updPure funs ctx = ctx `S.union` S.fromList [name | (name, f) <- M.toList funs, isPure (S.insert name ctx) f]
 
 isPure :: S.Set String -> Function String -> Bool
 isPure _ (Function _ _ (Native name _)) = name `M.member` builtinsE
diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
index d8bd156..5d93730 100644
--- a/komarov.andrey/src/FCC/Optimize/CalcPure.hs
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -56,8 +56,11 @@ opt e@(Call (Var fname) args) = do
   case ok of
    Nothing -> return e
    Just e' -> return e'
+opt (While (LitBool False) _) = return Empty
 opt e@(While cond body) = return e
-opt e@(If cond thn els) = return e
+--opt e@(If (LitBool True) thn _) = opt thn
+--opt e@(If (LitBool False) _ els) = opt els
+--opt e@(If cond thn els) = If <$> opt cond <*> opt thn <*> opt els
 opt e@(Assign dst src) = return e
 opt e@(Array a i) = return e
 opt (Return e) = Return <$> opt e

From 63ddc5f180facbd1cc71aeb729720d3b5ceba236 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 03:30:31 +0300
Subject: [PATCH 111/116] even more optimisations

---
 komarov.andrey/src/FCC/Evaluator.hs         |  8 ++++--
 komarov.andrey/src/FCC/Optimize/CalcPure.hs | 29 ++++++++++++++-------
 2 files changed, 26 insertions(+), 11 deletions(-)

diff --git a/komarov.andrey/src/FCC/Evaluator.hs b/komarov.andrey/src/FCC/Evaluator.hs
index a4ba6da..8a8f50a 100644
--- a/komarov.andrey/src/FCC/Evaluator.hs
+++ b/komarov.andrey/src/FCC/Evaluator.hs
@@ -76,7 +76,7 @@ defaultVal (TFun _ _) = impossible
 call :: Function String -> [Value] -> Evaluator r Value
 call (Function _ _ (Native name _)) args = do
   tick
-  case (builtinsE M.! name) args of
+  case do {ev <- M.lookup name builtinsE; ev args } of
    Nothing -> throwError ()
    Just res -> return res
 call (Function fargs _ (Inner s)) args = do
@@ -86,7 +86,11 @@ call (Function fargs _ (Inner s)) args = do
   callCC $ \k -> eval k $ instantiate (Var . (names !!)) s
 
 eval :: (Value -> Evaluator r Value) -> Expr String -> Evaluator r Value
-eval k (Var v) = gets $ (M.! v) . bindings
+eval k (Var v) = do
+  b <- gets bindings
+  case M.lookup v b of
+   Nothing -> throwError ()
+   Just val -> return val
 eval k (Lit i) = return $ VInt i
 eval k (LitBool b) = return $ VBool b
 --eval k (Lam t s) = do
diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
index 5d93730..937fac8 100644
--- a/komarov.andrey/src/FCC/Optimize/CalcPure.hs
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -12,16 +12,22 @@ import Bound
 
 import Data.List (elemIndex)
 import Data.Maybe (fromMaybe)
-import Control.Monad.Reader
+import Control.Monad.RWS
 
 import qualified Data.Map as M
 
 calcSubExprs :: Program String -> Program String
-calcSubExprs p = runReader (runOptimizer $ optP p) (config p)
+calcSubExprs p = fst $ evalRWS (runOptimizer $ optP p) (config p) 0
 
 newtype Optimizer a = Optimizer {
-  runOptimizer :: Reader EvalConfig a
-  } deriving (Functor, Applicative, Monad, MonadReader EvalConfig)
+  runOptimizer :: RWS EvalConfig () Int a
+  } deriving (Functor, Applicative, Monad, MonadReader EvalConfig, MonadState Int)
+
+fresh :: Optimizer String
+fresh = do
+  n <- get
+  put $ n + 1
+  return $ "_opt_t_vat_" ++ show n
 
 optP :: Program String -> Optimizer (Program String)
 optP p@(Program funs vars) = do
@@ -41,6 +47,11 @@ opt :: Expr String -> Optimizer (Expr String)
 opt e@(Var _) = return e
 opt e@(Lit _) = return e
 opt e@(LitBool _) = return e
+opt (Lam t s) = do
+  name <- fresh
+  let e = instantiate1 (Var name) s
+  e' <- opt e
+  return $ Lam t $ abstract1 name e'
 opt Empty = return Empty
 opt (Pop e) = Pop <$> opt e
 opt (Seq Empty e) = opt e
@@ -54,13 +65,13 @@ opt e@(Call (Var fname) args) = do
         v <- calcF cfg f args
         v2e v
   case ok of
-   Nothing -> return e
+   Nothing -> Call (Var fname) <$> forM args opt
    Just e' -> return e'
 opt (While (LitBool False) _) = return Empty
-opt e@(While cond body) = return e
---opt e@(If (LitBool True) thn _) = opt thn
---opt e@(If (LitBool False) _ els) = opt els
---opt e@(If cond thn els) = If <$> opt cond <*> opt thn <*> opt els
+opt e@(While cond body) = While <$> opt cond <*> opt body
+opt e@(If (LitBool True) thn _) = opt thn
+opt e@(If (LitBool False) _ els) = opt els
+opt e@(If cond thn els) = If <$> opt cond <*> opt thn <*> opt els
 opt e@(Assign dst src) = return e
 opt e@(Array a i) = return e
 opt (Return e) = Return <$> opt e

From 7e5210b9dea2bb8d9a83f35ef821cf7f7f28e20e Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 03:37:48 +0300
Subject: [PATCH 112/116] lalala

---
 komarov.andrey/src/FCC/Optimize/CalcPure.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/komarov.andrey/src/FCC/Optimize/CalcPure.hs b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
index 937fac8..d41ebe5 100644
--- a/komarov.andrey/src/FCC/Optimize/CalcPure.hs
+++ b/komarov.andrey/src/FCC/Optimize/CalcPure.hs
@@ -68,12 +68,12 @@ opt e@(Call (Var fname) args) = do
    Nothing -> Call (Var fname) <$> forM args opt
    Just e' -> return e'
 opt (While (LitBool False) _) = return Empty
-opt e@(While cond body) = While <$> opt cond <*> opt body
-opt e@(If (LitBool True) thn _) = opt thn
-opt e@(If (LitBool False) _ els) = opt els
-opt e@(If cond thn els) = If <$> opt cond <*> opt thn <*> opt els
-opt e@(Assign dst src) = return e
-opt e@(Array a i) = return e
+opt (While cond body) = While <$> opt cond <*> opt body
+opt (If (LitBool True) thn _) = opt thn
+opt (If (LitBool False) _ els) = opt els
+opt (If cond thn els) = If <$> opt cond <*> opt thn <*> opt els
+opt (Assign dst src) = Assign <$> opt dst <*> opt src
+opt (Array a i) = Array <$> opt a <*> opt i
 opt (Return e) = Return <$> opt e
 opt e = return e
 

From 26ea8fc4ad42b62676a342e232e821eb19f31c4b Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 03:57:35 +0300
Subject: [PATCH 113/116] examples

---
 komarov.andrey/examples/boolTest.fc           | 14 ------
 komarov.andrey/examples/callc.fc              |  6 ---
 komarov.andrey/examples/{cat.c => cat.fc}     |  0
 komarov.andrey/examples/e.fc                  |  1 +
 komarov.andrey/examples/e2.fc                 | 11 ++++
 komarov.andrey/examples/e3.fc                 |  9 ++++
 komarov.andrey/examples/e4.fc                 |  9 ++++
 komarov.andrey/examples/e5.fc                 | 10 ++++
 komarov.andrey/examples/e6.fc                 |  9 ++++
 komarov.andrey/examples/example2.fc           |  4 --
 komarov.andrey/examples/example3.fc           |  4 --
 komarov.andrey/examples/example4.fc           |  9 ----
 komarov.andrey/examples/example5.fc           |  8 ---
 komarov.andrey/examples/example6.fc           |  7 ---
 komarov.andrey/examples/example7.fc           | 13 -----
 komarov.andrey/examples/global.fc             |  8 ---
 komarov.andrey/examples/isPrime.fc            | 50 -------------------
 komarov.andrey/examples/manyArgs.fc           | 14 ------
 komarov.andrey/examples/parseErrBraces.fc     |  2 -
 .../examples/parseErrFunctionInt.fc           |  1 -
 komarov.andrey/examples/parseErrGarbage.fc    |  2 -
 .../examples/parseErrIfWithoutElse.fc         |  5 --
 komarov.andrey/examples/parseErrVarInt.fc     |  3 --
 komarov.andrey/examples/parseOkBraces.fc      |  3 --
 komarov.andrey/examples/sign.fc               | 12 -----
 .../examples/{example1.fc => sum.fc}          |  4 ++
 komarov.andrey/examples/whiletrue.fc          |  5 --
 komarov.andrey/examples/wrong1.fc             |  5 --
 komarov.andrey/examples/wrong2.fc             |  9 ----
 komarov.andrey/examples/wrong3.fc             |  7 ---
 komarov.andrey/examples/wrong4.fc             |  3 --
 komarov.andrey/examples/wrong5.fc             |  3 --
 komarov.andrey/examples/wrong6.fc             |  2 -
 komarov.andrey/src/FCC/Evaluator.hs           | 33 ++++++------
 34 files changed, 71 insertions(+), 214 deletions(-)
 delete mode 100644 komarov.andrey/examples/boolTest.fc
 delete mode 100644 komarov.andrey/examples/callc.fc
 rename komarov.andrey/examples/{cat.c => cat.fc} (100%)
 create mode 100644 komarov.andrey/examples/e.fc
 create mode 100644 komarov.andrey/examples/e2.fc
 create mode 100644 komarov.andrey/examples/e3.fc
 create mode 100644 komarov.andrey/examples/e4.fc
 create mode 100644 komarov.andrey/examples/e5.fc
 create mode 100644 komarov.andrey/examples/e6.fc
 delete mode 100644 komarov.andrey/examples/example2.fc
 delete mode 100644 komarov.andrey/examples/example3.fc
 delete mode 100644 komarov.andrey/examples/example4.fc
 delete mode 100644 komarov.andrey/examples/example5.fc
 delete mode 100644 komarov.andrey/examples/example6.fc
 delete mode 100644 komarov.andrey/examples/example7.fc
 delete mode 100644 komarov.andrey/examples/global.fc
 delete mode 100644 komarov.andrey/examples/isPrime.fc
 delete mode 100644 komarov.andrey/examples/manyArgs.fc
 delete mode 100644 komarov.andrey/examples/parseErrBraces.fc
 delete mode 100644 komarov.andrey/examples/parseErrFunctionInt.fc
 delete mode 100644 komarov.andrey/examples/parseErrGarbage.fc
 delete mode 100644 komarov.andrey/examples/parseErrIfWithoutElse.fc
 delete mode 100644 komarov.andrey/examples/parseErrVarInt.fc
 delete mode 100644 komarov.andrey/examples/parseOkBraces.fc
 delete mode 100644 komarov.andrey/examples/sign.fc
 rename komarov.andrey/examples/{example1.fc => sum.fc} (80%)
 delete mode 100644 komarov.andrey/examples/whiletrue.fc
 delete mode 100644 komarov.andrey/examples/wrong1.fc
 delete mode 100644 komarov.andrey/examples/wrong2.fc
 delete mode 100644 komarov.andrey/examples/wrong3.fc
 delete mode 100644 komarov.andrey/examples/wrong4.fc
 delete mode 100644 komarov.andrey/examples/wrong5.fc
 delete mode 100644 komarov.andrey/examples/wrong6.fc

diff --git a/komarov.andrey/examples/boolTest.fc b/komarov.andrey/examples/boolTest.fc
deleted file mode 100644
index a722586..00000000
--- a/komarov.andrey/examples/boolTest.fc
+++ /dev/null
@@ -1,14 +0,0 @@
-
-bool boolTest() {
-  bool ok;
-  ok = true;
-  ok = ok && (true && true);
-  ok = ok && ((true && false) == false);
-  ok = ok && ((false && true) == false);
-  ok = ok && ((false && false) == false);
-  ok = ok && (true || true);
-  ok = ok && (true || false);
-  ok = ok && (false || true);
-  ok = ok && ((false || false) == false);
-  return ok;
-}
diff --git a/komarov.andrey/examples/callc.fc b/komarov.andrey/examples/callc.fc
deleted file mode 100644
index 55bc32e..00000000
--- a/komarov.andrey/examples/callc.fc
+++ /dev/null
@@ -1,6 +0,0 @@
-int add(int a, int b);
-
-int f()
-{
-    return add(40, 2);
-}
diff --git a/komarov.andrey/examples/cat.c b/komarov.andrey/examples/cat.fc
similarity index 100%
rename from komarov.andrey/examples/cat.c
rename to komarov.andrey/examples/cat.fc
diff --git a/komarov.andrey/examples/e.fc b/komarov.andrey/examples/e.fc
new file mode 100644
index 00000000..fcf4713
--- /dev/null
+++ b/komarov.andrey/examples/e.fc
@@ -0,0 +1 @@
+int main() { return 10 + 20; }
diff --git a/komarov.andrey/examples/e2.fc b/komarov.andrey/examples/e2.fc
new file mode 100644
index 00000000..e0a34fc
--- /dev/null
+++ b/komarov.andrey/examples/e2.fc
@@ -0,0 +1,11 @@
+int f() {
+    if (true) {
+        return 10;
+    } else {
+        return 20;
+    }
+}
+
+int main() {
+    return f();
+}
diff --git a/komarov.andrey/examples/e3.fc b/komarov.andrey/examples/e3.fc
new file mode 100644
index 00000000..7a5e836
--- /dev/null
+++ b/komarov.andrey/examples/e3.fc
@@ -0,0 +1,9 @@
+int fact(int n) {
+  if (n == 0) {
+     return 10;
+  } else {
+     return 20;
+  }
+}
+
+int main() { return fact(10); }
diff --git a/komarov.andrey/examples/e4.fc b/komarov.andrey/examples/e4.fc
new file mode 100644
index 00000000..b48a5aa
--- /dev/null
+++ b/komarov.andrey/examples/e4.fc
@@ -0,0 +1,9 @@
+int fact(int n) {
+    if (n == 0) {
+        return 10;
+    } else {
+        return fact(n - 3);
+    }
+}
+
+int main() { return fact(10); }
diff --git a/komarov.andrey/examples/e5.fc b/komarov.andrey/examples/e5.fc
new file mode 100644
index 00000000..51cdeed
--- /dev/null
+++ b/komarov.andrey/examples/e5.fc
@@ -0,0 +1,10 @@
+int f() {
+    int a;
+    a = 0;
+    while (a < 10) {
+        a = a + 3;
+    }
+    return a;
+}
+
+int main() { return f(); }
diff --git a/komarov.andrey/examples/e6.fc b/komarov.andrey/examples/e6.fc
new file mode 100644
index 00000000..0d24a83
--- /dev/null
+++ b/komarov.andrey/examples/e6.fc
@@ -0,0 +1,9 @@
+int f() {
+    int a;
+    a = 10;
+    return a;
+}
+
+int main() {
+    return f();
+}
diff --git a/komarov.andrey/examples/example2.fc b/komarov.andrey/examples/example2.fc
deleted file mode 100644
index 3654127..00000000
--- a/komarov.andrey/examples/example2.fc
+++ /dev/null
@@ -1,4 +0,0 @@
-int lol() 
-{
-    return 42;
-}
diff --git a/komarov.andrey/examples/example3.fc b/komarov.andrey/examples/example3.fc
deleted file mode 100644
index 00283b2..00000000
--- a/komarov.andrey/examples/example3.fc
+++ /dev/null
@@ -1,4 +0,0 @@
-int lol() {
-    1;
-}
-
diff --git a/komarov.andrey/examples/example4.fc b/komarov.andrey/examples/example4.fc
deleted file mode 100644
index 442e715..00000000
--- a/komarov.andrey/examples/example4.fc
+++ /dev/null
@@ -1,9 +0,0 @@
-int f();
-
-int g() {
-    return f() + f();
-}
-
-int f() {
-    return 2;
-}
diff --git a/komarov.andrey/examples/example5.fc b/komarov.andrey/examples/example5.fc
deleted file mode 100644
index 7a87fb4..00000000
--- a/komarov.andrey/examples/example5.fc
+++ /dev/null
@@ -1,8 +0,0 @@
-int ifTest() 
-{
-    if (1 == 2) {
-        return 100;
-    } else {
-        return 200;
-    }
-}
diff --git a/komarov.andrey/examples/example6.fc b/komarov.andrey/examples/example6.fc
deleted file mode 100644
index af529db..00000000
--- a/komarov.andrey/examples/example6.fc
+++ /dev/null
@@ -1,7 +0,0 @@
-int testLocalVar() {
-    int a;
-    a = 10;
-    int b;
-    b = 20;
-    return a + b * a;
-}
diff --git a/komarov.andrey/examples/example7.fc b/komarov.andrey/examples/example7.fc
deleted file mode 100644
index 4822c9a..00000000
--- a/komarov.andrey/examples/example7.fc
+++ /dev/null
@@ -1,13 +0,0 @@
-int whileTest(int n)
-{
-    int sum;
-    sum = 0;
-    int i;
-    i = 0;
-    while (i < n) {
-        sum = sum + i;
-        i = i + 1;
-    }
-    return sum;
-}
-
diff --git a/komarov.andrey/examples/global.fc b/komarov.andrey/examples/global.fc
deleted file mode 100644
index 5a2f660..00000000
--- a/komarov.andrey/examples/global.fc
+++ /dev/null
@@ -1,8 +0,0 @@
-
-int v;
-
-int inc()
-{
-  v = v + 1;
-  return v;
-}
diff --git a/komarov.andrey/examples/isPrime.fc b/komarov.andrey/examples/isPrime.fc
deleted file mode 100644
index c9f9b53..00000000
--- a/komarov.andrey/examples/isPrime.fc
+++ /dev/null
@@ -1,50 +0,0 @@
-int div(int a, int b);
-int mod(int a, int b);
-
-bool isPrime(int n)
-{
-    int i;
-    i = 2;
-    while (i * i <= n)
-    {
-        if (mod(n, i) == 0)
-            return false;
-        else {}
-        i = i + 1;
-    }
-    return true;
-}
-
-int numPrimes(int from, int to)
-{
-    int i;
-    i = from;
-    int ans;
-    ans = 0;
-    while (i < to)
-    {
-        if (isPrime(i))
-            ans = ans + 1;
-        else {}
-        i = i + 1;
-    }
-    return ans;
-}
-
-int mod(int a, int b)
-{
-    return a - b * div(a, b);
-}
-
-int div(int a, int b)
-{
-    int c;
-    c = 0;
-    while (a >= 0)
-    {
-        c = c + 1;
-        a = a - b;
-    }
-    return c - 1;
-}
-
diff --git a/komarov.andrey/examples/manyArgs.fc b/komarov.andrey/examples/manyArgs.fc
deleted file mode 100644
index 26d33ec..00000000
--- a/komarov.andrey/examples/manyArgs.fc
+++ /dev/null
@@ -1,14 +0,0 @@
-int notreallymany(int a, int b, int c, int d)
-{
-  return a * 1 + b * 10 + c * 100 + d * 1000;
-}
-
-int many(int a, int b, int c, int d, int e, int f, int g, int h)
-{
-  return a * 1 + b * 10 + c * 100 + d * 1000 + e * 10000 + f * 100000 + g * 1000000 + h * 10000000;
-}
-
-int one()
-{
-  return many(1, 2, 3, 4, 5, 6, 7, 8);
-}
diff --git a/komarov.andrey/examples/parseErrBraces.fc b/komarov.andrey/examples/parseErrBraces.fc
deleted file mode 100644
index ef1df9c..00000000
--- a/komarov.andrey/examples/parseErrBraces.fc
+++ /dev/null
@@ -1,2 +0,0 @@
-int f() {
-}}
diff --git a/komarov.andrey/examples/parseErrFunctionInt.fc b/komarov.andrey/examples/parseErrFunctionInt.fc
deleted file mode 100644
index 28f6c3a..00000000
--- a/komarov.andrey/examples/parseErrFunctionInt.fc
+++ /dev/null
@@ -1 +0,0 @@
-int int() {}
diff --git a/komarov.andrey/examples/parseErrGarbage.fc b/komarov.andrey/examples/parseErrGarbage.fc
deleted file mode 100644
index ada0cee..00000000
--- a/komarov.andrey/examples/parseErrGarbage.fc
+++ /dev/null
@@ -1,2 +0,0 @@
-adf
-asdf
\ No newline at end of file
diff --git a/komarov.andrey/examples/parseErrIfWithoutElse.fc b/komarov.andrey/examples/parseErrIfWithoutElse.fc
deleted file mode 100644
index fce765d..00000000
--- a/komarov.andrey/examples/parseErrIfWithoutElse.fc
+++ /dev/null
@@ -1,5 +0,0 @@
-int f() {
-    if (1 == 2) {
-       return 0;
-    }
-}
diff --git a/komarov.andrey/examples/parseErrVarInt.fc b/komarov.andrey/examples/parseErrVarInt.fc
deleted file mode 100644
index c06e0c6..00000000
--- a/komarov.andrey/examples/parseErrVarInt.fc
+++ /dev/null
@@ -1,3 +0,0 @@
-int int;
-
-int f() {}
\ No newline at end of file
diff --git a/komarov.andrey/examples/parseOkBraces.fc b/komarov.andrey/examples/parseOkBraces.fc
deleted file mode 100644
index f68878e..00000000
--- a/komarov.andrey/examples/parseOkBraces.fc
+++ /dev/null
@@ -1,3 +0,0 @@
-int f() {
-{}{}{}
-}
diff --git a/komarov.andrey/examples/sign.fc b/komarov.andrey/examples/sign.fc
deleted file mode 100644
index 96b74b3..00000000
--- a/komarov.andrey/examples/sign.fc
+++ /dev/null
@@ -1,12 +0,0 @@
-int sign(int x)
-{
-    if (x == 0)
-        return 0;
-    else {
-        if (x < 0)
-            return 0-1;
-        else
-            return 1;
-    }
-}
-
diff --git a/komarov.andrey/examples/example1.fc b/komarov.andrey/examples/sum.fc
similarity index 80%
rename from komarov.andrey/examples/example1.fc
rename to komarov.andrey/examples/sum.fc
index 3e6d18d..0324ddd 100644
--- a/komarov.andrey/examples/example1.fc
+++ b/komarov.andrey/examples/sum.fc
@@ -12,3 +12,7 @@ int summ(int n)
     }
     return sum;
 }
+
+int main() {
+    return summ(100);
+}
diff --git a/komarov.andrey/examples/whiletrue.fc b/komarov.andrey/examples/whiletrue.fc
deleted file mode 100644
index fedabc2..00000000
--- a/komarov.andrey/examples/whiletrue.fc
+++ /dev/null
@@ -1,5 +0,0 @@
-int loop()
-{
-    while(1 == 1)
-    {}
-}
diff --git a/komarov.andrey/examples/wrong1.fc b/komarov.andrey/examples/wrong1.fc
deleted file mode 100644
index af437bd..00000000
--- a/komarov.andrey/examples/wrong1.fc
+++ /dev/null
@@ -1,5 +0,0 @@
-int f() {
-    int a;
-    bool b;
-    a == b;
-}
diff --git a/komarov.andrey/examples/wrong2.fc b/komarov.andrey/examples/wrong2.fc
deleted file mode 100644
index b8dd7f9..00000000
--- a/komarov.andrey/examples/wrong2.fc
+++ /dev/null
@@ -1,9 +0,0 @@
-int f(int a, int b);
-
-void g() {
-    f(0, 1 == 2);
-}
-
-void f(int a, int b) {
-    return a + b;
-}
diff --git a/komarov.andrey/examples/wrong3.fc b/komarov.andrey/examples/wrong3.fc
deleted file mode 100644
index 0eb0f7c..00000000
--- a/komarov.andrey/examples/wrong3.fc
+++ /dev/null
@@ -1,7 +0,0 @@
-int f(int x);
-
-int f() {
-    return 1;
-}
-
-
diff --git a/komarov.andrey/examples/wrong4.fc b/komarov.andrey/examples/wrong4.fc
deleted file mode 100644
index 1fa4794..00000000
--- a/komarov.andrey/examples/wrong4.fc
+++ /dev/null
@@ -1,3 +0,0 @@
-int f(int x) {
-    return f(x, x);
-}
diff --git a/komarov.andrey/examples/wrong5.fc b/komarov.andrey/examples/wrong5.fc
deleted file mode 100644
index d5c7bd1..00000000
--- a/komarov.andrey/examples/wrong5.fc
+++ /dev/null
@@ -1,3 +0,0 @@
-int f(int x, int y) {
-    return f(x);
-}
diff --git a/komarov.andrey/examples/wrong6.fc b/komarov.andrey/examples/wrong6.fc
deleted file mode 100644
index 1456dc0..00000000
--- a/komarov.andrey/examples/wrong6.fc
+++ /dev/null
@@ -1,2 +0,0 @@
-int f(int a, int a) {
-}
diff --git a/komarov.andrey/src/FCC/Evaluator.hs b/komarov.andrey/src/FCC/Evaluator.hs
index 8a8f50a..24fd816 100644
--- a/komarov.andrey/src/FCC/Evaluator.hs
+++ b/komarov.andrey/src/FCC/Evaluator.hs
@@ -24,7 +24,9 @@ import qualified Data.Map as M
 data Context = Context {
   bindings :: M.Map String Value,
   counter :: Int,
-  bound :: Int }
+  bound :: Int
+  } deriving (Eq, Ord, Show, Read)
+
 
 defaultTimeout = 10000
 
@@ -93,12 +95,12 @@ eval k (Var v) = do
    Just val -> return val
 eval k (Lit i) = return $ VInt i
 eval k (LitBool b) = return $ VBool b
---eval k (Lam t s) = do
---  v <- fresh
---  modify $ \c -> c{bindings = M.insert v (defaultVal t) (bindings c)}
---  eval k $ instantiate1 (Var v) s
+eval k (Lam t s) = do
+  v <- fresh
+  modify $ \c -> c{bindings = M.insert v (defaultVal t) (bindings c)}
+  eval k $ instantiate1 (Var v) s
 eval k Empty = return $ VVoid
---eval k (Pop e) = tick >> eval k e
+eval k (Pop e) = tick >> eval k e
 eval k (Seq e1 e2) = tick >> eval k e1 >> eval k e2
 eval k (Call (Var fname) args) = do
   f <- asks $ (M.lookup fname) . ctxFunctions
@@ -109,20 +111,21 @@ eval k (Call (Var fname) args) = do
      call f' args'
 eval k (Call _ _) = impossible
 --eval k (Eq _ _) = impossible
---eval k e@(While cond body) = do
---  c <- eval k cond
---  case c of
---   VBool b -> if b then eval k e else return VVoid
---   _ -> impossible
+eval k e@(While cond body) = do
+  g <- get
+  c <- eval k cond
+  case c of
+   VBool b -> if b then eval k body >> eval k e else return VVoid
+   _ -> impossible
 eval k (If cond thn els) = do
   c <- eval k cond
   case c of
    VBool b -> if b then eval k thn else eval k els
    _ -> impossible
---eval k (Assign (Var v) src) = do
---  src' <- eval k src
---  modify $ \c -> c{bindings = M.insert v src' (bindings c)}
---  _
+eval k (Assign (Var v) src) = do
+  src' <- eval k src
+  modify $ \c -> c{bindings = M.insert v src' (bindings c)}
+  return src'
 --eval k (Assign (Array a i) src) = _ -- TODO ?????? :((((((
 --eval k (Assign _ _) = impossible
 --eval k (Array a i) = _

From 022010c38f854995f6031ed0a260c05f1a5b48b1 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 04:09:29 +0300
Subject: [PATCH 114/116] add example for global

---
 komarov.andrey/examples/cat-global.fc | 9 +++++++++
 1 file changed, 9 insertions(+)
 create mode 100644 komarov.andrey/examples/cat-global.fc

diff --git a/komarov.andrey/examples/cat-global.fc b/komarov.andrey/examples/cat-global.fc
new file mode 100644
index 00000000..8dd0bd7
--- /dev/null
+++ b/komarov.andrey/examples/cat-global.fc
@@ -0,0 +1,9 @@
+int c;
+int main() {
+	c = getchar();
+	while (c != 0-1) {
+		putchar(c);
+		c = getchar();
+	}
+	return 0;
+}

From fecc8dec111c4f5be12a7067e9705650046fa5c9 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 23:54:35 +0300
Subject: [PATCH 115/116] add README

---
 komarov.andrey/README.md | 67 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 komarov.andrey/README.md

diff --git a/komarov.andrey/README.md b/komarov.andrey/README.md
new file mode 100644
index 00000000..df0af6c
--- /dev/null
+++ b/komarov.andrey/README.md
@@ -0,0 +1,67 @@
+# Что должно быть установлено в системе #
+
+* qemu
+* cabal
+
+# Установка эмулятора #
+
+В папке `vm` лежит файл `download.sh`, который скачает всё необходимое
+для запуска виртуальной машины (всё взято отсюда:
+https://people.debian.org/~aurel32/qemu/armel/).
+
+Затем, `run.sh` запустит виртуальную машину (несколько минут). После
+запуска, можно будет заходить на неё по ssh на 2222 порту. Пароли:
+user/user, root/root.
+
+На виртуальной машине выполнить:
+
+``````
+~# apt-get update && apt-get install -y gcc strace
+``````
+
+Убедиться, что `as` и `ld` установились.
+
+# Установка компилятора #
+
+``````
+cabal install 
+``````
+
+После этого должен появиться файл `~/.cabal/bin/fcc`. Это компилятор,
+который принимает на вход программу, и выводит на стандартный вывод
+ассемблер для ARM. Процесс компиляции и запуска:
+
+`````
+local $ fcc < examples/cat.fc > cat.S
+local $ scp -P 2222 cat.S user@localhost:~
+user@debian-armel $ as cat.S -o cat.o
+user@debian-armel $ ld cat.o -o cat
+user@debian-armel $ echo hello | ./cat
+hello
+`````
+
+# Как запустить что-то, отличное от `cat` #
+
+В остальных примерах не используется ввод-вывод, а для этого результат
+возвращается из функции main как код возврата. Наглядно за этим можно,
+например, наблюдать, запуская программу через strace и смотря на
+аргумент, с которым вызван системный вызов `exit`
+
+# Оптимизации #
+
+Реализовано два вида оптимизаций:
+
+* Удаление ненужного кода
+Начинаем с точки входа, смотрим, какие функции и глобальные
+переменные достижимы, остальные удаляем
+* Пытаемся посчитать значения подвыражений
+  * Выделяем <<хорошие>> функции и пытаемся вычислять их во время компиляции
+  * Хорошие --- те, которые не используют <<неправильных>>
+  <<библиотечных>> вызовов, массивов (TBD) и глобальных переменных
+  * Удаляем недостижимый код и упраздняем очевидные `if`-ы и `while`-ы
+  * Вычислятор -решает проблему останова- делает 10000 итераций и
+  успокаивается, если вычислить не удалось
+
+Примеры хорошо оптимизируемых программ: `examples/fact.fc`,
+`examples/sum.fc`
+

From 26dd041364934e606f1aee8f721c74346b7a2f46 Mon Sep 17 00:00:00 2001
From: Andrey Komarov <taukus@gmail.com>
Date: Fri, 22 May 2015 23:56:06 +0300
Subject: [PATCH 116/116] vm

---
 komarov.andrey/vm/download.sh | 5 +++++
 komarov.andrey/vm/run.sh      | 2 ++
 2 files changed, 7 insertions(+)
 create mode 100755 komarov.andrey/vm/download.sh
 create mode 100755 komarov.andrey/vm/run.sh

diff --git a/komarov.andrey/vm/download.sh b/komarov.andrey/vm/download.sh
new file mode 100755
index 00000000..9a20d71
--- /dev/null
+++ b/komarov.andrey/vm/download.sh
@@ -0,0 +1,5 @@
+#!/bin/sh
+wget https://people.debian.org/~aurel32/qemu/armel/debian_wheezy_armel_standard.qcow2
+wget https://people.debian.org/~aurel32/qemu/armel/initrd.img-3.2.0-4-versatile
+wget https://people.debian.org/~aurel32/qemu/armel/vmlinuz-3.2.0-4-versatile
+
diff --git a/komarov.andrey/vm/run.sh b/komarov.andrey/vm/run.sh
new file mode 100755
index 00000000..616aaa5
--- /dev/null
+++ b/komarov.andrey/vm/run.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+qemu-system-arm -M versatilepb -kernel vmlinuz-3.2.0-4-versatile -initrd initrd.img-3.2.0-4-versatile -hda debian_wheezy_armel_standard.qcow2 -append "root=/dev/sda1" -redir tcp:2222::22