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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 524 - (view) (download)

1 : blume 354 (*
2 :     * Mechanism for shell-environment configurable parameters.
3 :     *
4 :     * Copyright (c) 1999 by Lucent Technologies, Bell Laboratories.
5 :     *
6 :     * author: Matthias Blume (blume@cs.princeton.edu)
7 :     *)
8 :     signature ENVCONFIG = sig
9 :    
10 : blume 433 val new :
11 :     (string -> 'a option) ->
12 :     string * 'a ->
13 :     { get: unit -> 'a, set: 'a -> unit }
14 : blume 354
15 :     val init : unit -> unit
16 :     end
17 :    
18 :     structure EnvConfig :> ENVCONFIG = struct
19 :    
20 :     fun cfg cvt reg session0 fallback = let
21 :     val session = "CM_" ^ session0
22 :     val default = session ^ "_DEFAULT"
23 :     val getEnv = Option.join o (Option.map cvt) o OS.Process.getEnv
24 : blume 524 (* Some config values are established not at bootstrap time
25 :     * but at the time plugins are loaded. For those it is necessary
26 :     * to use a two-stage fallback strategy, testing the session
27 :     * variable if there is no default variable, because the config
28 :     * value will never witness a system startup (which is when
29 :     * the session variable is usually checked). *)
30 :     val r = ref (case getEnv default of
31 :     SOME v => v
32 :     | NONE => getOpt (getEnv session, fallback))
33 : blume 433 fun get () = !r
34 :     fun set new = r := new
35 :     val reg = fn () => (reg ();
36 :     case getEnv session of
37 :     NONE => ()
38 :     | SOME x => set x)
39 : blume 354 in
40 : blume 433 ({ get = get, set = set }, reg)
41 : blume 354 end
42 :    
43 :     val chain = ref (fn () => ())
44 :    
45 :     fun new cvt (session0, fallback) = let
46 : blume 433 val (getset, newChain) = cfg cvt (!chain) session0 fallback
47 : blume 354 in
48 :     chain := newChain;
49 : blume 433 getset
50 : blume 354 end
51 :    
52 :     fun init () = !chain ()
53 :     end

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