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/system/smlnj/installer/library-install.sml
ViewVC logotype

Annotation of /sml/trunk/system/smlnj/installer/library-install.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2297 - (view) (download)

1 : blume 2278 (* library-install.sml
2 :     * Installer routine for additional libraries.
3 :     *
4 :     * (C) 2007 The Fellowship of SML/NJ
5 :     *
6 :     * author: Matthias Blume
7 :     *)
8 :     structure LibraryInstall : sig end = struct
9 :    
10 : blume 2297 structure U = InstallerUtil
11 : blume 2278 structure P = OS.Path
12 :     structure F = OS.FileSys
13 :     structure SI = SMLofNJ.SysInfo
14 :    
15 : blume 2297 val say = U.say and fail = U.fail
16 :     val pconc = U.pconcat
17 : blume 2278
18 :     fun usage () =
19 : blume 2281 say ["sml -m $smlnj/library-install.cm src libdir tgt\n",
20 : blume 2278 "\tsrc: .cm-file for library (path name in Unix syntax)\n",
21 : blume 2281 "\tlibdir: library directory (path name in native syntax)\n",
22 : blume 2278 "\ttgt: .cm-file for destination (Unix-syntax, ",
23 :     "relative to libdir)\n"]
24 : blume 2297
25 : blume 2278 (* figure out who and what we are *)
26 : blume 2297 val { arch_oskind, ... } = U.platformInfo ()
27 : blume 2278
28 :     fun add_anchor (f, a) =
29 :     let val s = TextIO.openAppend f
30 :     in TextIO.output (s, concat [a, " ", a, "\n"]);
31 :     TextIO.closeOut s
32 :     end
33 :    
34 :     (* src is still Unix-style, tgt is native: *)
35 : blume 2283 fun install (usrc, src, libdir, rtgt) =
36 : blume 2278 (if CM.stabilize false usrc then
37 :     case #arcs (P.fromString rtgt) of
38 :     anchor :: _ =>
39 :     let val pathconfig =
40 :     case OS.Process.getEnv "CM_PATHCONFIG" of
41 :     SOME pc => pc
42 :     | NONE => P.concat (libdir, "pathconfig")
43 :     val srcdir = P.dir src
44 :     val srcfile = P.file src
45 :     val s_src = pconc [srcdir, CM.cm_dir_arc,
46 :     arch_oskind, srcfile]
47 :     val tgt = P.concat (libdir, rtgt)
48 :     val { dir = tgtdir, file = tgtfile } = P.splitDirFile tgt
49 :     val s_tgtdir = pconc [tgtdir, CM.cm_dir_arc, arch_oskind]
50 :     val s_tgt = P.concat (s_tgtdir, tgtfile)
51 : blume 2297 in U.mkdir s_tgtdir;
52 :     U.rename { old = s_src, new = s_tgt };
53 : blume 2278 add_anchor (pathconfig, anchor);
54 :     (* TODO: uniqconfig *)
55 :     OS.Process.success
56 :     end
57 :     | [] => (usage (); OS.Process.failure)
58 :     else OS.Process.failure)
59 :     handle exn => fail ["uncaught exception: ",
60 :     General.exnMessage exn, "\n"]
61 :    
62 : blume 2283 fun doit [src, libdir, tgt] =
63 :     install (src, P.fromUnixPath src, libdir, P.fromUnixPath tgt)
64 :     | doit [src, libdir] =
65 :     let val nsrc = P.fromUnixPath src
66 :     val f = P.file nsrc
67 :     in install (src, nsrc, libdir, P.concat (f, f))
68 :     end
69 : blume 2278 | doit _ = (usage (); OS.Process.failure)
70 :    
71 :     (* run the installer *)
72 :     val _ = OS.Process.exit (doit (CommandLine.arguments ()))
73 :     end

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