aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/common.jvm.lux
blob: 1f04f579868cca20deae1d4a0b8530524ccc119d (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
(;module:
  [lux #- function]
  (lux (control ["ex" exception #+ exception:])
       [io]
       (concurrency ["A" atom])
       (data ["R" result]
             (coll ["d" dict]))
       [host])
  (luxc (generator (host ["$" jvm]
                         (jvm ["$t" type]
                              ["$d" def]
                              ["$i" inst])))))

(host;import org.objectweb.asm.Opcodes
  (#static V1_6 int))

(host;import java.lang.Object)

(host;import (java.lang.Class a))

(host;import java.lang.ClassLoader
  (loadClass [String] (Class Object)))

(type: #export Bytecode host;Byte-Array)

(type: #export Class-Store (A;Atom (d;Dict Text Bytecode)))

(type: #export Host
  {#loader ClassLoader
   #store Class-Store
   #function-class (Maybe Text)})

(exception: Unknown-Class)
(exception: Class-Already-Stored)
(exception: No-Function-Being-Compiled)

(def: #export (store-class name byte-code)
  (-> Text Bytecode (Lux Unit))
  (;function [compiler]
    (let [store (|> (get@ #;host compiler)
                    (:! Host)
                    (get@ #store))]
      (if (d;contains? name (|> store A;get io;run))
        (ex;throw Class-Already-Stored name)
        (#R;Success [compiler (io;run (A;update (d;put name byte-code) store))])
        ))))

(def: #export (load-class name)
  (-> Text (Lux (Class Object)))
  (;function [compiler]
    (let [host (:! Host (get@ #;host compiler))
          store (|> host (get@ #store) A;get io;run)]
      (if (d;contains? name store)
        (#R;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
        (ex;throw Unknown-Class name)))))

(def: #export (with-function class expr)
  (All [a] (-> Text (Lux a) (Lux a)))
  (;function [compiler]
    (let [host (:! Host (get@ #;host compiler))
          old-function-class (get@ #function-class host)]
      (case (expr (set@ #;host
                        (:! Void (set@ #function-class
                                       (#;Some class)
                                       host))
                        compiler))
        (#R;Success [compiler' output])
        (#R;Success [(update@ #;host
                              (|>. (:! Host)
                                   (set@ #function-class old-function-class)
                                   (:! Void))
                              compiler')
                     output])

        (#R;Error error)
        (#R;Error error)))))

(def: #export function
  (Lux Text)
  (;function [compiler]
    (let [host (:! Host (get@ #;host compiler))]
      (case (get@ #function-class host)
        #;None
        (ex;throw No-Function-Being-Compiled "")
        
        (#;Some function-class)
        (#R;Success [compiler function-class])))))

(def: #export bytecode-version Int Opcodes.V1_6)