(define-module (language python module abc)
  #:use-module (language python module weakref)
  #:use-module (oop pf-objects)
  #:use-module (oop goops)
  #: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 (or (isinstance subclass type)
		   (and (not (is-a? subclass <p>))
			((@@ (oop goops) class?) subclass))))
	  (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 cls))) ()		  
		  (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))