aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux
blob: afb6af8a5dd426c7cfc2805e294a0ae31e802782 (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
(.module:
  [library
   [lux "*"
    [abstract
     ["." monad {"+" [do]}]]
    [control
     [parser
      ["<.>" code]]]
    [data
     [collection
      ["." list ("#\." functor)]]]
    ["." meta]
    ["." macro {"+" [with_identifiers]}
     ["." code]
     [syntax {"+" [syntax:]}]]]]
  ["." /// "_"
   ["#." extension]
   [//
    [synthesis {"+" [Synthesis]}]
    ["." generation]
    [///
     ["#" phase]]]])

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

(type: .public (Nullary of) (-> (Vector 0 of) of))
(type: .public (Unary of)   (-> (Vector 1 of) of))
(type: .public (Binary of)  (-> (Vector 2 of) of))
(type: .public (Trinary of) (-> (Vector 3 of) of))
(type: .public (Variadic of) (-> (List of) of))

(syntax: (arity: [arity <code>.nat
                  name <code>.local_identifier
                  type <code>.any])
  (with_identifiers [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive]
    (do [! meta.monad]
      [g!input+ (monad.all ! (list.repeated arity (macro.identifier "input")))]
      (in (list (` (def: .public ((~ (code.local_identifier name)) (~ g!extension))
                     (All ((~ g!_) (~ g!anchor) (~ g!expression) (~ g!directive))
                       (-> ((~ type) (~ g!expression))
                           (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive))))
                     (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs))
                       (case (~ g!inputs)
                         (^ (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+)])))

                         (~' _)
                         (///.except ///extension.incorrect_arity [(~ g!name) 1 (list.size (~ g!inputs))]))))))))))

(arity: 0 nullary ..Nullary)
(arity: 1 unary ..Unary)
(arity: 2 binary ..Binary)
(arity: 3 trinary ..Trinary)

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