aboutsummaryrefslogtreecommitdiffstats
path: root/src/Evaluator.hs
diff options
context:
space:
mode:
authorJan Tuomi <jans.tuomi@gmail.com>2022-09-27 16:41:27 +0300
committerJan Tuomi <jans.tuomi@gmail.com>2022-12-05 14:21:53 +0200
commitfe5d1ec1b76b8cb42359324030e701a719847a50 (patch)
treeaa37852acd83ffd38d00ec65285665bec68c7f12 /src/Evaluator.hs
parent2d9588f5b309aa6b5114d8719bfe3d0b17abbcff (diff)
Add shadowing symbol error
Diffstat (limited to 'src/Evaluator.hs')
-rw-r--r--src/Evaluator.hs13
1 files changed, 11 insertions, 2 deletions
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
index 2797fcd..4de5565 100644
--- a/src/Evaluator.hs
+++ b/src/Evaluator.hs
@@ -102,9 +102,16 @@ evaluateFunctionDef env asts = do
| length args' < 2 ->
throwL (astPos defAst) $ "\\ called with " ++ show (length args) ++ " arguments"
| otherwise -> return $ (head args', tail args')
+
AST { astNode = ASTVector params' } <- assertIsASTVector params''
params <- mapM assertIsASTSymbol params'
+ let shadowingParamM = L.find (astNode .> (\(ASTSymbol sym) -> sym) .> isParamNameShadowing) params
+ case shadowingParamM of
+ Just shadowingParam -> throwL (astPos shadowingParam)
+ $ "parameter is shadowing already defined symbol " ++ show (astNode shadowingParam)
+ Nothing -> return ()
+
let letExprs = take (length exprs - 1) exprs
let nonLetExprM = L.find (not . isLetAST) letExprs
case nonLetExprM of
@@ -117,6 +124,7 @@ evaluateFunctionDef env asts = do
where
isLetAST AST { astNode = ASTFunctionCall (AST { astNode = ASTSymbol "let" }:_) } = True
isLetAST _ = False
+ isParamNameShadowing name = M.member name env
evaluateMatch :: Env -> [AST] -> LContext (Env, AST)
evaluateMatch env asts = do
@@ -137,8 +145,9 @@ evaluateMatch env asts = do
return (env, matchAst { astNode = astNode ret })
where
matchPairs :: (AST, AST) -> [(AST, AST)] -> LContext AST
- matchPairs (actualExpr, evaledActual) [] = throwL (astPos actualExpr) $ "matching case not found when matching on expression: " ++ show actualExpr
- ++ " (actual value: " ++ show evaledActual ++ ")"
+ matchPairs (actualExpr, evaledActual) [] = throwL (astPos actualExpr)
+ $ "matching case not found when matching on expression: " ++ show actualExpr
+ ++ " (actual value: " ++ show evaledActual ++ ")"
matchPairs (actualExpr, evaledActual) ((matcher, branch):restPairs) = do
(_, evaledMatcher) <- evaluate env matcher
if evaledActual == evaledMatcher