[project @ 1999-01-18 19:38:27 by sof]
[nofib.git] / real / symalg / Parser.hs
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