camlspotter avatar camlspotter committed caf2fd6

module rec hack

Comments (0)

Files changed (11)

 autoapioo.ml: autoapi.ml pa/pa_opycaml.cmo
     camlp4o ./pa/pa_opycaml.cmo -impl autoapi.ml -printer Camlp4OCamlPrinter > $@
 
+api.auto.mli: api.cmi api.ml
+
 autoapioo2.ml: api.auto.mli oowrap/oowrap.cmo
     camlp4o ./oowrap/oowrap.cmo api.auto.mli -printer Camlp4OCamlPrinter > $@
 
     end = struct
       let from_list lst =
 	let tpl = new_ (OCaml.List.length lst) in
-	Utils.List.iteri (setItem tpl) lst;
+	Utils.List.iteri (setItemPos tpl) lst;
 	tpl
   
       let to_list a =
 	let len = _GET_SIZE a in
 	let rec f st = function
           | -1 -> st
-          | n -> f (getItem a n :: st) (n-1)
+          | n -> f (getItemPos a n :: st) (n-1)
 	in
 	f [](len-1)
     end
 [new] PyByteArrayObject* PyByteArray_FromStringAndSize([string] const char *string, Py_ssize_t len);
 //    Create a new bytearray object from string and its length, len. On failure, NULL is returned.
 
-[new] PyByteArrayObject* PyByteArray_Concat(PyByteArrayObject *a, PyByteArrayObject *b);
+[new] PyByteArrayObject* PyByteArray_Concat(PyByteArrayObject *a, PyByteArrayObject *b); [mlname concatByteArray]
 //    Concat bytearrays a and b and return a new bytearray with the result.
 
 size_or_fail PyByteArray_Size(PyByteArrayObject *bytearray);
 unit_or_fail PyDict_DelItem(PyDictObject *p, PyObject *key);
 // Remove the entry in dictionary p with key key. key must be hashable; if it isn’t, TypeError is raised. Return 0 on success or -1 on failure.
 
-int PyDict_DelItemString(PyDictObject *p, [string] char *key);
+unit_or_fail PyDict_DelItemString(PyDictObject *p, [string] char *key);
 // Remove the entry in dictionary p which has a key specified by the string key. Return 0 on success or -1 on failure.
 
 PyObject* PyDict_GetItem(PyDictObject *p, PyObject *key);
 // Return value: Borrowed reference.
 // This is the same as PyDict_GetItem(), but key is specified as a char*, rather than a PyObject*.
 
-[new] PyObject* PyDict_Items(PyDictObject *p);
+[new] PyListObject* PyDict_Items(PyDictObject *p);
 // Return value: New reference.
 // Return a PyListObject containing all the items from the dictionary, as in the dictionary method dict.items().
 
-[new] PyObject* PyDict_Keys(PyDictObject *p);
+[new] PyListObject* PyDict_Keys(PyDictObject *p);
 // Return value: New reference.
 // Return a PyListObject containing all the keys from the dictionary, as in the dictionary method dict.keys().
 
-[new] PyObject* PyDict_Values(PyDictObject *p);
+[new] PyListObject* PyDict_Values(PyDictObject *p);
 // Return value: New reference.
 // Return a PyListObject containing all the values from the dictionary p, as in the dictionary method dict.values().
 
     s/\[stolen\]\s*([A-Za-z0-9_]+)/$1_incr/g;
     s/\[internal\]//g;
     s/\[wrap\] ([A-Za-z0-9_]+)/$1_wrap/g; # in ML side, _wrap must be removed (module.pl)
+    s/\[mlname[^\]]*\]//g;
     if( /^[^\/]/ ){
         s/value/value_/g;
     }
 		if( /\[internal\]/ ){
 		    $internal{$func_name} = 1;
 		}
+		if( /\[mlname ([^\]]+)\]/ ){
+		    $mlname{$func_name} = $1;
+		}
 		while(<IN>){
 		    if( /^\/\/\s*/ ){
 			$_ = $';
       	        $f = lcfirst($f);
             }
     	    $f =~ s/^(type|and|or|new)$/$1_/;
+	    if( $mlname{$fname} ){ $f = $mlname{$fname}; }
             if( $internal ){ $f = "_internal_$f"; }
             $f =~ s/_wrap$//; # [wrap] cleanup
 
 PyIntObject* PyNumber_ToBase(PyNumberObject *n, int base);
 // Returns the integer n converted to base as a string with a base marker of '0b', '0o', or '0x' if applicable. When base is not 2, 8, 10, or 16, the format is 'x#num' where x is the base. If n is not an int object, it is converted with PyNumber_Index() first.
 
-size_or_fail PyNumber_AsSsize_t(PyNumberObject *o, PyObject *exc);
+size_or_fail PyNumber_AsSsize_t(PyNumberObject *o, PyObject *exc); [mlname asSsize_t_exn]
 // Returns o converted to a Py_ssize_t value if o can be interpreted as an integer. If o can be converted to a Python int or long but the attempt to convert to a Py_ssize_t value would raise an OverflowError, then the exc argument is the type of exception that will be raised (usually IndexError or OverflowError). If exc is NULL, then the exception is cleared and the value is clipped to PY_SSIZE_T_MIN for a negative integer or PY_SSIZE_T_MAX for a positive integer.
 
 boolean PyIndex_Check(PyObject *o); // or bool_or_fail ?
     ) ancestors;
     tbl
 
