aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test/luxc/generator/function.lux
blob: 3757c0937ab3fdade414efe5a88228063bdb6f6b (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
96
(;module:
  lux
  (lux [io]
       (control [monad #+ do]
                pipe)
       (data [product]
             [maybe]
             ["R" result]
             (coll ["a" array]
                   [list "list/" Functor<List>]))
       ["r" math/random "r/" Monad<Random>]
       [macro]
       (macro [code])
       [host]
       test)
  (luxc (lang ["ls" synthesis])
        [analyser]
        [synthesizer]
        (generator ["@;" expr]
                   ["@;" eval]
                   ["@;" runtime]
                   ["@;" common]))
  (test/luxc common))

(def: arity-limit Nat +10)

(def: arity
  (r;Random ls;Arity)
  (|> r;nat (r/map (|>. (n.% arity-limit) (n.max +1)))))

(def: gen-function
  (r;Random [ls;Arity Nat ls;Synthesis])
  (do r;Monad<Random>
    [arity arity
     arg (|> r;nat (:: @ map (n.% arity)))
     #let [functionS (#ls;Function arity (list) (#ls;Variable (nat-to-int (n.inc arg))))]]
    (wrap [arity arg functionS])))

(context: "Function."
  [[arity arg functionS] gen-function
   cut-off (|> r;nat (:: @ map (n.% arity)))
   args (r;list arity r;nat)
   #let [arg-value (maybe;assume (list;nth arg args))
         argsS (list/map (|>. #ls;Nat) args)
         last-arg (n.dec arity)
         cut-off (|> cut-off (n.min (n.dec last-arg)))]]
  ($_ seq
      (test "Can read arguments."
            (|> (do macro;Monad<Lux>
                  [runtime-bytecode @runtime;generate
                   sampleI (@expr;generate (#ls;Call argsS functionS))]
                  (@eval;eval sampleI))
                (macro;run (init-compiler []))
                (case> (#R;Success valueG)
                       (n.= arg-value (:! Nat valueG))

                       (#R;Error error)
                       false)))
      (test "Can partially apply functions."
            (or (n.= +1 arity)
                (|> (do macro;Monad<Lux>
                      [#let [partial-arity (n.inc cut-off)
                             preS (list;take partial-arity argsS)
                             postS (list;drop partial-arity argsS)]
                       runtime-bytecode @runtime;generate
                       sampleI (@expr;generate (|> functionS (#ls;Call preS) (#ls;Call postS)))]
                      (@eval;eval sampleI))
                    (macro;run (init-compiler []))
                    (case> (#R;Success valueG)
                           (n.= arg-value (:! Nat valueG))

                           (#R;Error error)
                           false))))
      (test "Can read environment."
            (or (n.= +1 arity)
                (|> (do macro;Monad<Lux>
                      [#let [env (|> (list;n.range +0 cut-off)
                                     (list/map (|>. n.inc nat-to-int)))
                             super-arity (n.inc cut-off)
                             arg-var (if (n.<= cut-off arg)
                                       (|> arg n.inc nat-to-int (i.* -1))
                                       (|> arg n.inc (n.- super-arity) nat-to-int))
                             sub-arity (|> arity (n.- super-arity))
                             functionS (<| (#ls;Function super-arity (list))
                                           (#ls;Function sub-arity env)
                                           (#ls;Variable arg-var))]
                       runtime-bytecode @runtime;generate
                       sampleI (@expr;generate (#ls;Call argsS functionS))]
                      (@eval;eval sampleI))
                    (macro;run (init-compiler []))
                    (case> (#R;Success valueG)
                           (n.= arg-value (:! Nat valueG))

                           (#R;Error error)
                           false))))
      ))