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 /ml-burg/releases/release-110.84.2/example2.burg
ViewVC logotype

Annotation of /ml-burg/releases/release-110.84.2/example2.burg

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4778 - (view) (download)

1 : monnier 249
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 opchildren 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 = print s
111 :    
112 :    
113 :     local
114 :     val num = ref 1
115 :     fun inc iref = iref := (!iref + 1)
116 :     in
117 :     fun resetreg () = (num := 1)
118 :     fun newreg () = ("r"^(Int.toString (!num)) before inc num)
119 :     end
120 :    
121 :    
122 :     fun walk (Burm.R_reg_INT, INT n) =
123 :     let val reg = newreg () in
124 :     say ("ldi "^reg^","^(Int.toString (n+n+1))^"\n"); reg
125 :     end
126 :     | walk (Burm.R_sreg_INT, INT n) =
127 :     let val reg = newreg () in
128 :     say ("ldi "^reg^","^(Int.toString (n+n))^"\n"); reg
129 :     end
130 :     | walk (Burm.R_ureg_INT, INT n) =
131 :     let val reg = newreg () in
132 :     say ("ldi "^reg^","^(Int.toString n)^"\n"); reg
133 :     end
134 :     | walk (Burm.R_reg_VAR, VAR v) =
135 :     let val reg = newreg () in
136 :     say ("ld "^reg^",["^v^"]\n"); reg
137 :     end
138 :     | walk (Burm.R_reg_sreg reg, _) =
139 :     let val reg' = walk reg in
140 :     say ("inc "^reg'^"\n"); reg'
141 :     end
142 :     | walk (Burm.R_sreg_reg reg, _) =
143 :     let val reg' = walk reg in
144 :     say ("dec "^reg'^"\n"); reg'
145 :     end
146 :     | walk (Burm.R_sreg_ureg reg, _) =
147 :     let val reg' = walk reg in
148 :     say ("shl "^reg'^"\n"); reg'
149 :     end
150 :     | walk (Burm.R_ureg_sreg_or_reg reg, _) =
151 :     let val reg' = walk reg in
152 :     say ("shr "^reg'^"\n"); reg'
153 :     end
154 :     | walk (Burm.R_r_ADD_r_r (r1,r2), _) =
155 :     let val (r1',r2') = (walk r1, walk r2) in
156 :     say ("add "^r1'^","^r2'^"\n"); r1'
157 :     end
158 :     | walk (Burm.R_r_ADD_2i_r reg, ADD (INT n,_)) =
159 :     let val reg' = walk reg in
160 :     say ("addi "^reg'^","^(Int.toString (n+n))^"\n"); reg'
161 :     end
162 :     | walk (Burm.R_r_ADD_r_2i reg, ADD (_,INT n)) =
163 :     let val reg' = walk reg in
164 :     say ("addi "^reg'^","^(Int.toString (n+n))^"\n"); reg'
165 :     end
166 :     | walk (Burm.R_r_ADD_2ip_r reg, ADD (INT n,_)) =
167 :     let val reg' = walk reg in
168 :     say ("addi "^reg'^","^(Int.toString (n+n+1))^"\n"); reg'
169 :     end
170 :     | walk (Burm.R_r_ADD_r_2ip reg, ADD (_,INT n)) =
171 :     let val reg' = walk reg in
172 :     say ("addi "^reg'^","^(Int.toString (n+n+1))^"\n"); reg'
173 :     end
174 :     | walk (Burm.R_r_ADD_2im_r reg, ADD (INT n,_)) =
175 :     let val reg' = walk reg in
176 :     say ("addi "^reg'^","^(Int.toString (n+n-1))^"\n"); reg'
177 :     end
178 :     | walk (Burm.R_r_ADD_r_2im reg, ADD (_,INT n)) =
179 :     let val reg' = walk reg in
180 :     say ("addi "^reg'^","^(Int.toString (n+n-1))^"\n"); reg'
181 :     end
182 :     | walk (Burm.R_r_SUB_r_r (r1,r2), _) =
183 :     let val (r1',r2') = (walk r1, walk r2) in
184 :     say ("sub "^r1'^","^r2'^"\n"); r1'
185 :     end
186 :     | walk (Burm.R_r_SUB_2ipp_r reg, SUB (INT n,_)) =
187 :     let val reg' = walk reg val r = newreg () in
188 :     say ("ldi "^r^","^(Int.toString (n+n+1))^"\n");
189 :     say ("sub "^r^","^reg'^"\n");
190 :     r
191 :     end
192 :     | walk (Burm.R_r_SUB_r_2i reg, SUB (_,INT n)) =
193 :     let val reg' = walk reg in
194 :     say ("subi "^reg'^","^(Int.toString (n+n))^"\n"); reg'
195 :     end
196 :     | walk (Burm.R_r_SUB_r_2im reg, SUB (_,INT n)) =
197 :     let val reg' = walk reg in
198 :     say ("subi "^reg'^","^(Int.toString (n+n-1))^"\n"); reg'
199 :     end
200 :     | walk (Burm.R_r_SUB_r_2ip reg, SUB (_,INT n)) =
201 :     let val reg' = walk reg in
202 :     say ("subi "^reg'^","^(Int.toString (n+n+1))^"\n"); reg'
203 :     end
204 :     | walk (Burm.R_r_MUL_r_r (r1,r2), _) =
205 :     let val (r1',r2') = (walk r1, walk r2) in
206 :     say ("mul "^r1'^","^r2'^"\n"); r1'
207 :     end
208 :     | walk (Burm.R_r_MUL_i_r reg, MUL (INT n,_)) =
209 :     let val reg' = walk reg in
210 :     say ("muli "^reg'^","^(Int.toString (n))^"\n"); reg'
211 :     end
212 :     | walk (Burm.R_r_MUL_r_i reg, MUL (_,INT n)) =
213 :     let val reg' = walk reg in
214 :     say ("muli "^reg'^","^(Int.toString (n))^"\n"); reg'
215 :     end
216 :     | walk (Burm.R_r_MUL_2i_r reg, MUL (INT n,_)) =
217 :     let val reg' = walk reg in
218 :     say ("muli "^reg'^","^(Int.toString (n+n))^"\n"); reg'
219 :     end
220 :     | walk (Burm.R_r_MUL_r_2i reg, MUL (_,INT n)) =
221 :     let val reg' = walk reg in
222 :     say ("muli "^reg'^","^(Int.toString (n+n))^"\n"); reg'
223 :     end
224 :     | walk (Burm.R_r_DIV_r_r (r1,r2), _) =
225 :     let val (r1',r2') = (walk r1, walk r2) in
226 :     say ("div "^r1'^","^r2'^"\n"); r1'
227 :     end
228 :     | walk (Burm.R_r_DIV_r_i reg, DIV (_,INT n)) =
229 :     let val reg' = walk reg in
230 :     say ("divi "^reg'^","^(Int.toString (n))^"\n"); reg'
231 :     end
232 :     | walk (Burm.R_r_NEG_r reg, _) =
233 :     let val reg' = walk reg in
234 :     say ("neg "^reg'^"\n"); reg'
235 :     end
236 :     | walk (Burm.R_r_NEG_r_p_2 reg, _) =
237 :     let val reg' = walk reg in
238 :     say ("neg "^reg'^"\n");
239 :     say ("addi "^reg'^",\n");
240 :     reg'
241 :     end
242 :     | walk _ = (print "Error, bad match in walk\n"; raise Match)
243 :    
244 :    
245 :     fun doit t = walk (Burm.reduce t)
246 :    
247 :     val a = SUB (ADD (VAR "a", INT 2), INT 5)
248 :     val b = ADD (DIV (SUB (VAR "a", INT 1), VAR "b"), INT 1)
249 :     val c = ADD (VAR "a", INT 1)
250 :    
251 :     end
252 :    

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