fix classfile & constpool errors

Co-authored-by: Copilot <copilot@github.com>

.gitignore

@@ -32,3 +32,4 @@ hie.yaml
 src/Grammar/Scanner.hs
 src/Grammar/Parser.hs
 src/Grammar/Parser.info
+src/Main

src/Codegen/ClassFile.hs

@@ -1,6 +1,18 @@
 module Codegen.ClassFile where
 
+import Codegen.ConstPool
+  ( generateConstPool,
+    lookupClassIndex,
+    lookupUtf8Index,
+  )
+import Codegen.Types
 import Data.Word (Word16, Word32, Word8)
+import Grammar.AST (Type)
+import Grammar.TAST
+  ( TypedClass (..),
+    TypedFieldDecl (..),
+    TypedMethodDecl (..),
+  )
 
 data ClassFile = ClassFile
   { magic :: Magic,
@@ -19,7 +31,7 @@ data ClassFile = ClassFile
 
 -- Counts are derivable from list lengths, so no need to store them separately
 
-type CP_Infos = [CP_Info]
+type Index = Int
 
 type Interfaces = [Word16] -- constant pool indices
 
@@ -29,8 +41,6 @@ type Method_Infos = [Method_Info]
 
 type Attribute_Infos = [Attribute_Info]
 
-type Index = Int -- constant pool index (1-based)
-
 newtype Magic = Magic Word32 deriving (Show, Eq) -- always 0xCAFEBABE
 
 newtype MinorVersion = MinorVersion Int deriving (Show, Eq)
@@ -56,40 +66,6 @@ data AccessFlag
   | ACC_ENUM
   deriving (Show, Eq)
 
--- Duplicate field names fixed by prefixing per constructor
-data CP_Info
-  = Class_Info
-      {ci_nameIndex :: Index}
-  | FieldRef_Info
-      { fr_classIndex :: Index,
-        fr_nameAndTypeIndex :: Index
-      }
-  | MethodRef_Info
-      { mr_classIndex :: Index,
-        mr_nameAndTypeIndex :: Index
-      }
-  | InterfaceMethodRef_Info
-      { imr_classIndex :: Index,
-        imr_nameAndTypeIndex :: Index
-      }
-  | String_Info
-      {si_stringIndex :: Index}
-  | Integer_Info
-      {ii_value :: Int}
-  | Float_Info
-      {fi_value :: Float}
-  | Long_Info
-      {li_value :: Integer} -- Long fits in Haskell Integer
-  | Double_Info
-      {di_value :: Double}
-  | NameAndType_Info
-      { nt_nameIndex :: Index,
-        nt_descriptorIndex :: Index
-      }
-  | Utf8_Info
-      {u8_value :: String}
-  deriving (Show, Eq)
-
 data Field_Info = Field_Info
   { fieldAccessFlags :: AccessFlags,
     fieldNameIndex :: Index,
@@ -128,3 +104,76 @@ data ExceptionEntry = ExceptionEntry
     catchType :: Index -- 0 means catches all (finally)
   }
   deriving (Show, Eq)
+
+generateClassFile :: TypedClass -> ClassFile
+generateClassFile cls =
+  let constPool = makeConstpool cls
+   in ClassFile
+        { magic = Magic 0xCAFEBABE,
+          minorVersion = MinorVersion 0,
+          majorVersion = MajorVersion 48,
+          constantPool = constPool,
+          accessFlags = makeAccessFlags,
+          thisClass = makeThisClass constPool cls,
+          superClass = makeSuperClass constPool,
+          interfaces = makeInterface,
+          fields = makeFields constPool cls,
+          methods = makeMethods constPool cls,
+          attributes = makeAttributes constPool
+        }
+
+makeConstpool :: TypedClass -> CP_Infos
+makeConstpool = generateConstPool
+
+makeAccessFlags :: AccessFlags
+makeAccessFlags = AccessFlags [ACC_PUBLIC, ACC_SUPER]
+
+makeThisClass :: CP_Infos -> TypedClass -> ThisClass
+makeThisClass constPool (Class name _ _) =
+  ThisClass (lookupClassIndex constPool name)
+
+makeSuperClass :: CP_Infos -> SuperClass
+makeSuperClass constPool =
+  SuperClass (lookupClassIndex constPool "java/lang/Object")
+
+makeInterface :: Interfaces
+makeInterface = []
+
+makeFields :: CP_Infos -> TypedClass -> Field_Infos
+makeFields constPool (Class _ fields _) = map (makeField constPool) fields
+
+makeField :: CP_Infos -> TypedFieldDecl -> Field_Info
+makeField constPool (Field fieldType name _) =
+  Field_Info
+    { fieldAccessFlags = AccessFlags [ACC_PUBLIC],
+      fieldNameIndex = lookupUtf8Index constPool name,
+      fieldDescIndex = lookupUtf8Index constPool (typeDescriptor fieldType),
+      fieldAttributes = []
+    }
+
+makeAttributes :: CP_Infos -> Attribute_Infos
+makeAttributes _ = []
+
+makeMethods :: CP_Infos -> TypedClass -> Method_Infos
+makeMethods constPool (Class _ _ methods) = map (makeMethod constPool) methods
+
+makeMethod :: CP_Infos -> TypedMethodDecl -> Method_Info
+makeMethod constPool (Method returnType name params _body) =
+  Method_Info
+    { methodAccessFlags = AccessFlags [ACC_PUBLIC],
+      methodNameIndex = lookupUtf8Index constPool name,
+      methodDescIndex = lookupUtf8Index constPool (methodDescriptor params returnType),
+      methodAttributes = []
+    }
+
+methodDescriptor :: [(Type, String)] -> Type -> String
+methodDescriptor params returnType =
+  "(" ++ concatMap (typeDescriptor . fst) params ++ ")" ++ typeDescriptor returnType
+
+typeDescriptor :: Type -> String
+typeDescriptor t = case t of
+  "int" -> "I"
+  "boolean" -> "Z"
+  "char" -> "C"
+  "void" -> "V"
+  _ -> "L" ++ t ++ ";"

src/Codegen/ConstPool.hs

@@ -1,54 +1,232 @@
-module ConstantPool where
-  data Index_Constant_Pool
+module Codegen.ConstPool where
 
-  data CPInfo = 
-    ClassInfo
-      { tag_cp   :: Tag
-      , index_cp :: Index_Constant_Pool
-      , desc     :: String
-      }
-    | FieldRefInfo
-        { tag_cp               :: Tag
-        , index_name_cp        :: Index_Constant_Pool
-        , index_nameandtype_cp :: Index_Constant_Pool
-        , desc                 :: String
-        }
-    | MethodRefInfo
-        { tag_cp               :: Tag
-        , index_name_cp        :: Index_Constant_Pool
-        , index_nameandtype_cp :: Index_Constant_Pool
-        , desc                 :: String
-        }
-    | StringInfo
-        { tag_cp   :: Tag
-        , index_cp :: Index_Constant_Pool
-        , desc     :: String
-        }
-    | IntegerInfo
-        { tag_cp  :: Tag
-        , numi_cp :: Int
-        , desc    :: String
-        }
-    | NameAndTypeInfo
-        { tag_cp         :: Tag
-        , index_name_cp  :: Index_Constant_Pool
-        , index_descr_cp :: Index_Constant_Pool
-        , desc           :: String
-        }
-    | Utf8Info
-        { tag_cp :: Tag
-        , tam_cp :: Int
-        , cad_cp :: String
-        , desc   :: String
-        }
-    deriving ()
+import Codegen.Types
+import Data.List (isSuffixOf)
+import qualified Grammar.TAST as TAST
 
-  data Tag = 
-    TagClass
-    | TagFieldRef
-    | TagMethodRef
-    | TagString
-    | TagInteger
-    | TagNameAndType
-    | TagUtf8
-    deriving (Eq, Ord, Show)
+------------------------------------------------------------------------
+-- Recursive extraction of Tags from an already-built pool
+------------------------------------------------------------------------
+
+extractTags :: CP_Infos -> [Tag]
+extractTags [] = []
+extractTags (x : xs) = tag_cp x : extractTags xs
+
+countEntries :: CP_Infos -> Int
+countEntries [] = 0
+countEntries (_ : xs) = 1 + countEntries xs
+
+------------------------------------------------------------------------
+-- Helper constructors
+------------------------------------------------------------------------
+
+mkClassInfo :: IndexConstantPool -> String -> CP_Info
+mkClassInfo = ClassInfo TagClass
+
+mkFieldRefInfo :: IndexConstantPool -> IndexConstantPool -> String -> CP_Info
+mkFieldRefInfo = FieldRefInfo TagFieldRef
+
+mkMethodRefInfo :: IndexConstantPool -> IndexConstantPool -> String -> CP_Info
+mkMethodRefInfo = MethodRefInfo TagMethodRef
+
+mkStringInfo :: IndexConstantPool -> String -> CP_Info
+mkStringInfo = StringInfo TagString
+
+mkIntegerInfo :: Int -> String -> CP_Info
+mkIntegerInfo = IntegerInfo TagInteger
+
+mkNameAndTypeInfo :: IndexConstantPool -> IndexConstantPool -> String -> CP_Info
+mkNameAndTypeInfo = NameAndTypeInfo TagNameAndType
+
+mkUtf8Info :: String -> String -> CP_Info
+mkUtf8Info str = Utf8Info TagUtf8 (length str) str
+
+------------------------------------------------------------------------
+-- Tag utilities
+------------------------------------------------------------------------
+
+tagToByte :: Tag -> Int
+tagToByte TagClass = 7
+tagToByte TagFieldRef = 9
+tagToByte TagMethodRef = 10
+tagToByte TagString = 8
+tagToByte TagInteger = 3
+tagToByte TagNameAndType = 12
+tagToByte TagUtf8 = 1
+
+tagToString :: Tag -> String
+tagToString TagClass = "Class"
+tagToString TagFieldRef = "FieldRef"
+tagToString TagMethodRef = "MethodRef"
+tagToString TagString = "String"
+tagToString TagInteger = "Integer"
+tagToString TagNameAndType = "NameAndType"
+tagToString TagUtf8 = "Utf8"
+
+------------------------------------------------------------------------
+-- Descriptor helpers
+------------------------------------------------------------------------
+
+typeToDescriptor :: String -> String
+typeToDescriptor "int" = "I"
+typeToDescriptor "boolean" = "Z"
+typeToDescriptor "char" = "C"
+typeToDescriptor "void" = "V"
+typeToDescriptor t = "L" ++ t ++ ";"
+
+methodDescriptor :: [(String, String)] -> String -> String
+methodDescriptor params ret =
+  "(" ++ paramsDesc params ++ ")" ++ typeToDescriptor ret
+  where
+    paramsDesc [] = ""
+    paramsDesc ((pty, _) : ps) = typeToDescriptor pty ++ paramsDesc ps
+
+------------------------------------------------------------------------
+-- Recursive traversal of TAST to collect CP_Info entries
+------------------------------------------------------------------------
+
+collectFromExprs :: [TAST.TypedExpr] -> CP_Infos
+collectFromExprs [] = []
+collectFromExprs (e : es) = collectFromTypedExpr e ++ collectFromExprs es
+
+collectFromTypedExpr :: TAST.TypedExpr -> CP_Infos
+collectFromTypedExpr (TAST.Integer n _) =
+  [mkIntegerInfo (fromIntegral n) ("int " ++ show n)]
+collectFromTypedExpr (TAST.Bool _ _) =
+  []
+collectFromTypedExpr (TAST.Char c _) =
+  [mkIntegerInfo (fromEnum c) ("char " ++ show c)]
+collectFromTypedExpr (TAST.Null _) =
+  []
+collectFromTypedExpr (TAST.This _) =
+  []
+collectFromTypedExpr (TAST.LocalOrFieldVar _ _) =
+  []
+collectFromTypedExpr (TAST.InstVar obj name typ) =
+  collectFromTypedExpr obj
+    ++ [ mkUtf8Info name ("field name: " ++ name),
+         mkUtf8Info (typeToDescriptor typ) ("field descriptor: " ++ typeToDescriptor typ),
+         mkNameAndTypeInfo 0 0 ("field NameAndType: " ++ name),
+         mkFieldRefInfo 0 0 ("field ref: " ++ name)
+       ]
+collectFromTypedExpr (TAST.Unary _ e _) =
+  collectFromTypedExpr e
+collectFromTypedExpr (TAST.Binary _ e1 e2 _) =
+  collectFromTypedExpr e1 ++ collectFromTypedExpr e2
+collectFromTypedExpr (TAST.StmtExprExpr se _) =
+  collectFromTypedStmtExpr se
+
+collectFromTypedStmtExpr :: TAST.TypedStmtExpr -> CP_Infos
+collectFromTypedStmtExpr (TAST.Assign lhs rhs _) =
+  collectFromTypedExpr lhs ++ collectFromTypedExpr rhs
+collectFromTypedStmtExpr (TAST.New t args _) =
+  collectFromExprs args
+    ++ [ mkUtf8Info t ("class name: " ++ t),
+         mkClassInfo 0 ("class: " ++ t)
+       ]
+collectFromTypedStmtExpr (TAST.MethodCall obj name args retTyp) =
+  collectFromTypedExpr obj
+    ++ collectFromExprs args
+    ++ [ mkUtf8Info name ("method name: " ++ name),
+         mkUtf8Info (typeToDescriptor retTyp) ("method ret desc: " ++ typeToDescriptor retTyp),
+         mkNameAndTypeInfo 0 0 ("method NameAndType: " ++ name),
+         mkMethodRefInfo 0 0 ("method ref: " ++ name)
+       ]
+
+collectFromStmts :: [TAST.TypedStmt] -> CP_Infos
+collectFromStmts [] = []
+collectFromStmts (s : ss) = collectFromTypedStmt s ++ collectFromStmts ss
+
+collectFromTypedStmt :: TAST.TypedStmt -> CP_Infos
+collectFromTypedStmt (TAST.Block stmts _) =
+  collectFromStmts stmts
+collectFromTypedStmt (TAST.Return (Just e) _) =
+  collectFromTypedExpr e
+collectFromTypedStmt (TAST.Return Nothing _) =
+  []
+collectFromTypedStmt (TAST.While cond body _) =
+  collectFromTypedExpr cond ++ collectFromTypedStmt body
+collectFromTypedStmt (TAST.LocalVarDecl _ _ _) =
+  []
+collectFromTypedStmt (TAST.If cond then_ mElse _) =
+  collectFromTypedExpr cond
+    ++ collectFromTypedStmt then_
+    ++ collectFromMaybeStmt mElse
+collectFromTypedStmt (TAST.StmtExprStmt se _) =
+  collectFromTypedStmtExpr se
+
+collectFromMaybeStmt :: Maybe TAST.TypedStmt -> CP_Infos
+collectFromMaybeStmt Nothing = []
+collectFromMaybeStmt (Just s) = collectFromTypedStmt s
+
+collectFromFields :: [TAST.TypedFieldDecl] -> CP_Infos
+collectFromFields [] = []
+collectFromFields (TAST.Field fType fName _: fs ) =
+  [ mkUtf8Info fName ("field: " ++ fName),
+
+    mkUtf8Info (typeToDescriptor fType) ("field desc: " ++ fType)
+  ]
+    ++ collectFromFields fs
+
+collectFromMethods :: [TAST.TypedMethodDecl] -> CP_Infos
+collectFromMethods [] = []
+collectFromMethods (TAST.Method mType mName params body : ms) =
+  [ mkUtf8Info mName ("method: " ++ mName),
+    mkUtf8Info (methodDescriptor params mType) ("method desc: " ++ mName)
+  ]
+    ++ collectFromTypedStmt body
+    ++ collectFromMethods ms
+
+------------------------------------------------------------------------
+-- Build the complete constant pool for a class
+------------------------------------------------------------------------
+
+generateConstPool :: TAST.TypedClass -> CP_Infos
+generateConstPool (TAST.Class cName fields methods) =
+  [ mkUtf8Info cName ("this class: " ++ cName),
+    mkUtf8Info "java/lang/Object" "super class",
+    mkClassInfo 0 ("this class: " ++ cName),
+    mkClassInfo 0 "super class"
+  ]
+    ++ collectFromFields fields
+    ++ collectFromMethods methods
+
+lookupClassIndex :: CP_Infos -> String -> IndexConstantPool
+lookupClassIndex pool name =
+  case findIndex matches pool of
+    Just i -> i
+    Nothing -> 0
+  where
+    matches entry = case entry of
+      ClassInfo {desc = descVal}
+        | name == "java/lang/Object" -> descVal == "super class" || isSuffixOf name descVal
+        | otherwise -> descVal == name || isSuffixOf name descVal
+      _ -> False
+
+lookupUtf8Index :: CP_Infos -> String -> IndexConstantPool
+lookupUtf8Index pool value =
+  case findIndex matches pool of
+    Just i -> i
+    Nothing -> 0
+  where
+    matches entry = case entry of
+      Utf8Info {cad_cp = cadVal, desc = descVal} -> cadVal == value || isSuffixOf value descVal
+      _ -> False
+
+lookupNameAndTypeIndex :: CP_Infos -> String -> IndexConstantPool
+lookupNameAndTypeIndex pool name =
+  case findIndex matches pool of
+    Just i -> i
+    Nothing -> lookupUtf8Index pool name
+  where
+    matches entry = case entry of
+      NameAndTypeInfo {desc = descVal} -> descVal == name || isSuffixOf name descVal
+      _ -> False
+
+findIndex :: (CP_Info -> Bool) -> CP_Infos -> Maybe IndexConstantPool
+findIndex predicate pool = go 1 pool
+  where
+    go _ [] = Nothing
+    go i (x : xs)
+      | predicate x = Just i
+      | otherwise = go (i + 1) xs

src/Codegen/Lowerer.hs

@@ -1,6 +1,7 @@
 module Codegen.Lowerer where
 
 import Codegen.ClassFile
+import Codegen.Types (CP_Info (Utf8Info), CP_Infos)
 import Data.Word (Word8)
 import Numeric (showHex)
 
@@ -50,7 +51,7 @@ lowerClassFile cf =
 methodName :: ClassFile -> Method_Info -> String
 methodName cf m =
   case lookupPool (constantPool cf) (methodNameIndex m) of
-    Just (Utf8_Info name) -> name
+    Just (Utf8Info {cad_cp = name}) -> name
     _ -> "<unknown>"
 
 -- Lower a single method's Code attribute into a BtcProgram

src/Codegen/Types.hs

@@ -0,0 +1,57 @@
+module Codegen.Types where
+
+type IndexConstantPool = Int
+
+type CP_Infos = [CP_Info]
+
+data CP_Info
+  = ClassInfo
+      { tag_cp :: Tag,
+        index_cp :: IndexConstantPool,
+        desc :: String
+      }
+  | FieldRefInfo
+      { tag_cp :: Tag,
+        index_name_cp :: IndexConstantPool,
+        index_nameandtype_cp :: IndexConstantPool,
+        desc :: String
+      }
+  | MethodRefInfo
+      { tag_cp :: Tag,
+        index_name_cp :: IndexConstantPool,
+        index_nameandtype_cp :: IndexConstantPool,
+        desc :: String
+      }
+  | StringInfo
+      { tag_cp :: Tag,
+        index_cp :: IndexConstantPool,
+        desc :: String
+      }
+  | IntegerInfo
+      { tag_cp :: Tag,
+        numi_cp :: Int,
+        desc :: String
+      }
+  | NameAndTypeInfo
+      { tag_cp :: Tag,
+        index_name_cp :: IndexConstantPool,
+        index_descr_cp :: IndexConstantPool,
+        desc :: String
+      }
+  | Utf8Info
+      { tag_cp :: Tag,
+        tam_cp :: Int,
+        cad_cp :: String,
+        desc :: String
+      }
+  deriving (Eq, Show)
+
+data Tag
+  = TagClass
+  | TagFieldRef
+  | TagMethodRef
+  | TagString
+  | TagInteger
+  | TagNameAndType
+  | TagUtf8
+  deriving (Eq, Ord, Show)

src/Grammar/AST.hs

@@ -6,7 +6,7 @@ type Program = [Class]
 
 data Class = Class Type [FieldDecl] [MethodDecl] deriving (Show, Eq)
 
-data FieldDecl = Field Type String deriving (Show, Eq)
+data FieldDecl = Field Type String (Maybe Expr) deriving (Show, Eq)
 
 data MethodDecl = Method Type String [(Type, String)] Stmt deriving (Show, Eq)
 

src/Grammar/Parser.y

@@ -10,6 +10,8 @@ import Grammar.AST
 %error { parseError }
 
 %token
+    public  { TokenVisibility Public }
+    private { TokenVisibility Private }
     class   { TokenClass }
     void    { TokenVoid }
     return  { TokenReturn }
@@ -68,15 +70,26 @@ Classes     : Classes ClassDecl                 { $2 : $1 }
             | ClassDecl                         { [$1] }
 
 ClassDecl   : class id '{' Decls '}'            { Class $2 (fst $4) (snd $4) }
+            | public class id '{' Decls '}'     { Class $3 (fst $5) (snd $5) }
+            | private class id '{' Decls '}'    { Class $3 (fst $5) (snd $5) }
 
 Decls       : FieldDecl Decls                   { ($1 : fst $2, snd $2) }
             | MethodDecl Decls                  { (fst $2, $1 : snd $2) }
             | {- leer -}                        { ([], []) }
 
-FieldDecl   : Type id ';'                       { Field $1 $2 }
+FieldDecl   : Type id ';'                       { Field $1 $2 Nothing }
+            | public Type id ';'                { Field $2 $3 Nothing }
+            | private Type id ';'               { Field $2 $3 Nothing }
+            | Type id '=' Expr ';'              { Field $1 $2 (Just $4) }
+            | public Type id '=' Expr ';'       { Field $2 $3 (Just $5) }
+            | private Type id '=' Expr ';'      { Field $2 $3 (Just $5) }
 
-MethodDecl  : Type id '(' Params ')' Block      { Method $1 $2 $4 $6 }
-            | void id '(' Params ')' Block      { Method "void" $2 $4 $6 }
+MethodDecl  : Type id '(' Params ')' Block          { Method $1 $2 $4 $6 }
+            | public Type id '(' Params ')' Block   { Method $2 $3 $5 $7 }
+            | private Type id '(' Params ')' Block  { Method $2 $3 $5 $7 }
+            | void id '(' Params ')' Block          { Method "void" $2 $4 $6 }
+            | public void id '(' Params ')' Block   { Method "void" $3 $5 $7 }
+            | private void id '(' Params ')' Block  { Method "void" $3 $5 $7 }
 
 Params      : ParamList                         { $1 }
             | {- leer -}                        { [] }
@@ -97,7 +110,8 @@ Stmts       : Stmts Stmt                        { $2 : $1 }
             | {- leer -}                        { [] }
 
 Stmt        : Block                             { $1 }
-            | return Expr ';'                   { Return $2 }
+            | return Expr ';'                   { Return (Just $2) }
+            | return ';'                        { Return Nothing }
             | while '(' Expr ')' Stmt           { While $3 $5 }
             | if '(' Expr ')' Stmt else Stmt    { If $3 $5 (Just $7) }
             | if '(' Expr ')' Stmt              { If $3 $5 Nothing }
@@ -141,5 +155,5 @@ ExprList    : Expr                              { [$1] }
 
 {
 parseError :: [Token] -> a
-parseError tokens = error $ "Lexical error or syntax error at: " ++ show tokens
+parseError tokens = error $ "abc Lexical error or syntax error at: " ++ show tokens
 }

src/Grammar/Scanner.x

@@ -14,6 +14,8 @@ tokens :-
   "/*"([^\*]|(\*+([^\*\/])))*\*+\/      ; -- multi-line comments
 
   -- key words
+  public                                { \_ -> TokenVisibility Public }
+  private                               { \_ -> TokenVisibility Private }
   class                                 { \_ -> TokenClass }
   void                                  { \_ -> TokenVoid }
   return                                { \_ -> TokenReturn }
@@ -49,8 +51,14 @@ tokens :-
   $alpha [$alpha $digit]*               { \s -> TokenIdent s }
 
 {
+data Visibility
+    = Public
+    | Private
+    deriving (Eq, Show)
+
 data Token
-    = TokenClass
+    = TokenVisibility Visibility
+    | TokenClass
     | TokenStatic
     | TokenVoid
     | TokenReturn

src/Grammar/TAST.hs

@@ -2,6 +2,12 @@ module Grammar.TAST where
 
 import Grammar.AST (BinaryOperator, Type, UnaryOperator)
 
+data TypedClass = Class Type [TypedFieldDecl] [TypedMethodDecl] deriving (Show, Eq)
+
+data TypedFieldDecl = Field Type String (Maybe TypedExpr) deriving (Show, Eq)
+
+data TypedMethodDecl = Method Type String [(Type, String)] TypedStmt deriving (Show, Eq)
+
 data TypedExpr
   = This Type
   | LocalOrFieldVar String Type

src/Main.hs

@@ -1,10 +1,45 @@
 module Main where
 
-import Grammar.AST
-import Grammar.TAST
-import Typecheck.SemanticChecker
+import Codegen.ClassFile (ClassFile, generateClassFile)
+import Grammar.AST (Program)
+import Grammar.Parser (parse)
+import Grammar.Scanner (Token, alexScanTokens)
+import Grammar.TAST (TypedClass (Class))
+import System.Environment (getArgs)
+import Typecheck.SemanticChecker (typeCheckClass)
 
 main :: IO ()
 main = do
-  let t = getTypeFromExpr $ TypedExpr This "myType"
-  putStrLn t
+  args <- getArgs
+  case args of
+    [path] -> runPipeline path
+    _ -> putStrLn "Usage: compoiler <input.java>"
+
+runPipeline :: FilePath -> IO ()
+runPipeline path = do
+  source <- readFile path
+  let tokens = scan source
+  let ast = parseProgram tokens
+  let typedClasses = typeCheckProgram ast
+  let classFiles = map generateClassFile typedClasses
+  reportSuccess ast typedClasses classFiles
+
+scan :: String -> [Token]
+scan = alexScanTokens
+
+parseProgram :: [Token] -> Program
+parseProgram = parse
+
+typeCheckProgram :: Program -> [TypedClass]
+typeCheckProgram classes =
+  map (\cls -> typeCheckClass cls [] classes) classes
+
+reportSuccess :: Program -> [TypedClass] -> [ClassFile] -> IO ()
+reportSuccess ast typed classFiles = do
+  putStrLn ("Parsed classes: " ++ show (length ast))
+  putStrLn ("Typed classes: " ++ show (length typed))
+  putStrLn ("Generated class files: " ++ show (length classFiles))
+  putStrLn ("Class names: " ++ unwords (map className typed))
+
+className :: TypedClass -> String
+className (Class name _ _) = name

src/Testsuite/AstFiles/ArithmeticTestAST.hs

@@ -0,0 +1,48 @@
+module Testsuite.AstFiles.ArithmeticTestAST (expectedAST) where
+
+import Grammar.AST
+
+expectedAST =
+  [ Class
+      "ArithmeticTest"
+      []
+      [ Method
+          "int"
+          "basic"
+          [("int", "a"), ("int", "b"), ("int", "c")]
+          ( Block
+              [ Return
+                  ( Just
+                      ( Binary
+                          Subtract
+                          (Binary Add (LocalOrFieldVar "a") (LocalOrFieldVar "b"))
+                          ( Binary
+                              Modulo
+                              ( Binary
+                                  Divide
+                                  (Binary Multiply (LocalOrFieldVar "c") (LocalOrFieldVar "a"))
+                                  (LocalOrFieldVar "b")
+                              )
+                              (LocalOrFieldVar "c")
+                          )
+                      )
+                  )
+              ]
+          ),
+        Method
+          "boolean"
+          "logic"
+          [("boolean", "a"), ("boolean", "b"), ("boolean", "c")]
+          ( Block
+              [ Return
+                  ( Just
+                      ( Binary
+                          And
+                          (Unary Not (LocalOrFieldVar "a"))
+                          (Binary Or (LocalOrFieldVar "c") (LocalOrFieldVar "b"))
+                      )
+                  )
+              ]
+          )
+      ]
+  ]

src/Testsuite/AstFiles/EmptyTest.ast

@@ -0,0 +1,3 @@
+[
+  Class "EmptyTest" [] []
+]

src/Testsuite/ExecutableTests/ArithmeticASTTest.hs

@@ -0,0 +1,14 @@
+module TestSuite.ExecutableTests.ArithmeticASTTest where
+
+import Grammar.Parser
+import Grammar.Scanner
+import Testsuite.AstFiles.ArithmeticTestAST (expectedAST)
+
+mainArithemticASTTest :: IO ()
+mainArithemticASTTest = do
+  let javaFilePath = "Testsuite/javaFiles/ArithmeticTest.java"
+  java <- readFile javaFilePath
+  let actualAST = parse . alexScanTokens $ java
+  print $ actualAST == expectedAST
+  print actualAST
+  print expectedAST

src/Testsuite/abcFiles/ArithmeticTest.abc

@@ -0,0 +1 @@
+[("basic",BtcProgram [BtcLine {lineNumber = 0, instruction = ILoad 0},BtcLine {lineNumber = 1, instruction = ILoad 1},BtcLine {lineNumber = 2, instruction = IAdd},BtcLine {lineNumber = 3, instruction = ILoad 2},BtcLine {lineNumber = 4, instruction = ILoad 0},BtcLine {lineNumber = 5, instruction = IMul},BtcLine {lineNumber = 6, instruction = ILoad 1},BtcLine {lineNumber = 7, instruction = ISub},BtcLine {lineNumber = 8, instruction = ILoad 2},BtcLine {lineNumber = 9, instruction = ISub},BtcLine {lineNumber = 10, instruction = IReturn}]),("logic",BtcProgram [BtcLine {lineNumber = 0, instruction = ILoad 0},BtcLine {lineNumber = 1, instruction = ILoad 2},BtcLine {lineNumber = 2, instruction = ILoad 1},BtcLine {lineNumber = 3, instruction = IAdd},BtcLine {lineNumber = 4, instruction = IAdd},BtcLine {lineNumber = 5, instruction = IReturn}])]

src/Testsuite/abcFiles/EmptyTest.abc

@@ -0,0 +1 @@
+[]

src/Testsuite/javaFiles/ArithmeticTest.java

@@ -0,0 +1,10 @@
+public class ArithmeticTest {
+
+    public int basic(int a, int b, int c) {
+        return a + b - (((c * a) / b) % c);
+    }
+
+    public boolean logic(boolean a, boolean b, boolean c) {
+        return !a && (c || b);
+    }
+}

src/Testsuite/javaFiles/FieldsTest.java

@@ -1,5 +1,5 @@
-public class FieldsTest
-{
+public class FieldsTest {
+
     public int a;
     public int b = 42;
 }

src/Testsuite/javaFiles/Main.java

@@ -18,6 +18,13 @@ public class Main {
         LoopTest loop = new LoopTest();
         MethodOverloadTest overload = new MethodOverloadTest();
         ShenaniganceTest shenanigance = new ShenaniganceTest();
+        AllSyntaxTest allSyntax = new AllSyntaxTest(0);
+        CombinedControlTest combined = new CombinedControlTest(6);
+        ExpressionTest expression = new ExpressionTest();
+        IfTest ifTest = new IfTest();
+        MultiClassTest multiClass = new MultiClassTest();
+        SingletonTest singleton = new SingletonTest();
+        WhileTest whileTest = new WhileTest();
         
         // constructing a basic class works
         System.out.println("test empty non-null. Expected: non-null, Real: " + (empty != null));
@@ -53,6 +60,24 @@ public class Main {
         // other syntactic sugar
         System.out.println("test shenanigance.testAssignment(). Expected: 5, Real: " + shenanigance.testAssignment());
         System.out.println("test shenanigance.divEqual(). Expected: " + (234_343_000 / 4) + ", Real: " + shenanigance.divEqual());
-        System.out.println("test shenanigance.testIf(5). Expected: true, Real: " + shenanigance.testIf(5));
+        // AllSyntaxTest tests
+        System.out.println("test AllSyntaxTest.inc(). Expected: 1, Real: " + allSyntax.inc());
+        System.out.println("test AllSyntaxTest.inc(4). Expected: 5, Real: " + allSyntax.inc(4));
+        System.out.println("test AllSyntaxTest.sumUpTo(5). Expected: 15, Real: " + AllSyntaxTest.sumUpTo(5));
+        System.out.println("test AllSyntaxTest.predicate('a'). Expected: true, Real: " + allSyntax.predicate('a'));
+        // CombinedControlTest tests
+        System.out.println("test CombinedControlTest.compute(). Expected: -3, Real: " + combined.compute());
+        // ExpressionTest tests
+        System.out.println("test ExpressionTest.shortCircuit(2, 1). Expected: true, Real: " + ExpressionTest.shortCircuit(2, 1));
+        System.out.println("test ExpressionTest.shortCircuit(0, 1). Expected: false, Real: " + ExpressionTest.shortCircuit(0, 1));
+        System.out.println("test ExpressionTest.charArithmetic('A', 2). Expected: C, Real: " + ExpressionTest.charArithmetic('A', 2));
+        // IfTest tests
+        System.out.println("test IfTest.ifElseTest(-1). Expected: false, Real: " + IfTest.ifElseTest(-1));
+        System.out.println("test IfTest.ifElseTest(0). Expected: true, Real: " + IfTest.ifElseTest(0));
+        System.out.println("test IfTest.ifElseTest(11). Expected: true, Real: " + IfTest.ifElseTest(11));
+        // SingletonTest tests
+        System.out.println("test SingletonTest.getInstance(). Expected: non-null, Real: " + (singleton.getInstance() != null));
+        // WhileTest tests
+        System.out.println("test WhileTest.whileLoopTest(5). Expected: 15, Real: " + WhileTest.whileLoopTest(5));
     }
 }

src/Testsuite/javaFiles/ShenaniganceTest.java

@@ -11,15 +11,4 @@ class ShenaniganceTest {
         x /= 4;
         return x;
     }
-
-    boolean testIf(int x) {
-        if (true && x < 8) {
-            char f = 'c';
-            return f > x ;
-        }
-        ifn't {
-            return false;
-        }
-    }
-
 }

src/Testsuite/tastFiles/ArithmeticTest.tast

@@ -0,0 +1,55 @@
+[
+  Class "ArithmeticTest"
+    []
+    [ Method "int" "basic" [("int", "a"), ("int", "b"), ("int", "c")]
+        (TypedStmt
+          (Block
+            [ TypedStmt
+                (Return
+                  (Just
+                    (Binary Subtract
+                      (Binary Add
+                        (LocalOrFieldVar "a" "int")
+                        (LocalOrFieldVar "b" "int")
+                      )
+                      (Binary Modulo
+                        (Binary Divide
+                          (Binary Multiply
+                            (LocalOrFieldVar "c" "int")
+                            (LocalOrFieldVar "a" "int")
+                          )
+                          (LocalOrFieldVar "b" "int")
+                        )
+                        (LocalOrFieldVar "c" "int")
+                      )
+                    )
+                  )
+                )
+                "int"
+            ]
+          )
+          "int"
+        )
+    , Method "boolean" "logic" [("boolean", "a"), ("boolean", "b"), ("boolean", "c")]
+        (TypedStmt
+          (Block
+            [ TypedStmt
+                (Return
+                  (Just
+                    (Binary And
+                      (Unary Not (LocalOrFieldVar "a" "boolean") "boolean")
+                      (Binary Or
+                        (LocalOrFieldVar "c" "boolean")
+                        (LocalOrFieldVar "b" "boolean")
+                        "boolean"
+                      )
+                    )
+                  )
+                )
+                "boolean"
+            ]
+          )
+          "boolean"
+        )
+    ]
+]

src/Testsuite/tastFiles/EmptyTest.tast

@@ -0,0 +1,3 @@
+[
+  Class "EmptyTest" [] []
+]

src/Typecheck/SemanticChecker.hs

@@ -1,13 +1,14 @@
 module Typecheck.SemanticChecker where
 
+import Data.List (find)
 import Grammar.AST as AST
 import Grammar.TAST as TAST
 
 --------------------------------------------------
--- Helper functions
+-- Get type functions
 --------------------------------------------------
 getTypeFromTypedExpr :: TypedExpr -> Type
-getTypeFromTypedExpr (TAST.This t) = t 
+getTypeFromTypedExpr (TAST.This t) = t
 getTypeFromTypedExpr (TAST.LocalOrFieldVar _ t) = t
 getTypeFromTypedExpr (TAST.InstVar _ _ t) = t
 getTypeFromTypedExpr (TAST.Unary _ _ t) = t
@@ -26,46 +27,263 @@ getTypeFromTypedStmtExpr (TAST.MethodCall _ _ _ t) = t
 
 getTypeFromTypedStmt :: TypedStmt -> Type
 getTypeFromTypedStmt (TAST.Block _ t) = t
-getTypeFromTypedStmt (TAST.Return _ t) = t 
+getTypeFromTypedStmt (TAST.Return _ t) = t
 getTypeFromTypedStmt (TAST.While _ _ t) = t
 getTypeFromTypedStmt (TAST.LocalVarDecl _ _ t) = t
 getTypeFromTypedStmt (TAST.If _ _ _ t) = t
 getTypeFromTypedStmt (TAST.StmtExprStmt _ t) = t
 
 
-upperBound :: Type -> Type -> Type
-upperBound t1 t2
-  | t1 == t2 = t1
-  | otherwise = "Object" -- // Or: Throw an error because types don't match
+--------------------------------------------------
+-- Typechecking Class
+--------------------------------------------------
+
+typeCheckClass :: AST.Class -> [(String, Type)] -> [AST.Class] -> TAST.TypedClass
+typeCheckClass (AST.Class typ fields methods) symtab cls =
+  let checkedFields = map (\f -> typeCheckField f symtab cls) fields
+      checkedMethods = map (\m -> typeCheckMethod m symtab cls) methods
+  in TAST.Class typ checkedFields checkedMethods
+
+typeCheckField :: AST.FieldDecl -> [(String, Type)] -> [AST.Class] -> TAST.TypedFieldDecl
+typeCheckField (AST.Field typ name Nothing) symtab cls =
+  TAST.Field typ name Nothing
+typeCheckField (AST.Field expectedTyp name (Just expr)) symtab cls =
+  let checkedExpr = typeCheckExpr expr symtab cls
+      actualTyp = getTypeFromTypedExpr checkedExpr
+  in if expectedTyp == actualTyp
+      then TAST.Field expectedTyp name (Just checkedExpr)
+      else error $ "Type mismatch: Expected " ++ expectedTyp ++ " found " ++ actualTyp
+
+
+
+typeCheckMethod :: AST.MethodDecl -> [(String, Type)] -> [AST.Class] -> TAST.TypedMethodDecl
+typeCheckMethod (AST.Method typ name params stmt) symtab cls =
+  let checkedStmt = typeCheckStmt stmt symtab cls
+      stmtTyp = getTypeFromTypedStmt checkedStmt
+  in if typ == stmtTyp || stmtTyp == "void"
+    then TAST.Method typ name params checkedStmt
+    else error $ "Return type mismatch: expected " ++ typ ++ ", got " ++ stmtTyp
+
 
 --------------------------------------------------
 -- Statement Typechecking
 --------------------------------------------------
-typeCheckStmt :: Stmt -> [(String, Type)] -> [Class] -> TypedStmt
--- If-Else Statement
-typeCheckStmt (AST.If cond body elseBranch) symtab cls =
+typeCheckStmt :: AST.Stmt -> [(String, Type)] -> [AST.Class] -> TAST.TypedStmt
+
+-- If-Statement
+typeCheckStmt (AST.If cond body Nothing) symtab cls =
   let checkedCond = typeCheckExpr cond symtab cls
       checkedBody = typeCheckStmt body symtab cls
-      checkedElse = fmap (\e -> typeCheckStmt e symtab cls) elseBranch
-      typ = case checkedElse of
-              Nothing -> getTypeFromTypedStmt checkedBody
-              Just ce -> upperBound (getTypeFromTypedStmt checkedBody) (getTypeFromTypedStmt ce)
-   in if getTypeFromTypedExpr checkedCond == "boolean"
-        then TAST.If checkedCond checkedBody checkedElse typ
-        else error "Condition in if statement must be of type boolean"
+      typ = getTypeFromTypedStmt checkedBody
+    in if getTypeFromTypedExpr checkedCond == "boolean"
+      then TAST.If checkedCond checkedBody Nothing typ
+      else error "Condition in if statement must be of type boolean"
+
+-- If-Else-Statement
+typeCheckStmt (AST.If cond body (Just elseBody)) symtab cls =
+  let checkedCond = typeCheckExpr cond symtab cls
+      checkedBody = typeCheckStmt body symtab cls
+      checkedElse = Just (typeCheckStmt elseBody symtab cls)
+      typ = upperBound (getTypeFromTypedStmt checkedBody) (getTypeFromTypedStmt (maybe checkedBody id checkedElse))
+  in if getTypeFromTypedExpr checkedCond == "boolean"
+      then TAST.If checkedCond checkedBody checkedElse typ
+      else error "Condition in if statement must be of type boolean"
+
+-- While-Statement
+typeCheckStmt (AST.While cond body) symtab cls =
+  let checkedCond = typeCheckExpr cond symtab cls
+      checkedBody = typeCheckStmt body symtab cls
+      typ = getTypeFromTypedStmt checkedBody
+  in if getTypeFromTypedExpr checkedCond == "boolean"
+      then TAST.While checkedCond checkedBody typ
+      else error "Condition in if statement must be of type boolean"
+
+-- Return Statement
+typeCheckStmt (AST.Return maybeExpr) symtab cls =
+  let checkedExpr = fmap (\expr -> typeCheckExpr expr symtab cls) maybeExpr
+      typ = maybe "void" getTypeFromTypedExpr checkedExpr
+  in TAST.Return checkedExpr typ
+
+
+typeCheckStmt (AST.LocalVarDecl typ str) _ _ =
+  TAST.LocalVarDecl typ str typ
+
+-- Block statement
+typeCheckStmt (AST.Block stmts) symtab cls =
+  let checkedStmts = map (\s -> typeCheckStmt s symtab cls) stmts
+      typ = case reverse checkedStmts of
+              [] -> "void"
+              (lastStmt : _) -> getTypeFromTypedStmt lastStmt
+  in TAST.Block checkedStmts typ
+
+-- Expression statement
+typeCheckStmt (AST.StmtExprStmt stmtExpr) symtab cls =
+  let checkedStmtExpr = typeCheckStmtExpr stmtExpr symtab cls
+      typ = getTypeFromTypedStmtExpr checkedStmtExpr
+  in TAST.StmtExprStmt checkedStmtExpr typ
+
+--------------------------------------------------
+-- Statement Expression Typechecking
+--------------------------------------------------
+typeCheckStmtExpr :: AST.StmtExpr -> [(String, Type)] -> [AST.Class] -> TAST.TypedStmtExpr
+
+-- Assign
+typeCheckStmtExpr (AST.Assign lhs rhs) symtab cls =
+  let checkedLhs = typeCheckExpr lhs symtab cls
+      checkedRhs = typeCheckExpr rhs symtab cls
+      lhsType = getTypeFromTypedExpr checkedLhs
+      rhsType = getTypeFromTypedExpr checkedRhs
+  in if lhsType == rhsType || rhsType == "null"
+        then TAST.Assign checkedLhs checkedRhs lhsType
+        else error "Type mismatch in assignment"
+
+-- New
+typeCheckStmtExpr (AST.New typ args) symtab cls =
+  let checkedArgs = map (\arg -> typeCheckExpr arg symtab cls) args
+  in TAST.New typ checkedArgs typ
+
+-- Method call
+typeCheckStmtExpr (AST.MethodCall target methodName args) symtab cls =
+  let checkedTarget = typeCheckExpr target symtab cls
+      checkedArgs = map (\arg -> typeCheckExpr arg symtab cls) args
+      targetType = getTypeFromTypedExpr checkedTarget
+      returnType = lookupMethodReturnType targetType methodName cls
+  in TAST.MethodCall checkedTarget methodName checkedArgs returnType
+
+-- Helper methods
+lookupMethodReturnType :: Type -> String -> [AST.Class] -> Type
+lookupMethodReturnType classType methodName classes =
+  case findMethod classType methodName classes of
+    Just t -> t
+    Nothing -> error $ "Method not found: " ++ methodName ++ " in class " ++ classType
+
+findMethod :: Type -> String -> [AST.Class] -> Maybe Type
+findMethod classType methodName classes =
+  case find (\(AST.Class clsName _ _) -> clsName == classType) classes of
+    Just (AST.Class _ _ methods) ->
+      case find (\(AST.Method ret name _ _) -> name == methodName) methods of
+        Just (AST.Method ret _ _ _) -> Just ret
+        Nothing -> Nothing
+    Nothing -> Nothing
+
+lookupFieldType :: Type -> String -> [AST.Class] -> Type
+lookupFieldType classType fieldName classes =
+  case find (\(AST.Class clsName _ _) -> clsName == classType) classes of
+    Just (AST.Class _ fields _) ->
+      case find (\(AST.Field _ name _) -> name == fieldName) fields of
+        Just (AST.Field t _ _) -> t
+        Nothing -> error $ "Field not found: " ++ fieldName ++ " in class " ++ classType
+    Nothing -> error $ "Class not found: " ++ classType
+
 
 --------------------------------------------------
 -- Expression Typechecking
 --------------------------------------------------
-typeCheckExpr :: Expr -> [(String, Type)] -> [Class] -> TypedExpr
+typeCheckExpr :: AST.Expr -> [(String, Type)] -> [AST.Class] -> TAST.TypedExpr
+
 -- boolean literals
 typeCheckExpr (AST.Bool value) symtbl cls =
   TAST.Bool value "boolean"
+
 -- integer literals
 typeCheckExpr (AST.Integer value) symtbl cls =
   TAST.Integer value "int"
+
 -- variable references
 typeCheckExpr (AST.LocalOrFieldVar varName) symtbl cls =
   case lookup varName symtbl of
     Just t -> TAST.LocalOrFieldVar varName t
     Nothing -> error $ "Undefined variable: " ++ varName
+
+-- this reference
+typeCheckExpr AST.This _ cls =
+  case cls of
+    (AST.Class className _ _ : _) -> TAST.This className
+    [] -> error "No class context for this expression"
+
+-- field access on an object
+typeCheckExpr (AST.InstVar obj fieldName) symtbl cls =
+  let checkedObj = typeCheckExpr obj symtbl cls
+      objType = getTypeFromTypedExpr checkedObj
+      fieldType = lookupFieldType objType fieldName cls
+  in TAST.InstVar checkedObj fieldName fieldType
+
+-- unary operators
+typeCheckExpr (AST.Unary op expr) symtbl cls =
+  let checkedExpr = typeCheckExpr expr symtbl cls
+      exprType = getTypeFromTypedExpr checkedExpr
+  in case op of
+       AST.Not -> if exprType == "boolean"
+                    then TAST.Unary AST.Not checkedExpr "boolean"
+                    else error "Operator ! requires boolean operand"
+       AST.Negate -> if exprType == "int"
+                       then TAST.Unary AST.Negate checkedExpr "int"
+                       else error "Unary - requires integer operand"
+
+-- binary operators
+typeCheckExpr (AST.Binary op left right) symtbl cls =
+  let checkedLeft = typeCheckExpr left symtbl cls
+      checkedRight = typeCheckExpr right symtbl cls
+      leftType = getTypeFromTypedExpr checkedLeft
+      rightType = getTypeFromTypedExpr checkedRight
+  in case op of
+       AST.Add -> checkIntOp leftType rightType checkedLeft checkedRight op
+       AST.Subtract -> checkIntOp leftType rightType checkedLeft checkedRight op
+       AST.Multiply -> checkIntOp leftType rightType checkedLeft checkedRight op
+       AST.Divide -> checkIntOp leftType rightType checkedLeft checkedRight op
+       AST.Modulo -> checkIntOp leftType rightType checkedLeft checkedRight op
+       AST.CompLessThan -> checkIntComparison leftType rightType checkedLeft checkedRight op
+       AST.CompLessOrEqual -> checkIntComparison leftType rightType checkedLeft checkedRight op
+       AST.CompGreaterThan -> checkIntComparison leftType rightType checkedLeft checkedRight op
+       AST.CompGreaterOrEqual -> checkIntComparison leftType rightType checkedLeft checkedRight op
+       AST.CompEqual -> checkEquality leftType rightType checkedLeft checkedRight op
+       AST.CompNotEqual -> checkEquality leftType rightType checkedLeft checkedRight op
+       AST.BitAnd -> checkIntOp leftType rightType checkedLeft checkedRight op
+       AST.BitOr -> checkIntOp leftType rightType checkedLeft checkedRight op
+       AST.BitXor -> checkIntOp leftType rightType checkedLeft checkedRight op
+       AST.And -> checkBoolOp leftType rightType checkedLeft checkedRight op
+       AST.Or -> checkBoolOp leftType rightType checkedLeft checkedRight op
+
+-- character literals
+typeCheckExpr (AST.Char value) _ _ =
+  TAST.Char value "char"
+
+-- null literal
+typeCheckExpr AST.Null _ _ =
+  TAST.Null "null"
+
+-- statement expression
+typeCheckExpr (AST.StmtExprExpr stmtExpr) symtbl cls =
+  let checkedStmtExpr = typeCheckStmtExpr stmtExpr symtbl cls
+      typ = getTypeFromTypedStmtExpr checkedStmtExpr
+  in TAST.StmtExprExpr checkedStmtExpr typ
+
+-- Helper methods
+checkIntOp :: Type -> Type -> TAST.TypedExpr -> TAST.TypedExpr -> AST.BinaryOperator -> TAST.TypedExpr
+checkIntOp leftType rightType left right op =
+  if leftType == "int" && rightType == "int"
+    then TAST.Binary op left right "int"
+    else error "Integer binary operator requires int operands"
+
+checkBoolOp :: Type -> Type -> TAST.TypedExpr -> TAST.TypedExpr -> AST.BinaryOperator -> TAST.TypedExpr
+checkBoolOp leftType rightType left right op =
+  if leftType == "boolean" && rightType == "boolean"
+    then TAST.Binary op left right "boolean"
+    else error "Boolean binary operator requires boolean operands"
+
+checkIntComparison :: Type -> Type -> TAST.TypedExpr -> TAST.TypedExpr -> AST.BinaryOperator -> TAST.TypedExpr
+checkIntComparison leftType rightType left right op =
+  if leftType == "int" && rightType == "int"
+    then TAST.Binary op left right "boolean"
+    else error "Comparison operator requires int operands"
+
+checkEquality :: Type -> Type -> TAST.TypedExpr -> TAST.TypedExpr -> AST.BinaryOperator -> TAST.TypedExpr
+checkEquality leftType rightType left right op =
+  if leftType == rightType || leftType == "null" || rightType == "null"
+    then TAST.Binary op left right "boolean"
+    else error $ "Equality operator: cannot compare " ++ leftType ++ " with " ++ rightType
+
+upperBound :: Type -> Type -> Type
+upperBound t1 t2
+  | t1 == t2 = t1
+  | otherwise = "Object"

src/testsuite/ArithmeticTest.java

@@ -1,11 +0,0 @@
-public class ArithmeticTest {
-    public int basic(int a, int b, int c)
-    {
-        return a + b - c * a / b % c;
-    }
-
-    public boolean logic(boolean a, boolean b, boolean c)
-    {
-        return !a && (c || b);
-    }
-}

src/testsuite/example.abc

@@ -1,4 +0,0 @@
-func Main.main : int
-entry:
-  t0 = 0
-  return t0

src/testsuite/example.ast

@@ -1,11 +0,0 @@
-[
-  Class "Main" []
-    [
-      Method "int" "main" []
-        (Block
-          [
-            Return (Integer 0)
-          ]
-        )
-    ]
-]

src/testsuite/example.tast

@@ -1,16 +0,0 @@
-[
-  Class "Main" []
-    [
-      Method "int" "main" []
-        (TypedStmt
-          (Block
-            [
-              TypedStmt
-                (Return (Integer 0))
-                "int"
-            ]
-          )
-          "int"
-        )
-    ]
-]