You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
66 lines
1.7 KiB
66 lines
1.7 KiB
(*Stream:class_ctors*) |
|
let create_$classname_from_ptr raw_ptr = |
|
C_obj |
|
begin |
|
let h = Hashtbl.create 20 in |
|
List.iter (fun (nm,fn) -> Hashtbl.replace h nm fn) |
|
[ "nop", (fun args -> C_void) ; |
|
$classbody |
|
"&", (fun args -> raw_ptr) ; |
|
":parents", |
|
(fun args -> |
|
C_list |
|
(let out = ref [] in |
|
Hashtbl.iter (fun x y -> out := (x,y) :: !out) h ; |
|
(List.map |
|
(fun (x,y) -> |
|
C_string (String.sub x 2 ((String.length x) - 2))) |
|
(List.filter |
|
(fun (x,y) -> |
|
((String.length x) > 2) |
|
&& x.[0] == ':' && x.[1] == ':') !out)))) ; |
|
":classof", (fun args -> C_string "$realname") ; |
|
":methods", (fun args -> |
|
C_list (let out = ref [] in |
|
Hashtbl.iter (fun x y -> out := (C_string x) :: !out) h ; !out)) |
|
] ; |
|
let rec invoke_inner raw_ptr mth arg = |
|
begin |
|
try |
|
let application = Hashtbl.find h mth in |
|
application |
|
(match arg with |
|
C_list l -> (C_list (raw_ptr :: l)) |
|
| C_void -> (C_list [ raw_ptr ]) |
|
| v -> (C_list [ raw_ptr ; v ])) |
|
with Not_found -> |
|
(* Try parent classes *) |
|
begin |
|
let parent_classes = [ |
|
$baselist |
|
] in |
|
let rec try_parent plist raw_ptr = |
|
match plist with |
|
p :: tl -> |
|
begin |
|
try |
|
(invoke (p raw_ptr)) mth arg |
|
with (BadMethodName (p,m,s)) -> |
|
try_parent tl raw_ptr |
|
end |
|
| [] -> |
|
raise (BadMethodName (raw_ptr,mth,"$realname")) |
|
in try_parent parent_classes raw_ptr |
|
end |
|
end in |
|
(fun mth arg -> invoke_inner raw_ptr mth arg) |
|
end |
|
|
|
let _ = Callback.register |
|
"create_$normalized_from_ptr" |
|
create_$classname_from_ptr |
|
|
|
|
|
(*Stream:mli*) |
|
val create_$classname_from_ptr : c_obj -> c_obj |
|
|
|
|