abc

1 files changed, 167 insertions, 0 deletions

diff --git a/modules/language/python/module/abc.scm b/modules/language/python/module/abc.scm
new file mode 100644
index 0000000..f0b8442
--- /dev/null
+++ b/modules/language/python/module/abc.scm
@@ -0,0 +1,167 @@
+(define-module (language python module abc)
+  #:use-module (language python module weakref)
+  #:use-module (oop pf-objects)
+  #:use-module (ice-9 control)
+  #:use-module (language python for)
+  #:use-module (language python try)
+  #:use-module (language python dict)
+  #:use-module (language python set)
+  #:use-module (language python string)
+  #:use-module (language python list)
+  #:use-module (language python def)
+  #:use-module (language python bool)
+  #:use-module (language python exceptions)
+  #:use-module (language python property)
+  #:use-module ((language python module python)
+		#:select (objectmethod classmethod staticmethod type
+				       isinstance super issubclass
+				       getattr sorted dir))
+  
+  #:export (get_cache_token ABC ABCMeta
+			    abstractmethod abstractclassmethod
+			    abstractstaticmethod abstractproperty
+			    get_cache_token))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define (abstractmethod f)
+  (set f '__isabstractmethod__ #t)
+  (objectmethod f))
+
+
+(define (abstractclassmethod f)
+  (set f '__isabstractmethod__ #t)
+  (classmethod f))
+
+(define (abstractstaticmethod f)
+  (set f '__isabstractmethod__ #t)
+  f)
+
+(define (abstractproperty f)
+  (let ((f (property f)))
+    (set f '__isabstractmethod__ #t)
+    f))
+  
+(define-python-class ABCMeta (type)
+  (define _abc_invalidation_counter 0)
+
+  (define __new__
+    (lam (mcls name bases namespace (** kwargs))
+	 (let ((cls (py-apply (ref (super *class* mcls) '__new__)
+			      mcls name bases namespace (** kwargs)))
+	       
+	       (abstracts
+		(py-set
+		 (append (list name)
+			 (for ((name value : (py-items namespace))) ((l '()))
+			      (if (ref value '__isabstractmethod__)
+				  (cons name l)
+				  l)
+			      #:final (reverse l))))))
+
+	   (for ((base : bases)) ()
+		(for ((name : (ref base '__abstractmethods__ (py-set '())))) ()
+		     (let ((value (getattr cls name None)))
+		       (if (ref value '__isabstractmethod__)
+			   ((ref abstracts 'add) name)))))
+
+	   (set cls '__abstractmethods__ (frozenset abstracts))
+	   (set cls '_abc_registry       (WeakSet))
+	   (set cls '_abc_cache          (WeakSet))
+	   (set cls '_abc_negative_cache (WeakSet))
+	   (set cls '_abc_negative_cache_version _abc_invalidation_counter)
+
+	   cls)))
+  
+  (define register
+    (lambda (cls subclass)
+      (if (not (isinstance subclass type))
+	  (raise TypeError "Can only register classes"))
+      
+      (if (issubclass subclass cls)
+	  subclass
+	  (if (issubclass cls subclass)
+	      (raise RuntimeError "Refusing to create an inheritance cycle")
+	      (begin
+		((ref (ref cls '_abc_registry) 'add) subclass)
+		(set ABCMeta '_abc_invalidation_counter
+		     (+ (ref ABCMeta '_abc_invalidation_counter) 1))
+		subclass)))))
+
+  (define _dump_registry
+    (lam (cls (= file None))
+      (define port (if (eq? file None) #t file))
+      (format port "Class: ~a.~a~%"
+	      (ref cls '__module__) (ref cls '__name__))
+      (format port "Inv.counter: ~a~%" (ref ABCMeta '_abc_invalidation_counter))
+      (for ((name : (sorted (dir cls)))) ()
+	   (if (py-startswith name "_abc_")
+	       (let ((value (getattr cls name)))
+		 (format port "~a: ~a~%" name value))))))
+
+  (define __instancecheck__
+    (lambda (cls instance)
+      (let ((subclass (ref instance '__class__)))
+        (if (in subclass (ref cls '_abc_cache))
+            #t
+	    (let ((subtype (type instance)))
+	      (if (eq? subtype subclass)
+		  (if (and (= (ref cls '_abc_negative_cache_version)
+			      (ref ABCMeta '_abc_invalidation_counter))
+			   (in subclass (ref cls '_abc_negative_cache)))
+		      #f
+		      ((ref cls '__subclasscheck__) subclass))
+		  (or ((ref cls '__subclasscheck__) subclass)
+		      ((ref cls '__subclasscheck__) subtype))))))))
+
+  (define __subclasscheck__
+    (lambda (cls subclass)
+      (let/ec ret
+	(cond
+	 ((in subclass (ref cls '_abc_cache))
+	  (ret #t))
+	 ((< (ref cls '_abc_negative_cache_version)
+	     (ref ABCMeta '_abc_invalidation_counter))
+
+	  (set cls '_abc_negative_cache (WeakSet))
+	  (set cls '_abc_negative_cache_version
+	       (ref ABCMeta '_abc_invalidation_counter)))
+	 ((in subclass (ref cls '_abc_negative_cache))
+	  (ret #f)))
+
+	(aif it (ref cls '__subclasshook__)
+	     (let ((ok (it subclass)))
+	       (if (not (eq? ok NotImplemented))
+		   (begin
+		     (if (bool ok)
+			 ((ref (ref cls '_abc_cache) 'add) subclass)
+			 ((ref (ref cls '_abc_negative_cache) 'add) subclass)))
+		   (ret (bool ok))))
+	     #f)
+	
+        
+        (if (in cls (ref subclass '__mro__ '()))
+            (begin
+	      ((ref (ref cls '_abc_cache) 'add) subclass)
+	      (ret #t)))
+
+	(for ((rcls : (ref cls '_abc_registry))) ()
+	     (when (issubclass subclass rcls)
+		   ((ref (ref cls '_abc_cache) 'add) subclass)
+		   (ret #t)))
+
+	(aif it (ref cls '__subclasses__)
+	     (for ((scls : (it))) ()
+		  (when (issubclass subclass scls)
+			((ref (ref cls '_abc_cache) 'add) subclass)
+			(ret #t)))
+	     #f)
+
+	((ref (ref cls '_abc_negative_cache) 'add) subclass)
+	#f))))
+
+(define-python-class ABC (#:metaclass ABCMeta))
+
+
+(define (get_cache_token)
+   (ref ABCMeta '_abc_invalidation_counter))