Fix the parser to treat application without brackets as left associative

Author: nigosto

README.md

@@ -35,7 +35,7 @@ cabal install
 Now the executable should be located in the configured `installdir` of `cabal` (usually `~/.local/bin` or `~/.cabal/bin`).
 
 ## Documentation
-The parser traverses the lambda term and creates AST where the nodes are variables, applications and abstractions (lexing and parsing are done simultaneously). Then the substitution is done on the AST with the corresponding tokens instead of directly on the term. After the substitution, a new lambda term is generated based on the newly created AST and the result is returned as the final answer. If there are no brackets, the application term is right associative. Bear in mind that in the generated final term some brackets may be added because there is no way to know where they can be skipped without looking ahead, which the current generator does not do.
+The parser traverses the lambda term and creates AST where the nodes are variables, applications and abstractions (lexing and parsing are done simultaneously). Then the substitution is done on the AST with the corresponding tokens instead of directly on the term. After the substitution, a new lambda term is generated based on the newly created AST and the result is returned as the final answer. If there are no brackets, the application term is left associative. Bear in mind that in the generated final term some brackets may be added because there is no way to know where they can be skipped without looking ahead, which the current generator does not do.
 
 ### Grammar
 $` variable \Coloneqq [a-z] `$ <br>

lambda-parser.cabal

@@ -34,6 +34,7 @@ executable lambda-parser
         Substitution.Named
         Substitution.Nameless
         Generator
+        Stack
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:

src/Main.hs

@@ -8,6 +8,7 @@ import Substitution.Nameless (substituteNameless)
 import System.IO (BufferMode (BlockBuffering), hSetBuffering, stdout)
 import Transformer (toNamed, toNameless)
 import Prelude hiding (lookup)
+import Stack (emptyStack)
 
 -- TODO: let the user decide which substitution to be used and how the
 --       result should be displayed - either as named or nameless term
@@ -19,13 +20,13 @@ main = do
   if length var /= 1
     then error "please provide valid variable"
     else do
-      let (namelessTerm, context) = toNameless $ parseTerm term
+      let (namelessTerm, context) = toNameless (parseTerm term emptyStack) empty
           substituteVariable = head var `lookup` context
       substituteTerm <- putStr "Input substitution term: " >> getLine
       case substituteVariable of
         Nothing -> putStrLn term
         Just index ->
-          let (substituteNamelessTerm, updatedContext) = toNameless $ parseTerm substituteTerm
+          let (substituteNamelessTerm, updatedContext) = toNameless (parseTerm substituteTerm emptyStack) context
            in putStrLn $ generateTerm $ toNamed (substituteNameless namelessTerm index substituteNamelessTerm) updatedContext
 
 -- let substituteVariable = head var

src/Parser.hs

@@ -1,5 +1,7 @@
 module Parser (parseTerm, Term(Variable, Application, Abstraction)) where
 import Data.Char (isAlpha)
+import Debug.Trace (trace)
+import Stack (Stack, peek, pop, emptyStack, push)
 
 data Term =
   Variable Char |
@@ -22,23 +24,18 @@ dropWhileClosingBracket (x:xs) count = dropWhileClosingBracket xs count
 invalidTermError :: String
 invalidTermError = "invalid term"
 
-parseTerm :: String -> Term
-parseTerm [var]
-  | isAlpha var = Variable var
+parseTerm :: String -> Stack Term -> Term
+parseTerm "" [term] = term
+parseTerm "" stack = let rhs = peek stack
+                         lhs = peek $ pop stack
+                         updatedStack = pop stack
+  in Application (parseTerm "" updatedStack) rhs
+parseTerm term@('λ':argument:'.':body) stack
+  | isAlpha argument = parseTerm "" (push stack (Abstraction argument (parseTerm body emptyStack)))
   | otherwise = error invalidTermError
-
-parseTerm ('λ':argument:'.':body)
-  | isAlpha argument = Abstraction argument $ parseTerm body
+parseTerm ('(':rest) stack = let lhs = takeWhileClosingBracket rest 1
+                                 rhs = dropWhileClosingBracket rest 1
+  in parseTerm rhs (push stack (parseTerm lhs emptyStack))
+parseTerm (var:rest) stack
+  | isAlpha var = parseTerm rest (push stack (Variable var))
   | otherwise = error invalidTermError
-
-parseTerm ('(':term) = let lhs = takeWhileClosingBracket term 1
-                           rhs = dropWhileClosingBracket term 1
-  in if length (init term) == length lhs 
-     then parseTerm (init term) 
-     else Application (parseTerm lhs) (parseTerm rhs)
-
-parseTerm (var:term)
-  | isAlpha var = Application (Variable var) $ parseTerm term
-  | otherwise = error invalidTermError
-
-parseTerm _ = error invalidTermError

src/Stack.hs

@@ -0,0 +1,15 @@
+module Stack where
+
+type Stack t = [t]
+
+push :: Stack t -> t -> Stack t
+push stack element = element : stack
+
+peek :: Stack t -> t
+peek = head
+
+pop :: Stack t -> Stack t
+pop = tail
+
+emptyStack :: Stack t
+emptyStack = []

src/Transformer.hs

@@ -35,8 +35,8 @@ toNamelessWithContext (Abstraction argument body) depth bv context =
     in (NamelessAbstraction (fst namelessBody), snd namelessBody)
     where insertBoundVariable var bv = if var `elem` bv then bv else var:bv
 
-toNameless :: Term -> (NamelessTerm, NamingContext)
-toNameless term = toNamelessWithContext term 0 [] empty
+toNameless :: Term -> NamingContext -> (NamelessTerm, NamingContext)
+toNameless term = toNamelessWithContext term 0 []
 
 toNamedWithContext :: NamelessTerm  -> BoundVariables -> NamingContext -> Term
 toNamedWithContext (NamelessVariable var) bv context