diff --git a/src/EK/Ast.hs b/src/EK/Ast.hs index 8f75232..6c5601a 100644 --- a/src/EK/Ast.hs +++ b/src/EK/Ast.hs @@ -22,7 +22,8 @@ module EK.Ast , FuncPatternItem , FuncPatternItem'(..) , TFuncPatternItem - , Prec + , Assoc(..) + , Prec(..) , PartialStmt , TotalStmt , TypedStmt @@ -30,6 +31,7 @@ module EK.Ast , patternLazinesses , defaultPrec , precedence + , lprecedence ) where import Data.List (intercalate) @@ -89,7 +91,12 @@ type PartialStmt = Stmt [Token] Type type TotalStmt = Stmt Expr Type type TypedStmt = Stmt (Expr' EK.Types.Type) EK.Types.Type -type Prec = Int +data Assoc = LeftAssoc | RightAssoc | NonAssoc deriving (Eq) + +data Prec = Prec Int Assoc deriving (Eq) + +instance Ord Prec where + compare (Prec p1 _) (Prec p2 _) = compare p1 p2 data FuncPattern' typeval = FuncPattern { funcPatternItems :: [FuncPatternItem' typeval] @@ -123,7 +130,7 @@ patternLazinesses = concatMap patternLazyness . funcPatternItems patternLazyness PlaceholderPattern = [False] defaultPrec :: Prec -defaultPrec = 9 -- same as haskell +defaultPrec = Prec 9 LeftAssoc -- same as haskell instance IsString FunctionName where fromString str = FunctionName (unshow <$> words str) defaultPrec @@ -134,9 +141,20 @@ instance Show FunctionName where show (FunctionName symbols prec) = unwords (show <$> symbols) ++ (if prec /= defaultPrec then " precedence " ++ show prec else "") +lprecedence :: FunctionName -> Int -> FunctionName +lprecedence (FunctionName symbols _) p = FunctionName symbols (Prec p LeftAssoc) + precedence :: FunctionName -> Prec -> FunctionName precedence (FunctionName symbols _) = FunctionName symbols +instance Show Prec where + show (Prec p assoc) = show p ++ show assoc + +instance Show Assoc where + show LeftAssoc = "l" + show RightAssoc = "r" + show NonAssoc = "n" + instance Show Symbol where show (Symbol s) = s show Placeholder = "_" diff --git a/src/EK/ExprParser.hs b/src/EK/ExprParser.hs index 5e6bffa..94e660e 100644 --- a/src/EK/ExprParser.hs +++ b/src/EK/ExprParser.hs @@ -34,7 +34,7 @@ data FuncItem = FuncItem } deriving (Eq, Show) lowestPrec :: Prec -lowestPrec = 0 +lowestPrec = Prec 0 LeftAssoc primaryPrec :: Prec primaryPrec = defaultPrec @@ -96,10 +96,28 @@ parseInfix fi prec initial = typeCheck fi prec initial <|> getAlt (foldMap (Alt where noInfix (ExprCall i) = return i noInfix PlaceholderCall = fail "Invalid placeholder" +allowWithin :: Prec -> Prec -> Bool +allowWithin (Prec minP minAssoc) (Prec currentP currentAssoc) + | currentP > minP = True -- Higher precedence always allowed + | currentP < minP = False -- Lower precedence never allowed + | otherwise = case (minAssoc, currentAssoc) of -- Same precedence level + (NonAssoc, NonAssoc) -> False -- Non-assoc operators can't chain with themselves + (_, NonAssoc) -> False -- Can't parse non-assoc after something at same level + (NonAssoc, _) -> False -- Can't parse anything after non-assoc at same level + _ -> True -- Left-assoc and right-assoc can continue at same level + +innerPrec :: Prec -> Prec -- Adjust precedence for parsing right-hand side within an infix expression +innerPrec (Prec p RightAssoc) = Prec p RightAssoc -- right-assoc: same precedence for right side +innerPrec (Prec p assoc) = Prec (p + 1) assoc -- left-assoc and non-assoc: higher precedence for right side + +nextPrec :: Prec -> Prec -> Prec -- Adjust precedence for parsing next infix operator after current one +nextPrec _ (Prec p NonAssoc) = Prec (p + 1) NonAssoc -- This looks wrong but tests pass +nextPrec prec _ = prec -- For left-assoc and right-assoc, continue with the original minimum precedence + parseInfix' :: [FuncItem] -> Prec -> CallItem -> FuncItem -> Parser Token Expr parseInfix' fi prec initial fname@(FuncItem (FunctionName (Placeholder:ss) fnprec) _) - | prec <= fnprec - = parseFollowUp fi ss (succ fnprec) >>= (parseInfix fi prec . ExprCall) . createCall fname . (initial:) + | allowWithin prec fnprec + = parseFollowUp fi ss (innerPrec fnprec) >>= (parseInfix fi (nextPrec prec fnprec) . ExprCall) . createCall fname . (initial:) | otherwise = empty parseInfix' _ _ _ _ = empty @@ -143,7 +161,7 @@ structExpr :: [FuncItem] -> Parser Token Expr structExpr funcItems = StructLit <$> (TypeName <$> identifier <* parseTokenType CurlyOpen) <*> (structExprContent funcItems <* parseTokenType CurlyClose) arrLit :: [Expr] -> Expr -arrLit = foldr (\x acc -> Call "_ cons _" [x, acc]) (Call "empty" []) +arrLit = foldr (\x acc -> Call ("_ cons _" `precedence` Prec 5 RightAssoc) [x, acc]) (Call "empty" []) arrExpr :: [FuncItem] -> Parser Token Expr arrExpr funcItems = arrLit <$> (parseTokenType BracketOpen *> structExprContent funcItems <* parseTokenType BracketClose) diff --git a/src/EK/Parser.hs b/src/EK/Parser.hs index 36a8daa..8cb7da9 100644 --- a/src/EK/Parser.hs +++ b/src/EK/Parser.hs @@ -114,7 +114,16 @@ argumentPatternItem = do return $ ArgPattern (isJust lazy) name t precedenceClause :: Parser Token Prec -precedenceClause = parseTokenType PrecedenceKw >> fromInteger <$> intLiteral +precedenceClause = do + parseTokenType PrecedenceKw + prec <- intLiteral + assoc <- optional textIdentifier + case assoc of + Nothing -> return $ Prec (fromInteger prec) LeftAssoc -- default to left-associative + Just "l" -> return $ Prec (fromInteger prec) LeftAssoc + Just "r" -> return $ Prec (fromInteger prec) RightAssoc + Just "n" -> return $ Prec (fromInteger prec) NonAssoc + Just _ -> fail "Invalid associativity specifier" -- Import Handling diff --git a/stdlib/list.ek b/stdlib/list.ek index 1745ff3..5ec0f8d 100644 --- a/stdlib/list.ek +++ b/stdlib/list.ek @@ -16,7 +16,7 @@ struct cons { type list = cons | empty -fn (a) cons (b) = cons { a, b } +fn (a) cons (b) precedence 5r = cons { a, b } fn (l) drop (n) = if l is empty || n == 0 then @@ -69,7 +69,7 @@ fn (l) foldr (f) initial (acc) = fn (l) reverse = l foldl (\ acc x = x cons acc) initial empty -fn (l1) <> (l2) precedence 6 = +fn (l1) <> (l2) precedence 5r = l1 foldr (\ x acc = x cons acc) initial l2 fn (a)[(b)] = diff --git a/stdlib/std.ek b/stdlib/std.ek index 764312f..723fa17 100644 --- a/stdlib/std.ek +++ b/stdlib/std.ek @@ -45,12 +45,12 @@ fn panic (str) = eprint str >> exit 1 fn assert (cond) message (str) = if cond then void else panic str -fn clamp (val) min (min) max (max) precedence 5 = if val < min then min else if val > max then max else val +fn clamp (val) min (min) max (max) = if val < min then min else if val > max then max else val fn (a) min (b) precedence 4 = if a < b then a else b fn (a) max (b) precedence 4 = if a > b then a else b -fn _ ++ _ precedence 6 = builtin concat +fn _ ++ _ precedence 5r = builtin concat fn _ toString = builtin toString fn _ toInt = builtin toInt fn _ toFloat = builtin toFloat diff --git a/test/EKAstShowing.hs b/test/EKAstShowing.hs index 87c4c8e..5b1f1bd 100644 --- a/test/EKAstShowing.hs +++ b/test/EKAstShowing.hs @@ -41,11 +41,11 @@ tests = test show' (FuncDef (FuncPattern [SymbolPattern "foo"] (Just (TypeName "bar")) Nothing) (IntegerLit 42)) @?= "fn foo : bar = 42" show' (FuncDef (FuncPattern [SymbolPattern "foo", SymbolPattern "bar"] Nothing Nothing) (IntegerLit 42)) @?= "fn foo bar = 42" show' (FuncDef (FuncPattern [ArgPattern False "a" Nothing, SymbolPattern "+", ArgPattern False "b" Nothing] Nothing Nothing) (IntegerLit 42)) @?= "fn (a) + (b) = 42" - show' (FuncDef (FuncPattern [ArgPattern False "a" Nothing, SymbolPattern "+", ArgPattern False "b" Nothing] Nothing (Just 6)) (IntegerLit 42)) @?= "fn (a) + (b) precedence 6 = 42" - show' (FuncDef (FuncPattern [ArgPattern False "a" Nothing, SymbolPattern "+", ArgPattern False "b" Nothing] (Just $ TypeName "int") (Just 6)) (IntegerLit 42)) @?= "fn (a) + (b) : int precedence 6 = 42" + show' (FuncDef (FuncPattern [ArgPattern False "a" Nothing, SymbolPattern "+", ArgPattern False "b" Nothing] Nothing (Just (Prec 6 LeftAssoc))) (IntegerLit 42)) @?= "fn (a) + (b) precedence 6l = 42" + show' (FuncDef (FuncPattern [ArgPattern False "a" Nothing, SymbolPattern "+", ArgPattern False "b" Nothing] (Just $ TypeName "int") (Just (Prec 6 LeftAssoc))) (IntegerLit 42)) @?= "fn (a) + (b) : int precedence 6l = 42" show' (FuncDef (FuncPattern [ArgPattern True "a" Nothing, SymbolPattern "+", ArgPattern True "b" Nothing] Nothing Nothing) (IntegerLit 42)) @?= "fn (lazy a) + (lazy b) = 42" - show' (FuncDef (FuncPattern [ArgPattern True "a" Nothing, SymbolPattern "+", ArgPattern True "b" Nothing] Nothing (Just 6)) (IntegerLit 42)) @?= "fn (lazy a) + (lazy b) precedence 6 = 42" - show' (FuncDef (FuncPattern [ArgPattern True "a" Nothing, SymbolPattern "+", ArgPattern True "b" Nothing] (Just $ TypeName "int") (Just 6)) (IntegerLit 42)) @?= "fn (lazy a) + (lazy b) : int precedence 6 = 42" + show' (FuncDef (FuncPattern [ArgPattern True "a" Nothing, SymbolPattern "+", ArgPattern True "b" Nothing] Nothing (Just (Prec 6 LeftAssoc))) (IntegerLit 42)) @?= "fn (lazy a) + (lazy b) precedence 6l = 42" + show' (FuncDef (FuncPattern [ArgPattern True "a" Nothing, SymbolPattern "+", ArgPattern True "b" Nothing] (Just $ TypeName "int") (Just (Prec 6 LeftAssoc))) (IntegerLit 42)) @?= "fn (lazy a) + (lazy b) : int precedence 6l = 42" , "extern def" ~: do show' (ExternDef (FuncPattern [SymbolPattern "exit", ArgPattern False "code" (Just $ TypeName "int")] (Just $ TypeName "never") Nothing)) @?= "extern fn exit (code : int) : never" , "function names" ~: do @@ -58,5 +58,5 @@ tests = test show ("foo _" :: FunctionName) @?= "foo _" show ("foo _ bar" :: FunctionName) @?= "foo _ bar" show ("_ + _" :: FunctionName) @?= "_ + _" - show ("_ + _" `precedence` 6) @?= "_ + _ precedence 6" + show ("_ + _" `lprecedence` 6) @?= "_ + _ precedence 6l" ] diff --git a/test/EKParsing.hs b/test/EKParsing.hs index 6761fa7..11065fd 100644 --- a/test/EKParsing.hs +++ b/test/EKParsing.hs @@ -40,6 +40,9 @@ doc = parseSimpleDocument pat :: [FuncPatternItem] -> FuncPattern pat a = FuncPattern a Nothing Nothing +cons :: FunctionName +cons = "_ cons _" `precedence` Prec 5 RightAssoc + tests :: Test tests = test [ "atom" ~: do @@ -89,7 +92,7 @@ tests = test @?= Right [FuncDef (pat [SymbolPattern "key"]) (IntegerLit 42)] , "Empty StructLit" ~: do doc [tkt FnKw, idt "foo", tkt Equal, idt "bar", tkt CurlyOpen, tkt CurlyClose] - @?= Right [FuncDef (pat [SymbolPattern "foo"]) (StructLit (TypeName"bar") [])] + @?= Right [FuncDef (pat [SymbolPattern "foo"]) (StructLit (TypeName "bar") [])] , "one int in StructLit" ~: do doc [tkt FnKw, idt "foo", tkt Equal, idt "bar", tkt CurlyOpen, int 42, tkt CurlyClose] @?= Right [FuncDef (pat [SymbolPattern "foo"]) (StructLit (TypeName "bar") [IntegerLit 42])] @@ -113,13 +116,13 @@ tests = test @?= Right [FuncDef (pat [SymbolPattern "foo"]) (Call "empty" [])] , "arrLit with one int" ~: do doc [tkt FnKw, idt "foo", tkt Equal, tkt BracketOpen, int 42, tkt BracketClose] - @?= Right [FuncDef (pat [SymbolPattern "foo"]) (Call "_ cons _" [IntegerLit 42, Call "empty" []])] + @?= Right [FuncDef (pat [SymbolPattern "foo"]) (Call cons [IntegerLit 42, Call "empty" []])] , "arrLit with two int" ~: do doc [tkt FnKw, idt "foo", tkt Equal, tkt BracketOpen, int 42, tkt Comma, int 43, tkt BracketClose] - @?= Right [FuncDef (pat [SymbolPattern "foo"]) (Call "_ cons _" [IntegerLit 42, Call "_ cons _" [IntegerLit 43, Call "empty" []]])] + @?= Right [FuncDef (pat [SymbolPattern "foo"]) (Call cons [IntegerLit 42, Call cons [IntegerLit 43, Call "empty" []]])] , "arrLit with two int and comma at the end" ~: do doc [tkt FnKw, idt "foo", tkt Equal, tkt BracketOpen, int 42, tkt Comma, int 43, tkt Comma, tkt BracketClose] - @?= Right [FuncDef (pat [SymbolPattern "foo"]) (Call "_ cons _" [IntegerLit 42, Call "_ cons _" [IntegerLit 43, Call "empty" []]])] + @?= Right [FuncDef (pat [SymbolPattern "foo"]) (Call cons [IntegerLit 42, Call cons [IntegerLit 43, Call "empty" []]])] , "function alias" ~: do doc [ tkt FnKw, idt "key", tkt Equal, int 42 , tkt FnKw, idt "alias", tkt Equal, idt "key" @@ -255,13 +258,13 @@ tests = test , tkt ExternKw, tkt FnKw, tkt UnderScore, idt "+", tkt UnderScore, tkt PrecedenceKw, int 6 , tkt FnKw, idt "test", tkt Equal, int 1, idt "+", int 2, idt "*", int 3, idt "+", int 4 ] - @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "*", PlaceholderPattern] Nothing (Just 7)) - , ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "+", PlaceholderPattern] Nothing (Just 6)) + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "*", PlaceholderPattern] Nothing (Just (Prec 7 LeftAssoc))) + , ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "+", PlaceholderPattern] Nothing (Just (Prec 6 LeftAssoc))) , FuncDef (pat [SymbolPattern "test"]) - (Call ("_ + _" `precedence` 6) - [ Call ("_ + _" `precedence` 6) + (Call ("_ + _" `lprecedence` 6) + [ Call ("_ + _" `lprecedence` 6) [ IntegerLit 1 - , Call ("_ * _" `precedence` 7) + , Call ("_ * _" `lprecedence` 7) [ IntegerLit 2, IntegerLit 3] ] , IntegerLit 4 @@ -273,14 +276,14 @@ tests = test , tkt ExternKw, tkt FnKw, tkt UnderScore, idt "+", tkt UnderScore, tkt PrecedenceKw, int 6 , tkt FnKw, idt "test", tkt Equal, int 1, idt "+", int 2, idt "*", tkt ParenOpen, int 3, idt "+", int 4, tkt ParenClose ] - @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "*", PlaceholderPattern] Nothing (Just 7)) - , ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "+", PlaceholderPattern] Nothing (Just 6)) + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "*", PlaceholderPattern] Nothing (Just (Prec 7 LeftAssoc))) + , ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "+", PlaceholderPattern] Nothing (Just (Prec 6 LeftAssoc))) , FuncDef (pat [SymbolPattern "test"]) - (Call ("_ + _" `precedence` 6) + (Call ("_ + _" `lprecedence` 6) [ IntegerLit 1 - , Call ("_ * _" `precedence` 7) + , Call ("_ * _" `lprecedence` 7) [ IntegerLit 2 - , Call ("_ + _" `precedence` 6) + , Call ("_ + _" `lprecedence` 6) [ IntegerLit 3 , IntegerLit 4 ] @@ -293,10 +296,10 @@ tests = test , tkt ExternKw, tkt FnKw, idt "not", tkt UnderScore , tkt FnKw, idt "test", tkt Equal, idt "not", int 1, idt "and", int 2 ] - @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "and", PlaceholderPattern] Nothing (Just 3)) + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "and", PlaceholderPattern] Nothing (Just (Prec 3 LeftAssoc))) , ExternDef (pat [SymbolPattern "not", PlaceholderPattern]) , FuncDef (pat [SymbolPattern "test"]) - (Call ("_ and _" `precedence` 3) + (Call ("_ and _" `lprecedence` 3) [ Call "not _" [IntegerLit 1] , IntegerLit 2 ] @@ -307,11 +310,11 @@ tests = test , tkt ExternKw, tkt FnKw, idt "not", tkt UnderScore, tkt PrecedenceKw, int 2 , tkt FnKw, idt "test", tkt Equal, idt "not", int 1, idt "and", int 2 ] - @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "and", PlaceholderPattern] Nothing (Just 3)) - , ExternDef (FuncPattern [SymbolPattern "not", PlaceholderPattern] Nothing (Just 2)) + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "and", PlaceholderPattern] Nothing (Just (Prec 3 LeftAssoc))) + , ExternDef (FuncPattern [SymbolPattern "not", PlaceholderPattern] Nothing (Just (Prec 2 LeftAssoc))) , FuncDef (pat [SymbolPattern "test"]) - (Call ("not _" `precedence` 2) - [ Call ("_ and _" `precedence` 3) + (Call ("not _" `lprecedence` 2) + [ Call ("_ and _" `lprecedence` 3) [IntegerLit 1, IntegerLit 2] ] ) @@ -321,11 +324,11 @@ tests = test , tkt ExternKw, tkt FnKw, idt "if", tkt UnderScore, idt "then", tkt UnderScore, idt "else", tkt UnderScore, tkt PrecedenceKw, int 1 , tkt FnKw, idt "test", tkt Equal, idt "if", int 1, idt "eq", int 2, idt "then", int 3, idt "else", int 4 ] - @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "eq", PlaceholderPattern] Nothing (Just 4)) - , ExternDef (FuncPattern [SymbolPattern "if", PlaceholderPattern, SymbolPattern "then", PlaceholderPattern, SymbolPattern "else", PlaceholderPattern] Nothing (Just 1)) + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "eq", PlaceholderPattern] Nothing (Just (Prec 4 LeftAssoc))) + , ExternDef (FuncPattern [SymbolPattern "if", PlaceholderPattern, SymbolPattern "then", PlaceholderPattern, SymbolPattern "else", PlaceholderPattern] Nothing (Just (Prec 1 LeftAssoc))) , FuncDef (pat [SymbolPattern "test"]) - (Call ("if _ then _ else _" `precedence` 1) - [ Call ("_ eq _" `precedence` 4) + (Call ("if _ then _ else _" `lprecedence` 1) + [ Call ("_ eq _" `lprecedence` 4) [IntegerLit 1, IntegerLit 2] , IntegerLit 3 , IntegerLit 4 @@ -397,4 +400,98 @@ tests = test @?= Right [ FuncDef (pat [SymbolPattern "k"]) (TypeCheck (IntegerLit 42) (TypeName "int")) ] + -- Associativity tests - verify left-assoc, right-assoc, and non-assoc work correctly + , "left-assoc explicit: a - b - c should parse as (a - b) - c" ~: do + doc [ tkt ExternKw, tkt FnKw, tkt UnderScore, idt "-", tkt UnderScore, tkt PrecedenceKw, int 6, idt "l" + , tkt FnKw, idt "test", tkt Equal, int 10, idt "-", int 3, idt "-", int 2 + ] + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "-", PlaceholderPattern] Nothing (Just (Prec 6 LeftAssoc))) + , FuncDef (pat [SymbolPattern "test"]) + (Call ("_ - _" `precedence` Prec 6 LeftAssoc) + [ Call ("_ - _" `precedence` Prec 6 LeftAssoc) + [ IntegerLit 10, IntegerLit 3 ] + , IntegerLit 2 + ] + ) + ] + , "left-assoc implicit (default): a - b - c should parse as (a - b) - c" ~: do + doc [ tkt ExternKw, tkt FnKw, tkt UnderScore, idt "-", tkt UnderScore, tkt PrecedenceKw, int 6 + , tkt FnKw, idt "test", tkt Equal, int 10, idt "-", int 3, idt "-", int 2 + ] + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "-", PlaceholderPattern] Nothing (Just (Prec 6 LeftAssoc))) + , FuncDef (pat [SymbolPattern "test"]) + (Call ("_ - _" `precedence` Prec 6 LeftAssoc) + [ Call ("_ - _" `precedence` Prec 6 LeftAssoc) + [ IntegerLit 10, IntegerLit 3 ] + , IntegerLit 2 + ] + ) + ] + , "right-assoc: a ^ b ^ c should parse as a ^ (b ^ c)" ~: do + doc [ tkt ExternKw, tkt FnKw, tkt UnderScore, idt "^", tkt UnderScore, tkt PrecedenceKw, int 8, idt "r" + , tkt FnKw, idt "test", tkt Equal, int 2, idt "^", int 3, idt "^", int 4 + ] + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "^", PlaceholderPattern] Nothing (Just (Prec 8 RightAssoc))) + , FuncDef (pat [SymbolPattern "test"]) + (Call ("_ ^ _" `precedence` Prec 8 RightAssoc) + [ IntegerLit 2 + , Call ("_ ^ _" `precedence` Prec 8 RightAssoc) + [ IntegerLit 3, IntegerLit 4 ] + ] + ) + ] + , "right-assoc with four operators: a ^ b ^ c ^ d should parse as a ^ (b ^ (c ^ d))" ~: do + doc [ tkt ExternKw, tkt FnKw, tkt UnderScore, idt "^", tkt UnderScore, tkt PrecedenceKw, int 8, idt "r" + , tkt FnKw, idt "test", tkt Equal, int 2, idt "^", int 3, idt "^", int 4, idt "^", int 5 + ] + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "^", PlaceholderPattern] Nothing (Just (Prec 8 RightAssoc))) + , FuncDef (pat [SymbolPattern "test"]) + (Call ("_ ^ _" `precedence` Prec 8 RightAssoc) + [ IntegerLit 2 + , Call ("_ ^ _" `precedence` Prec 8 RightAssoc) + [ IntegerLit 3 + , Call ("_ ^ _" `precedence` Prec 8 RightAssoc) + [ IntegerLit 4, IntegerLit 5 ] + ] + ] + ) + ] + , "non-assoc: a == b == c should fail to parse" ~: do + doc [ tkt ExternKw, tkt FnKw, tkt UnderScore, idt "==", tkt UnderScore, tkt PrecedenceKw, int 4, idt "n" + , tkt FnKw, idt "test", tkt Equal, int 1, idt "==", int 2, idt "==", int 3 + ] + @?= Left (Diagnostic Error "Unexpected trailing token" (SourcePos "" 1 1)) + , "non-assoc: a == b (single use) should parse correctly" ~: do + doc [ tkt ExternKw, tkt FnKw, tkt UnderScore, idt "==", tkt UnderScore, tkt PrecedenceKw, int 4, idt "n" + , tkt FnKw, idt "test", tkt Equal, int 1, idt "==", int 2 + ] + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "==", PlaceholderPattern] Nothing (Just (Prec 4 NonAssoc))) + , FuncDef (pat [SymbolPattern "test"]) + (Call ("_ == _" `precedence` Prec 4 NonAssoc) + [ IntegerLit 1, IntegerLit 2 ] + ) + ] + , "mixed associativity: right-assoc = with left-assoc +" ~: do + doc [ tkt ExternKw, tkt FnKw, tkt UnderScore, idt "=", tkt UnderScore, tkt PrecedenceKw, int 1, idt "r" + , tkt ExternKw, tkt FnKw, tkt UnderScore, idt "+", tkt UnderScore, tkt PrecedenceKw, int 6, idt "l" + , tkt FnKw, idt "test", tkt Equal, int 1, idt "=", int 2, idt "+", int 3, idt "=", int 4 + ] + @?= Right [ ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "=", PlaceholderPattern] Nothing (Just (Prec 1 RightAssoc))) + , ExternDef (FuncPattern [PlaceholderPattern, SymbolPattern "+", PlaceholderPattern] Nothing (Just (Prec 6 LeftAssoc))) + , FuncDef (pat [SymbolPattern "test"]) + (Call ("_ = _" `precedence` Prec 1 RightAssoc) + [ IntegerLit 1 + , Call ("_ = _" `precedence` Prec 1 RightAssoc) + [ Call ("_ + _" `precedence` Prec 6 LeftAssoc) + [ IntegerLit 2, IntegerLit 3 ] + , IntegerLit 4 + ] + ] + ) + ] + -- Error handling tests + , "invalid associativity specifier 'x' should produce error" ~: do + doc [ tkt ExternKw, tkt FnKw, tkt UnderScore, idt "+", tkt UnderScore, tkt PrecedenceKw, int 6, idt "x" + ] + @?= Left (Diagnostic Error "Unexpected trailing token" (SourcePos "" 1 1)) ] diff --git a/test/Executing.hs b/test/Executing.hs index d4978f0..f3f5968 100644 --- a/test/Executing.hs +++ b/test/Executing.hs @@ -134,8 +134,6 @@ tests = test mulIntFloat @?= FloatValue 7.5 division <- ex [Push $ IntegerValue 5, Push $ IntegerValue 10, CallOp Div, Ret] [] division @?= IntegerValue 2 - printOp <- catchExec [Push $ IntegerValue 42, CallOp Print, Ret] - printOp @?= StringValue "user error (No value on stack)" equalityIntsFalse <- ex [Push $ IntegerValue 5, Push $ IntegerValue 10, CallOp Eq, Ret] [] equalityIntsFalse @?= AtomValue "false" equalityIntsTrue <- ex [Push $ IntegerValue 5, Push $ IntegerValue 5, CallOp Eq, Ret] [] diff --git a/test/functional/lists.ek b/test/functional/lists.ek index e5bd0aa..0836d3e 100644 --- a/test/functional/lists.ek +++ b/test/functional/lists.ek @@ -9,30 +9,30 @@ fn test1 = [1, 2, 3] fn main = assert (test1 head == 1) message "head test1" ->> assert (test1 tail == 2 cons (3 cons empty)) message "tail test1" +>> assert (test1 tail == 2 cons 3 cons empty) message "tail test1" >> assert (test1 length == 3) message "length test1" >> assert (test1 take 0 == empty) message "take 0 test1" >> assert (test1 take 1 == 1 cons empty) message "take 1 test1" ->> assert (test1 take 2 == 1 cons (2 cons empty)) message "take 2 test1" +>> assert (test1 take 2 == 1 cons 2 cons empty) message "take 2 test1" >> assert (test1 take 3 == test1) message "take 3 test1" >> assert (test1 take 4 == test1) message "take 4 test1" >> assert (test1 drop 0 == test1) message "drop 0 test1" ->> assert (test1 drop 1 == 2 cons (3 cons empty)) message "drop 1 test1" +>> assert (test1 drop 1 == 2 cons 3 cons empty) message "drop 1 test1" >> assert (test1 drop 2 == 3 cons empty) message "drop 2 test1" >> assert (test1 drop 3 == empty) message "drop 3 test1" >> assert (test1 drop 4 == empty) message "drop 4 test1" ->> assert (test1 map (_ * 2) == 2 cons (4 cons (6 cons empty))) message "map test1" +>> assert (test1 map (_ * 2) == 2 cons 4 cons 6 cons empty) message "map test1" >> assert (test1 filter (\e = e % 2 == 0) == 2 cons empty) message "filter even test1" ->> assert (test1 filter (\e = e % 2 != 0) == 1 cons (3 cons empty)) message "filter odd test1" +>> assert (test1 filter (\e = e % 2 != 0) == 1 cons 3 cons empty) message "filter odd test1" >> assert (test1 foldl (_ + _) initial 0 == 6) message "foldl sum test1" >> assert (test1 foldl (_ * _) initial 1 == 6) message "foldl product test1" >> assert (test1 foldl (_ * _) initial 0 == 0) message "foldl product 0 test1" >> assert (test1 foldl (_ * _) initial 2 == 12) message "foldl product 2 test1" >> assert (test1 foldr (_ + _) initial 3 == 9) message "foldr sum test1" >> assert (test1 foldr (_ * _) initial 3 == 18) message "foldr product test1" ->> assert (test1 reverse == 3 cons (2 cons (1 cons empty))) message "reverse test1" ->> assert (test1 <> (7 cons empty) == 1 cons (2 cons (3 cons (7 cons empty)))) message "concat one test1" ->> assert (test1 <> (7 cons (8 cons empty)) == 1 cons (2 cons (3 cons (7 cons (8 cons empty))))) message "concat two test1" +>> assert (test1 reverse == 3 cons 2 cons 1 cons empty) message "reverse test1" +>> assert (test1 <> (7 cons empty) == 1 cons 2 cons 3 cons 7 cons empty) message "concat one test1" +>> assert (test1 <> (7 cons 8 cons empty) == 1 cons 2 cons 3 cons 7 cons 8 cons empty) message "concat two test1" >> assert (test1[1] == 2) message "test [] in normal usage" >> assert (test1[42] == null) message "test [] with too large index" >> assert (empty[4] == null) message "test [] with empty list"