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/shelltool.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/tools/shelltool.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 666 - (view) (download)

1 : blume 587 (*
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 : blume 588 fun err msg = raise ToolError { tool = tool, msg = msg }
21 :     fun badspec kw = err (concat ["bad specification for keyword `",
22 :     kw, "'"])
23 : blume 587
24 :     fun rule { spec, context, mkNativePath } = let
25 : blume 642 val { name = str, mkpath, opts = too, derived, ... } : spec = spec
26 : blume 666 val specpath = srcpath (mkpath str)
27 : blume 642 val specname = nativeSpec specpath
28 : blume 588 val (sname, tname, tclass, topts, cmdline) =
29 : blume 587 case too of
30 : blume 588 NONE => err "missing options"
31 : blume 587 | SOME ol => let
32 : blume 588 val { matches, restoptions } =
33 :     parseOptions
34 :     { tool = tool, keywords = kwl, options = ol }
35 :     fun fmatch kw =
36 :     case matches kw of
37 :     NONE => NONE
38 :     | SOME [STRING { name, mkpath }] =>
39 : blume 666 SOME (nativeSpec (srcpath (mkpath name)))
40 : blume 588 | _ => badspec kw
41 :     val tclass =
42 :     case matches kw_class of
43 :     NONE => NONE
44 :     | SOME [STRING { name, ... }] => SOME name
45 :     | _ => badspec kw_class
46 :     val topts = matches kw_options
47 :     fun return (sname, tname) = let
48 :     fun subst "%s" = sname
49 :     | subst "%t" = tname
50 :     | subst "" = ""
51 : blume 595 | subst s = if String.sub (s, 0) <> #"%" then s
52 :     else String.extract (s, 1, NONE)
53 : blume 587 fun ad (x, l) = " " :: subst x :: l
54 :     val cmdline =
55 :     case restoptions of
56 : blume 588 [] => err "no command line specified"
57 : blume 587 | h :: t => concat (subst h :: foldr ad [] t)
58 :     in
59 : blume 588 (sname, tname, tclass, topts, cmdline)
60 : blume 587 end
61 :     in
62 : blume 588 case (fmatch kw_source, fmatch kw_target) of
63 :     (NONE, NONE) => err
64 : blume 587 "either `source=' or `target=' must be specified"
65 : blume 588 | (SOME src, NONE) => return (src, specname)
66 :     | (NONE, SOME tgt) => return (specname, tgt)
67 :     | (SOME _, SOME _) => err
68 : blume 587 "only one of `source=' and `target=' can be specified"
69 :     end
70 : blume 666 val spath = srcpath (mkNativePath sname)
71 : blume 587 val partial_expansion =
72 : blume 642 ({ smlfiles = [], cmfiles = [],
73 :     (* If str was the target, then "derived" does not really
74 :     * make much sense. I guess the best thing is to get
75 :     * rid of the "source:" option. FIXME!! *)
76 :     sources = [(spath, { class = class, derived = derived })] },
77 :     [{ name = tname, mkpath = mkNativePath,
78 :     class = tclass, opts = topts, derived = true }])
79 : blume 587 fun runcmd () =
80 :     (vsay ["[", cmdline, "]\n"];
81 :     if OS.Process.system cmdline = OS.Process.success then ()
82 : blume 588 else err cmdline)
83 : blume 587 fun rulefn () =
84 :     (if outdated tool ([tname], sname) then runcmd ()
85 :     else ();
86 :     partial_expansion)
87 :     in
88 :     context rulefn
89 :     end
90 :     in
91 :     val _ = Tools.registerClass (class, rule)
92 :     end
93 :     end

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