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 186 - (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 :     type op_spec = {name : string, ty : string option, arity : int, comment : string option}
45 :    
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 :     ty = optField (stripWS ty),
56 :     arity = #1(valOf (Int.scan StringCvt.DEC SS.getc arity)),
57 :     comment = optField (stripWS comment)
58 :     }
59 :     | [_] => NONE (* assume a blank line *)
60 :     | _ => raise Fail "bogus input"
61 :     (* end case *))
62 :    
63 :     (* read a specification file, returning a list of operator specifications *)
64 :     fun readFile fname = let
65 :     val inS = TextIO.openIn fname
66 :     fun lp lns = (case TextIO.inputLine inS
67 :     of NONE => List.rev lns
68 :     | SOME ln => (case doLine (SS.full ln)
69 :     of SOME ln => lp(ln::lns)
70 :     | NONE => lp lns
71 :     (* end case *))
72 :     (* end case *))
73 :     in
74 :     lp [] before TextIO.closeIn inS
75 :     end
76 :    
77 :     fun usage sts = (
78 :     TextIO.output(TextIO.stdErr, "usage: gen-ops <spec-file> <template-file> <out-file>\n");
79 :     sts)
80 :    
81 :     (* extract the path part of a qualified name (if it exists) *)
82 :     fun pathOf ty = (case String.fields (fn #"." => true | _ => false) ty
83 :     of [path, _] => SOME path
84 :     | _ => NONE
85 :     (* end case *))
86 :    
87 :     fun genFun (outS, name, ops, genOp : op_spec -> unit) = let
88 :     fun lp (_, []) = ()
89 :     | lp (prefix, rator::ops) = (
90 :     TextIO.output(outS, concat[" ", prefix, " ", name, " "]);
91 :     genOp rator;
92 :     lp (" |", ops))
93 :     in
94 :     lp ("fun", ops)
95 :     end
96 :    
97 :     fun genType (outS, ops) = let
98 :     fun lp (_, []) = ()
99 :     | lp (prefix, {name, ty, arity, comment}::r) = (
100 :     case ty
101 :     of NONE => TextIO.output(outS, concat[" ", prefix, " ", name, "\n"])
102 :     | SOME ty => TextIO.output(outS,
103 :     concat[" ", prefix, " ", name, " of ", ty, "\n"])
104 :     (* end case *);
105 :     lp ("|", r))
106 :     in
107 :     TextIO.output (outS, " datatype rator\n");
108 :     lp ("=", ops)
109 :     end
110 :    
111 :     fun genArity (outS, ops) = let
112 :     fun genOp {name, ty=NONE, arity, comment} =
113 :     TextIO.output(outS, concat[name, " = ", Int.toString arity, "\n"])
114 :     | genOp {name, arity, ...} =
115 :     TextIO.output(outS, concat["(", name, " _) = ", Int.toString arity, "\n"])
116 :     in
117 :     genFun (outS, "arity", ops, genOp)
118 :     end
119 :    
120 :     fun genSame (outS, ops) = let
121 :     fun genOp {name, ty=NONE, arity, comment} =
122 :     TextIO.output(outS,
123 :     concat["(", name, ", ", name, ") = true\n"])
124 :     | genOp {name, ty=SOME argTy, arity, ...} = let
125 :     val test = (case pathOf argTy
126 :     of SOME path => path ^ ".same"
127 :     | NONE => "same" ^ argTy
128 :     (* end case *))
129 :     in
130 :     TextIO.output(outS,
131 :     concat["(", name, " a, ", name, " b) = ", test, "(a, b)\n"])
132 :     end
133 :     in
134 :     genFun (outS, "same", ops, genOp);
135 :     TextIO.output (outS, " | same _ = false\n")
136 :     end
137 :    
138 :     (* the first 200 primes *)
139 :     val primes = Vector.fromList [
140 :     2, 3, 5, 7, 11, 13, 17, 19, 23, 29,
141 :     31, 37, 41, 43, 47, 53, 59, 61, 67, 71,
142 :     73, 79, 83, 89, 97, 101, 103, 107, 109, 113,
143 :     127, 131, 137, 139, 149, 151, 157, 163, 167, 173,
144 :     179, 181, 191, 193, 197, 199, 211, 223, 227, 229,
145 :     233, 239, 241, 251, 257, 263, 269, 271, 277, 281,
146 :     283, 293, 307, 311, 313, 317, 331, 337, 347, 349,
147 :     353, 359, 367, 373, 379, 383, 389, 397, 401, 409,
148 :     419, 421, 431, 433, 439, 443, 449, 457, 461, 463,
149 :     467, 479, 487, 491, 499, 503, 509, 521, 523, 541,
150 :     547, 557, 563, 569, 571, 577, 587, 593, 599, 601,
151 :     607, 613, 617, 619, 631, 641, 643, 647, 653, 659,
152 :     661, 673, 677, 683, 691, 701, 709, 719, 727, 733,
153 :     739, 743, 751, 757, 761, 769, 773, 787, 797, 809,
154 :     811, 821, 823, 827, 829, 839, 853, 857, 859, 863,
155 :     877, 881, 883, 887, 907, 911, 919, 929, 937, 941,
156 :     947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013,
157 :     1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069,
158 :     1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151,
159 :     1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223
160 :     ]
161 :    
162 :     fun genHash (outS, ops) = let
163 :     fun genOp (i, {name, ty=NONE, arity, comment}) =
164 :     TextIO.output(outS,
165 :     concat[name, " = 0w", Int.toString(Vector.sub(primes, i)), "\n"])
166 :     | genOp (i, {name, ty=SOME argTy, ...}) = let
167 :     val hash = (case pathOf argTy
168 :     of SOME path => path ^ ".hash"
169 :     | NONE => "hash" ^ argTy
170 :     (* end case *))
171 :     in
172 :     TextIO.output(outS, concat[
173 :     "(", name, " a) = 0w", Int.toString(Vector.sub(primes, i)),
174 :     " + ", hash, " a\n"
175 :     ])
176 :     end
177 :     fun lp (_, _, []) = ()
178 :     | lp (i, prefix, rator::r) = (
179 :     TextIO.output(outS, concat[" ", prefix, " hash "]);
180 :     genOp (i, rator);
181 :     lp (i+1, " |", r))
182 :     in
183 :     lp (1, "fun", ops)
184 :     end
185 :    
186 :     fun genToString (outS, ops) = let
187 :     fun genOp {name, ty=NONE, arity, comment} =
188 :     TextIO.output(outS, concat[name, " = \"", name, "\"\n"])
189 :     | genOp {name, ty=SOME argTy, ...} = let
190 :     val toS = (case pathOf argTy
191 :     of SOME path => path ^ ".toString"
192 :     | NONE => argTy ^ "ToString"
193 :     (* end case *))
194 :     in
195 :     TextIO.output(outS,
196 :     concat["(", name, " a) = concat[\"", name, "(\", ", toS, " a, \")\"]\n"])
197 :     end
198 :     in
199 :     genFun (outS, "toString", ops, genOp)
200 :     end
201 :    
202 :     fun gen (outS, ops : op_spec list) = (
203 :     genType (outS, ops);
204 :     TextIO.output(outS, "\n");
205 :     genArity (outS, ops);
206 :     TextIO.output(outS, "\n");
207 :     genSame (outS, ops);
208 :     TextIO.output(outS, "\n");
209 :     genHash (outS, ops);
210 :     TextIO.output(outS, "\n");
211 :     genToString (outS, ops))
212 :    
213 :     fun main (cmd, [specFile, templateFile, outFile]) = let
214 :     val ops = readFile specFile
215 :     val inS = TextIO.openIn templateFile
216 :     val outS = TextIO.openOut outFile
217 :     fun copy () = (case TextIO.inputLine inS
218 :     of SOME "@BODY@\n" => (gen (outS, ops); copy())
219 :     | SOME ln => (TextIO.output(outS, ln); copy())
220 :     | NONE => ()
221 :     (* end case *))
222 :     in
223 :     copy();
224 :     TextIO.closeIn inS;
225 :     TextIO.closeOut outS;
226 :     OS.Process.success
227 :     end
228 :     | main (cmd, ["-h"]) = usage OS.Process.success
229 :     | main (cmd, _) = usage OS.Process.failure
230 :    
231 :     end

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