From: Christoph Bauer <c_bauer@informatik.uni-kl.de>
To: OCaml List <caml-list@inria.fr>
Subject: Re: [Caml-list] how to define a property list
Date: Sat, 24 Apr 2004 10:15:00 +0200 [thread overview]
Message-ID: <m3pt9xkd17.fsf@diebuntekuh.de> (raw)
In-Reply-To: <m3wu46cyt0.fsf@diebuntekuh.de> (Christoph Bauer's message of "Fri, 23 Apr 2004 20:51:55 +0200")
Hi,
>> http://caml.inria.fr/archives/200105/msg00175.html
I rewrote this code as a module. Differences are
* there is no `prop := None' bug (maybe others)
* it uses a hashtable to find the unit->unit functions (should be much faster)
* Symbols can be created from strings, variants, ints, ...
* properties can have trigger-functions, one for get and one for put. These
function will be called on each reading or modifying of the property.
This is maybe more than someone wants, but it's cheap to implement.
Is there one of those ExtLibs which accepts this module as contribution?
Regards,
Christoph Bauer
(* symbols.mli *)
(** Symbols with properties of various types. *)
module type KEY_TYPE = sig type t end
(**
KEYTYPE abstracts from the concret type of a symbol.
*)
module Make :
functor (Key_type : KEY_TYPE) ->
sig
type 'a property
type symbol
val make : Key_type.t -> symbol
(** [make key] creates a symbol. *)
val key_of_symbol : symbol -> Key_type.t
(** [key_of_symbol symbol] returns the key of a symbol. *)
val make_property :
?put_trigger:(symbol -> 'a -> unit) ->
?get_trigger:(symbol -> 'a -> unit) -> unit -> 'a property
(** [make_property ?put_tigger ?get_trigger ()] creates a new property.
[put symbol this_property] calls the [put_trigger] (if specified)
and [get symbol this_property] calls the [get_trigger]. *)
val put : symbol -> 'a property -> 'a -> unit
(** [put symbol prop value] puts a property with value [value] to a symbol.
[put] calls the put_trigger for property.
*)
val get : symbol -> 'a property -> 'a
(** [get symbol property] returns the value of the property of the symbol.
[get] calls the get_trigger for property.
*)
end
(** [StringSymbol = Make(String)] *)
module StringSymbol :
sig
type 'a property
type symbol
val symbol_table : (String.t, symbol) Hashtbl.t
val make : String.t -> symbol
val key_of_symbol : symbol -> String.t
val make_property :
?put_trigger:(symbol -> 'a -> unit) ->
?get_trigger:(symbol -> 'a -> unit) -> unit -> 'a property
val put : symbol -> 'a property -> 'a -> unit
val get : symbol -> 'a property -> 'a
end
(* symbols.ml *)
module type KEY_TYPE =
sig
type t
end
let some_of =
function
Some x -> x
| None -> invalid_arg "some_of"
module Make(Key_type: KEY_TYPE) =
struct
type 'a property = {
id : int;
mutable value : 'a option;
get_trigger : (symbol -> 'a -> unit) option; (* maybe mutable ? *)
put_trigger : (symbol -> 'a -> unit) option; (* maybe mutable ? *)
}
and symbol = {
name : Key_type.t;
mutable properties : (int, unit->unit) Hashtbl.t;
}
let symbol_table = Hashtbl.create 127
let make name =
try Hashtbl.find symbol_table name
with Not_found ->
let s = { name = name; properties = Hashtbl.create 13 } in
Hashtbl.add symbol_table name s;
s
let key_of_symbol symbol = symbol.name
let pcounter = ref ~-1
let make_property ?put_trigger ?get_trigger () = (* not thread safe *)
incr pcounter;
{
id = !pcounter;
value = None;
get_trigger = get_trigger;
put_trigger = put_trigger;
}
let put symbol prop value =
Hashtbl.add symbol.properties prop.id (fun () -> prop.value <- Some value);
match prop.put_trigger with
Some g -> g symbol value
| None -> ()
let get symbol prop =
let f = Hashtbl.find symbol.properties prop.id in
f ();
(match prop.get_trigger with
Some g -> g symbol (some_of prop.value);
| None -> ());
some_of prop.value
end
module StringSymbol = Make(String)
(* symbol_test.ml *)
module Symbol = Symbol.StringSymbol
let () =
let symbol = Symbol.make "hello" in
let string_property = Symbol.make_property
~get_trigger: (fun s v -> print_endline ("get on `" ^ Symbol.key_of_symbol s ^ "' returns `" ^ v ^ "'")) ()
and int_property = Symbol.make_property
~put_trigger: (fun s v -> print_endline ("put `" ^ string_of_int v ^ "' to `" ^ Symbol.key_of_symbol s ^ "'")) ()
and bool_property = Symbol.make_property () in
Symbol.put symbol string_property "test";
Symbol.put symbol int_property 42;
Symbol.put symbol bool_property true;
let s = Symbol.get symbol string_property
and i = Symbol.get symbol int_property
and b = Symbol.get symbol bool_property in
print_endline
("s=" ^ s ^ "\n"
^ "i=" ^ string_of_int i ^ "\n"
^ "b=" ^ if b then "true" else "false")
--
beginfig(1)u=3cm;draw fullcircle scaled 2u;x0=x1=y1=x2=y3=0;-y0=y2=x3=1u;
filldraw z0..{left}z1{left}..z2{curl 1}..z3..z0..cycle;def t(expr p)=fullcircle
scaled .25u shifted(0,p*u);enddef;unfill t(.5);fill t(-.5);endfig;bye
-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners
next prev parent reply other threads:[~2004-04-24 8:09 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2004-04-23 17:56 Christoph Bauer
2004-04-23 18:00 ` Alain.Frisch
2004-04-23 18:51 ` Christoph Bauer
2004-04-24 8:15 ` Christoph Bauer [this message]
2004-04-23 18:06 ` Richard Jones
2004-04-23 19:02 ` Christoph Bauer
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m3pt9xkd17.fsf@diebuntekuh.de \
--to=c_bauer@informatik.uni-kl.de \
--cc=caml-list@inria.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).