-  let rec extract_vals sig_item = 
+  let check_rev_path classes rev_path = 
+    let path = List.rev rev_path in
+    match path with
+    | [ "Py"; s ] when List.mem ("_" ^ s) classes -> true ,s
+    | _ -> false, "NOPE!"
+
+  let rec extract_vals classes sig_item = 
     let vals = ref [] in
     let rec visit rev_path sig_item = 
+      let register, mname = check_rev_path classes rev_path in
       iter_sig_item sig_item ~f:(function
-        | <:sig_item< external $name$ : $typ$ = $_$ >> -> 
-            Format.eprintf "%s : val %s (external)@." (String.concat "." (List.rev rev_path)) name;
-            vals := (rev_path, name, typ) :: !vals 
-        | <:sig_item< val $name$ : $typ$ >> -> 
+        | <:sig_item< external $name$ : $typ$ = $_$ >> when register -> 
+            Format.eprintf "%s : val %s (external)@." mname name;
+            vals := (mname, name, typ) :: !vals 
+        | <:sig_item< val $name$ : $typ$ >> when register -> 
             Format.eprintf "%s : val %s@." (String.concat "." (List.rev rev_path)) name;
-            vals := (rev_path, name, typ) :: !vals 
+            vals := (mname, name, typ) :: !vals 
         | <:sig_item< module $name$ : $ MtSig(_, sig_item) $ >> ->
-            visit (name :: rev_path) sig_item
+            let rev_path = name :: rev_path in
+            visit rev_path sig_item
         | _ -> ())
     in
     visit [] sig_item;
     
     let modules = Hashtbl.create 107 in
+    List.iter (fun cls -> 
+      let cls = String.sub cls 1 (String.length cls - 1) in (* remove the prefix '_' *)
+      Hashtbl.replace modules cls []) classes;
     let hashtbl_add_in_list tbl k v =
       let vs = try Hashtbl.find tbl k with Not_found -> [] in
       Hashtbl.replace tbl k (v::vs)
     in
-    List.iter (fun (rev_path, name, typ) -> 
-      hashtbl_add_in_list modules rev_path (name, typ)) !vals;
+    List.iter (fun (mname, name, typ) -> 
+      hashtbl_add_in_list modules mname (name, typ)) !vals;
     modules
 
   module A = struct (* Dirty part *)
 
     let class_name s = "o" ^ s
+    let m_class_ident s : ident = <:ident< M. $lid: "o" ^ s $ >>
 
     let mk_id pos = Printf.sprintf "v%d" pos
 
       match ty with
       | <:ctyp@tyloc< Type.$lid:clsname$ Type.t >> ->
           (fun e -> <:expr< new $lid: class_name clsname$ $e$ >>), 
-          <:ctyp@tyloc< $lid: class_name clsname$ >>
+          <: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$) >>), 
-          <:ctyp@tyloc< $lid: class_name clsname$ option >>
+          <:ctyp@tyloc< $id: m_class_ident clsname $ option >>
       | _ -> (fun e -> e), ty
     ;;
 
   (*  open A *)
 
   let build class_dep_graph modules =
-    Hashtbl.fold (fun revpath name_typ_list (clses, st) ->
-      match List.rev revpath with
-      | [ "Py"; modname ] ->
+    Hashtbl.fold (fun modname name_typ_list (clses, st) ->
           let tyname = "_" ^ modname in
           let clsname = "o" ^ tyname in
           let sitems, methods = 
                 CrSem(_loc, <:class_str_item< inherit $lid:ox$ >>, st))
                 <:class_str_item< method $tyname$ = (t :> $lid:tyname$ t) >> []
             in
+
+            let method_sigs = List.map (function
+              | <:class_str_item< method $name$ : $polytype$ = $_$ >> ->
+                  <:class_sig_item< method $name$ : $polytype$ >>
+              | _ -> assert false) methods
+            in
+            let method_sigs = 
+              let init = 
+                let inherits = try Hashtbl.find class_dep_graph tyname with _ -> [] in
+                List.fold_left (fun st x ->
+                  let ox = "o" ^ x in
+                  CgSem(_loc, <:class_sig_item< inherit M.$lid:ox$ >>, st))
+                  <:class_sig_item< method $tyname$ : $lid:tyname$ t >> inherits
+              in
+              List.fold_left (fun st x -> CgSem(_loc, st, x)) init method_sigs 
+            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
-            (tyname, sitem) :: clses
+
+            let cltype = CtEq(_loc, 
+                              CtCon(_loc, ViNil, <:ident< $lid:clsname$ >>, <:ctyp<>>),
+                              <:class_type< object $method_sigs$ end >>) in
+            (tyname, sitem, cltype) :: clses
           end,
-          <:str_item< $st$ module $modname$ = struct $sitems$ end >>
-
-      | _ -> clses, st) modules ([], <:str_item<>>)
+          <:str_item< $st$ module $modname$ = struct $sitems$ end >> ) modules ([], <:str_item<>>)
 
   let build class_dep_graph modules =
     let clses, st = build class_dep_graph modules in
 
