Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/ml-burg/example2.burg
ViewVC logotype

Annotation of /sml/trunk/src/ml-burg/example2.burg

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (view) (download)
Original Path: sml/branches/SMLNJ/src/ml-burg/example2.burg

1 : monnier 2
2 :    
3 :     %{
4 :     (* this is the header *)
5 :     %}
6 :    
7 :    
8 :    
9 :     %term INT
10 :     | VAR
11 :     | ADD
12 :     | SUB
13 :     | MUL
14 :     | DIV
15 :     | NEG
16 :    
17 :     %termprefix T_
18 :     %ruleprefix R_
19 :    
20 :     %start reg
21 :    
22 :     %%
23 :    
24 :    
25 :     reg: INT = reg_INT (1);
26 :     sreg: INT = sreg_INT (1);
27 :     ureg: INT = ureg_INT (1);
28 :    
29 :     reg: VAR = reg_VAR (1); (* fetch *)
30 :    
31 :     reg: sreg = reg_sreg (1); (* inc *)
32 :     sreg: reg = sreg_reg (1); (* dec *)
33 :     sreg: ureg = sreg_ureg (1); (* shl *)
34 :     ureg: sreg = ureg_sreg_or_reg (1); (* shr *)
35 :     ureg: reg = ureg_sreg_or_reg (1); (* shr *)
36 :    
37 :     reg: ADD(reg,sreg) = r_ADD_r_r (1); (* add *)
38 :     reg: ADD(sreg,reg) = r_ADD_r_r (1); (* add *)
39 :     reg: ADD(INT,reg) = r_ADD_2i_r (1); (* add 2*imm *)
40 :     reg: ADD(reg,INT) = r_ADD_r_2i (1); (* add 2*imm *)
41 :     reg: ADD(INT,sreg) = r_ADD_2ip_r (1); (* add 2*imm+1 *)
42 :     reg: ADD(sreg,INT) = r_ADD_r_2ip (1); (* add 2*imm+1 *)
43 :     sreg: ADD(sreg,sreg) = r_ADD_r_r (1); (* add *)
44 :     sreg: ADD(INT,sreg) = r_ADD_2i_r (1); (* add 2*imm *)
45 :     sreg: ADD(sreg,INT) = r_ADD_r_2i (1); (* add 2*imm *)
46 :     sreg: ADD(INT,reg) = r_ADD_2im_r (1); (* add 2*imm-1 *)
47 :     sreg: ADD(reg,INT) = r_ADD_r_2im (1); (* add 2*imm-1 *)
48 :    
49 :     reg: SUB(reg,sreg) = r_SUB_r_r (1); (* sub *)
50 :     reg: SUB(INT,reg) = r_SUB_2ipp_r (2); (* sub 2*imm+2,x *)
51 :     reg: SUB(reg,INT) = r_SUB_r_2i (1); (* sub x,2*imm *)
52 :     reg: SUB(sreg,INT) = r_SUB_r_2im (1); (* sub x,2*imm-1 *)
53 :     sreg: SUB(sreg,sreg) = r_SUB_r_r (1); (* sub *)
54 :     sreg: SUB(reg,reg) = r_SUB_r_r (1); (* sub *)
55 :     sreg: SUB(sreg,INT) = r_SUB_r_2i (1); (* sub x,2*imm *)
56 :     sreg: SUB(reg,INT) = r_SUB_r_2ip (1); (* sub x,2*imm+1 *)
57 :    
58 :     sreg: MUL(sreg,ureg) = r_MUL_r_r (1); (* mul *)
59 :     sreg: MUL(ureg,sreg) = r_MUL_r_r (1); (* mul *)
60 :     sreg: MUL(INT,sreg) = r_MUL_i_r (1); (* mul *)
61 :     sreg: MUL(sreg,INT) = r_MUL_r_i (1); (* mul *)
62 :     sreg: MUL(INT,ureg) = r_MUL_2i_r (1); (* mul 2*imm,x *)
63 :     sreg: MUL(ureg,INT) = r_MUL_r_2i (1); (* mul x,2*imm *)
64 :    
65 :     ureg: DIV(sreg,sreg) = r_DIV_r_r (1); (* div *)
66 :     ureg: DIV(ureg,ureg) = r_DIV_r_r (1); (* div *)
67 :     ureg: DIV(ureg,INT) = r_DIV_r_i (1); (* div *)
68 :    
69 :     reg: NEG(reg) = r_NEG_r_p_2 (2); (* 2-r *)
70 :     ureg: NEG(ureg) = r_NEG_r (1); (* 0-r *)
71 :     sreg: NEG(sreg) = r_NEG_r (1); (* 0-r *)
72 :    
73 :    
74 :    
75 :     %%
76 :    
77 :     structure In = struct
78 :    
79 :     open BurmOps
80 :    
81 :     datatype tree =
82 :     INT of int
83 :     | VAR of string
84 :     | ADD of tree * tree
85 :     | SUB of tree * tree
86 :     | MUL of tree * tree
87 :     | DIV of tree * tree
88 :     | NEG of tree
89 :    
90 :     fun termchildren t =
91 :     case t of
92 :     INT _ => (T_INT, [])
93 :     | VAR _ => (T_VAR, [])
94 :     | ADD (t1,t2) => (T_ADD, [t1,t2])
95 :     | SUB (t1,t2) => (T_SUB, [t1,t2])
96 :     | MUL (t1,t2) => (T_MUL, [t1,t2])
97 :     | DIV (t1,t2) => (T_DIV, [t1,t2])
98 :     | NEG (t1) => (T_NEG, [t1])
99 :    
100 :     end
101 :    
102 :    
103 :    
104 :    
105 :     structure Example = struct
106 :    
107 :     structure Burm = BurmGen (In)
108 :     open In
109 :    
110 :     fun say s = String.print s
111 :    
112 :    
113 :     local
114 :     val num = ref 1
115 :     in
116 :     fun resetreg () = (num := 1)
117 :     fun newreg () = ("r"^(makestring (!num)) before inc num)
118 :     end
119 :    
120 :    
121 :     fun walk (Burm.R_reg_INT, INT n) =
122 :     let val reg = newreg () in
123 :     say ("ldi "^reg^","^(makestring (n+n+1))^"\n"); reg
124 :     end
125 :     | walk (Burm.R_sreg_INT, INT n) =
126 :     let val reg = newreg () in
127 :     say ("ldi "^reg^","^(makestring (n+n))^"\n"); reg
128 :     end
129 :     | walk (Burm.R_ureg_INT, INT n) =
130 :     let val reg = newreg () in
131 :     say ("ldi "^reg^","^(makestring n)^"\n"); reg
132 :     end
133 :     | walk (Burm.R_reg_VAR, VAR v) =
134 :     let val reg = newreg () in
135 :     say ("ld "^reg^",["^v^"]\n"); reg
136 :     end
137 :     | walk (Burm.R_reg_sreg reg, _) =
138 :     let val reg' = walk reg in
139 :     say ("inc "^reg'^"\n"); reg'
140 :     end
141 :     | walk (Burm.R_sreg_reg reg, _) =
142 :     let val reg' = walk reg in
143 :     say ("dec "^reg'^"\n"); reg'
144 :     end
145 :     | walk (Burm.R_sreg_ureg reg, _) =
146 :     let val reg' = walk reg in
147 :     say ("shl "^reg'^"\n"); reg'
148 :     end
149 :     | walk (Burm.R_ureg_sreg_or_reg reg, _) =
150 :     let val reg' = walk reg in
151 :     say ("shr "^reg'^"\n"); reg'
152 :     end
153 :     | walk (Burm.R_r_ADD_r_r (r1,r2), _) =
154 :     let val (r1',r2') = (walk r1, walk r2) in
155 :     say ("add "^r1'^","^r2'^"\n"); r1'
156 :     end
157 :     | walk (Burm.R_r_ADD_2i_r reg, ADD (INT n,_)) =
158 :     let val reg' = walk reg in
159 :     say ("addi "^reg'^","^(makestring (n+n))^"\n"); reg'
160 :     end
161 :     | walk (Burm.R_r_ADD_r_2i reg, ADD (_,INT n)) =
162 :     let val reg' = walk reg in
163 :     say ("addi "^reg'^","^(makestring (n+n))^"\n"); reg'
164 :     end
165 :     | walk (Burm.R_r_ADD_2ip_r reg, ADD (INT n,_)) =
166 :     let val reg' = walk reg in
167 :     say ("addi "^reg'^","^(makestring (n+n+1))^"\n"); reg'
168 :     end
169 :     | walk (Burm.R_r_ADD_r_2ip reg, ADD (_,INT n)) =
170 :     let val reg' = walk reg in
171 :     say ("addi "^reg'^","^(makestring (n+n+1))^"\n"); reg'
172 :     end
173 :     | walk (Burm.R_r_ADD_2im_r reg, ADD (INT n,_)) =
174 :     let val reg' = walk reg in
175 :     say ("addi "^reg'^","^(makestring (n+n-1))^"\n"); reg'
176 :     end
177 :     | walk (Burm.R_r_ADD_r_2im reg, ADD (_,INT n)) =
178 :     let val reg' = walk reg in
179 :     say ("addi "^reg'^","^(makestring (n+n-1))^"\n"); reg'
180 :     end
181 :     | walk (Burm.R_r_SUB_r_r (r1,r2), _) =
182 :     let val (r1',r2') = (walk r1, walk r2) in
183 :     say ("sub "^r1'^","^r2'^"\n"); r1'
184 :     end
185 :     | walk (Burm.R_r_SUB_2ipp_r reg, SUB (INT n,_)) =
186 :     let val reg' = walk reg val r = newreg () in
187 :     say ("ldi "^r^","^(makestring (n+n+1))^"\n");
188 :     say ("sub "^r^","^reg'^"\n");
189 :     r
190 :     end
191 :     | walk (Burm.R_r_SUB_r_2i reg, SUB (_,INT n)) =
192 :     let val reg' = walk reg in
193 :     say ("subi "^reg'^","^(makestring (n+n))^"\n"); reg'
194 :     end
195 :     | walk (Burm.R_r_SUB_r_2im reg, SUB (_,INT n)) =
196 :     let val reg' = walk reg in
197 :     say ("subi "^reg'^","^(makestring (n+n-1))^"\n"); reg'
198 :     end
199 :     | walk (Burm.R_r_SUB_r_2ip reg, SUB (_,INT n)) =
200 :     let val reg' = walk reg in
201 :     say ("subi "^reg'^","^(makestring (n+n+1))^"\n"); reg'
202 :     end
203 :     | walk (Burm.R_r_MUL_r_r (r1,r2), _) =
204 :     let val (r1',r2') = (walk r1, walk r2) in
205 :     say ("mul "^r1'^","^r2'^"\n"); r1'
206 :     end
207 :     | walk (Burm.R_r_MUL_i_r reg, MUL (INT n,_)) =
208 :     let val reg' = walk reg in
209 :     say ("muli "^reg'^","^(makestring (n))^"\n"); reg'
210 :     end
211 :     | walk (Burm.R_r_MUL_r_i reg, MUL (_,INT n)) =
212 :     let val reg' = walk reg in
213 :     say ("muli "^reg'^","^(makestring (n))^"\n"); reg'
214 :     end
215 :     | walk (Burm.R_r_MUL_2i_r reg, MUL (INT n,_)) =
216 :     let val reg' = walk reg in
217 :     say ("muli "^reg'^","^(makestring (n+n))^"\n"); reg'
218 :     end
219 :     | walk (Burm.R_r_MUL_r_2i reg, MUL (_,INT n)) =
220 :     let val reg' = walk reg in
221 :     say ("muli "^reg'^","^(makestring (n+n))^"\n"); reg'
222 :     end
223 :     | walk (Burm.R_r_DIV_r_r (r1,r2), _) =
224 :     let val (r1',r2') = (walk r1, walk r2) in
225 :     say ("div "^r1'^","^r2'^"\n"); r1'
226 :     end
227 :     | walk (Burm.R_r_DIV_r_i reg, DIV (_,INT n)) =
228 :     let val reg' = walk reg in
229 :     say ("divi "^reg'^","^(makestring (n))^"\n"); reg'
230 :     end
231 :     | walk (Burm.R_r_NEG_r reg, _) =
232 :     let val reg' = walk reg in
233 :     say ("neg "^reg'^"\n"); reg'
234 :     end
235 :     | walk (Burm.R_r_NEG_r_p_2 reg, _) =
236 :     let val reg' = walk reg in
237 :     say ("neg "^reg'^"\n");
238 :     say ("addi "^reg'^",\n");
239 :     reg'
240 :     end
241 :     | walk _ = (print "Error, bad match in walk\n"; raise Match)
242 :    
243 :    
244 :     fun doit t = walk (Burm.reduce t)
245 :    
246 :     val a = SUB (ADD (VAR "a", INT 2), INT 5)
247 :     val b = ADD (DIV (SUB (VAR "a", INT 1), VAR "b"), INT 1)
248 :     val c = ADD (VAR "a", INT 1)
249 :    
250 :     end
251 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0