by jefhen
Background reading for this message is a flame war I started on environment idioms in caml, based on needs in cocanwiki and other projects I've had / am having / will have.
http://caml.inria.fr/pub/ml-archives/caml-list/2004/12/threads.en.html
Text search for "environment idiom". Here's another url but I don't know if it's permanent with all the recent archive reorg.
http://caml.inria.fr/pub/ml-archives/caml-list/2004/12/a0924032de03d517cb8cb8f2adde6c94.en.html
After the caml-list discussion, it occured to me that what I want is similar to a dynamic scoping idiom. So I looked up elisp and found this:
http://www.tac.nyc.ny.us/manuals/elisp/elisp_128.html#SEC131
Accordingly, I blended the "shallow binding" with the caml anonymous object access. The implementation, shallow.ml below, is two parts, which are right now in one module just because of tranaction cost. One is a "cell" type which can store values going down the call stack and pop them going up. The other is a code generator which can output an class definition for an arbitrary list of symbols. The user code then accesses environment variables like this:
let foo env = let myConfigVar = Shallow.value env#myConfigVar in . . .
and can rebind a variable with
let call_with_changed_config env =
let myConfigVar = Shallow.value env#myConfigVar in
Shallow.bind env#myConfigVar (myConfigVar+1)
(fun () ->
let myNewConfigVar = Shallow.value env#myConfigVar in
...)
Either returning from the free lambda or throwing an exception reverts the environment to its previous state.
The generated environment class is completely polymorphic, and so doesn't require the types of the arguments until instantiation. Creating the new environment object only creates the call links between the different variables. Actual member initialization is done in lazy (by need) order. Example:
Shallow.generateEnvironment
~idList:["apple",true;
"banana",true;
"pear",true]
~className:"env_0"
~fileName:"environment_fruit.ml";;
generates environment_fruit.ml:
class ['t1,'t2,'t3] env_0 ~init_apple ~init_banana ~init_pear =
object(env_0_self)
val apple : 't1 Shallow.t = Shallow.create "apple"
method apple = apple
val banana : 't2 Shallow.t = Shallow.create "banana"
method banana = banana
val pear : 't3 Shallow.t = Shallow.create "pear"
method pear = pear
method init =
Shallow.lazyInit apple (init_apple env_0_self);
Shallow.lazyInit banana (init_banana env_0_self);
Shallow.lazyInit pear (init_pear env_0_self)
end;;
I have been using this on another project and seems to work nicely for my purposes. I don't have the completely tangible justification for why I need dynamic scoping, but I know it can be useful for environments with complex configurations (like elisp.) Maybe I should learn a little more elisp.
One thing I am thinking about is "value" is a keyword in revised syntax. Maybe change to "get".
Any objections to using this or a similar method to rewrite cocanwiki? Target variables include dbh, hostid, and browser identification.
(** a module for dynamically scoped variables, via
shallow binding, ala elisp. See elisp manual Sec 11.9.3
"Implementation of Dynamic Scoping"
*)
open Printf;;
module Shallow =
struct
exception Unbound of string
type 'a t = ('a list ref) * string * ((unit -> 'a) option ref)
let create (id : string) : 'a t = ref [],id,ref None
let createInit (id : string) v = ref [],id,ref (Some (fun () -> v))
let lazyInit ((stack,id,fopt) : 'a t) f = fopt := Some f
let isEmpty ((stack,id,fopt) : 'a t) = (!stack=[])
let push ((stack,id,fopt) : 'a t) (v : 'a) =
stack := v::(!stack)
let reset ((stack,id,fopt) : 'a t) (v : 'a) =
stack := [v]
let bind ((stack,id,fopt) : 'a t) v f =
stack := v::(!stack);
try
f ()
with
ex ->
begin match !stack with
v::tl -> stack := tl
| _ -> ()
end;
raise ex
let value ((stack,id,fopt) : 'a t) =
match !stack with
v::tl -> v
| [] -> begin
match !fopt with
Some f ->
let v = f () in
stack := [v];
v
| None -> raise (Unbound id)
end
let list_filter_mapi f l =
let rec iter i ret l =
match l with
hd::tl -> begin
match f i hd with
Some x -> iter (i+1) (x::ret) tl
| None -> iter (i+1) ret tl
end
| [] -> ret in
List.rev (iter 0 [] l)
let generateEnvironment ~idList ~className ~fileName =
let gen_type_id i _ = sprintf "'t%d" (i+1) in
let gen_init_id i id = sprintf "init_%s" id in
let self_id = className ^ "_self" in
let tidList = String.concat ","
(list_filter_mapi (fun i x -> Some (gen_type_id i x)) idList) in
let iidList = String.concat " "
(list_filter_mapi
(fun i (id,hasInit) -> if not hasInit then None
else Some ("~" ^ (gen_init_id i id))) idList) in
let gen_method i (id,hasInit) =
Some (sprintf
" val %s : %s Shallow.t = Shallow.create \"%s\"\n method %s = %s"
id (gen_type_id i id) id
id id )in
let methodList =
String.concat "\n" (list_filter_mapi gen_method idList) in
let gen_init i (id,hasInit) =
if hasInit then
Some (sprintf " Shallow.lazyInit %s (%s %s)"
id (gen_init_id i id) self_id)
else
None in
let initList =
String.concat ";\n" (list_filter_mapi gen_init idList) in
let f = open_out fileName in
fprintf f "class [%s] %s %s =\n" tidList className iidList;
fprintf f "object(%s)\n" self_id;
fprintf f "%s\n" methodList;
fprintf f " method init =\n%s\nend;;\n" initList;
close_out f;
()
end;;