X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fvar2def.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fvar2def.ml;h=617c4c62db55646cb1c1b714e43debcd31349f96;hb=2ee84a2a641938988703e329aef9fc3c5eb5aacf;hp=0000000000000000000000000000000000000000;hpb=34d83812af9b7064cc8f735c2a78169881140010;p=helm.git

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/var2def.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/var2def.ml
new file mode 100644
index 000000000..617c4c62d
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/var2def.ml
@@ -0,0 +1,44 @@
+(* $Id$ *)
+
+(* Compile a list of variant tags into CPP defines *) 
+
+(* hash_variant, from ctype.ml *)
+
+let hash_variant s =
+  let accu = ref 0 in
+  for i = 0 to String.length s - 1 do
+    accu := 223 * !accu + Char.code s.[i]
+  done;
+  (* reduce to 31 bits *)
+  accu := !accu land (1 lsl 31 - 1);
+  (* make it signed for 64 bits architectures *)
+  if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu
+
+open Genlex
+
+let lexer = make_lexer ["`"; "["; "]"; "|"]
+
+let main () =
+  let s = lexer (Stream.of_channel stdin) in
+  let tags = Hashtbl.create 57 in
+  while match s with parser
+    [< ' Kwd "`"; ' Ident tag >] ->
+      let hash = hash_variant tag in
+      begin try
+	let tag' = Hashtbl.find tags hash in
+	if tag <> tag' then
+	  failwith (String.concat ~sep:" " ["Doublon tag:";tag;"and";tag'])
+      with Not_found ->
+	Hashtbl.add ~key:hash ~data:tag tags;
+	print_string "#define MLTAG_";
+	print_string tag;
+	print_string "\tVal_int(";
+	print_int hash;
+	print_string ")\n"
+      end;
+      true
+  | [< ' _ >] -> true
+  | [< >] -> false
+  do () done
+
+let _ = Printexc.print main ()