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/cm/tools/shell/tool.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/tools/shell/tool.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 873 - (view) (download)

1 : blume 756 (*
2 :     * A tool for running arbitrary shell commands from CM.
3 :     *
4 :     * (C) 2000 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 :     structure ShellTool = struct
9 :     local
10 :     open Tools
11 :    
12 :     val tool = "Shell-Command"
13 :     val class = "shell"
14 :     val kw_class = "class"
15 :     val kw_options = "options"
16 :     val kw_source = "source"
17 :     val kw_target = "target"
18 :     val kwl = [kw_class, kw_options, kw_source, kw_target]
19 :    
20 :     fun err msg = raise ToolError { tool = tool, msg = msg }
21 :     fun badspec kw = err (concat ["bad specification for keyword `",
22 :     kw, "'"])
23 :    
24 : blume 873 fun rule { spec, context, native2pathmaker, defaultClassOf, sysinfo } = let
25 : blume 756 val { name = str, mkpath, opts = too, derived, ... } : spec = spec
26 : blume 873 val { symval, archos } = sysinfo
27 : blume 756 val specpath = srcpath (mkpath ())
28 :     val specname = nativeSpec specpath
29 :     val (sname, tname, tclass, topts, cmdline) =
30 :     case too of
31 :     NONE => err "missing options"
32 :     | SOME ol => let
33 :     val { matches, restoptions } =
34 :     parseOptions
35 :     { tool = tool, keywords = kwl, options = ol }
36 :     fun fmatch kw =
37 :     case matches kw of
38 :     NONE => NONE
39 :     | SOME [STRING { name, mkpath }] =>
40 :     SOME (nativeSpec (srcpath (mkpath ())))
41 :     | _ => badspec kw
42 :     val tclass =
43 :     case matches kw_class of
44 :     NONE => NONE
45 :     | SOME [STRING { name, ... }] => SOME name
46 :     | _ => badspec kw_class
47 :     val topts = matches kw_options
48 :     fun return (sname, tname) = let
49 : blume 873 fun subst s = let
50 :     fun otherpercents ss =
51 :     if Substring.size ss = 2 then
52 :     SOME (String.str (Substring.sub (ss, 1)))
53 :     else NONE
54 :     fun sv ss =
55 :     SOME (case symval (Substring.string ss) of
56 :     NONE => ""
57 :     | SOME i => Int.toString i)
58 :     fun qsv ss = let
59 :     val sslen = Substring.size ss
60 :     fun doqsv (var, value) =
61 :     case symval (Substring.string var) of
62 :     NONE => SOME ""
63 :     | SOME _ => SOME (Substring.string value)
64 :     fun findcolon i =
65 :     if i >= sslen then doqsv (ss, ss)
66 :     else if Substring.sub (ss, i) = #":" then
67 :     doqsv (Substring.slice (ss, 0, SOME i),
68 :     Substring.slice (ss, i+1,
69 :     SOME (sslen-i-1)))
70 :     else findcolon (i+1)
71 :     in
72 :     findcolon 0
73 :     end
74 :     in
75 :     Subst.substitute [{ prefix = "$?(",
76 :     substitutions =
77 :     [Subst.submap (3, #")") qsv] },
78 :     { prefix = "$(",
79 :     substitutions =
80 :     [Subst.submap (2, #")") sv] },
81 :     { prefix = "%",
82 :     substitutions =
83 :     [Subst.subfor "%s" sname,
84 :     Subst.subfor "%t" tname,
85 :     Subst.subfor "%a" archos,
86 :     otherpercents] }]
87 :     s
88 :     end
89 : blume 756 fun ad (x, l) = " " :: subst x :: l
90 :     val cmdline =
91 :     case restoptions of
92 :     [] => err "no command line specified"
93 :     | h :: t => concat (subst h :: foldr ad [] t)
94 :     in
95 :     (sname, tname, tclass, topts, cmdline)
96 :     end
97 :     in
98 :     case (fmatch kw_source, fmatch kw_target) of
99 :     (NONE, NONE) => err
100 : blume 873 "either `source:' or `target:' must be specified"
101 : blume 756 | (SOME src, NONE) => return (src, specname)
102 :     | (NONE, SOME tgt) => return (specname, tgt)
103 :     | (SOME _, SOME _) => err
104 : blume 873 "only one of `source:' and `target:' can be specified"
105 : blume 756 end
106 :     val spath = srcpath (native2pathmaker sname ())
107 :     val partial_expansion =
108 :     ({ smlfiles = [], cmfiles = [],
109 :     (* If str was the target, then "derived" does not really
110 :     * make much sense. I guess the best thing is to get
111 :     * rid of the "source:" option. FIXME!! *)
112 :     sources = [(spath, { class = class, derived = derived })] },
113 :     [{ name = tname, mkpath = native2pathmaker tname,
114 :     class = tclass, opts = topts, derived = true }])
115 :     fun runcmd () =
116 :     (vsay ["[", cmdline, "]\n"];
117 :     if OS.Process.system cmdline = OS.Process.success then ()
118 :     else err cmdline)
119 :     fun rulefn () =
120 :     (if outdated tool ([tname], sname) then runcmd ()
121 :     else ();
122 :     partial_expansion)
123 :     in
124 :     context rulefn
125 :     end
126 :     in
127 :     val _ = Tools.registerClass (class, rule)
128 :     end
129 :     end

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