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

SCM Repository

[diderot] Annotation of /trunk/src/compiler/IL/gen/gen-ops.sml
ViewVC logotype

Annotation of /trunk/src/compiler/IL/gen/gen-ops.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 282 - (view) (download)

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

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