summaryrefslogtreecommitdiff
path: root/modules/language/python/module/abc.scm
blob: f0b84424cf54a3e906afe900331d2e4fe4ef68c6 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
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))