Commits

camlspotter committed 107228f

need topo sort

Comments (0)

Files changed (2)

 autoapioo2.ml: api.auto.mli oowrap/oowrap.cmo
     camlp4o ./oowrap/oowrap.cmo api.auto.mli -printer Camlp4OCamlPrinter > $@
 
+.DEFAULT: autoapioo2.cmo
+
 auto_stubs.o: auto_stubs.c auto.h api_ml.h autoclasses.h
 
 clean:
     let wrap_out ty =
       match ty with
       | <:ctyp@tyloc< Type.$lid:clsname$ Type.t >> ->
-          (fun e -> <:expr< new $lid: class_name clsname$ $e$ >>), 
+          (fun e -> <:expr< ! $lid: "new_" ^ class_name clsname$ $e$ >>), 
           <:ctyp@tyloc< $id: m_class_ident clsname$ >>
       | <:ctyp@tyloc< Type.$lid:clsname$ Type.t option >> ->
-          (fun e -> <:expr< option_bind $e$ (new $lid: class_name clsname$) >>), 
+          (fun e -> <:expr< option_bind $e$ (! $lid: "new_" ^ class_name clsname$) >>), 
           <:ctyp@tyloc< $id: m_class_ident clsname $ option >>
       | _ -> (fun e -> e), ty
     ;;
               | <:ctyp<  $arg$ -> $typ'$  >> ->
                   begin match class_type arg with
                   | Some (`Bigger, tyname') when tyname' = tyname -> 
-                      let polytype, exp = A.wrap_oo <:expr< $lid:name$ t >> typ' in
+                      let polytype, exp = A.wrap_oo <:expr< Py.$uid:modname$.$lid:name$ t >> typ' in
                       st, <:class_str_item< method $name$ : $polytype$ = $exp$ >> :: methods
                   | _ -> 
-                      let polytype, exp = A.wrap_oo <:expr< $lid:name$ >> typ in
+                      let polytype, exp = A.wrap_oo <:expr< Py.$uid:modname$.$lid:name$ >> typ in
                       <:str_item<  let $lid:name$ : $polytype$ = $exp$ ;; $st$ >>, methods
                   end
               | _ -> st, methods
           in
           begin 
             let init = 
-              let _inherits = try Hashtbl.find class_dep_graph tyname with _ -> [] in
+              let inherits = try Hashtbl.find class_dep_graph tyname with _ -> [] in
               List.fold_left (fun st x ->
                 let ox = "o" ^ x in
-                CrSem(_loc, <:class_str_item< inherit $lid:ox$ >>, st))
-                <:class_str_item< method $tyname$ = (t :> $lid:tyname$ t) >> []
+                CrSem(_loc, <:class_str_item< inherit $lid:ox$ t >>, st))
+                <:class_str_item< method $tyname$ = (t :> $lid:tyname$ t) >> inherits
             in
 
             let method_sigs = List.map (function
             in
 
             let methods = List.fold_left (fun st x -> CrSem(_loc, st, x)) init methods in
-            let sitem = <:str_item< class $lid:clsname$ t = object $methods$ end >> in
+            let sitem = <:str_item< class $lid:clsname$ t : M.$lid:clsname$ = object $methods$ end >> in
 
             let cltype = CtEq(_loc, 
                               CtCon(_loc, ViNil, <:ident< $lid:clsname$ >>, <:ctyp<>>),
   let build class_dep_graph modules =
     let clses, st = build class_dep_graph modules in
 
-    ignore st;
+    let news =
+      List.fold_left (fun st (tyname, _, _) ->
+        <:str_item< $st$ 
+                    let $lid: "new_o" ^ tyname$ = ref (fun _ -> assert false) >>) <:str_item<>> clses
+    in
 
     (* create structure of classes in the order of dependency *)
 
       | Not_found -> <:str_item< module rec M : sig end = M >>
     in
 
-    let sitem = ref <:str_item< open Type;; $mutual_class_types$ >> in
+    let sitem = ref <:str_item<>> in
 
-(*
-    let print_class tyname = 
+    let print_class tyname =  (* CR jfuruse: we must recursively check the parents! *)
       try
         let (i, _) = Hashtbl.find tbl tyname in
         sitem := <:str_item< $!sitem$ $i$ >>;
       List.iter print_class parents;
       print_class tyname) clses;
 
-    <:str_item< $!sitem$ $st$ >>
-*)
-    !sitem
+    <:str_item< 
+      open Type;;
+      module Py = Api.Py;;
+      $mutual_class_types$
+      $news$ 
+      $!sitem$ 
+      $st$ 
+    >>
 
   let wrap_sig_item sig_item = 
     let class_dep_graph = get_class_dep_graph sig_item in