Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/charisee/src/compiler/gen/il/gen-ops.sml
ViewVC logotype

Annotation of /branches/charisee/src/compiler/gen/il/gen-ops.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2523 - (view) (download)

1 : jhr 186 (* gen-ops.sml
2 :     *
3 : jhr 435 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 : jhr 186 * All rights reserved.
5 :     *
6 :     * This module implements a program for generating the Operators for the instances
7 :     * of the IL functor. The program has the following usage
8 :     *
9 : jhr 2356 * gen-ops <spec-file> <template-file> <out-file>
10 : jhr 186 *
11 :     * The format of a specification is a line-oriented file, where each line (other than
12 : jhr 1640 * comments) specifies an operator using five fields, which are separated by ":". The
13 : jhr 186 * fields are
14 :     *
15 : jhr 2356 * name
16 :     * argument type (optional)
17 : jhr 1640 * result arity
18 : jhr 2356 * arity
19 :     * comment (optional)
20 : jhr 186 *
21 : jhr 2356 * Operations with effects are denoted by a "!" as the first character of the line.
22 :     *
23 : jhr 186 * The template file must contain a line consisting of just the string "@BODY@" (i.e.,
24 :     * without leading/trailing whitespace). This line is replaced with the generated
25 :     * definitions; all other lines are passed to the output file unchanged.
26 :     *
27 : jhr 2356 * We generate the following definitions:
28 : jhr 186 *
29 : jhr 2356 * datatype rator = ...
30 :     * val arity : rator -> int
31 :     * val resultArity : rator -> int
32 :     * val pure : rator -> bool
33 :     * val same : rator * rator -> bool
34 :     * val hash : rator -> word
35 :     * val toString : rator -> toString
36 : jhr 186 *
37 :     *)
38 :    
39 :     structure GenOps : sig
40 :    
41 :     val main : string * string list -> OS.Process.status
42 :    
43 :     end = struct
44 :    
45 :     structure SS = Substring
46 :    
47 :     (* Specification file input *)
48 :    
49 : jhr 1640 (* operator-specification fields *)
50 :     type op_spec = {
51 :     name : string,
52 : jhr 2356 isPure : bool,
53 : jhr 1640 ty : string list,
54 :     resArity : int,
55 :     arity : int,
56 :     comment : string option
57 :     }
58 : jhr 186
59 :     fun stripWS ss = SS.dropl Char.isSpace (SS.dropr Char.isSpace ss)
60 :    
61 :     fun optField ss = if (SS.isEmpty ss) then NONE else SOME(SS.string ss)
62 :    
63 : jhr 2356 fun doLine ss = let
64 :     fun doFields (isPure, ss) = (case SS.fields (fn #":" => true | _ => false) ss
65 :     of [name, ty, resArity, arity, comment] => SOME{
66 :     name = SS.string (stripWS name),
67 :     isPure = isPure,
68 :     ty = let
69 :     val ty = stripWS ty
70 :     fun cvt ty = SS.string(stripWS ty)
71 :     in
72 :     if (SS.isEmpty ty)
73 :     then []
74 :     else List.map cvt (SS.fields (fn #"*" => true | _ => false) ty)
75 :     end,
76 :     resArity = #1(valOf (Int.scan StringCvt.DEC SS.getc resArity)),
77 :     arity = if SS.compare(stripWS arity, SS.full "*") = EQUAL
78 :     then ~1 (* variable arity *)
79 :     else #1(valOf (Int.scan StringCvt.DEC SS.getc arity)),
80 :     comment = optField (stripWS comment)
81 :     }
82 :     | [_] => NONE (* assume a blank line *)
83 : cchiw 2523 | _ => (
84 :     print(concat[
85 :     "bogus input: \"", String.toString(Substring.string ss),
86 :     "\"\n"
87 :     ]);
88 :     raise Fail "bogus input")
89 : jhr 2356 (* end case *))
90 :     in
91 :     case SS.getc ss
92 :     of NONE => NONE
93 :     | SOME(#"#", _) => NONE
94 :     | SOME(#"!", rest) => doFields (false, rest)
95 :     | _ => doFields (true, ss)
96 :     (* end case *)
97 :     end
98 : jhr 186
99 :     (* read a specification file, returning a list of operator specifications *)
100 :     fun readFile fname = let
101 : jhr 2356 val inS = TextIO.openIn fname
102 :     fun lp lns = (case TextIO.inputLine inS
103 :     of NONE => List.rev lns
104 :     | SOME ln => (case doLine (SS.full ln)
105 :     of SOME ln => lp(ln::lns)
106 :     | NONE => lp lns
107 :     (* end case *))
108 :     (* end case *))
109 :     in
110 :     lp [] before TextIO.closeIn inS
111 :     end
112 : jhr 186
113 :     fun usage sts = (
114 : jhr 2356 TextIO.output(TextIO.stdErr, "usage: gen-ops <spec-file> <template-file> <out-file>\n");
115 :     sts)
116 : jhr 186
117 :     (* extract the path part of a qualified name (if it exists) *)
118 :     fun pathOf ty = (case String.fields (fn #"." => true | _ => false) ty
119 : jhr 2356 of [path, _] => SOME path
120 :     | _ => NONE
121 :     (* end case *))
122 : jhr 186
123 :     fun genFun (outS, name, ops, genOp : op_spec -> unit) = let
124 : jhr 2356 fun lp (_, []) = ()
125 :     | lp (prefix, rator::ops) = (
126 :     TextIO.output(outS, concat[" ", prefix, " ", name, " "]);
127 :     genOp rator;
128 :     lp (" |", ops))
129 :     in
130 :     lp ("fun", ops)
131 :     end
132 : jhr 186
133 :     fun genType (outS, ops) = let
134 : jhr 2356 fun lp (_, []) = ()
135 :     | lp (prefix, {name, isPure, ty, resArity, arity, comment}::r) = (
136 :     case ty
137 :     of [] => TextIO.output(outS, concat[" ", prefix, " ", name, "\n"])
138 :     | [ty] => TextIO.output(outS,
139 :     concat[" ", prefix, " ", name, " of ", ty, "\n"])
140 :     | ty::tys => (
141 :     TextIO.output(outS,
142 :     concat[" ", prefix, " ", name, " of ", ty]);
143 :     List.app (fn ty => TextIO.output(outS, " * "^ty)) tys;
144 :     TextIO.output(outS, "\n"))
145 :     (* end case *);
146 :     lp ("|", r))
147 :     in
148 :     TextIO.output (outS, " datatype rator\n");
149 :     lp ("=", ops)
150 :     end
151 : jhr 186
152 : jhr 1640 (* FIXME: eventually we should use default values *)
153 :     fun genResArity (outS, ops) = let
154 : jhr 2356 fun genOp {name, isPure, ty=[], resArity, arity, comment} =
155 :     TextIO.output(outS, concat[name, " = ", Int.toString resArity, "\n"])
156 :     | genOp {name, resArity, ...} =
157 :     TextIO.output(outS, concat["(", name, " _) = ", Int.toString resArity, "\n"])
158 :     in
159 :     genFun (outS, "resultArity", ops, genOp)
160 :     end
161 : jhr 1640
162 : jhr 186 fun genArity (outS, ops) = let
163 : jhr 2356 fun genOp {name, isPure, ty=[], resArity, arity, comment} =
164 :     TextIO.output(outS, concat[name, " = ", Int.toString arity, "\n"])
165 :     | genOp {name, arity, ...} =
166 :     TextIO.output(outS, concat["(", name, " _) = ", Int.toString arity, "\n"])
167 :     in
168 :     genFun (outS, "arity", ops, genOp)
169 :     end
170 : jhr 186
171 : jhr 2356 fun genPurity (outS, ops) = let
172 :     fun lp (prefix, []) =
173 :     TextIO.output(outS, concat[" ", prefix, " isPure _ = true\n"])
174 :     | lp (prefix, {name, isPure=false, ty, resArity, arity, comment}::ops) = (
175 :     TextIO.output(outS, concat[" ", prefix, " isPure "]);
176 :     case ty
177 :     of [] => TextIO.output(outS, concat[name, " = false\n"])
178 :     | _ => TextIO.output(outS, concat["(", name, " _) = false\n"])
179 :     (* end case *);
180 :     lp (" |", ops))
181 :     | lp (prefix, {isPure=true, ...}::ops) = lp (prefix, ops)
182 :     in
183 :     lp ("fun", ops)
184 :     end
185 :    
186 : jhr 186 fun genSame (outS, ops) = let
187 : jhr 2356 fun prl l = TextIO.output(outS, concat l)
188 :     fun genOp {name, isPure, ty=[], resArity, arity, comment} =
189 :     prl ["(", name, ", ", name, ") = true\n"]
190 :     | genOp {name, ty=ty::tys, arity, ...} = let
191 :     fun test argTy = (case pathOf argTy
192 :     of SOME path => path ^ ".same"
193 :     | NONE => "same" ^ argTy
194 :     (* end case *))
195 :     val nArgs = List.length tys + 1
196 :     val arg1::args1 = List.tabulate(nArgs, fn i => "a"^Int.toString i)
197 :     val arg2::args2 = List.tabulate(nArgs, fn i => "b"^Int.toString i)
198 :     fun app3 f (x::xs, y::ys, z::zs) = (f(x, y, z); app3 f (xs, ys, zs))
199 :     | app3 f ([], [], []) = ()
200 :     in
201 :     prl ["(", name, "(", arg1];
202 :     List.app (fn x => prl [",", x]) args1;
203 :     prl ["), ", name, "(", arg2];
204 :     List.app (fn x => prl [",", x]) args2;
205 :     prl [")) = ", test ty, "(a0, b0)"];
206 :     app3
207 :     (fn (ty, a, b) => prl[" andalso ", test ty, "(", a, ", ", b, ")"])
208 :     (tys, args1, args2);
209 :     TextIO.output(outS,"\n")
210 :     end
211 :     in
212 :     genFun (outS, "same", ops, genOp);
213 :     TextIO.output (outS, " | same _ = false\n")
214 :     end
215 : jhr 186
216 :     (* the first 200 primes *)
217 :     val primes = Vector.fromList [
218 : jhr 2356 2, 3, 5, 7, 11, 13, 17, 19, 23, 29,
219 :     31, 37, 41, 43, 47, 53, 59, 61, 67, 71,
220 :     73, 79, 83, 89, 97, 101, 103, 107, 109, 113,
221 :     127, 131, 137, 139, 149, 151, 157, 163, 167, 173,
222 :     179, 181, 191, 193, 197, 199, 211, 223, 227, 229,
223 :     233, 239, 241, 251, 257, 263, 269, 271, 277, 281,
224 :     283, 293, 307, 311, 313, 317, 331, 337, 347, 349,
225 :     353, 359, 367, 373, 379, 383, 389, 397, 401, 409,
226 :     419, 421, 431, 433, 439, 443, 449, 457, 461, 463,
227 :     467, 479, 487, 491, 499, 503, 509, 521, 523, 541,
228 :     547, 557, 563, 569, 571, 577, 587, 593, 599, 601,
229 :     607, 613, 617, 619, 631, 641, 643, 647, 653, 659,
230 :     661, 673, 677, 683, 691, 701, 709, 719, 727, 733,
231 :     739, 743, 751, 757, 761, 769, 773, 787, 797, 809,
232 :     811, 821, 823, 827, 829, 839, 853, 857, 859, 863,
233 :     877, 881, 883, 887, 907, 911, 919, 929, 937, 941,
234 :     947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013,
235 :     1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069,
236 :     1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151,
237 :     1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223
238 :     ]
239 : jhr 186
240 :     fun genHash (outS, ops) = let
241 : jhr 2356 fun prl l = TextIO.output(outS, concat l)
242 :     fun genOp (i, {name, isPure, ty=[], resArity, arity, comment}) =
243 :     prl [name, " = 0w", Int.toString(Vector.sub(primes, i)), "\n"]
244 :     | genOp (i, {name, ty=ty::tys, ...}) = let
245 :     fun hash argTy = (case pathOf argTy
246 :     of SOME path => path ^ ".hash"
247 :     | NONE => "hash" ^ argTy
248 :     (* end case *))
249 :     val arg::args = List.tabulate(List.length tys + 1, fn i => "a"^Int.toString i)
250 :     in
251 :     prl ["(", name, "(", arg];
252 :     List.app (fn x => prl [",", x]) args;
253 :     prl [
254 :     ")) = 0w", Int.toString(Vector.sub(primes, i)),
255 :     " + ", hash ty, " ", arg
256 :     ];
257 :     ListPair.appEq
258 :     (fn (ty, x) => prl [" + ", hash ty, " ", x])
259 :     (tys, args);
260 :     TextIO.output(outS, "\n")
261 :     end
262 :     fun lp (_, _, []) = ()
263 :     | lp (i, prefix, rator::r) = (
264 :     prl [" ", prefix, " hash "];
265 :     genOp (i, rator);
266 :     lp (i+1, " |", r))
267 :     in
268 :     lp (1, "fun", ops)
269 :     end
270 : jhr 186
271 :     fun genToString (outS, ops) = let
272 : jhr 2356 fun prl l = TextIO.output(outS, concat l)
273 :     fun genOp {name, isPure, ty=[], resArity, arity, comment} =
274 :     prl [name, " = \"", name, "\"\n"]
275 :     | genOp {name, ty=ty::tys, ...} = let
276 :     fun toS argTy = (case pathOf argTy
277 :     of SOME path => path ^ ".toString"
278 :     | NONE => argTy ^ "ToString"
279 :     (* end case *))
280 :     val arg::args = List.tabulate(List.length tys + 1, fn i => "a"^Int.toString i)
281 :     in
282 :     prl ["(", name, "(", arg];
283 :     List.app (fn x => prl [",", x]) args;
284 :     prl [")) = concat[\"", name, "<\", ", toS ty, " ", arg];
285 :     ListPair.app
286 :     (fn (ty, x) => prl[", \",\", ", toS ty, " ", x])
287 :     (tys, args);
288 :     TextIO.output(outS, ", \">\"]\n")
289 :     end
290 :     in
291 :     genFun (outS, "toString", ops, genOp)
292 :     end
293 : jhr 186
294 :     fun gen (outS, ops : op_spec list) = (
295 : jhr 2356 genType (outS, ops);
296 :     TextIO.output(outS, "\n");
297 :     genResArity (outS, ops);
298 :     TextIO.output(outS, "\n");
299 :     genArity (outS, ops);
300 :     TextIO.output(outS, "\n");
301 :     genPurity (outS, ops);
302 :     TextIO.output(outS, "\n");
303 :     genSame (outS, ops);
304 :     TextIO.output(outS, "\n");
305 :     genHash (outS, ops);
306 :     TextIO.output(outS, "\n");
307 :     genToString (outS, ops))
308 : jhr 186
309 :     fun main (cmd, [specFile, templateFile, outFile]) = let
310 : jhr 2356 val ops = readFile specFile
311 :     val inS = TextIO.openIn templateFile
312 :     val outS = TextIO.openOut outFile
313 :     fun copy () = (case TextIO.inputLine inS
314 :     of SOME "@BODY@\n" => (gen (outS, ops); copy())
315 :     | SOME ln => (TextIO.output(outS, ln); copy())
316 :     | NONE => ()
317 :     (* end case *))
318 :     in
319 :     copy();
320 :     TextIO.closeIn inS;
321 :     TextIO.closeOut outS;
322 :     OS.Process.success
323 :     end
324 : jhr 186 | main (cmd, ["-h"]) = usage OS.Process.success
325 :     | main (cmd, _) = usage OS.Process.failure
326 :    
327 :     end

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