1 module Parser (parse) where
    2 
    3 import Ast
    4 import BasicNumber
    5 import Lexer
    6 import Op
    7 
    8 -- parse string to ast
    9 parse :: String -> Ast
   10 
   11 parse str = if succ then parser lexeme
   12                     else SyntaxError
   13         where
   14                 (lexeme, succ) = lexer str
   15 
   16 -- parse lexeme list to ast
   17 parser :: [Lexeme] -> Ast
   18 
   19 parser lexeme = if rest == [] then ast else SyntaxError
   20                 where (ast,rest) = parse_command lexeme
   21 
   22 -- parse a lexeme list, return an ast and the rest of the lexeme list
   23 parse_command :: [Lexeme] -> (Ast, [Lexeme])
   24 parse_command [] = (NullCmd,[])
   25 parse_command ((Evar evar):(Op "="):bexpr) = 
   26                 case bexpr of
   27                     []              -> (NullCmd,[])
   28                     (Op "'"):bexpr1 -> ((Set evar ast), rest)
   29                                 where (ast,rest) = parse_bexpr bexpr1
   30                     _                     -> ((EvalSet evar ast), rest)
   31                                 where (ast,rest) = parse_bexpr bexpr
   32 parse_command bexpr = ((Eval ast), rest)
   33                         where
   34                                 (ast,rest) = parse_bexpr bexpr
   35 
   36 -- parse an expression
   37 parse_bexpr :: [Lexeme] -> (BasicExp, [Lexeme])
   38 parse_bexpr [] = (BSError, [])
   39 parse_bexpr expr = parse_prec 7 expr
   40 
   41 parse_prec :: Int -> [Lexeme] -> (BasicExp, [Lexeme])
   42 -- we are now in front of an expression
   43 parse_prec prec rest =
   44     if prec == 0 then parse_bexpr3 rest
   45     else 
   46         case rest of
   47             ((Op op):rs) -> if opname == "" then (BSError,rest)
   48                             else parse_op_acum prec sofar r
   49                             where 
   50                                 (t,r) = parse_prec ((opPrec1 op)-1) rs
   51                                 sofar = Func opname [t]
   52                                 opname = opName1 op
   53             _    -> parse_op_acum prec t r
   54                             where
   55                                 (t,r) = parse_prec (prec-1) rest
   56         where
   57             parse_op_acum prec sofar r =
   58                 case r of
   59                     ((Op op):rs) -> if prec >= opPrec op then
   60                                         let
   61                                           (s1,r1) = parse_op op sofar rs
   62                                         in parse_op_acum prec s1 r1
   63                                     else (sofar,r)
   64                     _            -> (sofar,r)
   65 
   66 -- in front of an operator
   67 parse_op :: String -> BasicExp -> [Lexeme] -> (BasicExp, [Lexeme])
   68 parse_op op sofar rest =
   69     if opname == "" then (BSError, rest)
   70     else
   71         if opAssoc op == "right" then
   72                 let (t2,r2) = parse_prec (opPrec op) rest
   73                 in ((Func opname [sofar,t2]), r2) 
   74         else if opAssoc op == "left" then
   75                 parse_left op sofar rest
   76              else
   77                 parse_non op sofar rest
   78     where opname = opName op
   79 
   80 -- parse operators with no fixity
   81 parse_non :: String -> BasicExp -> [Lexeme] -> (BasicExp, [Lexeme])
   82 parse_non op sofar rest =
   83         ((Func (opName op) [sofar,t2]), r2) 
   84         where
   85                 (t2,r2) = parse_prec ((opPrec op)-1) rest
   86 
   87 -- parsing left-associative operators
   88 parse_left :: String -> BasicExp -> [Lexeme] -> (BasicExp, [Lexeme])
   89 parse_left op sofar rest =
   90         case r1 of
   91             ((Op nop):rs) ->
   92                 if (opPrec op) == (opPrec nop) then
   93                     parse_left nop nsofar rs
   94                 else
   95                     (nsofar,r1)
   96 --               parse_op nop (Func (opName op) [sofar,t1]) rs
   97             _            -> (nsofar,r1)
   98         where
   99             (t1,r1) = parse_prec ((opPrec op)-1) rest
  100             nsofar = Func (opName op) [sofar,t1]
  101 
  102 -- atomic expression
  103 parse_bexpr3 :: [Lexeme] -> (BasicExp, [Lexeme])
  104 parse_bexpr3 ((Evar evar):rest)      = ((EVar evar), rest)
  105 parse_bexpr3 ((Ide var):Lparen:rest) = 
  106                         if succ then ((Func var args), r)
  107                                 else (BSError,r)
  108                         where
  109                                 (args,r,succ) = parse_arglist [] rest
  110 parse_bexpr3 ((Ide var):rest)       = ((Var var), rest)
  111 parse_bexpr3 ((Num num):rest)       = ((Numb (read num)), rest)
  112 parse_bexpr3 (Lparen:rest)          = case r1 of
  113                                         (Rparen:r2) -> (exp,r2)
  114                                         _       -> (BSError,r1)
  115                                       where
  116                                         (exp,r1) = parse_bexpr rest
  117 parse_bexpr3 x                     = (BSError,x)
  118 
  119 -- parse argument list
  120 parse_arglist :: [BasicExp] -> [Lexeme] -> ([BasicExp], [Lexeme], Bool)
  121 parse_arglist acum (Rparen:x) = (acum, x, True)
  122 parse_arglist acum x = case r1 of
  123                         (Comma:rs)  -> parse_arglist (acum++[arg]) rs
  124                         (Rparen:rs) -> (acum++[arg],rs,True)
  125                         _        -> ([],[],False) 
  126                 where
  127                         (arg,r1) = parse_bexpr x