Compare commits
3 Commits
3f6eb68e91
...
3acbce8afc
Author | SHA1 | Date | |
---|---|---|---|
|
3acbce8afc | ||
|
44c6d74afb | ||
7e13b3fac3 |
@ -442,7 +442,7 @@ assembleStatementExpression
|
|||||||
expr = (TypedExpression dtype (LocalVariable name))
|
expr = (TypedExpression dtype (LocalVariable name))
|
||||||
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
||||||
in case localIndex of
|
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)
|
Nothing -> error("No such local variable found in local variable pool: " ++ name)
|
||||||
(TypedExpression dtype (FieldVariable name)) -> let
|
(TypedExpression dtype (FieldVariable name)) -> let
|
||||||
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
||||||
@ -464,7 +464,7 @@ assembleStatementExpression
|
|||||||
expr = (TypedExpression dtype (LocalVariable name))
|
expr = (TypedExpression dtype (LocalVariable name))
|
||||||
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
||||||
in case localIndex of
|
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)
|
Nothing -> error("No such local variable found in local variable pool: " ++ name)
|
||||||
(TypedExpression dtype (FieldVariable name)) -> let
|
(TypedExpression dtype (FieldVariable name)) -> let
|
||||||
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
||||||
@ -486,7 +486,7 @@ assembleStatementExpression
|
|||||||
expr = (TypedExpression dtype (LocalVariable name))
|
expr = (TypedExpression dtype (LocalVariable name))
|
||||||
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
||||||
in case localIndex of
|
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)
|
Nothing -> error("No such local variable found in local variable pool: " ++ name)
|
||||||
(TypedExpression dtype (FieldVariable name)) -> let
|
(TypedExpression dtype (FieldVariable name)) -> let
|
||||||
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
||||||
@ -508,7 +508,7 @@ assembleStatementExpression
|
|||||||
expr = (TypedExpression dtype (LocalVariable name))
|
expr = (TypedExpression dtype (LocalVariable name))
|
||||||
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
(exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
|
||||||
in case localIndex of
|
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)
|
Nothing -> error("No such local variable found in local variable pool: " ++ name)
|
||||||
(TypedExpression dtype (FieldVariable name)) -> let
|
(TypedExpression dtype (FieldVariable name)) -> let
|
||||||
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
owner = resolveNameChainOwner (TypedExpression dtype receiver)
|
||||||
|
@ -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