Feature: Associativity

src/EK/Ast.hs

@@ -22,14 +22,16 @@ module EK.Ast
   , FuncPatternItem
   , FuncPatternItem'(..)
   , TFuncPatternItem
-  , Prec
+  , Assoc(..)
+  , Prec(..)
   , PartialStmt
   , TotalStmt
   , TypedStmt
   , patternToName
   , 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 = "_"

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)

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
 

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)] =

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

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"
   ]