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 3773 - (view) (download)

1 : jhr 3773 (* mkfrags.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2016 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 :     * Program to generate a file "fragments.sml" containing a structure "Fragments"
9 :     * from a CATALOG file.
10 :     *)
11 :    
12 :     structure MkFrags : sig
13 :    
14 :     val doit : string -> unit
15 :    
16 :     val main : string * string list -> OS.Process.status
17 :    
18 :     end = struct
19 :    
20 :     structure F = Format
21 :    
22 :     val smlHead = "\
23 :     \(* %s\n\
24 :     \ *\n\
25 :     \ * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)\n\
26 :     \ *\n\
27 :     \ * COPYRIGHT (c) 2016 The University of Chicago\n\
28 :     \ * All rights reserved.\n\
29 :     \ *\n\
30 :     \ * !!! THIS FILE WAS GENERATED; DO NOT EDIT !!!\n\
31 :     \ *)\n\
32 :     \\n\
33 :     \structure Fragments =\n\
34 :     \ struct\n\
35 :     \"
36 :    
37 :     val smlFoot = "\
38 :     \\n\
39 :     \ end\n\
40 :     \"
41 :    
42 :     (* load the catalog from the file *)
43 :     fun loadCatalog file = let
44 :     val inS = TextIO.openIn file
45 :     fun lp l = (case TextIO.inputLine inS
46 :     of NONE => List.rev l
47 :     | SOME ln => (case String.tokens Char.isSpace ln
48 :     of [] => lp l
49 :     | s1::sr => if String.isPrefix "#" s1
50 :     then lp l
51 :     else (case sr
52 :     of [s2] => lp ((s1, s2) :: l)
53 :     | _ => raise Fail (concat[
54 :     "bogus input line \"", String.toString ln, "\""
55 :     ])
56 :     (* end case *))
57 :     (* end case *))
58 :     (* end case *))
59 :     in
60 :     (lp [] before TextIO.closeIn inS)
61 :     handle ex => (TextIO.closeIn inS; raise ex)
62 :     end
63 :    
64 :     (* load the contents of an ".in" file *)
65 :     fun load srcFile = let
66 :     val inS = TextIO.openIn srcFile
67 :     fun lp l = (case TextIO.inputLine inS
68 :     of NONE => List.rev l
69 :     | SOME ln => lp(ln::l)
70 :     (* end case *))
71 :     in
72 :     (lp [] before TextIO.closeIn inS)
73 :     handle ex => (TextIO.closeIn inS; raise ex)
74 :     end
75 :    
76 :     fun doFile (outS, fragDir) (srcFile, smlVar) = let
77 :     val text = load (OS.Path.concat (fragDir, srcFile))
78 :     fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
79 :     in
80 :     prf ("\n", []);
81 :     prf (" val %s = \"\\\n", [F.STR smlVar]);
82 :     prf (" \\/*---------- begin %s ----------*/\\n\\\n", [F.STR srcFile]);
83 :     List.app (fn ln => prf(" \\%s\\\n", [F.STR(String.toString ln)])) text;
84 :     prf (" \\/*---------- end %s ----------*/\\n\\\n", [F.STR srcFile]);
85 :     prf (" \\\"\n", [])
86 :     end
87 :    
88 :     fun doit dir = let
89 :     val fragDir = OS.Path.concat(dir, "fragments")
90 :     val catalogFile = OS.Path.concat(fragDir, "CATALOG")
91 :     val fragFile = OS.Path.concat(dir, "fragments.sml")
92 :     val catalog = if OS.FileSys.access(catalogFile, [OS.FileSys.A_READ])
93 :     then loadCatalog catalogFile
94 :     else raise Fail(concat["cannot find \"", catalogFile, "\""])
95 :     val outS = TextIO.openOut fragFile
96 :     fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
97 :     in
98 :     prf (smlHead, [F.STR(OS.Path.file fragFile)]);
99 :     List.app (doFile (outS, fragDir)) catalog;
100 :     prf (smlFoot, []);
101 :     TextIO.closeOut outS
102 :     end
103 :    
104 :     fun main (_, [srcDir]) = (
105 :     (doit srcDir; OS.Process.success) handle _ => OS.Process.failure)
106 :     | main _ = (
107 :     TextIO.output(TextIO.stdErr, "usage: mkfrags <dir>\n");
108 :     OS.Process.failure)
109 :    
110 :     end

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