blob: 81c2cbe2f1e5f3c07218620249288037e18726a7 (
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
|
(define-module (language python expr)
#:use-module (language python class)
#:export (py-true? to-py py-or py-and py-not py_==
py_>= py_<= py_< py_> py_<> py_!= py_in py_notin py_is
py_isnot py_bor py_xor py_band py-<< py->> py-+ py--
py-* py-/ py-% py-// py-u+ py-u- py-u~ py-power
))
(define-syntax-rule (py-true? x) (eq? x 'True))
(define-syntax-rule (to-py x) (if x 'True 'false))
(define-syntax-rule (py-or x ...) (to-py (or (py-true? x) ...)))
(define-syntax-rule (py-and x ...) (to-py (and (py-true? x) ...)))
(define-syntax-rule (py-not x) (if (py-true? x) 'False 'True))
(define-syntax-rule (py_== x y)
(if (struct? x)
(if (class? x)
(class_== x y)
(to-py (equal? x y)))
(to-py (equal? x y))))
(define-syntax-rule (mk-comp py_>= >= class_>=)
(define-syntax-rule (py_>= x y)
(if (number? x)
(to-py (>= x y))
(if (class? x)
(class_>= x y)
'False))))
(mk-comp py_>= >= class_>=)
(mk-comp py_<= <= class_<=)
(mk-comp py_< < class_<)
(mk-comp py_> > class_>)
(define-syntax-rule (<> x y) (not (= x y)))
(mk-comp py_<> <> class_<>)
(mk-comp py_!= <> class_<>)
(define-syntax-rule (py_in x y)
(cond
((struct? y)
(if (class? y)
(to-py (class_in y x))
'False))
((pair? y)
(list-in x y))
((vector? y)
(vector-in x y))
(else
'False)))
(define-syntax-rule (py_notin x y)
(cond
((struct? y)
(if (class? y)
(to-py (not (class_in y x)))
'True))
((pair? y)
(to-py (list-in x y)))
((vector? y)
(to-py (vector-in x y)))
(else
'True)))
(define-syntax-rule (py_is x y)
(to-py (and (class? x) (class? y) (eq? (class-ref x) (class-ref y)))))
(define-syntax-rule (py_isnot x y)
(to-py (not (and (class? x) (class? y) (eq? (class-ref x) (class-ref y))))))
(define-syntax-rule (mk-num py_>= >= class_>=)
(define-syntax-rule (py_>= x . y)
(if (number? x)
(>= x . y)
(if (class? x)
(class_>= x . y)
(error "wrong numerics")))))
(mk-num py_bor logior class_ior)
(mk-num py_xor logxor class_xor)
(mk-num py_band logand class_band)
(mk-num py-<< ash class_<<)
(define-syntax-rule (rash x y) (ash x (- y)))
(mk-num py->> rash class_>>)
(mk-num py-+ + class_+)
(mk-num py-- - class_-)
(mk-num py-* * class_*)
(mk-num py-/ / class_/)
(mk-num py-% modulo class_%)
(mk-num py-// truncate-quotient class_//)
(define-syntax-rule (mk-unum py_>= >= class_>=)
(define-syntax-rule (py_>= x)
(if (number? x)
(>= x)
(if (class? x)
(class_>= x)
(error "wrong numerics")))))
(mk-unum py-u+ + class_u+)
(mk-unum py-u- - class_u-)
(mk-unum py-u~ lognot class_u~)
(mk-num py-power expt class_power)
|
