aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/abstract/order.lux
blob: 9d031bca281ede7f13ece31c5a8a87809e2dd306 (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
(.module:
  [lux #*
   [control
    ["." function]]]
  [//
   ["." equivalence (#+ Equivalence)]
   [functor
    ["." contravariant]]])

(interface: #export (Order a)
  {#.doc "A signature for types that possess some sense of ordering among their elements."}
  
  (: (Equivalence a)
     &equivalence)

  (: (-> a a Bit)
     <)
  )

(type: #export (Comparison a)
  (-> (Order a) a a Bit))

(def: #export (<= order parameter subject)
  Comparison
  (or (\ order < parameter subject)
      (\ order = parameter subject)))

(def: #export (> order parameter subject)
  Comparison
  (\ order < subject parameter))

(def: #export (>= order parameter subject)
  Comparison
  (or (\ order < subject parameter)
      (\ order = subject parameter)))

(type: #export (Choice a)
  (-> (Order a) a a a))

(def: #export (min order x y)
  Choice
  (if (\ order < y x) x y))

(def: #export (max order x y)
  Choice
  (if (\ order < y x) y x))

(implementation: #export functor
  (contravariant.Functor Order)
  
  (def: (map f order)
    (implementation
     (def: &equivalence
       (\ equivalence.functor map f (\ order &equivalence)))
     
     (def: (< reference sample)
       (\ order < (f reference) (f sample))))))