aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/host/jvm.lux
blob: 5bcc3eef034ed31a15b3220524d6ce37fc5eb7e5 (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
(.module:
  [lux (#- Definition Type)
   [host (#+ import:)]
   [abstract
    monad]
   [control
    ["p" parser
     ["s" code]]]
   [data
    [binary (#+ Binary)]
    [collection
     ["." list ("#/." functor)]]]
   [macro
    ["." code]
    [syntax (#+ syntax:)]]
   [target
    [jvm
     ["." type (#+ Type)
      [category (#+ Class)]]]]
   [tool
    [compiler
     [reference (#+ Register)]
     [language
      [lux
       ["." generation]]]]]])

(import: org/objectweb/asm/MethodVisitor)

(import: org/objectweb/asm/ClassWriter)

(import: #long org/objectweb/asm/Label
  (new []))

(type: #export Def
  (-> ClassWriter ClassWriter))

(type: #export Inst
  (-> MethodVisitor MethodVisitor))

(type: #export Label
  org/objectweb/asm/Label)

(type: #export Visibility
  #Public
  #Protected
  #Private
  #Default)

(type: #export Version
  #V1_1
  #V1_2
  #V1_3
  #V1_4
  #V1_5
  #V1_6
  #V1_7
  #V1_8)

(type: #export ByteCode Binary)

(type: #export Definition [Text ByteCode])

(type: #export Anchor [Label Register])

(type: #export Host
  (generation.Host Inst Definition))

(template [<name> <base>]
  [(type: #export <name>
     (<base> ..Anchor Inst Definition))]

  [State     generation.State]
  [Operation generation.Operation]
  [Phase     generation.Phase]
  [Handler   generation.Handler]
  [Bundle    generation.Bundle]
  )

(syntax: (config: {type s.local-identifier}
           {none s.local-identifier}
           {++ s.local-identifier}
           {options (s.tuple (p.many s.local-identifier))})
  (let [g!type (code.local-identifier type)
        g!none (code.local-identifier none)
        g!tags+ (list/map code.local-tag options)
        g!_left (code.local-identifier "_left")
        g!_right (code.local-identifier "_right")
        g!options+ (list/map (function (_ option)
                               (` (def: (~' #export) (~ (code.local-identifier option))
                                    (~ g!type)
                                    (|> (~ g!none)
                                        (set@ (~ (code.local-tag option)) #1)))))
                             options)]
    (wrap (list& (` (type: (~' #export) (~ g!type)
                      (~ (code.record (list/map (function (_ tag)
                                                  [tag (` .Bit)])
                                                g!tags+)))))

                 (` (def: (~' #export) (~ g!none)
                      (~ g!type)
                      (~ (code.record (list/map (function (_ tag)
                                                  [tag (` #0)])
                                                g!tags+)))))

                 (` (def: (~' #export) ((~ (code.local-identifier ++)) (~ g!_left) (~ g!_right))
                      (-> (~ g!type) (~ g!type) (~ g!type))
                      (~ (code.record (list/map (function (_ tag)
                                                  [tag (` (or (get@ (~ tag) (~ g!_left))
                                                              (get@ (~ tag) (~ g!_right))))])
                                                g!tags+)))))

                 g!options+))))

(config: Class-Config  noneC ++C [finalC])
(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM])
(config: Field-Config  noneF ++F [finalF staticF transientF volatileF])

(def: #export new-label
  (-> Any Label)
  (function (_ _)
    (org/objectweb/asm/Label::new)))

(def: #export (simple-class name)
  (-> Text (Type Class))
  (type.class name (list)))