Commits

camlspotter committed 22e3117

subtyping!

  • Participants
  • Parent commits 4c9aa90

Comments (0)

Files changed (13)

 .*~$
 \.(sp[io]t|annot|o|cm[a-z]+|orig|omc|lock|so|a|exe|byt|opt|run)$
 \.omakedb$
-^auto\.(idl|ml|mli)
-^.*\.idl
-^auto_stubs\.c
-autoapi\.ml
+^auto\.(idl|ml|mli)$
+^.*\.idl$
+^auto_stubs\.c$
+autoapi\.ml$
+automacro\.h$
 %.idl: %.idl.in idlconvert.pl
     ./idlconvert.pl $< > $@
 
-auto.ml auto.mli auto_stubs.c: $(addsuffix .idl, $(IDLS)) $(Installed camlidl)
+automacro.h: automacro.h.in automacro.pl # *.idl.in
+    ./automacro.pl *.idl.in > $@
+
+auto.ml auto.mli auto_stubs.c: $(addsuffix .idl, $(IDLS)) $(Installed camlidl) automacro.h
 	camlidl auto.idl
 
 autoapi.ml : auto.ml automodular.pl
     ./automodular.pl *.idl.in > $@
 
-auto_stubs.o: auto_stubs.c auto.h api_ml.h
+auto_stubs.o: auto_stubs.c auto.h api_ml.h automacro.h
 
 clean:
   rm -f $(filter-proper-targets $(ls R, .))
 module Base : sig
   include module type of Base
 
-  external none : unit -> t = "opycaml_none"
+  external none : unit -> _Object t = "opycaml_none"
     (** Get Py_None object. *)
 
-  external phys_eq : t -> t -> bool = "opycaml_physical_equal"
+  external phys_eq : [>_Object] t -> [>_Object] t -> bool = "opycaml_physical_equal"
     (** Checks physical equality of objects *)
 
   (* reference count functions: use with care *)
-  external refcnt : t -> int = "opycaml_refcnt"
-  external incref : t -> unit = "opycaml_incref"
-  external decref : t -> unit = "opycaml_decref"
+  external refcnt : [>_Object] t -> int = "opycaml_refcnt"
+  external incref : [>_Object] t -> unit = "opycaml_incref"
+  external decref : [>_Object] t -> unit = "opycaml_decref"
 
   (* get address of objects for debugging *)
-  external address : t -> nativeint = "opycaml_address"
+  external address : [>_Object] t -> nativeint = "opycaml_address"
 
   val initialize : unit -> unit
     (** Python api initialization with OCaml exception registeration.
 	Any other function in OPyCaml must be called after [initialize ()].
     *)
 
-  val debug : string -> t -> unit
+  val debug : string -> [>_Object] t -> unit
     (** debug print of objects *) 
 
   val main : string list -> int
 end = struct
   include Base
 
-  external none : unit -> t = "opycaml_none"
-  external phys_eq : t -> t -> bool = "opycaml_physical_equal"
-  external refcnt : t -> int = "opycaml_refcnt"
-  external incref : t -> unit = "opycaml_incref"
-  external decref : t -> unit = "opycaml_decref"
-  external address : t -> nativeint = "opycaml_address"
+  external none : unit -> _Object t = "opycaml_none"
+  external phys_eq : [>_Object] t -> [>_Object] t -> bool = "opycaml_physical_equal"
+  external refcnt : [>_Object] t -> int = "opycaml_refcnt"
+  external incref : [>_Object] t -> unit = "opycaml_incref"
+  external decref : [>_Object] t -> unit = "opycaml_decref"
+  external address : [>_Object] t -> nativeint = "opycaml_address"
 
   external internal_init : unit -> unit = "opycaml_init"
   let initialize () =
 	Err.Occured() must be return Some. Otherwise Failwith is
     raised instead. *)
 
-  val normalizeException : unit -> (t * t * t) option
+  val normalizeException : unit -> (_Object t * _Object t * _Object t) option
 end = struct
   include Err
     
 module Int : sig
   include module type of Int
 
-  val asLong : t -> int
+  val asLong : [>_Object] t -> int
     (** raises Error at overflow *)
 end = struct
   include Int
