aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/meta/extension.lux
blob: 1f1569c5b409171891534e21976fb9ce215def69 (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
(.`` (.require
      [library
       [lux (.except)
        [abstract
         ["[0]" monad]]
        [control
         ["<>" parser (.use "[1]#[0]" monad)]]
        [data
         ["[0]" product]
         [collection
          ["[0]" list (.use "[1]#[0]" functor)]]]
        [meta
         ["@" target (.only)
          (.,, (.for "JVM"
                     [jvm
                      ["_" bytecode (.only Bytecode)]]

                     ... else
                     [/]))]
         ["[0]" code (.only)
          ["<c>" \\parser (.only Parser)]]
         [macro (.only with_symbols)
          [syntax (.only syntax)]
          ["[0]" template]]
         [compiler
          ["[0]" phase]
          [language
           [lux
            ["[0]" analysis (.only)
             ["<a>" \\parser]]
            ["[0]" synthesis (.only)
             ["<s>" \\parser]]
            ["[0]" translation]
            ["[0]" declaration]
            [phase
             [translation
              (.,, (.for "{old}"
                         ["[0]" jvm
                          ["[1]" runtime]]

                         "JVM"
                         ["[0]" jvm
                          ["[1]" runtime]]

                         ... else
                         [/]))
              ["[0]" js
               ["[1]" runtime]]
              ["[0]" lua
               ["[1]" runtime]]
              ["[0]" python
               ["[1]" runtime]]
              ["[0]" ruby
               ["[1]" runtime]]]]]]]]]]))

(with_template [<any> <end> <and> <result> <name> <extension_type> <handler_type>]
  [(def .public <name>
     (syntax (_ [[handler phase archive inputs] (<c>.form (all <>.and
                                                               <c>.local
                                                               <c>.local
                                                               <c>.local
                                                               (<c>.tuple (<>.some <c>.any))))
                 body <c>.any])
       (let [g!handler (code.local handler)
             g!phase (code.local phase)
             g!archive (code.local archive)]
         (with_symbols [g!inputs g!error g!_]
           (in (list (` (<| (as <extension_type>)
                            (is <handler_type>)
                            (.function ((, g!handler) (, 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 analysis .Analysis analysis.Handler]
  [<a>.any <a>.end <a>.and <a>.result synthesis .Synthesis synthesis.Handler]
  [<s>.any <s>.end <s>.and <s>.result translation .Translation
   (for @.jvm (translation.Handler jvm.Anchor jvm.Value jvm.Declaration)
        @.js (translation.Handler js.Anchor js.Value js.Declaration)
        @.lua (translation.Handler lua.Anchor lua.Value lua.Declaration)
        @.python (translation.Handler python.Anchor python.Value python.Declaration)
        @.ruby (translation.Handler ruby.Anchor ruby.Value ruby.Declaration))]
  [<c>.any <c>.end <c>.and <c>.result declaration .Declaration
   (for @.jvm (declaration.Handler jvm.Anchor jvm.Value jvm.Declaration)
        @.js (declaration.Handler js.Anchor js.Value js.Declaration)
        @.lua (declaration.Handler lua.Anchor lua.Value lua.Declaration)
        @.python (declaration.Handler python.Anchor python.Value python.Declaration)
        @.ruby (declaration.Handler ruby.Anchor ruby.Value ruby.Declaration))]
  )