{-
File: expr.hs

This is a recursive-descent parser for the grammar:

    expr -> term | term + expr | term - expr
	term -> factor | factor * term | factor / term
	factor -> id | const | ( expr )

There is one function for each non-terminal ( expr, term and factor ).

Each function takes a list of strings to simulate the token stream. The
return value is a pair (b, t). The Boolean b indicates whether parsing
was successful. The list t is a list of unprocessed tokens.

For exmple:

> term ["id", "*", "id", "+", "id"]
(True,["+","id"])

-}

-- tail that doesn't crash on empty list

safetail [] = []
safetail (x:xs) = xs

-- head that doesn't crash on empty list

safehead [] = ""
safehead (x:xs) = x


-- ------------------------------------------------------

expr [] = (False, [])

expr tokens = 
     let (b1,tokens1) = term tokens 
         next = safehead tokens1 
     in
         if b1 && ( next == "+" || next == "-") then
            expr (safetail tokens1)
         else
            (b1, tokens1)


-- ------------------------------------------------------

term [] = (False, [])

term tokens = 
     let (b1,tokens1) = factor tokens 
         next = safehead tokens1 
     in
         if b1 && ( next == "*" || next == "/") then
            term (safetail tokens1)
         else
            (b1, tokens1)


-- ------------------------------------------------------

factor [] = (False, [])

factor (t:tokens)

   | t == "id"     = (True, tokens)

   | t == "const"  = (True, tokens)

   | t == "("      = let (b1,tokens1) = expr tokens in
                     if b1 && safehead tokens1 == ")" then
                        (True, safetail tokens1)
                     else
                        (False, tokens1)
                  
   | otherwise     = (False, t:tokens)

-- ------------------------------------------------------


main = do
    print $ factor ["id"]   
    print $ term ["id", "*", "id"]   
    print $ expr ["id", "+", "id"]   
    print $ expr ["const", "+", "id", "*", "const"]   
    print $ expr ["(", "const", "+", "id", ")", "*", "const"]