+    ignore st;
+
     (* create structure of classes in the order of dependency *)
 
     let tbl = Hashtbl.create 107 in
-    List.iter (fun (tyname, sitem) -> Hashtbl.add tbl tyname sitem) clses;
+    List.iter (fun (tyname, sitem, cltype) -> Hashtbl.add tbl tyname (sitem, cltype)) clses;
 
-    let sitem = ref <:str_item< >> in
+    let mutual_class_types =
+      let rec concat = function
+        | [] -> raise Not_found
+        | [x] -> x
+        | x::xs -> CtAnd(_loc, x, concat xs)
+      in
+      let cltype = concat (List.map (fun (_,_,cltype) -> cltype) clses) in
+      try
+        <:str_item< module rec M : sig class type $cltype$ end = M >>
+      with
+      | Not_found -> <:str_item< module rec M : sig end = M >>
+    in
 
+    let sitem = ref <:str_item< open Type;; $mutual_class_types$ >> in
+
+(*
     let print_class tyname = 
       try
-        let i = Hashtbl.find tbl tyname in
+        let (i, _) = Hashtbl.find tbl tyname in
         sitem := <:str_item< $!sitem$ $i$ >>;
         Hashtbl.remove tbl tyname (* done *)
       with
       | Not_found -> () (* already done *)
     in
     
-    List.iter (fun (tyname, _sitem) ->
+    List.iter (fun (tyname, _sitem, _clsty) ->
       let parents = try Hashtbl.find class_dep_graph tyname with _ -> [] in
       List.iter print_class parents;
       print_class tyname) clses;
 
     <:str_item< $!sitem$ $st$ >>
-      
+*)
+    !sitem
+
   let wrap_sig_item sig_item = 
     let class_dep_graph = get_class_dep_graph sig_item in
-    let modules = extract_vals sig_item in
+    let classes = Hashtbl.fold (fun k _ st -> k::st) class_dep_graph [] in
+    let modules = extract_vals classes sig_item in
     build class_dep_graph modules
 
   let wrap = object
-camlp4o oowrap.cmo ../api.auto.mli
+camlp4o oowrap.cmo -printer Camlp4OCamlPrinter ../api.auto.mli
 // Return value: New reference.
 // Return the result of repeating sequence object o count times, or NULL on failure. The operation is done in-place when o supports it. This is the equivalent of the Python expression o *= count.
 
-[new] PyObject* PySequence_GetItem(PySequenceObject *o, Py_ssize_t i);
+[new] PyObject* PySequence_GetItem(PySequenceObject *o, Py_ssize_t i); [mlname getItemPos]
 // Return value: New reference.
 // Return the ith element of o, or NULL on failure. This is the equivalent of the Python expression o[i].
 
 // Return value: New reference.
 // Return the slice of sequence object o between i1 and i2, or NULL on failure. This is the equivalent of the Python expression o[i1:i2].
 
-unit_or_fail PySequence_SetItem(PySequenceObject *o, Py_ssize_t i, [stolen] PyObject *v);
+unit_or_fail PySequence_SetItem(PySequenceObject *o, Py_ssize_t i, [stolen] PyObject *v); [mlname setItemPos]
 // Assign object v to the ith element of o. Returns -1 on failure. This is the equivalent of the Python statement o[i] = v. This function does not steal a reference to v.
 
-unit_or_fail PySequence_DelItem(PySequenceObject *o, Py_ssize_t i);
+unit_or_fail PySequence_DelItem(PySequenceObject *o, Py_ssize_t i); [mlname delItemPos]
 // Delete the ith element of object o. Returns -1 on failure. This is the equivalent of the Python statement del o[i].
 
 unit_or_fail PySequence_SetSlice(PySequenceObject *o, Py_ssize_t i1, Py_ssize_t i2, PySequenceObject *v);
 size_or_fail PyTuple_GET_SIZE(PyTupleObject *p);
 // Return the size of the tuple p, which must be non-NULL and point to a tuple; no error checking is performed.
 
-PyObject* PyTuple_GetItem(PyTupleObject *p, Py_ssize_t pos);
+PyObject* PyTuple_GetItem(PyTupleObject *p, Py_ssize_t pos); [mlname getItemPos]
 // Return value: Borrowed reference.
 // Return the object at position pos in the tuple pointed to by p. If pos is out of bounds, return NULL and sets an IndexError exception.
 
 // Return value: New reference.
 // Take a slice of the tuple pointed to by p from low to high and return it as a new tuple.
 
-unit_or_fail PyTuple_SetItem(PyTupleObject *p, Py_ssize_t pos, [stolen] PyObject *o);
+unit_or_fail PyTuple_SetItem(PyTupleObject *p, Py_ssize_t pos, [stolen] PyObject *o); [mlname setItemPos]
 // Insert a reference to object o at position pos of the tuple pointed to by p. Return 0 on success.
 // 
 // Note This function “steals” a reference to o.
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.