development
[software/python-on-guile.git] / modules / language / python / expr.scm
1 (define-module (language python expr)
2 #:use-module (language python class)
3 #:export (py-true? to-py py-or py-and py-not py_==
4 py_>= py_<= py_< py_> py_<> py_!= py_in py_notin py_is
5 py_isnot py_bor py_xor py_band py-<< py->> py-+ py--
6 py-* py-/ py-% py-// py-u+ py-u- py-u~ py-power
7 ))
8
9
10 (define-syntax-rule (py-true? x) (eq? x 'True))
11 (define-syntax-rule (to-py x) (if x 'True 'false))
12 (define-syntax-rule (py-or x ...) (to-py (or (py-true? x) ...)))
13 (define-syntax-rule (py-and x ...) (to-py (and (py-true? x) ...)))
14 (define-syntax-rule (py-not x) (if (py-true? x) 'False 'True))
15
16 (define-syntax-rule (py_== x y)
17 (if (struct? x)
18 (if (class? x)
19 (class_== x y)
20 (to-py (equal? x y)))
21 (to-py (equal? x y))))
22
23 (define-syntax-rule (mk-comp py_>= >= class_>=)
24 (define-syntax-rule (py_>= x y)
25 (if (number? x)
26 (to-py (>= x y))
27 (if (class? x)
28 (class_>= x y)
29 'False))))
30
31 (mk-comp py_>= >= class_>=)
32 (mk-comp py_<= <= class_<=)
33 (mk-comp py_< < class_<)
34 (mk-comp py_> > class_>)
35
36 (define-syntax-rule (<> x y) (not (= x y)))
37 (mk-comp py_<> <> class_<>)
38 (mk-comp py_!= <> class_<>)
39
40
41 (define-syntax-rule (py_in x y)
42 (cond
43 ((struct? y)
44 (if (class? y)
45 (to-py (class_in y x))
46 'False))
47 ((pair? y)
48 (list-in x y))
49 ((vector? y)
50 (vector-in x y))
51 (else
52 'False)))
53
54 (define-syntax-rule (py_notin x y)
55 (cond
56 ((struct? y)
57 (if (class? y)
58 (to-py (not (class_in y x)))
59 'True))
60 ((pair? y)
61 (to-py (list-in x y)))
62 ((vector? y)
63 (to-py (vector-in x y)))
64 (else
65 'True)))
66
67 (define-syntax-rule (py_is x y)
68 (to-py (and (class? x) (class? y) (eq? (class-ref x) (class-ref y)))))
69
70 (define-syntax-rule (py_isnot x y)
71 (to-py (not (and (class? x) (class? y) (eq? (class-ref x) (class-ref y))))))
72
73 (define-syntax-rule (mk-num py_>= >= class_>=)
74 (define-syntax-rule (py_>= x . y)
75 (if (number? x)
76 (>= x . y)
77 (if (class? x)
78 (class_>= x . y)
79 (error "wrong numerics")))))
80
81 (mk-num py_bor logior class_ior)
82 (mk-num py_xor logxor class_xor)
83 (mk-num py_band logand class_band)
84 (mk-num py-<< ash class_<<)
85 (define-syntax-rule (rash x y) (ash x (- y)))
86 (mk-num py->> rash class_>>)
87 (mk-num py-+ + class_+)
88 (mk-num py-- - class_-)
89 (mk-num py-* * class_*)
90 (mk-num py-/ / class_/)
91 (mk-num py-% modulo class_%)
92 (mk-num py-// truncate-quotient class_//)
93
94 (define-syntax-rule (mk-unum py_>= >= class_>=)
95 (define-syntax-rule (py_>= x)
96 (if (number? x)
97 (>= x)
98 (if (class? x)
99 (class_>= x)
100 (error "wrong numerics")))))
101
102 (mk-unum py-u+ + class_u+)
103 (mk-unum py-u- - class_u-)
104 (mk-unum py-u~ lognot class_u~)
105
106 (mk-num py-power expt class_power)