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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 276 - (view) (download)

1 : blume 275 (*
2 : blume 276 * Mechanism for shell-environment configurable parameters.
3 : blume 275 *
4 :     * Copyright (c) 1999 by Lucent Technologies, Bell Laboratories.
5 :     *
6 :     * author: Matthias Blume (blume@cs.princeton.edu)
7 :     *)
8 : blume 276 signature ENVCONFIG = sig
9 : blume 275
10 : blume 276 type 'a getterSetter = 'a option -> 'a
11 : blume 275
12 : blume 276 val new : (string -> 'a option) -> string * 'a -> 'a getterSetter
13 : blume 275
14 : blume 276 val init : unit -> unit
15 :     end
16 : blume 275
17 : blume 276 structure EnvConfig :> ENVCONFIG = struct
18 :    
19 :     type 'a getterSetter = 'a option -> 'a
20 :    
21 :     fun cfg cvt reg session0 fallback = let
22 :     val session = "CM_" ^ session0
23 :     val default = session ^ "_DEFAULT"
24 :     val getEnv = Option.join o (Option.map cvt) o OS.Process.getEnv
25 :     val r = ref (getOpt (getEnv default, fallback))
26 :     fun getterSetter arg =
27 :     !r before (case arg of SOME new => r := new | NONE => ())
28 :     val reg = fn () => (reg (); ignore (getterSetter (getEnv session)))
29 :     in
30 :     (getterSetter, reg)
31 : blume 275 end
32 : blume 276
33 :     val chain = ref (fn () => ())
34 :    
35 :     fun new cvt (session0, fallback) = let
36 :     val (getterSetter, newChain) = cfg cvt (!chain) session0 fallback
37 :     in
38 :     chain := newChain;
39 :     getterSetter
40 :     end
41 :    
42 :     fun init () = !chain ()
43 : blume 275 end

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