diff --git a/Test/TestEval.hs b/Test/TestEval.hs index e34cad2..b1e103a 100644 --- a/Test/TestEval.hs +++ b/Test/TestEval.hs @@ -62,12 +62,35 @@ spec = do `shouldBe` (map Boolean [False, False, False, False]) describe "logical operators" $ do - it "not" $ runParse "return not nil, not true, not false, not 5, not \"\"" `shouldBe` - (map Boolean [True, False, True, False, False]) - it "or" $ runParse "return true and true, true and false, false and true, false and false" `shouldBe` - (map Boolean [True, False, False, False]) - it "and" $ runParse "return true or true, true or false, false or true, false or false" `shouldBe` - (map Boolean [True, True, True, False]) + describe "basics" $ do + it "not" $ runParse "return not nil, not true, not false, not 5, not \"\"" `shouldBe` + (map Boolean [True, False, True, False, False]) + it "or" $ runParse "return true and true, true and false, false and true, false and false" `shouldBe` + (map Boolean [True, False, False, False]) + it "and" $ runParse "return true or true, true or false, false or true, false or false" `shouldBe` + (map Boolean [True, True, True, False]) + describe "passthrough" $ do + describe "or" $ do + it "both true" $ do + runParse "return 1 or 2" `shouldBe` [Number 1.0] + runParse "return true or 5" `shouldBe` [Boolean True] + it "first false" $ do + runParse "return false or 3" `shouldBe` [Number 3.0] + runParse "return nil or 4" `shouldBe` [Number 4.0] + runParse "return false or true" `shouldBe` [Boolean True] + it "both coerced false" $ do + runParse "return false or nil" `shouldBe` [Nil] + runParse "return nil or nil" `shouldBe` [Nil] + it "doesn't eval 2nd if first true" $ + runParse "x = 1; function f() x = 2 end; return true or f(), x" + `shouldBe` [Boolean True, Number 1.0] + + describe "and" $ do + it "both true" $ runParse "return 1 and 2" `shouldBe` [Number 2.0] + it "first false" $ runParse "return false and 3" `shouldBe` [Boolean False] + it "doesn't eval 2nd if first false" $ + runParse "x = 1; function f() x = 2 end; return false and f(), x" + `shouldBe` [Boolean False, Number 1.0] describe "should eval 'if' statements" $ do it "trivial always-true" $ diff --git a/src/Turnip/Eval/Eval.hs b/src/Turnip/Eval/Eval.hs index 5ce5244..6da1bff 100644 --- a/src/Turnip/Eval/Eval.hs +++ b/src/Turnip/Eval/Eval.hs @@ -161,10 +161,9 @@ eval (AST.FieldRef t k) = do _ -> return [Nil] Nothing -> return [Nil] -eval (AST.BinOp op lhs rhs) = do +eval (AST.BinOp op lhs rhs) = do a <- head <$> eval lhs - b <- head <$> eval rhs - binaryOperatorCall op a b + binaryOperatorCall op a rhs eval (AST.UnOp op expr) = do a <- head <$> eval expr @@ -207,28 +206,34 @@ evalExpressionList xs = do -------------- +-- The second param to Binary Operators is an expression to allow +-- short-circuiting of and/or operators. type BinaryOperatorImpl = Value -> Value -> LuaM [Value] type UnaryOperatorImpl = Value -> LuaM [Value] -binaryOperatorCall :: AST.BinaryOperator -> Value -> Value -> LuaM [Value] +binaryOperatorCall :: AST.BinaryOperator -> Value -> AST.Expr -> LuaM [Value] binaryOperatorCall AST.OpRaise = \_ _ -> vmErrorStr "Sorry, ^ not implemented yet" -binaryOperatorCall AST.OpPlus = opPlus -binaryOperatorCall AST.OpMinus = opMinus -binaryOperatorCall AST.OpMult = opMult -binaryOperatorCall AST.OpDivide = opDiv +binaryOperatorCall AST.OpPlus = strictBinaryOp opPlus +binaryOperatorCall AST.OpMinus = strictBinaryOp opMinus +binaryOperatorCall AST.OpMult = strictBinaryOp opMult +binaryOperatorCall AST.OpDivide = strictBinaryOp opDiv binaryOperatorCall AST.OpModulo = \_ _ -> vmErrorStr "Sorry, % not implemented yet" -binaryOperatorCall AST.OpConcat = opConcat +binaryOperatorCall AST.OpConcat = strictBinaryOp opConcat -binaryOperatorCall AST.OpEqual = opEqual -binaryOperatorCall AST.OpLess = opLess -binaryOperatorCall AST.OpGreater = opGreater +binaryOperatorCall AST.OpEqual = strictBinaryOp opEqual +binaryOperatorCall AST.OpLess = strictBinaryOp opLess +binaryOperatorCall AST.OpGreater = strictBinaryOp opGreater binaryOperatorCall AST.OpLE = \_ _ -> vmErrorStr "Sorry, <= not implemented yet" binaryOperatorCall AST.OpGE = \_ _ -> vmErrorStr "Sorry, >= not implemented yet" binaryOperatorCall AST.OpNotEqual = \_ _ -> vmErrorStr "Sorry, ~= not implemented yet" binaryOperatorCall AST.OpAnd = opAnd binaryOperatorCall AST.OpOr = opOr + +strictBinaryOp op a rhs = do + b <- head <$> eval rhs + op a b unaryOperatorCall :: AST.UnaryOperator -> Value -> LuaM [Value] unaryOperatorCall AST.OpUnaryMinus = opUnaryMinus @@ -335,11 +340,21 @@ opLess a b = binaryMetaOperator "__lt" a b opNot :: UnaryOperatorImpl opNot a = return [Boolean . not . coerceToBool $ [a]] -opOr :: BinaryOperatorImpl -opOr a b = return [Boolean $ (coerceToBool [a]) || (coerceToBool [b])] - -opAnd :: BinaryOperatorImpl -opAnd a b = return [Boolean $ (coerceToBool [a]) && (coerceToBool [b])] +opOr :: Value -> AST.Expr -> LuaM [Value] +opOr a rhs = do + if coerceToBool [a] then + return [a] + else do + b <- head <$> eval rhs + return [b] + +opAnd :: Value -> AST.Expr -> LuaM [Value] +opAnd a rhs = do + if not $ coerceToBool [a] then + return [a] + else do + b <- head <$> eval rhs + return [b] --------------