Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/system/smlnj/internal/versiontool.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/smlnj/internal/versiontool.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1700 - (view) (download)

1 : mblume 1639 (* versiontool.sml
2 :     *
3 :     * A CM tool for automatically generating file version.sml
4 : mblume 1689 * from a template, incorporating current version and release.
5 : mblume 1639 *
6 :     * Copyright (c) 2004 by The Fellowship of SML/NJ
7 :     *
8 :     * Author: Matthias Blume (blume@tti-c.org)
9 :     *)
10 :     structure VersionTool = struct
11 :     local
12 :     val bump_release =
13 :     ref (Option.isSome (OS.Process.getEnv "VERSIONTOOL_BUMP_RELEASE"))
14 :    
15 :     fun getVersion file =
16 :     let val s = TextIO.openIn file
17 : mblume 1689 in case TextIO.inputLine s of
18 :     SOME l =>
19 :     let val _ = TextIO.closeIn s
20 :     val fl = String.tokens
21 :     (fn c => Char.isSpace c orelse c = #".") l
22 :     in map (fn f => getOpt (Int.fromString f, 0)) fl
23 :     end
24 :     | NONE => [0, 0]
25 : mblume 1639 end handle _ => [0, 0]
26 :    
27 :     fun getRelease file =
28 :     let val s = TextIO.openIn file
29 : mblume 1689 in case TextIO.inputLine s of
30 :     SOME l => (TextIO.closeIn s; Int.fromString l)
31 :     | NONE => (TextIO.closeIn s; NONE)
32 : mblume 1639 end handle _ => NONE
33 :    
34 :     fun putRelease (file, r) =
35 :     let val s = TextIO.openOut file
36 : mblume 1689 in TextIO.output (s, Int.toString r ^ "\n");
37 :     TextIO.closeOut s
38 : mblume 1639 end
39 :    
40 :     fun bumpRelease (file, r) =
41 :     if !bump_release then putRelease (file, r + 1) else ()
42 :    
43 : mblume 1700 fun gen { template, target, vfile, release } =
44 : mblume 1639 let val version = getVersion vfile
45 : mblume 1689 val version' = case release of
46 :     NONE => version
47 :     | SOME r => version @ [r]
48 : mblume 1639 val vstring = String.concatWith ", " (map Int.toString version')
49 :     val ss = TextIO.openIn template
50 :     val ts = TextIO.openOut target
51 :     fun loop () =
52 :     case TextIO.input1 ss of
53 :     NONE => ()
54 :     | SOME #"%" =>
55 : mblume 1689 (case TextIO.input1 ss of
56 :     SOME #"V" => (TextIO.output (ts, vstring); loop ())
57 :     | SOME #"F" => (TextIO.output (ts, OS.Path.file target);
58 :     TextIO.output (ts, " generated from");
59 :     loop ())
60 :     | SOME c => (TextIO.output1 (ts, c); loop ())
61 :     | NONE => TextIO.output1 (ts, #"%"))
62 : mblume 1639 | SOME c => (TextIO.output1 (ts, c); loop ())
63 : mblume 1700 in
64 : mblume 1689 loop ();
65 :     TextIO.closeIn ss;
66 :     TextIO.closeOut ts
67 : mblume 1639 end
68 :    
69 :     val tool = "versiontool"
70 :     val class = "version"
71 :    
72 :     val kw_target = "target"
73 :     val kw_versionfile = "versionfile"
74 :     val kw_releasefile = "releasefile"
75 :     val keywords = [kw_target, kw_versionfile, kw_releasefile]
76 :    
77 :     fun versiontoolrule { spec: Tools.spec,
78 :     native2pathmaker,
79 :     context: Tools.rulecontext,
80 :     defaultClassOf,
81 :     sysinfo } : Tools.partial_expansion =
82 :     let fun dogen (targetpp, versionfilepp, releasefilepp) () =
83 :     let val templatep = Tools.srcpath (#mkpath spec ())
84 :     val targetp = Tools.srcpath targetpp
85 : mblume 1689 val target = Tools.nativeSpec targetp
86 :     val template = Tools.nativeSpec templatep
87 :     val vfile = Tools.nativePreSpec versionfilepp
88 :     val rfile = Tools.nativePreSpec releasefilepp
89 : mblume 1700 val release = getRelease rfile
90 : mblume 1689 fun newerThanTarget f = Tools.outdated tool ([target], f)
91 :     in if List.exists newerThanTarget [template, vfile, rfile] then
92 :     gen { template = template, target = target,
93 : mblume 1700 vfile = vfile, release = release }
94 : mblume 1689 else ();
95 : mblume 1700 bumpRelease (rfile, getOpt (release, ~1));
96 : mblume 1689 ({ smlfiles = [(targetp, { share = Sharing.DONTCARE,
97 :     setup = (NONE, NONE),
98 :     split = NONE,
99 :     noguid = false,
100 :     locl = false,
101 :     controllers = [] })],
102 :     cmfiles = [],
103 :     sources = [(templatep, { class = class,
104 :     derived = #derived spec })] },
105 :     [])
106 : mblume 1639 end
107 :     fun complain l =
108 :     raise Tools.ToolError { tool = tool, msg = concat l }
109 : mblume 1689 in case #opts spec of
110 :     NONE => complain ["missing parameters"]
111 :     | SOME to =>
112 :     let val { matches, restoptions } =
113 :     Tools.parseOptions { tool = tool,
114 :     keywords = keywords,
115 :     options = to }
116 :     fun match kw =
117 :     case matches kw of
118 :     NONE => complain ["missing parameter \"", kw, "\""]
119 :     | SOME [Tools.STRING { mkpath, ... }] => mkpath ()
120 :     | _ => complain ["invalid parameter \"", kw, "\""]
121 :     in context (dogen (match kw_target,
122 :     match kw_versionfile,
123 :     match kw_releasefile))
124 :     end
125 : mblume 1639 end
126 :     in
127 : mblume 1689 val bump_release = bump_release
128 :     val _ = Tools.registerClass (class, versiontoolrule)
129 : mblume 1639 end
130 :     end

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