diff options
| -rw-r--r-- | src/Evaluator.hs | 13 | ||||
| -rw-r--r-- | src/Parser.hs | 2 | ||||
| -rw-r--r-- | test/Spec.hs | 16 | ||||
| -rw-r--r-- | test/TestUtils.hs | 19 |
4 files changed, 33 insertions, 17 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 diff --git a/src/Parser.hs b/src/Parser.hs index 5089cb4..20a1454 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -41,7 +41,7 @@ parseToken (Token token tr tc tf) removeQuotes s = drop 1 s $> take (length s - 2) isBoolean t = t `elem` ["true", "false"] asBoolean t = t == "true" - ast astNode = AST { astNode = astNode, astRow = tr, astColumn = tc, astFileName = tf } + ast node = AST { astNode = node, astRow = tr, astColumn = tc, astFileName = tf } _parse :: [AST] -> [Token] -> LContext [AST] _parse acc' [] = do diff --git a/test/Spec.hs b/test/Spec.hs index 6e9104e..3d1ad3a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -18,10 +18,8 @@ tokenizeTests = testGroup "tokenize" [ parseTests = testGroup "parse" [ do got <- expectSuccessL $ parse (map makeNonsenseToken ["(", "+", "1", "2", ")"]) - let expected = [wrapAST $ ASTFunctionCall - [ wrapAST $ ASTSymbol "+", - wrapAST $ ASTInteger 1, - wrapAST $ ASTInteger 2 ]] + let expected = [astFunctionCall + [ astSymbol "+", astInteger 1, astInteger 2 ]] assertEqual "" got expected , do got <- expectErrorL $ parse (map makeNonsenseToken ["(", "+", "1", "2"]) @@ -31,11 +29,9 @@ parseTests = testGroup "parse" [ evaluateTests = testGroup "evaluate" [ do let env = M.fromList [builtinAdd2] :: Env - (gotEnv, gotAST) <- expectSuccessL $ evaluate env (wrapAST $ ASTFunctionCall - [wrapAST $ ASTSymbol "+", - wrapAST $ ASTInteger 1, - wrapAST $ ASTInteger 2]) - let expectedAST = wrapAST $ ASTInteger 3 + (gotEnv, gotAST) <- expectSuccessL $ evaluate env (astFunctionCall + [astSymbol "+", astInteger 1, astInteger 2]) + let expectedAST = astInteger 3 assertEqual "" gotAST expectedAST assertEqual "" (M.keys gotEnv) (M.keys env) ] @@ -46,7 +42,7 @@ e2eTests = testGroup "e2e" [ (gotEnv, gotASTs) <- expectSuccessL $ runInlineScript "<test>" env script1 let expectedEnvKeys = ["-", "sub2"] assertEqual "" (M.keys gotEnv) expectedEnvKeys - assertEqual "" (last gotASTs) (wrapAST $ ASTInteger 1) + assertEqual "" (last gotASTs) (astInteger 1) ] testGroup label xs = TestLabel label $ TestList $ map TestCase xs diff --git a/test/TestUtils.hs b/test/TestUtils.hs index 5206d27..e497ece 100644 --- a/test/TestUtils.hs +++ b/test/TestUtils.hs @@ -19,15 +19,26 @@ expectSuccessL :: LContext a -> IO a expectSuccessL lc = do res <- testRunL lc case res of - Left (LException err) -> error $ "unexpected error: " ++ err + Left (LException _ err) -> error $ "unexpected error: " ++ err Right val -> return val expectErrorL :: Show a => LContext a -> IO String expectErrorL lc = do res <- testRunL lc case res of - Left (LException err) -> return err + Left (LException _ err) -> return err Right val -> error $ "unexpected success: " ++ show val -wrapAST :: ASTNode -> AST -wrapAST node = AST { astNode = node } +ast :: ASTNode -> AST +ast node = AST { astNode = node } + +astInteger a = ast $ ASTInteger a +astDouble a = ast $ ASTDouble a +astSymbol a = ast $ ASTSymbol a +astBoolean a = ast $ ASTBoolean a +astString a = ast $ ASTString a +astVector a = ast $ ASTVector a +astFunctionCall a = ast $ ASTFunctionCall a +astHashMap a = ast $ ASTHashMap a +astUnit = ast $ ASTUnit +astHole = ast $ ASTHole |