-type t
+type _Object = [`_Object]
+type _String = [_Object | `_String]
+type _Tuple = [_Object | `_Tuple]
+type _ByteArray = [_Object | `_ByteArray]
+type _Number = [_Object | `_Number]
+type _Type = [_Object | `_Type]
+type _Mapping = [_Object | `_Mapping]
+type _Dict = [_Object | `_Dict]
+type _Module = [_Object | `_Module]
+type _Index = [_Object | `_Index]
+type _Iter = [_Object | `_Iter]
+type _Int = [_Number | `_Int]
+type _Callable = [_Object | `_Callable]
+type _Sequence = [_Object | `_Sequence]
+
+type 'a t
 type unit_or_fail = unit
 type bool_or_fail = bool
 type size_or_fail = int
 type py_ssize_t = int
 type size_t = int
 
-exception Error of t (* type *) * t (* detail value *)
+exception Error of _Object t (* type *) * _Object t (* detail value *)
 
+exception Coercion
 
+(** change the type of the object. Unsafe. *)
+let unsafe_coerce : [>_Object] t -> 'a t = fun t -> Obj.magic t
 #include "api_ml.h"
-typedef PyObject * PyObject_p;
-typedef PyObject * PyObject_p_noincr;
-typedef PyObject * PyObject_p_incr;
-typedef PyObject * PyObject_p_option;
-typedef PyTypeObject * PyTypeObject_p;
-#define PyObject_ml2c(value,c) (*c = PyObject_val(value))
-#define PyObject_c2ml(c) (Val_PyObject_exc_at_null(*c))
-#define PyObject_noincr_c2ml(c) (Val_PyObject_noincr_exc_at_null(*c))
-#define PyObject_incr_ml2c(value,c) (*c = PyObject_val(value), Py_INCREF(*c))
-#define PyObject_option_ml2c(value,c) (*c = PyObject_opt_val(value))
-#define PyObject_option_c2ml(c) (Val_PyObject_opt(*c, 0))
+
+#include "automacro.h"
+
 #define unit_or_fail_c2ml(p) (Plus_or_fail(*p))
 #define bool_or_fail_c2ml(p) (Plus_or_fail(*p))
 #define size_or_fail_c2ml(p) (Plus_or_fail(*p))
