aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/specification/compositor/generation/function.lux
blob: c03971eef132bd63b8f54c088a6465aef4d6c598 (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
94
95
(.using
  [lux {"-" function}
   ["_" test {"+" Test}]
   [abstract
    [monad {"+" do}]
    ["[0]" enum]]
   [control
    [pipe {"+" case>}]
    ["[0]" maybe]]
   [data
    [number
     ["n" nat]]
    [collection
     ["[0]" list ("[1]#[0]" functor)]]]
   [math
    ["r" random {"+" Random} ("[1]#[0]" monad)]]
   [tool
    [compiler
     [analysis {"+" Arity}]
     ["[0]" reference {"+" Register}]
     ["[0]" synthesis {"+" Synthesis}]]]]
  ["[0]" // "_"
   ["[1][0]" case]
   [//
    [common {"+" Runner}]]])

(def: max_arity
  Arity
  10)

(def: arity
  (Random Arity)
  (|> r.nat (r#each (|>> (n.% max_arity) (n.max 1)))))

(def: (local arity)
  (-> Arity (Random Register))
  (|> r.nat (r#each (|>> (n.% arity) ++))))

(def: function
  (Random [Arity Register Synthesis])
  (do r.monad
    [arity ..arity
     local (..local arity)]
    (in [arity local
         (synthesis.function/abstraction
          [synthesis.#environment (list)
           synthesis.#arity arity
           synthesis.#body (synthesis.variable/local local)])])))

(def: .public (spec run)
  (-> Runner Test)
  (do [! r.monad]
    [[arity local functionS] ..function
     partial_arity (|> r.nat (# ! each (|>> (n.% arity) (n.max 1))))
     inputs (r.list arity r.safe_frac)
     .let [expectation (maybe.trusted (list.item (-- local) inputs))
           inputsS (list#each (|>> synthesis.f64) inputs)]]
    ($_ _.and
        (_.test "Can read arguments."
                (|> (synthesis.function/apply [synthesis.#function functionS
                                               synthesis.#arguments inputsS])
                    (run "with_local")
                    (//case.verify expectation)))
        (_.test "Can partially apply functions."
                (or (n.= 1 arity)
                    (let [preS (list.first partial_arity inputsS)
                          postS (list.after partial_arity inputsS)
                          partialS (synthesis.function/apply [synthesis.#function functionS
                                                              synthesis.#arguments preS])]
                      (|> (synthesis.function/apply [synthesis.#function partialS
                                                     synthesis.#arguments postS])
                          (run "partial_application")
                          (//case.verify expectation)))))
        (_.test "Can read environment."
                (or (n.= 1 arity)
                    (let [environment (|> partial_arity
                                          (enum.range n.enum 1)
                                          (list#each (|>> {reference.#Local})))
                          variableS (if (n.<= partial_arity local)
                                      (synthesis.variable/foreign (-- local))
                                      (synthesis.variable/local (|> local (n.- partial_arity))))
                          inner_arity (n.- partial_arity arity)
                          innerS (synthesis.function/abstraction
                                  [synthesis.#environment environment
                                   synthesis.#arity inner_arity
                                   synthesis.#body variableS])
                          outerS (synthesis.function/abstraction
                                  [synthesis.#environment (list)
                                   synthesis.#arity partial_arity
                                   synthesis.#body innerS])]
                      (|> (synthesis.function/apply [synthesis.#function outerS
                                                     synthesis.#arguments inputsS])
                          (run "with_foreign")
                          (//case.verify expectation)))))
        )))