aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/meta/extension.lux
blob: 18012001cd6e9847840433ab4fdd406fed8c6d60 (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
97
98
99
100
(.require
 [library
  [lux (.except)
   [abstract
    ["[0]" monad]]
   [control
    ["<>" parser (.use "[1]#[0]" monad)]]
   [data
    ["[0]" product]
    [collection
     ["[0]" list (.use "[1]#[0]" functor)]]]
   [meta
    ["[0]" code (.only)
     ["<c>" \\parser (.only Parser)]]
    [macro (.only with_symbols)
     [syntax (.only syntax)]]
    [compiler
     ["[0]" phase]
     [language
      [lux
       [analysis
        ["<a>" \\parser]]
       [synthesis
        ["<s>" \\parser]]]]]]]])

(type Declaration
  (Record
   [#name Code
    #label Text
    #phase Text
    #archive Text
    #inputs (List Code)]))

(def (declarationP default)
  (-> Code (Parser Declaration))
  (<c>.form (all <>.and
                 <c>.any
                 <c>.local
                 <c>.local
                 <c>.local
                 (<c>.tuple (<>.some <c>.any)))))

(with_template [<any> <end> <and> <result> <extension> <name>]
  [(def .public <name>
     (syntax (_ [[name extension phase archive inputs] (..declarationP (` <any>))
                 body <c>.any])
       (let [g!name (code.local extension)
             g!phase (code.local phase)
             g!archive (code.local archive)]
         (with_symbols [g!handler g!inputs g!error g!_]
           (in (list (` (<extension> (, name)
                                     (.function ((, g!handler) (, g!name) (, g!phase) (, g!archive) (, g!inputs))
                                       (.when (<result>
                                               (monad.do <>.monad
                                                 [(,* inputs)
                                                  (, g!_) <end>]
                                                 (.at <>.monad (,' in) (, body)))
                                               (, g!inputs))
                                         {.#Right (, g!_)}
                                         (, g!_)

                                         {.#Left (, g!error)}
                                         (phase.failure (, g!error)))
                                       )))))))))]

  [<c>.any <c>.end <c>.and <c>.result "lux def declaration" declaration]
  )

(with_template [<any> <end> <and> <result> <extension> <name> <type>]
  [(def .public <name>
     (syntax (_ [[handler extension phase archive inputs] (<c>.form (all <>.and
                                                                         <c>.local
                                                                         <c>.local
                                                                         <c>.local
                                                                         <c>.local
                                                                         (<c>.tuple (<>.some <c>.any))))
                 body <c>.any])
       (let [g!handler (code.local handler)
             g!name (code.local extension)
             g!phase (code.local phase)
             g!archive (code.local archive)]
         (with_symbols [g!inputs g!error g!_]
           (in (list (` (<extension> (.function ((, g!handler) (, g!name) (, g!phase) (, g!archive) (, g!inputs))
                                       (.when (<result>
                                               (monad.do <>.monad
                                                 [(,* inputs)
                                                  (, g!_) <end>]
                                                 (.at <>.monad (,' in) (, body)))
                                               (, g!inputs))
                                         {.#Right (, g!_)}
                                         (, g!_)

                                         {.#Left (, g!error)}
                                         (phase.failure (, g!error)))
                                       )))))))))]

  [<c>.any <c>.end <c>.and <c>.result "lux extension analysis" analysis .Analysis]
  [<a>.any <a>.end <a>.and <a>.result "lux extension synthesis" synthesis .Synthesis]
  [<s>.any <s>.end <s>.and <s>.result "lux extension generation" generation .Generation]
  )