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

Annotation of /sml/trunk/src/cm/util/stdcfg.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1537 - (view) (download)

1 : blume 354 (*
2 :     * CM parameters that are configurable via shell-environment variables.
3 :     *
4 :     * Copyright (c) 1999 by Lucent Technologies, Bell Laboratories.
5 :     *
6 :     * author: Matthias Blume (blume@cs.princeton.edu)
7 :     *)
8 :     structure StdConfig = struct
9 :     local
10 : blume 1201 val priority = [10, 2]
11 :     val obscurity = 2
12 :     val prefix = "cm"
13 : blume 1126
14 : blume 1201 val registry = ControlRegistry.new
15 :     { help = "Compilation Manager (CM)" }
16 :    
17 : blume 1208 val _ = BasicControl.nest (prefix, registry, priority)
18 : blume 1201
19 : blume 1208 val bool_cvt = ControlUtil.Cvt.bool
20 :     val int_cvt = ControlUtil.Cvt.int
21 :    
22 : blume 1261 val st_cvt = (* string thunk *)
23 :     { tyName = "string",
24 :     fromString = fn s => SOME (fn () => s),
25 :     toString = fn th => th () }
26 :    
27 : blume 1201 val sot_cvt =
28 :     { tyName = "string", (* string option thunk *)
29 :     fromString = fn s => SOME (fn () => SOME s),
30 :     toString = fn th => (case th () of
31 :     SOME s => s
32 :     | NONE => "(not set)") }
33 :    
34 : blume 1208 val nextpri = ref 0
35 :    
36 : blume 1201 fun new (c, n, h, d) = let
37 :     val r = ref d
38 : blume 1208 val p = !nextpri
39 : blume 1201 val ctl = Controls.control { name = n,
40 : blume 1208 pri = [p],
41 : blume 1201 obscurity = obscurity,
42 :     help = h,
43 :     ctl = r }
44 : blume 1126 in
45 : blume 1208 nextpri := p + 1;
46 : blume 1201 ControlRegistry.register
47 :     registry
48 :     { ctl = Controls.stringControl c ctl,
49 : blume 1208 envName = SOME (ControlUtil.EnvName.toUpper "CM_" n) };
50 : blume 1201 { set = fn x => r := x,
51 :     get = fn () => !r }
52 : blume 1126 end
53 : blume 1261 val lib_pathconfig =
54 :     OS.Path.toString { isAbs = false, vol = "",
55 :     arcs = ["lib", "pathconfig"] }
56 :     val usr_lib_smlnj_pathconfig =
57 :     OS.Path.toString { isAbs = true, vol = "",
58 :     arcs = ["usr", "lib", "smlnj-pathconfig"] }
59 : blume 354 in
60 : blume 1201 val verbose = new (bool_cvt, "verbose", "CM chattiness", true)
61 :     val debug = new (bool_cvt, "debug", "CM debug mode", false)
62 :     val keep_going = new (bool_cvt, "keep-going",
63 :     "whether CM presses on in face of errors",
64 :     false)
65 : blume 1261 val pathcfgspec =
66 :     new (st_cvt, "pathconfig", "global path configuration file",
67 :     fn () =>
68 :     getOpt (Option.map (fn h => OS.Path.concat (h, lib_pathconfig))
69 :     (OS.Process.getEnv "SMLNJ_HOME"),
70 :     usr_lib_smlnj_pathconfig))
71 : blume 1126 val parse_caching =
72 : blume 1201 new (int_cvt, "parse-caching", "limit on parse trees cached", 100)
73 : blume 369 val local_pathconfig =
74 : blume 1201 new (sot_cvt, "local-pathconfig", "local path configuration file",
75 :     fn () => Option.map (fn h => OS.Path.concat
76 :     (h, ".smlnj-pathconfig"))
77 :     (OS.Process.getEnv "HOME"))
78 :     val warn_obsolete = new (bool_cvt, "warn-obsolete",
79 :     "whether CM accepts old-style syntax",
80 :     true)
81 : blume 1126 val conserve_memory =
82 : blume 1201 new (bool_cvt, "conserve-memory", "CM memory stinginess", false)
83 :     val generate_index = new (bool_cvt, "generate-index",
84 :     "whether CM generates library indices",
85 :     false)
86 : mblume 1537
87 :     (* controls for make tool *)
88 :     structure MakeTool = struct
89 :     local
90 :     val priority = [1]
91 :     val prefix = "make-tool"
92 :     val obscurity = 2
93 :     val mregistry = ControlRegistry.new { help = "CM Make Tool" }
94 :     val _ = ControlRegistry.nest registry { prefix = SOME prefix,
95 :     pri = priority,
96 :     obscurity = 0,
97 :     reg = mregistry }
98 :    
99 :     val nextpri = ref 0
100 :    
101 :     fun new (c, n, h, d) =
102 :     let val r = ref d
103 :     val p = !nextpri
104 :     val ctl = Controls.control { name = n, pri = [p],
105 :     obscurity = obscurity,
106 :     help = h, ctl = r }
107 :     in
108 :     nextpri := p + 1;
109 :     ControlRegistry.register mregistry
110 :     { ctl = Controls.stringControl c ctl,
111 :     envName = SOME (ControlUtil.EnvName.toUpper
112 :     "CM_MAKE_" n) };
113 :     { set = fn x => r := x,
114 :     get = fn () => !r }
115 :     end
116 :     in
117 :     val command =
118 :     new (ControlUtil.Cvt.string, "command",
119 :     "the shell-command", "make")
120 :     val pass_bindir =
121 :     new (ControlUtil.Cvt.bool, "smlnj-bindir",
122 :     "whether to pass SMLNJ_BINDIR to command", true)
123 :     end
124 :     end
125 : blume 354 end
126 :     end

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