aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/extension.lux
blob: 3d1b684f613e2be3a5a085c95472b07e237c01d3 (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
(.require
 [library
  [lux (.except)
   [abstract
    ["[0]" monad]]
   [control
    ["<>" parser (.use "[1]#[0]" monad)
     ["<c>" code (.only Parser)]]]
   [data
    ["[0]" product]
    [collection
     ["[0]" list (.use "[1]#[0]" functor)]]]
   [macro (.only with_symbols)
    [syntax (.only syntax)]
    ["[0]" code]]
   [tool
    [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 (declaration 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] (..declaration (` <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))
                                       (.case ((~! <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 analysis" analysis]
  [<a>.any <a>.end <a>.and <a>.result "lux def synthesis" synthesis]
  [<s>.any <s>.end <s>.and <s>.result "lux def generation" generation]
  [<c>.any <c>.end <c>.and <c>.result "lux def directive" directive]
  )