aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/lazy.lux
blob: eba4906178134ab506601ca3ee5e4eea1d49ad3a (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
(.module:
  lux
  (lux [io]
       (control [functor #+ Functor]
                [applicative #+ Applicative]
                [monad #+ Monad do])
       (concurrency [atom])
       [macro #+ with-gensyms]
       (macro ["s" syntax #+ syntax:])
       (type abstract)))

(abstract: #export (Lazy a)
  (-> [] a)

  (def: (freeze' generator)
    (All [a] (-> (-> [] a) (Lazy a)))
    (let [cache (atom.atom (: (Maybe ($ +0)) #.None))]
      (@abstract (function [_]
                   (case (io.run (atom.read cache))
                     (#.Some value)
                     value

                     _
                     (let [value (generator [])]
                       (exec (io.run (atom.compare-and-swap _ (#.Some value) cache))
                         value)))))))

  (def: #export (thaw l-value)
    (All [a] (-> (Lazy a) a))
    ((@repr l-value) [])))

(syntax: #export (freeze expr)
  (with-gensyms [g!_]
    (wrap (list (` ((~! freeze') (function [(~@ g!_)] (~ expr))))))))

(struct: #export _ (Functor Lazy)
  (def: (map f fa)
    (freeze (f (thaw fa)))))

(struct: #export _ (Applicative Lazy)
  (def: functor Functor<Lazy>)

  (def: (wrap a)
    (freeze a))

  (def: (apply ff fa)
    (freeze ((thaw ff) (thaw fa)))))

(struct: #export _ (Monad Lazy)
  (def: applicative Applicative<Lazy>)

  (def: join thaw))