From 0030f2d3a592d4d59fb4ecd6c228fe11ed81b208 Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sat, 18 Apr 2020 14:25:42 -0300 Subject: [PATCH 1/8] Improving some type checks --- spec/InterpreterSpec.hs | 6 ++++++ src/Language/Mulang/Interpreter.hs | 12 +++++++----- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/spec/InterpreterSpec.hs b/spec/InterpreterSpec.hs index 83b571c3b..6f354ac98 100644 --- a/spec/InterpreterSpec.hs +++ b/spec/InterpreterSpec.hs @@ -21,6 +21,12 @@ spec :: Spec spec = do describe "evalExpr" $ do context "javascript" $ do + it "rejects logic on number" $ do + lastRef (runjs "1 || 2") `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Bad parameters, expected two bools but got [MuNumber 1.0,MuNumber 2.0]\"") + + it "rejects math on bools" $ do + lastRef (runjs "true + false") `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Bad parameters, expected two numbers but got [MuBool True,MuBool False]\"") + it "evals addition" $ do lastRef (runjs "1 + 2") `shouldReturn` MuNumber 3 diff --git a/src/Language/Mulang/Interpreter.hs b/src/Language/Mulang/Interpreter.hs index ea105a9c8..797d6b4bb 100644 --- a/src/Language/Mulang/Interpreter.hs +++ b/src/Language/Mulang/Interpreter.hs @@ -124,29 +124,29 @@ evalExpr (M.Application (M.Primitive O.GreatherOrEqualThan) expressions) = evalExpr (M.Application (M.Primitive O.Modulo) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 `mod'` n2 - f params = error $ "Bad parameters, expected two numbers but got " ++ show params + f params = raiseString $ "Bad parameters, expected two numbers but got " ++ show params evalExpr (M.Application (M.Primitive O.GreatherThan) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 > n2 - f params = error $ "Bad parameters, expected two bools but got " ++ show params + f params = raiseString $ "Bad parameters, expected two bools but got " ++ show params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.Or) expressions) = evalExpressionsWith expressions f where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 || b2 - f params = error $ "Bad parameters, expected two bools but got " ++ show params + f params = raiseString $ "Bad parameters, expected two bools but got " ++ show params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.And) expressions) = evalExpressionsWith expressions f where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 && b2 - f params = error $ "Bad parameters, expected two bools but got " ++ show params + f params = raiseString $ "Bad parameters, expected two bools but got " ++ show params evalExpr (M.Application (M.Primitive O.Negation) expressions) = evalExpressionsWith expressions f where f [MuBool b] = createReference $ MuBool $ not b - f params = error $ "Bad parameters, expected one bool but got " ++ show params + f params = raiseString $ "Bad parameters, expected one bool but got " ++ show params evalExpr (M.Application (M.Primitive O.Multiply) expressions) = evalExpressionsWith expressions f @@ -173,10 +173,12 @@ evalExpr (M.Application (M.Primitive O.LessThan) expressions) = evalExpr (M.Application (M.Primitive O.Plus) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 + n2 + f params = raiseString $ "Bad parameters, expected two numbers but got " ++ show params evalExpr (M.Application (M.Primitive O.Minus) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 - n2 + f params = raiseString $ "Bad parameters, expected two numbers but got " ++ show params evalExpr (M.MuList expressions) = do refs <- forM expressions evalExpr From 7c81926d54b7c92c2b8eb7b5120ea7add224efd8 Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sat, 18 Apr 2020 14:25:58 -0300 Subject: [PATCH 2/8] Uncomenting pending tests --- spec/InterpreterSpec.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/spec/InterpreterSpec.hs b/spec/InterpreterSpec.hs index 6f354ac98..fb2e1e354 100644 --- a/spec/InterpreterSpec.hs +++ b/spec/InterpreterSpec.hs @@ -125,12 +125,10 @@ spec = do lastRef (runpy "7 % 4") `shouldReturn` MuNumber 3 it "evals and" $ do - --lastRef (runpy "true && true") `shouldReturn` MuBool True - pending + lastRef (runpy "True and True") `shouldReturn` MuBool True it "evals or" $ do - --lastRef (runpy "false || false") `shouldReturn` MuBool False - pending + lastRef (runpy "False or False") `shouldReturn` MuBool False it "evals comparison" $ do lastRef (runpy "7 > 4") `shouldReturn` MuBool True @@ -175,5 +173,4 @@ spec = do a|]) `shouldReturn` MuNumber 10 it "evals not" $ do - --lastRef (runpy "not false") `shouldReturn` MuBool True - pending + lastRef (runpy "not False") `shouldReturn` MuBool True From 85c444b5336ba28599751fad1b0277df235e273f Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sat, 18 Apr 2020 14:32:39 -0300 Subject: [PATCH 3/8] Introducing typeError --- spec/InterpreterSpec.hs | 4 ++-- src/Language/Mulang/Interpreter.hs | 21 ++++++++++++--------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/spec/InterpreterSpec.hs b/spec/InterpreterSpec.hs index fb2e1e354..687d5196c 100644 --- a/spec/InterpreterSpec.hs +++ b/spec/InterpreterSpec.hs @@ -22,10 +22,10 @@ spec = do describe "evalExpr" $ do context "javascript" $ do it "rejects logic on number" $ do - lastRef (runjs "1 || 2") `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Bad parameters, expected two bools but got [MuNumber 1.0,MuNumber 2.0]\"") + lastRef (runjs "1 || 2") `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Type error: expected two bools but got [MuNumber 1.0,MuNumber 2.0]\"") it "rejects math on bools" $ do - lastRef (runjs "true + false") `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Bad parameters, expected two numbers but got [MuBool True,MuBool False]\"") + lastRef (runjs "true + false") `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Type error: expected two numbers but got [MuBool True,MuBool False]\"") it "evals addition" $ do lastRef (runjs "1 + 2") `shouldReturn` MuNumber 3 diff --git a/src/Language/Mulang/Interpreter.hs b/src/Language/Mulang/Interpreter.hs index 797d6b4bb..1e937b961 100644 --- a/src/Language/Mulang/Interpreter.hs +++ b/src/Language/Mulang/Interpreter.hs @@ -124,29 +124,29 @@ evalExpr (M.Application (M.Primitive O.GreatherOrEqualThan) expressions) = evalExpr (M.Application (M.Primitive O.Modulo) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 `mod'` n2 - f params = raiseString $ "Bad parameters, expected two numbers but got " ++ show params + f params = raiseTypeError $ "expected two numbers but got " ++ show params evalExpr (M.Application (M.Primitive O.GreatherThan) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 > n2 - f params = raiseString $ "Bad parameters, expected two bools but got " ++ show params + f params = raiseTypeError $ "expected two bools but got " ++ show params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.Or) expressions) = evalExpressionsWith expressions f where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 || b2 - f params = raiseString $ "Bad parameters, expected two bools but got " ++ show params + f params = raiseTypeError $ "expected two bools but got " ++ show params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.And) expressions) = evalExpressionsWith expressions f where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 && b2 - f params = raiseString $ "Bad parameters, expected two bools but got " ++ show params + f params = raiseTypeError $ "expected two bools but got " ++ show params evalExpr (M.Application (M.Primitive O.Negation) expressions) = evalExpressionsWith expressions f where f [MuBool b] = createReference $ MuBool $ not b - f params = raiseString $ "Bad parameters, expected one bool but got " ++ show params + f params = raiseTypeError $ "expected one bool but got " ++ show params evalExpr (M.Application (M.Primitive O.Multiply) expressions) = evalExpressionsWith expressions f @@ -163,22 +163,22 @@ evalExpr (M.Application (M.Primitive O.NotEqual) expressions) = do evalExpr (M.Application (M.Primitive O.LessOrEqualThan) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 <= n2 - f params = raiseString $ "Bad parameters, expected two numbers but got " ++ show params + f params = raiseTypeError $ "expected two numbers but got " ++ show params evalExpr (M.Application (M.Primitive O.LessThan) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 < n2 - f params = raiseString $ "Bad parameters, expected two numbers but got " ++ show params + f params = raiseTypeError $ "expected two numbers but got " ++ show params evalExpr (M.Application (M.Primitive O.Plus) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 + n2 - f params = raiseString $ "Bad parameters, expected two numbers but got " ++ show params + f params = raiseTypeError $ "expected two numbers but got " ++ show params evalExpr (M.Application (M.Primitive O.Minus) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 - n2 - f params = raiseString $ "Bad parameters, expected two numbers but got " ++ show params + f params = raiseTypeError $ "expected two numbers but got " ++ show params evalExpr (M.MuList expressions) = do refs <- forM expressions evalExpr @@ -280,6 +280,9 @@ raiseString :: String -> Executable a raiseString s = do raiseInternal =<< (createReference $ MuString s) +raiseTypeError :: String -> Executable a +raiseTypeError message = raiseString $ "Type error: " ++ message + muValuesEqual r1 r2 | r1 == r2 = createReference $ MuBool True | otherwise = do From 78d49b281086e6c95f8da7912b09a7dab39316e2 Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sat, 18 Apr 2020 14:41:47 -0300 Subject: [PATCH 4/8] Refactoring raiseTypeError --- src/Language/Mulang/Interpreter.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Language/Mulang/Interpreter.hs b/src/Language/Mulang/Interpreter.hs index 1e937b961..34f41691a 100644 --- a/src/Language/Mulang/Interpreter.hs +++ b/src/Language/Mulang/Interpreter.hs @@ -124,29 +124,29 @@ evalExpr (M.Application (M.Primitive O.GreatherOrEqualThan) expressions) = evalExpr (M.Application (M.Primitive O.Modulo) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 `mod'` n2 - f params = raiseTypeError $ "expected two numbers but got " ++ show params + f params = raiseTypeError "expected two numbers" params evalExpr (M.Application (M.Primitive O.GreatherThan) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 > n2 - f params = raiseTypeError $ "expected two bools but got " ++ show params + f params = raiseTypeError "expected two bools" params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.Or) expressions) = evalExpressionsWith expressions f where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 || b2 - f params = raiseTypeError $ "expected two bools but got " ++ show params + f params = raiseTypeError "expected two bools" params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.And) expressions) = evalExpressionsWith expressions f where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 && b2 - f params = raiseTypeError $ "expected two bools but got " ++ show params + f params = raiseTypeError "expected two bools" params evalExpr (M.Application (M.Primitive O.Negation) expressions) = evalExpressionsWith expressions f where f [MuBool b] = createReference $ MuBool $ not b - f params = raiseTypeError $ "expected one bool but got " ++ show params + f params = raiseTypeError "expected one bool" params evalExpr (M.Application (M.Primitive O.Multiply) expressions) = evalExpressionsWith expressions f @@ -163,22 +163,22 @@ evalExpr (M.Application (M.Primitive O.NotEqual) expressions) = do evalExpr (M.Application (M.Primitive O.LessOrEqualThan) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 <= n2 - f params = raiseTypeError $ "expected two numbers but got " ++ show params + f params = raiseTypeError "expected two numbers" params evalExpr (M.Application (M.Primitive O.LessThan) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 < n2 - f params = raiseTypeError $ "expected two numbers but got " ++ show params + f params = raiseTypeError "expected two numbers" params evalExpr (M.Application (M.Primitive O.Plus) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 + n2 - f params = raiseTypeError $ "expected two numbers but got " ++ show params + f params = raiseTypeError "expected two numbers" params evalExpr (M.Application (M.Primitive O.Minus) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 - n2 - f params = raiseTypeError $ "expected two numbers but got " ++ show params + f params = raiseTypeError "expected two numbers" params evalExpr (M.MuList expressions) = do refs <- forM expressions evalExpr @@ -280,8 +280,8 @@ raiseString :: String -> Executable a raiseString s = do raiseInternal =<< (createReference $ MuString s) -raiseTypeError :: String -> Executable a -raiseTypeError message = raiseString $ "Type error: " ++ message +raiseTypeError :: String -> [Value] ->Executable a +raiseTypeError message values = raiseString $ "Type error: " ++ message ++ " but got " ++ show values muValuesEqual r1 r2 | r1 == r2 = createReference $ MuBool True From b214c232eaec83c236f5de9681a303dd5dc773e7 Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sat, 18 Apr 2020 23:13:06 -0300 Subject: [PATCH 5/8] Improving error messages --- spec/InterpreterSpec.hs | 10 +++++----- src/Language/Mulang/Interpreter.hs | 27 +++++++++++++++++++-------- 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/spec/InterpreterSpec.hs b/spec/InterpreterSpec.hs index 687d5196c..505297a16 100644 --- a/spec/InterpreterSpec.hs +++ b/spec/InterpreterSpec.hs @@ -22,10 +22,10 @@ spec = do describe "evalExpr" $ do context "javascript" $ do it "rejects logic on number" $ do - lastRef (runjs "1 || 2") `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Type error: expected two bools but got [MuNumber 1.0,MuNumber 2.0]\"") + lastRef (runjs "1 || 2") `shouldThrow` (errorCall "Exception thrown outside try: Type error: expected two booleans but got (number) 1.0, (number) 2.0") it "rejects math on bools" $ do - lastRef (runjs "true + false") `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Type error: expected two numbers but got [MuBool True,MuBool False]\"") + lastRef (runjs "true + false") `shouldThrow` (errorCall "Exception thrown outside try: Type error: expected two numbers but got (boolean) true, (boolean) false") it "evals addition" $ do lastRef (runjs "1 + 2") `shouldReturn` MuNumber 3 @@ -79,7 +79,7 @@ spec = do }|]) `shouldReturn` MuNumber 456 it "condition is non bool, fails" $ do - lastRef (runjs "if (6) { 123 } else { 456 }") `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Boolean expected, got: MuNumber 6.0\"") + lastRef (runjs "if (6) { 123 } else { 456 }") `shouldThrow` (errorCall "Exception thrown outside try: Type error: expected boolean but got (number) 6.0") it "evals functions" $ do lastRef (runjs [text| @@ -93,7 +93,7 @@ spec = do function a() { function b(){} } - b()|]) `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Reference not found for name 'b'\"") + b()|]) `shouldThrow` (errorCall "Exception thrown outside try: Reference not found for name 'b'") it "handles whiles" $ do lastRef (runjs [text| @@ -157,7 +157,7 @@ spec = do it "condition is non bool, fails" $ do lastRef (runpy [text| if 6: 123 - else: 456|]) `shouldThrow` (errorCall "Exception thrown outside try: MuString \"Boolean expected, got: MuNumber 6.0\"") + else: 456|]) `shouldThrow` (errorCall "Exception thrown outside try: Type error: expected boolean but got (number) 6.0") it "evals functions" $ do lastRef (runpy [text| diff --git a/src/Language/Mulang/Interpreter.hs b/src/Language/Mulang/Interpreter.hs index 34f41691a..a444151a3 100644 --- a/src/Language/Mulang/Interpreter.hs +++ b/src/Language/Mulang/Interpreter.hs @@ -15,7 +15,7 @@ module Language.Mulang.Interpreter ( import Data.Map.Strict (Map) import Data.Maybe (fromMaybe, fromJust) -import Data.List (find) +import Data.List (find, intercalate) import qualified Data.Map.Strict as Map import Control.Monad (forM) import Control.Monad.State.Class @@ -62,10 +62,21 @@ defaultContext = ExecutionContext , currentException = Nothing , currentRaiseCallback = \r -> do v <- dereference r - error $ "Exception thrown outside try: " ++ show v + error $ "Exception thrown outside try: " ++ asString v , currentReturnCallback = \_r -> error "Called return from outside a function" } +asString :: Value -> String +asString (MuString v) = v +asString other = debug other + +debug :: Value -> String +debug (MuString v) = "(string) " ++ v +debug (MuBool True) = "(boolean) true" +debug (MuBool False) = "(boolean) false" +debug (MuNumber v) = "(number) " ++ show v + + eval' :: ExecutionContext -> Executable Reference -> IO (Reference, ExecutionContext) eval' ctx ref = runStateT (runContT ref return) ctx @@ -129,24 +140,24 @@ evalExpr (M.Application (M.Primitive O.Modulo) expressions) = evalExpr (M.Application (M.Primitive O.GreatherThan) expressions) = evalExpressionsWith expressions f where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 > n2 - f params = raiseTypeError "expected two bools" params + f params = raiseTypeError "expected two booleans" params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.Or) expressions) = evalExpressionsWith expressions f where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 || b2 - f params = raiseTypeError "expected two bools" params + f params = raiseTypeError "expected two booleans" params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.And) expressions) = evalExpressionsWith expressions f where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 && b2 - f params = raiseTypeError "expected two bools" params + f params = raiseTypeError "expected two booleans" params evalExpr (M.Application (M.Primitive O.Negation) expressions) = evalExpressionsWith expressions f where f [MuBool b] = createReference $ MuBool $ not b - f params = raiseTypeError "expected one bool" params + f params = raiseTypeError "expected one boolean" params evalExpr (M.Application (M.Primitive O.Multiply) expressions) = evalExpressionsWith expressions f @@ -261,7 +272,7 @@ evalCondition :: M.Expression -> Executable Bool evalCondition cond = evalExpr cond >>= dereference >>= muBool where muBool (MuBool value) = return value - muBool v = raiseString $ "Boolean expected, got: " ++ show v + muBool v = raiseTypeError "expected boolean" [v] evalParams :: [M.Pattern] -> [M.Expression] -> Executable Reference evalParams params arguments = do @@ -281,7 +292,7 @@ raiseString s = do raiseInternal =<< (createReference $ MuString s) raiseTypeError :: String -> [Value] ->Executable a -raiseTypeError message values = raiseString $ "Type error: " ++ message ++ " but got " ++ show values +raiseTypeError message values = raiseString $ "Type error: " ++ message ++ " but got " ++ (intercalate ", " . map debug $ values) muValuesEqual r1 r2 | r1 == r2 = createReference $ MuBool True From 57300bcdc7fe0115cfea33257904aaf94e656973 Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sat, 18 Apr 2020 23:21:43 -0300 Subject: [PATCH 6/8] Extracting some duplications --- src/Language/Mulang/Interpreter.hs | 36 +++++++++++++++++------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/src/Language/Mulang/Interpreter.hs b/src/Language/Mulang/Interpreter.hs index a444151a3..d01be49b5 100644 --- a/src/Language/Mulang/Interpreter.hs +++ b/src/Language/Mulang/Interpreter.hs @@ -130,38 +130,41 @@ evalExpr (M.Assert negated (M.Equality expected actual)) = evalExpr (M.Application (M.Primitive O.GreatherOrEqualThan) expressions) = evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 >= n2 + where f [MuNumber n1, MuNumber n2] = createBool $ n1 >= n2 + f params = raiseTypeError "expected two numbers" params + evalExpr (M.Application (M.Primitive O.Modulo) expressions) = evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 `mod'` n2 + where f [MuNumber n1, MuNumber n2] = createNumber $ n1 `mod'` n2 f params = raiseTypeError "expected two numbers" params evalExpr (M.Application (M.Primitive O.GreatherThan) expressions) = evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 > n2 - f params = raiseTypeError "expected two booleans" params + where f [MuNumber n1, MuNumber n2] = createBool $ n1 > n2 + f params = raiseTypeError "expected two numbers" params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.Or) expressions) = evalExpressionsWith expressions f - where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 || b2 + where f [MuBool b1, MuBool b2] = createBool $ b1 || b2 f params = raiseTypeError "expected two booleans" params -- TODO make this evaluation non strict on both parameters evalExpr (M.Application (M.Primitive O.And) expressions) = evalExpressionsWith expressions f - where f [MuBool b1, MuBool b2] = createReference $ MuBool $ b1 && b2 + where f [MuBool b1, MuBool b2] = createBool $ b1 && b2 f params = raiseTypeError "expected two booleans" params evalExpr (M.Application (M.Primitive O.Negation) expressions) = evalExpressionsWith expressions f - where f [MuBool b] = createReference $ MuBool $ not b + where f [MuBool b] = createBool $ not b f params = raiseTypeError "expected one boolean" params evalExpr (M.Application (M.Primitive O.Multiply) expressions) = evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 * n2 + where f [MuNumber n1, MuNumber n2] = createNumber $ n1 * n2 + f params = raiseTypeError "expected two numbers" params evalExpr (M.Application (M.Primitive O.Equal) expressions) = do params <- mapM evalExpr expressions @@ -173,22 +176,22 @@ evalExpr (M.Application (M.Primitive O.NotEqual) expressions) = do evalExpr (M.Application (M.Primitive O.LessOrEqualThan) expressions) = evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 <= n2 + where f [MuNumber n1, MuNumber n2] = createBool $ n1 <= n2 f params = raiseTypeError "expected two numbers" params evalExpr (M.Application (M.Primitive O.LessThan) expressions) = evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createReference $ MuBool $ n1 < n2 + where f [MuNumber n1, MuNumber n2] = createBool $ n1 < n2 f params = raiseTypeError "expected two numbers" params evalExpr (M.Application (M.Primitive O.Plus) expressions) = evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 + n2 + where f [MuNumber n1, MuNumber n2] = createNumber $ n1 + n2 f params = raiseTypeError "expected two numbers" params evalExpr (M.Application (M.Primitive O.Minus) expressions) = evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createReference $ MuNumber $ n1 - n2 + where f [MuNumber n1, MuNumber n2] = createNumber $ n1 - n2 f params = raiseTypeError "expected two numbers" params evalExpr (M.MuList expressions) = do @@ -213,9 +216,9 @@ evalExpr (M.If cond thenBranch elseBranch) = do v <- evalCondition cond if v then evalExpr thenBranch else evalExpr elseBranch -evalExpr (M.MuNumber n) = createReference $ MuNumber n +evalExpr (M.MuNumber n) = createNumber n evalExpr (M.MuNil) = return nullRef -evalExpr (M.MuBool b) = createReference $ MuBool b +evalExpr (M.MuBool b) = createBool b evalExpr (M.MuString s) = createReference $ MuString s evalExpr (M.Return e) = do ref <- evalExpr e @@ -299,7 +302,7 @@ muValuesEqual r1 r2 | otherwise = do v1 <- dereference r1 v2 <- dereference r2 - createReference $ MuBool $ muEquals v1 v2 + createBool $ muEquals v1 v2 muEquals (MuBool b1) (MuBool b2) = b1 == b2 muEquals (MuNumber n1) (MuNumber n2) = n1 == n2 @@ -369,6 +372,9 @@ updateGlobalObjects f context = incrementRef (Reference n) = Reference $ n + 1 +createBool = createReference . MuBool +createNumber = createReference . MuNumber + createReference :: Value -> Executable Reference createReference value = do nextReferenceId :: Reference <- gets (fromJust . fmap incrementRef . getMaxKey . globalObjects) From d0082c0c535c7ab25897555d7ff2179efd7c336e Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sat, 18 Apr 2020 23:44:03 -0300 Subject: [PATCH 7/8] Extracting more duplications --- src/Language/Mulang/Interpreter.hs | 70 +++++++++--------------------- 1 file changed, 21 insertions(+), 49 deletions(-) diff --git a/src/Language/Mulang/Interpreter.hs b/src/Language/Mulang/Interpreter.hs index d01be49b5..a28b011cd 100644 --- a/src/Language/Mulang/Interpreter.hs +++ b/src/Language/Mulang/Interpreter.hs @@ -128,43 +128,19 @@ evalExpr (M.Assert negated (M.Equality expected actual)) = | muEquals v1 v2 /= negated = return nullRef | otherwise = raiseString $ "Expected " ++ show v1 ++ " but got: " ++ show v2 -evalExpr (M.Application (M.Primitive O.GreatherOrEqualThan) expressions) = - evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createBool $ n1 >= n2 - f params = raiseTypeError "expected two numbers" params - +evalExpr (M.Application (M.Primitive O.GreatherOrEqualThan) expressions) = evalBinaryNumeric expressions (>=) createBool +evalExpr (M.Application (M.Primitive O.Modulo) expressions) = evalBinaryNumeric expressions (mod') createNumber +evalExpr (M.Application (M.Primitive O.GreatherThan) expressions) = evalBinaryNumeric expressions (>) createBool -evalExpr (M.Application (M.Primitive O.Modulo) expressions) = - evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createNumber $ n1 `mod'` n2 - f params = raiseTypeError "expected two numbers" params - -evalExpr (M.Application (M.Primitive O.GreatherThan) expressions) = - evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createBool $ n1 > n2 - f params = raiseTypeError "expected two numbers" params - --- TODO make this evaluation non strict on both parameters -evalExpr (M.Application (M.Primitive O.Or) expressions) = - evalExpressionsWith expressions f - where f [MuBool b1, MuBool b2] = createBool $ b1 || b2 - f params = raiseTypeError "expected two booleans" params - --- TODO make this evaluation non strict on both parameters -evalExpr (M.Application (M.Primitive O.And) expressions) = - evalExpressionsWith expressions f - where f [MuBool b1, MuBool b2] = createBool $ b1 && b2 - f params = raiseTypeError "expected two booleans" params +evalExpr (M.Application (M.Primitive O.Or) expressions) = evalBinaryBoolean expressions (||) +evalExpr (M.Application (M.Primitive O.And) expressions) = evalBinaryBoolean expressions (&&) evalExpr (M.Application (M.Primitive O.Negation) expressions) = evalExpressionsWith expressions f where f [MuBool b] = createBool $ not b f params = raiseTypeError "expected one boolean" params -evalExpr (M.Application (M.Primitive O.Multiply) expressions) = - evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createNumber $ n1 * n2 - f params = raiseTypeError "expected two numbers" params +evalExpr (M.Application (M.Primitive O.Multiply) expressions) = evalBinaryNumeric expressions (*) createNumber evalExpr (M.Application (M.Primitive O.Equal) expressions) = do params <- mapM evalExpr expressions @@ -174,25 +150,10 @@ evalExpr (M.Application (M.Primitive O.Equal) expressions) = do evalExpr (M.Application (M.Primitive O.NotEqual) expressions) = do evalExpr $ M.Application (M.Primitive O.Negation) [M.Application (M.Primitive O.Equal) expressions] -evalExpr (M.Application (M.Primitive O.LessOrEqualThan) expressions) = - evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createBool $ n1 <= n2 - f params = raiseTypeError "expected two numbers" params - -evalExpr (M.Application (M.Primitive O.LessThan) expressions) = - evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createBool $ n1 < n2 - f params = raiseTypeError "expected two numbers" params - -evalExpr (M.Application (M.Primitive O.Plus) expressions) = - evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createNumber $ n1 + n2 - f params = raiseTypeError "expected two numbers" params - -evalExpr (M.Application (M.Primitive O.Minus) expressions) = - evalExpressionsWith expressions f - where f [MuNumber n1, MuNumber n2] = createNumber $ n1 - n2 - f params = raiseTypeError "expected two numbers" params +evalExpr (M.Application (M.Primitive O.LessOrEqualThan) expressions) = evalBinaryNumeric expressions (<=) createBool +evalExpr (M.Application (M.Primitive O.LessThan) expressions) = evalBinaryNumeric expressions (<) createBool +evalExpr (M.Application (M.Primitive O.Plus) expressions) = evalBinaryNumeric expressions (+) createNumber +evalExpr (M.Application (M.Primitive O.Minus) expressions) = evalBinaryNumeric expressions (-) createNumber evalExpr (M.MuList expressions) = do refs <- forM expressions evalExpr @@ -271,6 +232,17 @@ evalExpr (M.Reference name) = findReferenceForName name evalExpr (M.None) = return nullRef evalExpr e = raiseString $ "Unkown expression: " ++ show e +-- TODO make this evaluation non strict on both parameters +evalBinaryBoolean :: [M.Expression] -> (Bool -> Bool -> Bool) -> Executable Reference +evalBinaryBoolean expressions op = evalExpressionsWith expressions f + where f [MuBool b1, MuBool b2] = createBool $ op b1 b2 + f params = raiseTypeError "expected two booleans" params + +evalBinaryNumeric :: [M.Expression] -> (Double -> Double -> a) -> (a -> Executable Reference) -> Executable Reference +evalBinaryNumeric expressions op pack = evalExpressionsWith expressions f + where f [MuNumber n1, MuNumber n2] = pack $ op n1 n2 + f params = raiseTypeError "expected two numbers" params + evalCondition :: M.Expression -> Executable Bool evalCondition cond = evalExpr cond >>= dereference >>= muBool where From e631d04c86d9d3097b16a8c853ffeef4b99a8d07 Mon Sep 17 00:00:00 2001 From: Franco Bulgarelli Date: Sun, 19 Apr 2020 12:15:16 -0300 Subject: [PATCH 8/8] Extracting internals module --- mulang.cabal | 1 + src/Language/Mulang/Interpreter.hs | 97 +------------ src/Language/Mulang/Interpreter/Internals.hs | 142 +++++++++++++++++++ 3 files changed, 149 insertions(+), 91 deletions(-) create mode 100644 src/Language/Mulang/Interpreter/Internals.hs diff --git a/mulang.cabal b/mulang.cabal index 8042382db..c6022494e 100644 --- a/mulang.cabal +++ b/mulang.cabal @@ -95,6 +95,7 @@ library Language.Mulang.Edl.Lexer Language.Mulang.Edl.Parser Language.Mulang.Interpreter + Language.Mulang.Interpreter.Internals Language.Mulang.Interpreter.Runner build-depends: diff --git a/src/Language/Mulang/Interpreter.hs b/src/Language/Mulang/Interpreter.hs index a28b011cd..2d58262ff 100644 --- a/src/Language/Mulang/Interpreter.hs +++ b/src/Language/Mulang/Interpreter.hs @@ -14,9 +14,8 @@ module Language.Mulang.Interpreter ( ) where import Data.Map.Strict (Map) -import Data.Maybe (fromMaybe, fromJust) -import Data.List (find, intercalate) import qualified Data.Map.Strict as Map +import Data.List (find, intercalate) import Control.Monad (forM) import Control.Monad.State.Class import Control.Monad.Loops @@ -26,56 +25,7 @@ import Data.Fixed (mod') import qualified Language.Mulang.Ast as M import qualified Language.Mulang.Ast.Operator as O - -type Executable m = ContT Reference (StateT ExecutionContext IO) m - -type Callback = Reference -> Executable () - -newtype Reference = Reference Int deriving (Show, Eq, Ord) - -type ObjectSpace = Map Reference Value - -instance Show ExecutionContext where - show (ExecutionContext globalObjects scopes _ _ _) = - "ExecutionContext { globalObjects = " ++ show globalObjects ++ ", scopes = " ++ show scopes ++ " }" - -data ExecutionContext = ExecutionContext { globalObjects :: ObjectSpace - , scopes :: [Reference] - , currentException :: Maybe Reference - , currentReturnCallback :: Callback - , currentRaiseCallback :: Callback - } - -data Value = MuString String - | MuFunction [Reference] M.SubroutineBody - | MuList [Reference] - -- | The reference is the reference to the localScope - | MuNumber Double - | MuBool Bool - | MuObject (Map String Reference) - | MuNull - deriving (Show, Eq) - -defaultContext = ExecutionContext - { globalObjects = Map.singleton (Reference 1) (MuObject Map.empty) - , scopes = [Reference 1] - , currentException = Nothing - , currentRaiseCallback = \r -> do - v <- dereference r - error $ "Exception thrown outside try: " ++ asString v - , currentReturnCallback = \_r -> error "Called return from outside a function" - } - -asString :: Value -> String -asString (MuString v) = v -asString other = debug other - -debug :: Value -> String -debug (MuString v) = "(string) " ++ v -debug (MuBool True) = "(boolean) true" -debug (MuBool False) = "(boolean) false" -debug (MuNumber v) = "(number) " ++ show v - +import Language.Mulang.Interpreter.Internals eval' :: ExecutionContext -> Executable Reference -> IO (Reference, ExecutionContext) eval' ctx ref = runStateT (runContT ref return) ctx @@ -320,55 +270,20 @@ findReferenceForName name = do (MuObject context) <- dereference ref return $ context Map.! name -getMaxKey :: Map k a -> Maybe k -getMaxKey m = case Map.maxViewWithKey m of - Just ((k, _a), _) -> Just k - _ -> Nothing - nullRef = Reference 0 -dereference' :: ObjectSpace -> Reference -> Value -dereference' _ (Reference 0) = MuNull -dereference' objectSpace ref = do - fromMaybe (error $ "Failed to find ref " ++ show ref ++ " in " ++ show objectSpace) . - Map.lookup ref $ - objectSpace - -dereference :: Reference -> Executable Value -dereference ref = do - objectSpace <- gets globalObjects - return $ dereference' objectSpace ref - -updateGlobalObjects f context = - context { globalObjects = f $ globalObjects context } - -incrementRef (Reference n) = Reference $ n + 1 - createBool = createReference . MuBool createNumber = createReference . MuNumber -createReference :: Value -> Executable Reference -createReference value = do - nextReferenceId :: Reference <- gets (fromJust . fmap incrementRef . getMaxKey . globalObjects) - modify (updateGlobalObjects $ Map.insert nextReferenceId value) - return nextReferenceId - -currentFrame :: Executable Reference -currentFrame = gets (head . scopes) - setLocalVariable :: String -> Reference -> Executable () setLocalVariable name ref = do frame <- currentFrame updateRef frame (addAttrToObject name ref) + where + currentFrame :: Executable Reference + currentFrame = gets (head . scopes) + addAttrToObject :: String -> Reference -> Value -> Value addAttrToObject k r (MuObject map) = MuObject $ Map.insert k r map addAttrToObject k _r v = error $ "Tried adding " ++ k ++ " to a non object: " ++ show v - -putRef :: Reference -> Value -> Executable () -putRef ref = modify . updateGlobalObjects . Map.insert ref - -updateRef :: Reference -> (Value -> Value) -> Executable () -updateRef ref f = do - val <- dereference ref - putRef ref (f val) diff --git a/src/Language/Mulang/Interpreter/Internals.hs b/src/Language/Mulang/Interpreter/Internals.hs new file mode 100644 index 000000000..d6cd742c5 --- /dev/null +++ b/src/Language/Mulang/Interpreter/Internals.hs @@ -0,0 +1,142 @@ +module Language.Mulang.Interpreter.Internals ( + Executable, + Reference (..), + Value (..), + Callback, + ExecutionContext (..), + defaultContext, + debug, + createReference, + dereference, + dereference', + updateRef, + updateGlobalObjects) where + +import Language.Mulang.Ast (SubroutineBody) + +import Data.Maybe (fromMaybe, fromJust) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map + +import Control.Monad.State.Class +import Control.Monad.State.Strict +import Control.Monad.Cont + +type Executable m = ContT Reference (StateT ExecutionContext IO) m + +newtype Reference = Reference Int deriving (Show, Eq, Ord) + +data Value = MuString String + | MuFunction [Reference] SubroutineBody + | MuList [Reference] + -- | The reference is the reference to the localScope + | MuNumber Double + | MuBool Bool + | MuObject (Map String Reference) + | MuNull + deriving (Show, Eq) + +type Callback = Reference -> Executable () + +type ObjectSpace = Map Reference Value + +data ExecutionContext = ExecutionContext { + globalObjects :: ObjectSpace, + scopes :: [Reference], + currentException :: Maybe Reference, + currentReturnCallback :: Callback, + currentRaiseCallback :: Callback +} + +instance Show ExecutionContext where + show (ExecutionContext globalObjects scopes _ _ _) = + "ExecutionContext { globalObjects = " ++ show globalObjects ++ ", scopes = " ++ show scopes ++ " }" + +-- ================================ +-- Construction of ExecutionContext +-- ================================ + +defaultContext :: ExecutionContext +defaultContext = ExecutionContext { + globalObjects = Map.singleton (Reference 1) (MuObject Map.empty), + scopes = [Reference 1], + currentException = Nothing, + currentRaiseCallback = defaultRaiseCallback, + currentReturnCallback = defaultReturnCallback +} + +defaultRaiseCallback :: Callback +defaultRaiseCallback = \r -> do + v <- dereference r + error $ "Exception thrown outside try: " ++ asString v + +defaultReturnCallback :: Callback +defaultReturnCallback = \_r -> error "Called return from outside a function" + +-- ================ +-- Values Debugging +-- ================ + +asString :: Value -> String +asString (MuString v) = v +asString other = debug other + +debug :: Value -> String +debug (MuString v) = "(string) " ++ v +debug (MuBool True) = "(boolean) true" +debug (MuBool False) = "(boolean) false" +debug (MuNumber v) = "(number) " ++ show v + +-- ================== +-- Reference Creation +-- ================== + +createReference :: Value -> Executable Reference +createReference value = do + nextReferenceId <- gets (fromJust . fmap incrementRef . getMaxKey . globalObjects) + modify (updateGlobalObjects $ Map.insert nextReferenceId value) + return nextReferenceId + + where + incrementRef :: Reference -> Reference + incrementRef (Reference n) = Reference $ n + 1 + + getMaxKey :: Map k a -> Maybe k + getMaxKey m = case Map.maxViewWithKey m of + Just ((k, _a), _) -> Just k + _ -> Nothing + +-- ==================== +-- Reference Resolution +-- ==================== + +dereference' :: ObjectSpace -> Reference -> Value +dereference' _ (Reference 0) = MuNull +dereference' objectSpace ref = do + fromMaybe (error $ "Failed to find ref " ++ show ref ++ " in " ++ show objectSpace) . + Map.lookup ref $ + objectSpace + +dereference :: Reference -> Executable Value +dereference ref = do + objectSpace <- gets globalObjects + return $ dereference' objectSpace ref + + +-- ================ +-- Reference Update +-- ================ + +updateRef :: Reference -> (Value -> Value) -> Executable () +updateRef ref f = do + val <- dereference ref + putRef ref (f val) + + where + putRef :: Reference -> Value -> Executable () + putRef ref = modify . updateGlobalObjects . Map.insert ref + +updateGlobalObjects :: (ObjectSpace -> ObjectSpace) -> ExecutionContext -> ExecutionContext +updateGlobalObjects f context = + context { globalObjects = f $ globalObjects context } +