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