bytecode #3
@ -2,6 +2,7 @@ module Typecheck where
|
|||||||
import Data.List (find)
|
import Data.List (find)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Ast
|
import Ast
|
||||||
|
import Debug.Trace (trace)
|
||||||
|
|
||||||
typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
|
typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
|
||||||
typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
|
typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
|
||||||
@ -256,21 +257,27 @@ typeCheckStatement (While cond stmt) symtab classes =
|
|||||||
typeCheckStatement (Block statements) symtab classes =
|
typeCheckStatement (Block statements) symtab classes =
|
||||||
let
|
let
|
||||||
processStatements (accSts, currentSymtab, types) stmt =
|
processStatements (accSts, currentSymtab, types) stmt =
|
||||||
let
|
case stmt of
|
||||||
checkedStmt = typeCheckStatement stmt currentSymtab classes
|
|
||||||
stmtType = getTypeFromStmt checkedStmt
|
|
||||||
in case stmt of
|
|
||||||
LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) ->
|
LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) ->
|
||||||
let
|
let
|
||||||
|
alreadyDefined = any (\(id, _) -> id == identifier) currentSymtab
|
||||||
|
newSymtab = if alreadyDefined
|
||||||
|
then error ("Variable " ++ identifier ++ " already defined in this scope.")
|
||||||
|
else (identifier, dataType) : currentSymtab
|
||||||
checkedExpr = fmap (\expr -> typeCheckExpression expr currentSymtab classes) maybeExpr
|
checkedExpr = fmap (\expr -> typeCheckExpression expr currentSymtab classes) maybeExpr
|
||||||
newSymtab = (identifier, dataType) : currentSymtab
|
checkedStmt = typeCheckStatement stmt newSymtab classes
|
||||||
in (accSts ++ [checkedStmt], newSymtab, types)
|
in (accSts ++ [checkedStmt], newSymtab, types)
|
||||||
|
|
||||||
If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
_ ->
|
||||||
While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
let
|
||||||
Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
checkedStmt = typeCheckStatement stmt currentSymtab classes
|
||||||
Block _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
stmtType = getTypeFromStmt checkedStmt
|
||||||
_ -> (accSts ++ [checkedStmt], currentSymtab, types)
|
in case stmt of
|
||||||
|
If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||||
|
While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||||
|
Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||||
|
Block _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||||
|
_ -> (accSts ++ [checkedStmt], currentSymtab, types)
|
||||||
|
|
||||||
-- Initial accumulator: empty statements list, initial symbol table, empty types list
|
-- Initial accumulator: empty statements list, initial symbol table, empty types list
|
||||||
(checkedStatements, finalSymtab, collectedTypes) = foldl processStatements ([], symtab, []) statements
|
(checkedStatements, finalSymtab, collectedTypes) = foldl processStatements ([], symtab, []) statements
|
||||||
@ -280,6 +287,7 @@ typeCheckStatement (Block statements) symtab classes =
|
|||||||
|
|
||||||
in TypedStatement blockType (Block checkedStatements)
|
in TypedStatement blockType (Block checkedStatements)
|
||||||
|
|
||||||
|
|
||||||
typeCheckStatement (Return expr) symtab classes =
|
typeCheckStatement (Return expr) symtab classes =
|
||||||
let methodReturnType = fromMaybe (error "Method return type not found in symbol table") (lookup "thisMeth" symtab)
|
let methodReturnType = fromMaybe (error "Method return type not found in symbol table") (lookup "thisMeth" symtab)
|
||||||
expr' = case expr of
|
expr' = case expr of
|
||||||
|
Loading…
Reference in New Issue
Block a user