aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/luxc/lang/translation/jvm/common.lux
blob: f1dc4ae2429c2b355030304ddeeb324b8214176c (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
(.module:
  [library
   [lux #*
    ... [abstract
    ...  [monad (#+ do)]]
    ... [control
    ...  ["." try (#+ Try)]
    ...  ["ex" exception (#+ exception:)]
    ...  ["." io]]
    ... [data
    ...  [binary (#+ Binary)]
    ...  ["." text ("#/." hash)
    ...   format]
    ...  [collection
    ...   ["." dictionary (#+ Dictionary)]]]
    ... ["." macro]
    ... [host (#+ import:)]
    ... [tool
    ...  [compiler
    ...   [reference (#+ Register)]
    ...   ["." name]
    ...   ["." phase]]]
    ]]
  ... [luxc
  ...  [lang
  ...   [host
  ...    ["." jvm
  ...     [type]]]]]
  )

... (def: .public (with-artifacts action)
...   (All (_ a) (-> (Meta a) (Meta [Artifacts a])))
...   (function (_ state)
...     (case (action (revised@ #.host
...                            (|>> (:coerce Host)
...                                 (with@ #artifacts (dictionary.new text.hash))
...                                 (:coerce Nothing))
...                            state))
...       (#try.Success [state' output])
...       (#try.Success [(revised@ #.host
...                                 (|>> (:coerce Host)
...                                      (with@ #artifacts (|> (value@ #.host state) (:coerce Host) (value@ #artifacts)))
...                                      (:coerce Nothing))
...                                 state')
...                        [(|> state' (value@ #.host) (:coerce Host) (value@ #artifacts))
...                         output]])

...       (#try.Failure error)
...       (#try.Failure error))))

... (def: .public (load-definition state)
...   (-> Lux (-> Name Binary (Try Any)))
...   (function (_ (^@ def-name [def-module def-name]) def-bytecode)
...     (let [normal-name (format (name.normalize def-name) (%n (text/hash def-name)))
...           class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
...       (<| (macro.result state)
...           (do macro.monad
...             [_ (..store-class class-name def-bytecode)
...              class (..load-class class-name)]
...             (case (do try.monad
...                     [field (Class::getField [..value-field] class)]
...                     (Field::get [#.None] field))
...               (#try.Success (#.Some def-value))
...               (wrap def-value)

...               (#try.Success #.None)
...               (phase.throw invalid-definition-value (%name def-name))

...               (#try.Failure error)
...               (phase.throw cannot-load-definition
...                               (format "Definition: " (%name def-name) "\n"
...                                       "Error:\n"
...                                       error))))))))