aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux
blob: 6809570085e7a84e5ae853fefc23766228deb8e8 (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
(.using
 [library
  [lux (.except)
   [abstract
    ["[0]" monad (.only do)]]
   [control
    [parser
     ["<[0]>" code]]]
   [data
    [collection
     ["[0]" list (.open: "[1]#[0]" functor)]]]
   ["[0]" meta]
   ["[0]" macro (.only with_symbols)
    ["[0]" code]
    [syntax (.only syntax)]]]]
 ["[0]" ///
  ["[1][0]" extension]
  [//
   [synthesis (.only Synthesis)]
   ["[0]" generation]
   [///
    ["[1]" phase]]]])

(def Vector
  (syntax (_ [size <code>.nat
              elemT <code>.any])
    (in (list (` [(~+ (list.repeated size elemT))])))))

(def Arity
  (template (_ arity)
    [(All (_ of)
       (-> (Vector arity of) of))]))

(def arity
  (syntax (_ [arity <code>.nat])
    (with_symbols [g!_ g!extension g!name g!phase g!archive g!inputs g!anchor g!expression g!directive]
      (do [! meta.monad]
        [g!input+ (monad.all ! (list.repeated arity (macro.symbol "input")))]
        (in (list (` (is (All ((~ g!_) (~ g!anchor) (~ g!expression) (~ g!directive))
                           (-> ((Arity (~ (code.nat arity))) (~ g!expression))
                               (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive))))
                         (function ((~ g!_) (~ g!extension))
                           (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs))
                             (case (~ g!inputs)
                               (pattern (list (~+ g!input+)))
                               (do ///.monad
                                 [(~+ (|> g!input+
                                          (list#each (function (_ g!input)
                                                       (list g!input (` ((~ g!phase) (~ g!archive) (~ g!input))))))
                                          list.together))]
                                 ((~' in) ((~ g!extension) [(~+ g!input+)])))

                               (~ g!_)
                               (///.except ///extension.incorrect_arity [(~ g!name)
                                                                         (~ (code.nat arity))
                                                                         (list.size (~ g!inputs))]))
                             ))))))))))

(with_template [<arity> <type> <term>]
  [(type: .public <type> (Arity <arity>))
   (def .public <term> (arity <arity>))]

  [0 Nullary nullary]
  [1 Unary unary]
  [2 Binary binary]
  [3 Trinary trinary]
  )

(type: .public (Variadic of)
  (-> (List of) of))

(def .public (variadic extension)
  (All (_ anchor expression directive)
    (-> (Variadic expression) (generation.Handler anchor expression directive)))
  (function (_ extension_name)
    (function (_ phase archive inputsS)
      (let [! ///.monad]
        (|> inputsS
            (monad.each ! (phase archive))
            (at ! each extension))))))