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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/gen/fragments/mkfrags.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/gen/fragments/mkfrags.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5555 - (view) (download)

1 : jhr 3773 (* mkfrags.sml
2 :     *
3 : jhr 3996 * Program to generate a file "fragments.sml" containing a fragments structure
4 :     * from a CATALOG file. A CATALOG file has the following layout
5 :     *
6 : jhr 4317 * <structure name>
7 :     * <input file> <fragment name>
8 :     * <input file> <fragment name>
9 :     * ...
10 :     * <input file> <fragment name>
11 : jhr 3996 *
12 :     * The resulting file (named fragments.sml) will contain a structure with the given
13 : jhr 4954 * name; the structure consists of named fragments. Two kinds of input files are
14 :     * supported. If the input file has a ".in" suffix, then it is converted to an
15 :     * SML literal string in the output file. If it has a ".json" suffix, then it
16 :     * is parsed as a JSON value (see the SML/NJ JSON library) and the resulting
17 :     * value in the output will be SML code that defines the corresponding JSON.value
18 :     * value.
19 : jhr 5555 *
20 :     * COPYRIGHT (c) 2017 John Reppy (http://cs.uchicago.edu/~jhr)
21 :     *
22 :     * Permission is hereby granted, free of charge, to any person obtaining a copy
23 :     * of this software and associated documentation files (the "Software"), to deal
24 :     * in the Software without restriction, including without limitation the rights
25 :     * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
26 :     * copies of the Software, and to permit persons to whom the Software is
27 :     * furnished to do so, subject to the following conditions:
28 :     *
29 :     * The above copyright notice and this permission notice shall be included in all
30 :     * copies or substantial portions of the Software.
31 :     *
32 :     * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
33 :     * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
34 :     * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
35 :     * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
36 :     * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
37 :     * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
38 :     * SOFTWARE.
39 :     *
40 :     * This code is part of the SML Compiler Utilities, which can be found at
41 :     *
42 :     * https://github.com/JohnReppy/sml-compiler-utils
43 :     *
44 :     * This file has been specialized for the Diderot project.
45 :     *
46 :     * COPYRIGHT (c) 2018 The University of Chicago
47 :     * All rights reserved.
48 : jhr 3773 *)
49 :    
50 :     structure MkFrags : sig
51 :    
52 : jhr 5555 (* `mkFragments dir` generates the file `dir/fragments.sml` using the catalog
53 :     * file `dir/fragments/CATALOG`.
54 :     *)
55 : jhr 3816 val mkFragments : string -> unit
56 : jhr 3773
57 : jhr 5555 (* `mkMakefile dir` generates the file `dir/fragments.gmk` using the catalog
58 :     * file `dir/fragments/CATALOG`.
59 :     *)
60 : jhr 3816 val mkMakefile : string -> unit
61 : jhr 3773
62 :     end = struct
63 :    
64 :     structure F = Format
65 : jhr 4954 structure J = JSON
66 : jhr 3773
67 :     (* load the catalog from the file *)
68 :     fun loadCatalog file = let
69 : jhr 4317 val inS = TextIO.openIn file
70 :     (* report a bogus input line *)
71 :     fun error (lnum, ln) = raise Fail (concat[
72 :     "[", file, ":", Int.toString lnum, "] bogus input: \"",
73 :     String.toString ln, "\""
74 :     ])
75 :     (* get the structure name *)
76 :     val structName = (case TextIO.inputLine inS
77 :     of NONE => raise Fail "empty CATALOG file"
78 :     | SOME ln => (case String.tokens Char.isSpace ln
79 :     of [name] => name
80 :     | _ => error (1, ln)
81 :     (* end case *))
82 :     (* end case *))
83 :     fun lp (lnum, l) = (case TextIO.inputLine inS
84 :     of NONE => List.rev l
85 :     | SOME ln => (case String.tokens Char.isSpace ln
86 :     of [] => lp(lnum+1, l)
87 :     | s1::sr => if String.isPrefix "#" s1
88 :     then lp(lnum+1, l)
89 :     else (case sr
90 :     of [s2] => lp (lnum+1, (s1, s2) :: l)
91 :     | _ => error (lnum, ln)
92 :     (* end case *))
93 :     (* end case *))
94 :     (* end case *))
95 :     in
96 :     (structName, lp(2, []) before TextIO.closeIn inS)
97 : jhr 3773 handle ex => (TextIO.closeIn inS; raise ex)
98 :     end
99 :    
100 : jhr 5555 (* header for the generated SML file *)
101 : jhr 3816 val smlHead = "\
102 :     \(* %s\n\
103 :     \ *\n\
104 :     \ * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)\n\
105 : jhr 4317 \ *\n\
106 :     \ * COPYRIGHT (c) 2016 The University of Chicago\n\
107 : jhr 3816 \ * All rights reserved.\n\
108 :     \ *\n\
109 :     \ * !!! THIS FILE WAS GENERATED; DO NOT EDIT !!!\n\
110 :     \ *)\n\
111 :     \\n\
112 : jhr 3996 \structure %s =\n\
113 : jhr 3816 \ struct\n\
114 :     \"
115 :    
116 : jhr 5555 (* footer for the generated SML file *)
117 : jhr 3816 val smlFoot = "\
118 :     \\n\
119 :     \ end\n\
120 :     \"
121 :    
122 : jhr 3773 (* load the contents of an ".in" file *)
123 :     fun load srcFile = let
124 :     val inS = TextIO.openIn srcFile
125 :     fun lp l = (case TextIO.inputLine inS
126 :     of NONE => List.rev l
127 :     | SOME ln => lp(ln::l)
128 :     (* end case *))
129 :     in
130 :     (lp [] before TextIO.closeIn inS)
131 :     handle ex => (TextIO.closeIn inS; raise ex)
132 :     end
133 :    
134 : jhr 4954 fun doInFile (outS, fragDir) (srcFile, smlVar) = let
135 : jhr 3773 val text = load (OS.Path.concat (fragDir, srcFile))
136 :     fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
137 :     in
138 :     prf ("\n", []);
139 :     prf (" val %s = \"\\\n", [F.STR smlVar]);
140 : jhr 4317 prf (" \\/*---------- begin %s ----------*/\\n\\\n", [F.STR srcFile]);
141 : jhr 3773 List.app (fn ln => prf(" \\%s\\\n", [F.STR(String.toString ln)])) text;
142 : jhr 4317 prf (" \\/*---------- end %s ----------*/\\n\\\n", [F.STR srcFile]);
143 : jhr 3773 prf (" \\\"\n", [])
144 :     end
145 :    
146 : jhr 4954 fun doJSONFile (outS, fragDir) (srcFile, smlVar) = let
147 : jhr 5215 val value = JSONParser.parseFile (OS.Path.concat (fragDir, srcFile))
148 :     fun pr s = TextIO.output(outS, s)
149 : jhr 4954 fun prf (fmt, items) = pr (F.format fmt items)
150 : jhr 5215 fun prValue (indent, jv) = (case jv
151 :     of J.OBJECT[] => pr "JSON.OBJECT[]"
152 :     | J.OBJECT(fld::flds) => let
153 :     fun prFld indent (fld, v) = (
154 :     prf ("%s(\"%s\", ", [
155 :     F.LEFT(indent, F.STR ""), F.STR fld
156 :     ]);
157 :     prValue (indent, v);
158 : jhr 4954 pr ")")
159 : jhr 5215 in
160 :     prf ("JSON.OBJECT[\n", []);
161 :     prFld (indent+4) fld;
162 :     List.app (fn fld => (pr ",\n"; prFld (indent+4) fld)) flds;
163 :     prf ("\n%s]", [F.LEFT(indent+2, F.STR "")])
164 :     end
165 :     | J.ARRAY[] => pr "JSON.ARRAY[]"
166 :     | J.ARRAY(v::vs) => (
167 :     prf ("JSON.ARRAY[\n", []);
168 :     prValue' (indent+4, v);
169 :     List.app (fn v => (pr ",\n"; prValue' (indent+4, v))) vs;
170 :     prf ("\n%s]", [F.LEFT(indent+2, F.STR "")]))
171 :     | J.NULL => pr "JSON.NULL"
172 :     | J.BOOL b => prf ("JSON.BOOL %b", [F.BOOL b])
173 :     | J.INT n => prf ("JSON.INT %s", [F.STR(IntInf.toString n)])
174 :     | J.FLOAT f => prf ("JSON.REAL %s", [F.STR(Real.toString f)])
175 :     | J.STRING s => prf ("JSON.STRING \"%s\"", [F.STR(String.toString s)])
176 :     (* end case *))
177 :     and prValue' (indent, jv) = (
178 :     prf ("%s", [F.LEFT(indent, F.STR "")]);
179 :     prValue (indent, jv))
180 : jhr 4954 in
181 :     pr "\n";
182 :     prf (" val %s = ", [F.STR smlVar]);
183 : jhr 5215 prValue (16, value);
184 : jhr 4954 pr "\n"
185 :     end
186 :    
187 :     fun doFile arg = let
188 : jhr 5215 val doInFile = doInFile arg
189 :     val doJSONFile = doJSONFile arg
190 :     in
191 :     fn (srcFile, smlVar) => (case OS.Path.ext srcFile
192 :     of SOME "in" => doInFile (srcFile, smlVar)
193 :     | SOME "json" => doJSONFile (srcFile, smlVar)
194 :     | _ => raise Fail "unexpected/missing file suffix"
195 :     (* end case *))
196 :     end
197 : jhr 4954
198 : jhr 3816 fun mkFragments dir = let
199 : jhr 4317 val fragDir = OS.Path.concat(dir, "fragments")
200 :     val catalogFile = OS.Path.concat(fragDir, "CATALOG")
201 :     val fragFile = OS.Path.concat(dir, "fragments.sml")
202 :     val (structName, catalog) = if OS.FileSys.access(catalogFile, [OS.FileSys.A_READ])
203 :     then loadCatalog catalogFile
204 :     else raise Fail(concat["cannot find \"", catalogFile, "\""])
205 :     val outS = TextIO.openOut fragFile
206 : jhr 3773 fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
207 : jhr 4317 in
208 : jhr 3996 prf (smlHead, [F.STR(OS.Path.file fragFile), F.STR structName]);
209 : jhr 4317 List.app (doFile (outS, fragDir)) catalog;
210 : jhr 3773 prf (smlFoot, []);
211 :     TextIO.closeOut outS
212 :     end
213 :    
214 : jhr 5555 (* header for the generated Makefile file *)
215 : jhr 3816 val mkHead = "\
216 :     \# fragments.gmk\n\
217 :     \#\n\
218 :     \# This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)\n\
219 : jhr 4317 \#\n\
220 :     \# COPYRIGHT (c) 2016 The University of Chicago\n\
221 : jhr 3816 \# All rights reserved.\n\
222 :     \#\n\
223 :     \# !!! THIS FILE WAS GENERATED; DO NOT EDIT !!!\n\
224 :     \#\n\
225 :     \\n\
226 :     \"
227 :    
228 :     fun mkMakefile dir = let
229 : jhr 4317 val fragDir = OS.Path.concat(dir, "fragments")
230 :     val catalogFile = OS.Path.concat(fragDir, "CATALOG")
231 :     val makefile = OS.Path.concat(dir, "fragments.gmk")
232 :     val (_, catalog) = if OS.FileSys.access(catalogFile, [OS.FileSys.A_READ])
233 :     then loadCatalog catalogFile
234 :     else raise Fail(concat["cannot find \"", catalogFile, "\""])
235 :     val outS = TextIO.openOut makefile
236 : jhr 3816 fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
237 : jhr 4317 fun prDep file = prf(" \\\n %s/fragments/%s", [F.STR dir, F.STR file])
238 :     in
239 : jhr 3816 prf (mkHead, []);
240 : jhr 4317 prf ("%s/fragments.sml:", [F.STR dir]);
241 :     prDep "CATALOG";
242 :     List.app (fn (srcFile, _) => prDep srcFile) catalog;
243 : jhr 3816 prf ("\n", []);
244 :     TextIO.closeOut outS
245 :     end
246 :    
247 : jhr 3773 end

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