Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/util/envcfg.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 354, Fri Jun 25 08:36:12 1999 UTC revision 433, Mon Sep 13 06:57:29 1999 UTC
# Line 7  Line 7 
7   *)   *)
8  signature ENVCONFIG = sig  signature ENVCONFIG = sig
9    
10      type 'a getterSetter      val new :
11            (string -> 'a option) ->
12      val new : (string -> 'a option) -> string * 'a -> 'a getterSetter          string * 'a ->
13      val getSet : 'a getterSetter -> 'a option -> 'a          { get: unit -> 'a, set: 'a -> unit }
14    
15      val init : unit -> unit      val init : unit -> unit
16  end  end
17    
18  structure EnvConfig :> ENVCONFIG = struct  structure EnvConfig :> ENVCONFIG = struct
19    
     type 'a getterSetter = 'a option -> 'a  
   
     fun getSet gs = gs  
   
20      fun cfg cvt reg session0 fallback = let      fun cfg cvt reg session0 fallback = let
21          val session = "CM_" ^ session0          val session = "CM_" ^ session0
22          val default = session ^ "_DEFAULT"          val default = session ^ "_DEFAULT"
23          val getEnv = Option.join o (Option.map cvt) o OS.Process.getEnv          val getEnv = Option.join o (Option.map cvt) o OS.Process.getEnv
24          val r = ref (getOpt (getEnv default, fallback))          val r = ref (getOpt (getEnv default, fallback))
25          fun getterSetter arg =          fun get () = !r
26              !r before (case arg of SOME new => r := new | NONE => ())          fun set new = r := new
27          val reg = fn () => (reg (); ignore (getterSetter (getEnv session)))          val reg = fn () => (reg ();
28                                case getEnv session of
29                                    NONE => ()
30                                  | SOME x => set x)
31      in      in
32          (getterSetter, reg)          ({ get = get, set = set }, reg)
33      end      end
34    
35      val chain = ref (fn () => ())      val chain = ref (fn () => ())
36    
37      fun new cvt (session0, fallback) = let      fun new cvt (session0, fallback) = let
38          val (getterSetter, newChain) = cfg cvt (!chain) session0 fallback          val (getset, newChain) = cfg cvt (!chain) session0 fallback
39      in      in
40          chain := newChain;          chain := newChain;
41          getterSetter          getset
42      end      end
43    
44      fun init () = !chain ()      fun init () = !chain ()

Legend:
Removed from v.354  
changed lines
  Added in v.433

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