Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | (*Stream:class_ctors*) |
2 | let create_$classname_from_ptr raw_ptr = | |
3 | C_obj | |
4 | begin | |
5 | let h = Hashtbl.create 20 in | |
6 | List.iter (fun (nm,fn) -> Hashtbl.replace h nm fn) | |
7 | [ "nop", (fun args -> C_void) ; | |
8 | $classbody | |
9 | "&", (fun args -> raw_ptr) ; | |
10 | ":parents", | |
11 | (fun args -> | |
12 | C_list | |
13 | (let out = ref [] in | |
14 | Hashtbl.iter (fun x y -> out := (x,y) :: !out) h ; | |
15 | (List.map | |
16 | (fun (x,y) -> | |
17 | C_string (String.sub x 2 ((String.length x) - 2))) | |
18 | (List.filter | |
19 | (fun (x,y) -> | |
20 | ((String.length x) > 2) | |
21 | && x.[0] == ':' && x.[1] == ':') !out)))) ; | |
22 | ":classof", (fun args -> C_string "$realname") ; | |
23 | ":methods", (fun args -> | |
24 | C_list (let out = ref [] in | |
25 | Hashtbl.iter (fun x y -> out := (C_string x) :: !out) h ; !out)) | |
26 | ] ; | |
27 | let rec invoke_inner raw_ptr mth arg = | |
28 | begin | |
29 | try | |
30 | let application = Hashtbl.find h mth in | |
31 | application | |
32 | (match arg with | |
33 | C_list l -> (C_list (raw_ptr :: l)) | |
34 | | C_void -> (C_list [ raw_ptr ]) | |
35 | | v -> (C_list [ raw_ptr ; v ])) | |
36 | with Not_found -> | |
37 | (* Try parent classes *) | |
38 | begin | |
39 | let parent_classes = [ | |
40 | $baselist | |
41 | ] in | |
42 | let rec try_parent plist raw_ptr = | |
43 | match plist with | |
44 | p :: tl -> | |
45 | begin | |
46 | try | |
47 | (invoke (p raw_ptr)) mth arg | |
48 | with (BadMethodName (p,m,s)) -> | |
49 | try_parent tl raw_ptr | |
50 | end | |
51 | | [] -> | |
52 | raise (BadMethodName (raw_ptr,mth,"$realname")) | |
53 | in try_parent parent_classes raw_ptr | |
54 | end | |
55 | end in | |
56 | (fun mth arg -> invoke_inner raw_ptr mth arg) | |
57 | end | |
58 | ||
59 | let _ = Callback.register | |
60 | "create_$normalized_from_ptr" | |
61 | create_$classname_from_ptr | |
62 | ||
63 | ||
64 | (*Stream:mli*) | |
65 | val create_$classname_from_ptr : c_obj -> c_obj | |
66 |