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

Parent Directory | 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