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 354 - (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 :     type 'a getterSetter
11 :    
12 :     val new : (string -> 'a option) -> string * 'a -> 'a getterSetter
13 :     val getSet : 'a getterSetter -> 'a option -> 'a
14 :    
15 :     val init : unit -> unit
16 :     end
17 :    
18 :     structure EnvConfig :> ENVCONFIG = struct
19 :    
20 :     type 'a getterSetter = 'a option -> 'a
21 :    
22 :     fun getSet gs = gs
23 :    
24 :     fun cfg cvt reg session0 fallback = let
25 :     val session = "CM_" ^ session0
26 :     val default = session ^ "_DEFAULT"
27 :     val getEnv = Option.join o (Option.map cvt) o OS.Process.getEnv
28 :     val r = ref (getOpt (getEnv default, fallback))
29 :     fun getterSetter arg =
30 :     !r before (case arg of SOME new => r := new | NONE => ())
31 :     val reg = fn () => (reg (); ignore (getterSetter (getEnv session)))
32 :     in
33 :     (getterSetter, reg)
34 :     end
35 :    
36 :     val chain = ref (fn () => ())
37 :    
38 :     fun new cvt (session0, fallback) = let
39 :     val (getterSetter, newChain) = cfg cvt (!chain) session0 fallback
40 :     in
41 :     chain := newChain;
42 :     getterSetter
43 :     end
44 :    
45 :     fun init () = !chain ()
46 :     end

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