{-
   Purpose:  Recursive descent parsing in Haskell
   Author: Robin Cockett
   Date: Jan 17th 2002

   To run this program:
      (1) download the file: name it "recdec.hs"
      (2) run the Haskell interpreter HUGS by typing "hugs"
      (3) get the interpreter to load the file by writing 
          ":l recdec.hs" <return>
      (4) Try some examples: there are two "parsers" 
           (a) The recognizer  "exprR"
           (b) The recognizer and structure builder "exprB"
          an example is: 
              exprB ["(","num","add","num",")","sub","num"]
          you type this line in and press return the system should 
          return a syntax tree corresponding to the term.
 -}
-------------------------------------------------------------------
--  
--   A recursive descent recognizer for the small language:
--                    expr -> term rest
--                    rest -> ADD term rest
--                          | SUB term rest
--                          |
--                    term -> NUM
--                          | ( expr )
-------------------------------------------------------------------

exprR :: [String] -> [String]
exprR ts = restR (termR ts)             -- expr -> term rest

restR :: [String] -> [String]
restR ("add":ts) = restR (termR ts)     -- rest -> ADD term rest
restR ("sub":ts) = restR (termR ts)     --       | SUB term rest
restR ts = ts                           --       |

termR :: [String] -> [String]
termR ("num":ts) = ts                   -- term -> NUM 
termR ("(":tks)  = case (exprR tks) of  --       | ( expr )
                     ")":tks -> tks 
            
-------------------------------------------------------------------
--
--  Here is the definition of the syntax tree datatype
--
-------------------------------------------------------------------

data Expr = Num
          | Add (Expr,Expr)
          | Sub (Expr,Expr)
     deriving (Show,Eq)

-------------------------------------------------------------------
--
-- Here is the definition of the recursive descent recognizer which
-- builds the syntax tree
--
-------------------------------------------------------------------

exprB :: [String] -> (Expr,[String])
exprB tks = restB (termB tks)                   -- expr -> term rest

restB:: (Expr,[String]) -> (Expr,[String])
restB (t1,"add":tks) = (Add(t1,t3),tks'') where -- rest -> ADD term rest
        (t2,tks')  = termB tks                  --   the "rest" function is 
        (t3,tks'') = restB(t2,tks')             --   given the first arg. of "add"
restB (t1,"sub":tks) = (Sub(t1,t3),tks'') where --       | SUB term rest 
        (t2,tks')  = termB tks
        (t3,tks'') = restB(t2,tks')
restB (t1,tks) = (t1,tks)                       --       | (empty)

termB :: [String] -> (Expr,[String])
termB ("num":tks) = (Num,tks)                   -- term -> NUM
termB ("(":tks)   =                             -- term -> ( expr )
          (case tks' of (")":tks'') -> (t,tks'')) where               
        (t,tks') = exprB tks