1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
(* $Id: var2def.ml,v 1.9 2001/09/06 08:27:02 garrigue Exp $ *)
open StdLabels
(* 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
try while true do match s with parser
[< ' Ident tag >] ->
print_string "#define MLTAG_";
print_string tag;
print_string "\tVal_int(";
let hash = hash_variant tag in
begin try
failwith
(String.concat ~sep:" "
["Doublon ~tag:";tag;"and";Hashtbl.find tags hash])
with Not_found -> Hashtbl.add tags hash tag
end;
print_int hash;
print_string ")\n"
| [< ' Kwd "->"; ' Ident _ >] -> ()
| [< ' Kwd "$$" >] -> ()
| [< >] -> raise End_of_file
done with End_of_file -> ()
let _ = Printexc.print main ()
|
