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 1689 - (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 :     fun gen { template, target, vfile, rfile } =
44 :     let val version = getVersion vfile
45 :     val release = getRelease rfile
46 : mblume 1689 val version' = case release of
47 :     NONE => version
48 :     | SOME r => version @ [r]
49 : mblume 1639 val vstring = String.concatWith ", " (map Int.toString version')
50 :     val ss = TextIO.openIn template
51 :     val ts = TextIO.openOut target
52 :     fun loop () =
53 :     case TextIO.input1 ss of
54 :     NONE => ()
55 :     | SOME #"%" =>
56 : mblume 1689 (case TextIO.input1 ss of
57 :     SOME #"V" => (TextIO.output (ts, vstring); loop ())
58 :     | SOME #"F" => (TextIO.output (ts, OS.Path.file target);
59 :     TextIO.output (ts, " generated from");
60 :     loop ())
61 :     | SOME c => (TextIO.output1 (ts, c); loop ())
62 :     | NONE => TextIO.output1 (ts, #"%"))
63 : mblume 1639 | SOME c => (TextIO.output1 (ts, c); loop ())
64 : mblume 1689 in bumpRelease (rfile, getOpt (release, ~1));
65 :     loop ();
66 :     TextIO.closeIn ss;
67 :     TextIO.closeOut ts
68 : mblume 1639 end
69 :    
70 :     val tool = "versiontool"
71 :     val class = "version"
72 :    
73 :     val kw_target = "target"
74 :     val kw_versionfile = "versionfile"
75 :     val kw_releasefile = "releasefile"
76 :     val keywords = [kw_target, kw_versionfile, kw_releasefile]
77 :    
78 :     fun versiontoolrule { spec: Tools.spec,
79 :     native2pathmaker,
80 :     context: Tools.rulecontext,
81 :     defaultClassOf,
82 :     sysinfo } : Tools.partial_expansion =
83 :     let fun dogen (targetpp, versionfilepp, releasefilepp) () =
84 :     let val templatep = Tools.srcpath (#mkpath spec ())
85 :     val targetp = Tools.srcpath targetpp
86 : mblume 1689 val target = Tools.nativeSpec targetp
87 :     val template = Tools.nativeSpec templatep
88 :     val vfile = Tools.nativePreSpec versionfilepp
89 :     val rfile = Tools.nativePreSpec releasefilepp
90 :     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 :     vfile = vfile, rfile = rfile }
94 :     else ();
95 :     ({ smlfiles = [(targetp, { share = Sharing.DONTCARE,
96 :     setup = (NONE, NONE),
97 :     split = NONE,
98 :     noguid = false,
99 :     locl = false,
100 :     controllers = [] })],
101 :     cmfiles = [],
102 :     sources = [(templatep, { class = class,
103 :     derived = #derived spec })] },
104 :     [])
105 : mblume 1639 end
106 :     fun complain l =
107 :     raise Tools.ToolError { tool = tool, msg = concat l }
108 : mblume 1689 in case #opts spec of
109 :     NONE => complain ["missing parameters"]
110 :     | SOME to =>
111 :     let val { matches, restoptions } =
112 :     Tools.parseOptions { tool = tool,
113 :     keywords = keywords,
114 :     options = to }
115 :     fun match kw =
116 :     case matches kw of
117 :     NONE => complain ["missing parameter \"", kw, "\""]
118 :     | SOME [Tools.STRING { mkpath, ... }] => mkpath ()
119 :     | _ => complain ["invalid parameter \"", kw, "\""]
120 :     in context (dogen (match kw_target,
121 :     match kw_versionfile,
122 :     match kw_releasefile))
123 :     end
124 : mblume 1639 end
125 :     in
126 : mblume 1689 val bump_release = bump_release
127 :     val _ = Tools.registerClass (class, versiontoolrule)
128 : mblume 1639 end
129 :     end

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