aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux
blob: 2684da183df058481749c63fcb5ed00954819f85 (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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
(.module:
  [library
   [lux {"-" Definition}
    ["[0]" ffi {"+" import: do_to object}]
    [abstract
     [monad {"+" do}]]
    [control
     pipe
     ["[0]" try {"+" Try}]
     ["[0]" exception {"+" exception:}]
     ["[0]" io {"+" IO io}]
     [concurrency
      ["[0]" atom {"+" Atom atom}]]]
    [data
     [binary {"+" Binary}]
     ["[0]" product]
     ["[0]" text ("[1]#[0]" hash)
      ["%" format {"+" format}]]
     [collection
      ["[0]" array]
      ["[0]" dictionary {"+" Dictionary}]
      ["[0]" row]]
     ["[0]" format "_"
      ["[1]" binary]]]
    [target
     [jvm
      ["[0]" loader {"+" Library}]
      ["_" bytecode {"+" Bytecode}]
      ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)]
      ["[0]" field {"+" Field}]
      ["[0]" method {"+" Method}]
      ["[0]" version]
      ["[0]" class {"+" Class}]
      ["[0]" encoding "_"
       ["[1]/[0]" name]]
      ["[0]" type
       ["[0]" descriptor]]]]
    [tool
     [compiler
      ["[0]" name]]]]]
  ["[0]" // "_"
   ["[1][0]" runtime {"+" Definition}]]
  )

(import: java/lang/reflect/Field
  (get ["?" java/lang/Object] "try" "?" java/lang/Object))

(import: (java/lang/Class a)
  (getField [java/lang/String] "try" java/lang/reflect/Field))

(import: java/lang/Object
  (getClass [] (java/lang/Class java/lang/Object)))

(import: java/lang/ClassLoader)

(def: value::field "value")
(def: value::type (type.class "java.lang.Object" (list)))
(def: value::modifier ($_ modifier#composite field.public field.final field.static))

(def: init::type (type.method [(list) type.void (list)]))
(def: init::modifier ($_ modifier#composite method.public method.static method.strict))

(exception: .public (cannot_load [class Text
                                  error Text])
  (exception.report
   ["Class" class]
   ["Error" error]))

(exception: .public (invalid_field [class Text
                                    field Text
                                    error Text])
  (exception.report
   ["Class" class]
   ["Field" field]
   ["Error" error]))

(exception: .public (invalid_value [class Text])
  (exception.report
   ["Class" class]))

(def: (class_value class_name class)
  (-> Text (java/lang/Class java/lang/Object) (Try Any))
  (case (java/lang/Class::getField ..value::field class)
    {try.#Success field}
    (case (java/lang/reflect/Field::get {.#None} field)
      {try.#Success ?value}
      (case ?value
        {.#Some value}
        {try.#Success value}
        
        {.#None}
        (exception.except ..invalid_value [class_name]))
      
      {try.#Failure error}
      (exception.except ..cannot_load [class_name error]))
    
    {try.#Failure error}
    (exception.except ..invalid_field [class_name ..value::field error])))

(def: class_path_separator
  ".")

(def: (evaluate! library loader eval_class valueG)
  (-> Library java/lang/ClassLoader Text (Bytecode Any) (Try [Any Definition]))
  (let [bytecode_name (text.replaced class_path_separator .module_separator eval_class)
        bytecode (class.class version.v6_0
                              class.public
                              (encoding/name.internal bytecode_name)
                              (encoding/name.internal "java.lang.Object") (list)
                              (list (field.field ..value::modifier ..value::field ..value::type (row.row)))
                              (list (method.method ..init::modifier "<clinit>" ..init::type
                                                   (list)
                                                   {.#Some
                                                    ($_ _.composite
                                                        valueG
                                                        (_.putstatic (type.class bytecode_name (list)) ..value::field ..value::type)
                                                        _.return)}))
                              (row.row))]
    (io.run! (do [! (try.with io.monad)]
               [bytecode (# ! each (format.result class.writer)
                            (io.io bytecode))
                _ (loader.store eval_class bytecode library)
                class (loader.load eval_class loader)
                value (# io.monad in (class_value eval_class class))]
               (in [value
                    [eval_class bytecode]])))))

(def: (execute! library loader temp_label [class_name class_bytecode])
  (-> Library java/lang/ClassLoader Text Definition (Try Any))
  (io.run! (do (try.with io.monad)
             [existing_class? (|> (atom.read! library)
                                  (# io.monad each (function (_ library)
                                                     (dictionary.key? library class_name)))
                                  (try.lifted io.monad)
                                  (: (IO (Try Bit))))
              _ (if existing_class?
                  (in [])
                  (loader.store class_name class_bytecode library))]
             (loader.load class_name loader))))

(def: (define! library loader [module name] valueG)
  (-> Library java/lang/ClassLoader Symbol (Bytecode Any) (Try [Text Any Definition]))
  (let [class_name (format (text.replaced .module_separator class_path_separator module)
                           class_path_separator (name.normal name)
                           "___" (%.nat (text#hash name)))]
    (do try.monad
      [[value definition] (evaluate! library loader class_name valueG)]
      (in [class_name value definition]))))

(def: .public host
  (IO //runtime.Host)
  (io (let [library (loader.new_library [])
            loader (loader.memory library)]
        (: //runtime.Host
           (implementation
            (def: (evaluate! temp_label valueG)
              (let [eval_class (|> temp_label name.normal (text.replaced " " "$"))]
                (# try.monad each product.left
                   (..evaluate! library loader eval_class valueG))))
            
            (def: execute!
              (..execute! library loader))
            
            (def: define!
              (..define! library loader)))))))