blob: 20ea5fced7a011e3daf16df5277c0300bf614e4e (
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
|
## Copyright (c) Eduardo Julian. All rights reserved.
## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
## If a copy of the MPL was not distributed with this file,
## You can obtain one at http://mozilla.org/MPL/2.0/.
(;import lux
(lux/control (number #as N)
(monoid #as m)
(eq #as E)
(ord #as O)
(enum #as EN)
(bounded #as B)
(show #as S)))
## [Structures]
## Number
(do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>]
[(defstruct #export <name> (N;Number <type>)
(def (+ x y) (<+> x y))
(def (- x y) (<-> x y))
(def (* x y) (<*> x y))
(def (/ x y) (</> x y))
(def (% x y) (<%> x y))
(def (from-int x)
(<from> x))
(def (negate x)
(<*> <-1> x))
(def (abs x)
(if (<<> x <0>)
(<*> <-1> x)
x))
(def (signum x)
(cond (<=> x <0>) <0>
(<<> x <0>) <-1>
## else
<1>))
)]
[ Int/Number Int _jvm_ladd _jvm_lsub _jvm_lmul _jvm_ldiv _jvm_lrem _jvm_leq _jvm_llt id 0 1 -1])
## Eq
(defstruct #export Int/Eq (E;Eq Int)
(def (= x y) (_jvm_leq x y)))
## Ord
(do-template [<name> <type> <eq> <=> <lt> <gt>]
[(defstruct #export <name> (O;Ord <type>)
(def _eq <eq>)
(def (< x y) (<lt> x y))
(def (<= x y)
(or (<lt> x y)
(<=> x y)))
(def (> x y) (<gt> x y))
(def (>= x y)
(or (<gt> x y)
(<=> x y))))]
[ Int/Ord Int Int/Eq _jvm_leq _jvm_llt _jvm_lgt])
## Enum
(defstruct Int/Enum (EN;Enum Int)
(def _ord Int/Ord)
(def succ (lambda [n] (:: Int/Number (N;+ n 1))))
(def pred (lambda [n] (:: Int/Number (N;- n 1)))))
## Bounded
(do-template [<name> <type> <top> <bottom>]
[(defstruct #export <name> (B;Bounded <type>)
(def top <top>)
(def bottom <bottom>))]
[ Int/Bounded Int (_jvm_getstatic "java.lang.Long" "MAX_VALUE") (_jvm_getstatic "java.lang.Long" "MIN_VALUE")])
## Monoid
(do-template [<name> <type> <unit> <++>]
[(defstruct #export <name> (m;Monoid <type>)
(def unit <unit>)
(def (++ x y) (<++> x y)))]
[ IntAdd/Monoid Int 0 _jvm_ladd]
[ IntMul/Monoid Int 1 _jvm_lmul]
[ IntMax/Monoid Int (:: Int/Bounded B;bottom) (O;max Int/Ord)]
[ IntMin/Monoid Int (:: Int/Bounded B;top) (O;min Int/Ord)]
)
## Show
(do-template [<name> <type> <body>]
[(defstruct #export <name> (S;Show <type>)
(def (show x)
<body>))]
[ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])]
)
|
