blob: 41ed09ae97f6f481d99001311df2b8ee8adc8339 (
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
|
(define-module (language python class)
#:export (class_+ class_- class_* class_// class_%
class_power class_<< class_>> class_ior
class_xor class_band))
(define-syntax-rule (class-ref x) (struct-ref x 0))
(define-syntax-rule (class-num x) (struct-ref x 1))
(define-syntax-rule (class-log x) (struct-ref x 2))
(define-syntax-rule (class-map x) (struct-ref x 3))
(define-syntax-rule (mkref +-ref n)
(define-syntax-rule (+-ref x) (vector-ref x n)))
(mkref +-ref 0)
(mkref --ref 1)
(mkref *-ref 2)
(mkref /-ref 3)
(mkref //-ref 4)
(mkref %-ref 5)
(mkref **-ref 6)
(mkref <<-ref 7)
(mkref >>-ref 8)
(mkref ior-ref 0)
(mkref xor-ref 1)
(mkref and-ref 2)
(define-syntax-rule (class-lookup class key )
(hashq-ref (class-map class) key #f))
(define-syntax-rule (meta-mk mk-num class-num)
(define-syntax-rule (mk-num class_+ __add__ __radd__ +-ref err)
(define (class_+ x y)
(let* ((cl (class-ref x))
(r (class-num cl)))
(define (f)
(let ((rrr (class-lookup cl '__add__)))
(if rrr
(rrr x y)
(if (class? y)
(let* ((cl (class-ref y))
(rrrr (class-lookup cl '__radd__)))
(if rrrr
(rrrr y x)
(err)))
(err)))))
(if r
(let ((rr (+-ref r)))
(if rr
(rr x y)
(f)))
(f))))))
(meta-mk mk-num class-num)
(meta-mk mk-log class-log)
(define (err) (error "could not do artithmetic ops"))
(mk-num class_+ __add__ __radd__ +-ref err)
(mk-num class_- __sub__ __rsub__ --ref err)
(mk-num class_* __mul__ __rmul__ *-ref err)
(mk-num class_/ __div__ __rdiv__ /-ref err)
(mk-num class_// __floordiv__ __rfloordiv__ //-ref err)
(mk-num class_% __divmod__ __rdivmod__ %-ref err)
(mk-num class_power __pow__ __rpow__ **-ref err)
(mk-num class_<< __lshift__ __rlshift__ <<-ref err)
(mk-num class_>> __rshift__ __rrshift__ >>-ref err)
(mk-log class_ior __or__ __ror__ ior-ref err)
(mk-log class_xor __xor__ __rxor__ xor-ref err)
(mk-log class_band __and__ __rand__ and-ref err)
|
