Compare commits
3 Commits
3f6eb68e91
...
3acbce8afc
Author | SHA1 | Date | |
---|---|---|---|
|
3acbce8afc | ||
|
44c6d74afb | ||
7e13b3fac3 |
@ -442,7 +442,7 @@ assembleStatementExpression
|
||||
expr = (TypedExpression dtype (LocalVariable name))
|
||||
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
||||
in case localIndex of
|
||||
Just index -> (exprConstants, exprOps ++ [Opsipush 1, Opiadd, Opdup_x1, Opistore (fromIntegral index)], lvars)
|
||||
Just index -> (exprConstants, exprOps ++ [Opsipush 1, Opiadd, Opdup, Opistore (fromIntegral index)], lvars)
|
||||
Nothing -> error("No such local variable found in local variable pool: " ++ name)
|
||||
(TypedExpression dtype (FieldVariable name)) -> let
|
||||
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
||||
@ -464,7 +464,7 @@ assembleStatementExpression
|
||||
expr = (TypedExpression dtype (LocalVariable name))
|
||||
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
||||
in case localIndex of
|
||||
Just index -> (exprConstants, exprOps ++ [Opsipush 1, Opisub, Opdup_x1, Opistore (fromIntegral index)], lvars)
|
||||
Just index -> (exprConstants, exprOps ++ [Opsipush 1, Opisub, Opdup, Opistore (fromIntegral index)], lvars)
|
||||
Nothing -> error("No such local variable found in local variable pool: " ++ name)
|
||||
(TypedExpression dtype (FieldVariable name)) -> let
|
||||
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
||||
@ -486,7 +486,7 @@ assembleStatementExpression
|
||||
expr = (TypedExpression dtype (LocalVariable name))
|
||||
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
||||
in case localIndex of
|
||||
Just index -> (exprConstants, exprOps ++ [Opdup_x1, Opsipush 1, Opiadd, Opistore (fromIntegral index)], lvars)
|
||||
Just index -> (exprConstants, exprOps ++ [Opdup, Opsipush 1, Opiadd, Opistore (fromIntegral index)], lvars)
|
||||
Nothing -> error("No such local variable found in local variable pool: " ++ name)
|
||||
(TypedExpression dtype (FieldVariable name)) -> let
|
||||
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
||||
@ -508,7 +508,7 @@ assembleStatementExpression
|
||||
expr = (TypedExpression dtype (LocalVariable name))
|
||||
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
||||
in case localIndex of
|
||||
Just index -> (exprConstants, exprOps ++ [Opdup_x1, Opsipush 1, Opisub, Opistore (fromIntegral index)], lvars)
|
||||
Just index -> (exprConstants, exprOps ++ [Opdup, Opsipush 1, Opisub, Opistore (fromIntegral index)], lvars)
|
||||
Nothing -> error("No such local variable found in local variable pool: " ++ name)
|
||||
(TypedExpression dtype (FieldVariable name)) -> let
|
||||
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
||||
|
@ -2,6 +2,7 @@ module Typecheck where
|
||||
import Data.List (find)
|
||||
import Data.Maybe
|
||||
import Ast
|
||||
import Debug.Trace (trace)
|
||||
|
||||
typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
|
||||
typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
|
||||
@ -256,21 +257,27 @@ typeCheckStatement (While cond stmt) symtab classes =
|
||||
typeCheckStatement (Block statements) symtab classes =
|
||||
let
|
||||
processStatements (accSts, currentSymtab, types) stmt =
|
||||
let
|
||||
checkedStmt = typeCheckStatement stmt currentSymtab classes
|
||||
stmtType = getTypeFromStmt checkedStmt
|
||||
in case stmt of
|
||||
case stmt of
|
||||
LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) ->
|
||||
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
|
||||
newSymtab = (identifier, dataType) : currentSymtab
|
||||
checkedStmt = typeCheckStatement stmt newSymtab classes
|
||||
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)
|
||||
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)
|
||||
_ ->
|
||||
let
|
||||
checkedStmt = typeCheckStatement stmt currentSymtab classes
|
||||
stmtType = getTypeFromStmt checkedStmt
|
||||
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
|
||||
(checkedStatements, finalSymtab, collectedTypes) = foldl processStatements ([], symtab, []) statements
|
||||
@ -280,6 +287,7 @@ typeCheckStatement (Block statements) symtab classes =
|
||||
|
||||
in TypedStatement blockType (Block checkedStatements)
|
||||
|
||||
|
||||
typeCheckStatement (Return expr) symtab classes =
|
||||
let methodReturnType = fromMaybe (error "Method return type not found in symbol table") (lookup "thisMeth" symtab)
|
||||
expr' = case expr of
|
||||
|
Loading…
Reference in New Issue
Block a user