-typedef [abstract,ml2c(PyObject_ml2c),c2ml(PyObject_c2ml)] void * PyObject_p;
-typedef [abstract,c2ml(PyObject_noincr_c2ml)] void * PyObject_p_noincr;
-typedef [abstract,ml2c(PyObject_incr_ml2c)] void * PyObject_p_incr;
-typedef [abstract,ml2c(PyObject_option_ml2c),c2ml(PyObject_option_c2ml)] void * PyObject_p_option;
+#define Py(name) \
+  typedef [abstract,ml2c(Py##name##_ml2c),c2ml(Py##name##_c2ml)] void * Py##name##_p; \
+  typedef [abstract,c2ml(Py##name##_noincr_c2ml)] void * Py##name##_p_noincr; \
+  typedef [abstract,ml2c(Py##name##_incr_ml2c)] void * Py##name##_p_incr; \
+  typedef [abstract,ml2c(Py##name##_option_ml2c),c2ml(Py##name##_option_c2ml)] void * Py##name##_p_option;
+
+Py(Object)
+Py(String)
+
 // typedef [abstract,ml2c(PyTypeObject_ml2c),c2ml(PyTypeObject_c2ml)] void * PyTypeObject_p;
 typedef [abstract,c2ml(unit_or_fail_c2ml)] int unit_or_fail;
 typedef [abstract,c2ml(bool_or_fail_c2ml)] int bool_or_fail;

File automacro.h.in

+typedef PyObject * Py##name##_p;
+typedef PyObject * Py##name##_p_noincr;
+typedef PyObject * Py##name##_p_incr;
+typedef PyObject * Py##name##_p_option;
+#define Py##name##_ml2c(value,c) (*c = PyObject_val(value))
+#define Py##name##_c2ml(c) (Val_PyObject_exc_at_null(*c))
+#define Py##name##_noincr_c2ml(c) (Val_PyObject_noincr_exc_at_null(*c))
+#define Py##name##_incr_ml2c(value,c) (*c = PyObject_val(value), Py_INCREF(*c))
+#define Py##name##_option_ml2c(value,c) (*c = PyObject_opt_val(value))
+#define Py##name##_option_c2ml(c) (Val_PyObject_opt(*c, 0))

File automacro.pl

+#!/usr/bin/perl
+
+open(IN, "automacro.h.in");
+while(<IN>){
+    $str = "$str$_";
+}
+
+while(<>){
+    if( /Py([A-Z][A-Za-z]+)\s*\*/ ){
+	$cls = $1;
+	if( !$done{$cls} ){
+	    $done{$cls} = 1;
+	    $mystr = $str;
+	    $mystr =~ s/##name##/$cls/g;
+	    print $mystr;
+	}
+    }
+}

File automodular.pl

             if( $internal ){ $f = "_internal_$f"; }
     
             # rem includes type 
-            $rem =~ s/pyObject_p_option/t option/g;
-            $rem =~ s/pyObject_p_noincr/t/g;
-            $rem =~ s/pyObject_p_incr/t/g;
-            $rem =~ s/pyObject_p/t/g;
+            $rem =~ s/py([A-z]+)_p_option/py$1 option/g;
+            $rem =~ s/py([A-z]+)_p_noincr/py$1/g;
+            $rem =~ s/py([A-z]+)_p_incr/py$1/g;
+            $rem =~ s/py([A-z]+)_p/py$1/g;
     
+	    # introduce polymorphism (pretty dirty)
+	    # pyAbcd ... -> ==> [>_Abcd] t ... ->
+	    while( $rem =~ s/py([A-Z][A-z]+)(.*->)/[>_$1] t$2/g ){
+	    }
+	    # return types have no polymorphism
+	    $rem =~ s/py([A-Z][A-z]+)/_$1 t/g;
+
     	    if ( $k eq "" ){ $k = "Base"; }
             if( $comment ne "" ){
     	        $mod{$k} = "$mod{$k}  external $f $rem$def  (** $comment **)\n\n";
     for $k (keys %mod){
         print "module $k = struct\n";
         print $mod{$k};
+	if( $mod{$k} =~ /external check +: \[>_Object\] t -> bool/ ){
+	    print 
+"  (** coercion to [_$k t]. Raises Coercion when impossible *)
+  let coerce : [>_Object] t -> _$k t = fun t ->
+    if check t then unsafe_coerce t else raise Coercion
+  ;;
+
+  (** coercion to [_$k t]. Return None when impossible *)
+  let coerce_opt : [>_Object] t -> _$k t option = fun t ->
+    if check t then Some (unsafe_coerce t) else None
+  ;;
+";
+	}
         print "end\n\n";
     }
 }

File idlconvert.pl

 #!/usr/bin/perl
 while(<>){
-    s/Py([A-Za-z]*)Object[ ]*\*/Py$1Object_p /g;
+    s/Py([A-Za-z]*)[ ]*\*/Py$1_p /g;
     s/\[option\]\s*([A-Za-z0-9_]+)/$1_option/g;
     s/\[new\]\s*([A-Za-z0-9_]+)/$1_noincr/g;
     s/\[stolen\]\s*([A-Za-z0-9_]+)/$1_incr/g;

File object.idl.in

 // int PyObject_Compare(PyObject *o1, PyObject *o2);
 // Compare the values of o1 and o2 using a routine provided by o1, if one exists, otherwise with a routine provided by o2. Returns the result of the comparison on success. On error, the value returned is undefined; use PyErr_Occurred() to detect an error. This is equivalent to the Python expression cmp(o1, o2).
 
-[new] PyObject* PyObject_Repr(PyObject *o);
+[new] PyString* PyObject_Repr(PyObject *o);
 // Return value: New reference.
 // Compute a string representation of object o. Returns the string representation on success, NULL on failure. This is the equivalent of the Python expression repr(o). Called by the repr() built-in function and by reverse quotes.
 
-[new] PyObject* PyObject_Str(PyObject *o);
+[new] PyString* PyObject_Str(PyObject *o);
 // Return value: New reference.
-// aCompute a string representation of object o. Returns the string representation on success, NULL on failure. This is the equivalent of the Python expression str(o). Called by the str() built-in function and by the print statement.
+// Compute a string representation of object o. Returns the string representation on success, NULL on failure. This is the equivalent of the Python expression str(o). Called by the str() built-in function and by the print statement.
 
-[new] PyObject* PyObject_Bytes(PyObject *o);
+[new] PyString* PyObject_Bytes(PyObject *o);
 // Compute a bytes representation of object o. In 2.x, this is just a alias for PyObject_Str().
 
-[new] PyObject* PyObject_Unicode(PyObject *o);
+[new] PyString* PyObject_Unicode(PyObject *o);
 // Return value: New reference.
 // Compute a Unicode string representation of object o. Returns the Unicode string representation on success, NULL on failure. This is the equivalent of the Python expression unicode(o). Called by the unicode() built-in function.
 

File string.idl.in

 boolean /* or fail? */ PyString_CheckExact(PyObject *o);
 // Return true if the object o is a string object, but not an instance of a subtype of the string type.
 
-[new] PyObject* PyString_FromString([string] const char *v);
+[new] PyString* PyString_FromString([string] const char *v);
 // Return value: New reference.
 // Return a new string object with a copy of the string v as value on success, and NULL on failure. The parameter v must not be NULL; it will not be checked.
 
-[new] PyObject* PyString_FromStringAndSize([string] const char *v, Py_ssize_t len);
+[new] PyString* PyString_FromStringAndSize([string] const char *v, Py_ssize_t len);
 // Return value: New reference.
 // Return a new string object with a copy of the string v as value and length len on success, and NULL on failure. If v is NULL, the contents of the string are uninitialized.
 
-// PyObject* PyString_FromFormat(const char *format, ...);
+// PyString* PyString_FromFormat(const char *format, ...);
 // Return value: New reference.
 // Take a C printf()-style format string and a variable number of arguments, calculate the size of the resulting Python string and return a string with the values formatted into it. The variable arguments must be C types and must correspond exactly to the format characters in the format string. The following format characters are allowed:
 //
 // Note The “%lld” and “%llu” format specifiers are only available when HAVE_LONG_LONG is defined.
 // Changed in version 2.7: Support for “%lld” and “%llu” added.
 
-// PyObject* PyString_FromFormatV(const char *format, va_list vargs);
+// PyString* PyString_FromFormatV(const char *format, va_list vargs);
 // Return value: New reference.
 // Identical to PyString_FromFormat() except that it takes exactly two arguments.
 
-size_or_fail PyString_Size(PyObject *string);
+size_or_fail PyString_Size(PyString *string);
 // Return the length of the string in string object string.
 
-size_or_fail PyString_GET_SIZE(PyObject *string);
+size_or_fail PyString_GET_SIZE(PyString *string);
 // Macro form of PyString_Size() but without error checking.
 
-[string] char* PyString_AsString(PyObject *string);
+[string] char* PyString_AsString(PyString *string);
 // Return a NUL-terminated representation of the contents of string. The pointer refers to the internal buffer of string, not a copy. The data must not be modified in any way, unless the string was just created using PyString_FromStringAndSize(NULL, size). It must not be deallocated. If string is a Unicode object, this function computes the default encoding of string and operates on that. If string is not a string object at all, PyString_AsString() returns NULL and raises TypeError.
 
-[string] char* PyString_AS_STRING(PyObject *string);
+[string] char* PyString_AS_STRING(PyString *string);
 // Macro form of PyString_AsString() but without error checking. Only string objects are supported; no Unicode objects should be passed.
 
-size_or_fail /* int */ PyString_AsStringAndSize(PyObject *obj, char **buffer, Py_ssize_t *length);
+size_or_fail /* int */ PyString_AsStringAndSize(PyString *obj, char **buffer, Py_ssize_t *length);
 // Return a NUL-terminated representation of the contents of the object obj through the output variables buffer and length.
 // The function accepts both string and Unicode objects as input. For Unicode objects it returns the default encoded version of the object. If length is NULL, the resulting buffer may not contain NUL characters; if it does, the function returns -1 and a TypeError is raised.
 // The buffer refers to an internal string buffer of obj, not a copy. The data must not be modified in any way, unless the string was just created using PyString_FromStringAndSize(NULL, size). It must not be deallocated. If string is a Unicode object, this function computes the default encoding of string and operates on that. If string is not a string object at all, PyString_AsStringAndSize() returns -1 and raises TypeError.
 
-// void PyString_Concat(PyObject **string, PyObject *newpart);
+// void PyString_Concat(PyString **string, PyString *newpart);
 // Create a new string object in *string containing the contents of newpart appended to string; the caller will own the new reference. The reference to the old value of string will be stolen. If the new string cannot be created, the old reference to string will still be discarded and the value of *string will be set to NULL; the appropriate exception will be set.
 
-// void PyString_ConcatAndDel(PyObject **string, PyObject *newpart);
+// void PyString_ConcatAndDel(PyString **string, PyString *newpart);
 // Create a new string object in *string containing the contents of newpart appended to string. This version decrements the reference count of newpart.
 
-// int _PyString_Resize(PyObject **string, Py_ssize_t newsize);
+// int _PyString_Resize(PyString **string, Py_ssize_t newsize);
 // A way to resize a string object even though it is “immutable”. Only use this to build up a brand new string object; don’t use this if the string may already be known in other parts of the code. It is an error to call this function if the refcount on the input string object is not one. Pass the address of an existing string object as an lvalue (it may be written into), and the new size desired. On success, *string holds the resized string object and 0 is returned; the address in *string may differ from its input value. If the reallocation fails, the original string object at *string is deallocated, *string is set to NULL, a memory exception is set, and -1 is returned.
 
-[new] PyObject* PyString_Format(PyObject *format, PyObject *args);
+[new] PyString* PyString_Format(PyString *format, PyObject *args);
 // Return value: New reference.
 // Return a new string object from format and args. Analogous to format % args. The args argument must be a tuple.
 
-// void PyString_InternInPlace(PyObject **string);
+// void PyString_InternInPlace(PyString **string);
 // Intern the argument *string in place. The argument must be the address of a pointer variable pointing to a Python string object. If there is an existing interned string that is the same as *string, it sets *string to it (decrementing the reference count of the old string object and incrementing the reference count of the interned string object), otherwise it leaves *string alone and interns it (incrementing its reference count). (Clarification: even though there is a lot of talk about reference counts, think of this function as reference-count-neutral; you own the object after the call if and only if you owned it before the call.)
 
-[new] PyObject* PyString_InternFromString([string] const char *v);
+[new] PyString* PyString_InternFromString([string] const char *v);
 // Return value: New reference.
 // A combination of PyString_FromString() and PyString_InternInPlace(), returning either a new string object that has been interned, or a new (“owned”) reference to an earlier interned string object with the same value.
 
-// PyObject* PyString_Decode(const char *s, Py_ssize_t size, const char *encoding, const char *errors)
+// PyString* PyString_Decode(const char *s, Py_ssize_t size, const char *encoding, const char *errors)
 // Return value: New reference.
 // Create an object by decoding size bytes of the encoded buffer s using the codec registered for encoding. encoding and errors have the same meaning as the parameters of the same name in the unicode() built-in function. The codec to be used is looked up using the Python codec registry. Return NULL if an exception was raised by the codec.
 
-// PyObject* PyString_AsDecodedObject(PyObject *str, const char *encoding, const char *errors);
+// PyString* PyString_AsDecodedObject(PyString *str, const char *encoding, const char *errors);
 // Return value: New reference.
 // Decode a string object by passing it to the codec registered for encoding and return the result as Python object. encoding and errors have the same meaning as the parameters of the same name in the string encode() method. The codec to be used is looked up using the Python codec registry. Return NULL if an exception was raised by the codec.
 
-// PyObject* PyString_Encode(const char *s, Py_ssize_t size, const char *encoding, const char *errors);
+// PyString* PyString_Encode(const char *s, Py_ssize_t size, const char *encoding, const char *errors);
 // Return value: New reference.
 // Encode the char buffer of the given size by passing it to the codec registered for encoding and return a Python object. encoding and errors have the same meaning as the parameters of the same name in the string encode() method. The codec to be used is looked up using the Python codec registry. Return NULL if an exception was raised by the codec.
 
-// PyObject* PyString_AsEncodedObject(PyObject *str, const char *encoding, const char *errors);
+// PyString* PyString_AsEncodedObject(PyString *str, const char *encoding, const char *errors);
 // Return value: New reference.
 // Encode a string object using the codec registered for encoding and return the result as Python object. encoding and errors have the same meaning as the parameters of the same name in the string encode() method. The codec to be used is looked up using the Python codec registry. Return NULL if an exception was raised by the codec.
 
     let res = Object.callObject capitalize (Some tpl) in
     Printf.eprintf "res : refcnt = %d\n%!" (Base.refcnt res);
     prerr_endline "function called!";
-    prerr_endline (String.asString res);
+    prerr_endline (String.asString (String.coerce res));
     prerr_endline (String.asString o);
 
     let minus_1 = Int.fromLong (-1) in