aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/order.lux
blob: edd25aca0f23204cf9eb2d53a062d218f9e9f319 (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
(.module:
  lux
  (lux function)
  (// [equivalence (#+ Equivalence)]))

## [Signatures]
(signature: #export (Order a)
  {#.doc "A signature for types that possess some sense of ordering among their elements."}
  
  (: (Equivalence a)
     eq)
  
  (do-template [<name>]
    [(: (-> a a Bool) <name>)]

    [<] [<=] [>] [>=]
    )
  )

## [Values]
(def: #export (order eq <)
  (All [a]
    (-> (Equivalence a) (-> a a Bool) (Order a)))
  (let [> (flip <)]
    (structure (def: eq eq)
               (def: < <)
               (def: (<= test subject)
                 (or (< test subject)
                     (:: eq = test subject)))
               (def: > >)
               (def: (>= test subject)
                 (or (> test subject)
                     (:: eq = test subject))))))

(do-template [<name> <op>]
  [(def: #export (<name> order x y)
     (All [a]
       (-> (Order a) a a a))
     (if (:: order <op> y x) x y))]

  [max >]
  [min <]
  )