aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/host/jvm.lux
blob: 4b4b1d38e4e6fbfce4501421ebe5015b90dc92b4 (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
(;module:
  [lux #- Type Def]
  (lux (control monad
                ["p" parser])
       (data (coll [list "L/" Functor<List>]))
       [macro]
       (macro [code]
              ["s" syntax #+ syntax:])
       [host]))

## [Host]
(host;import org.objectweb.asm.MethodVisitor)

(host;import org.objectweb.asm.ClassWriter)

(host;import #long org.objectweb.asm.Label
  (new []))

## [Type]
(type: #export Bound
  #Upper
  #Lower)

(type: #export Primitive
  #Boolean
  #Byte
  #Short
  #Int
  #Long
  #Float
  #Double
  #Char)

(type: #export #rec Generic
  (#Var Text)
  (#Wildcard (Maybe [Bound Generic]))
  (#Class Text (List Generic)))

(type: #export Class
  [Text (List Generic)])

(type: #export Parameter
  [Text Class (List Class)])

(type: #export #rec Type
  (#Primitive Primitive)
  (#Generic Generic)
  (#Array Type))

(type: #export Method
  {#args (List Type)
   #return (Maybe Type)
   #exceptions (List Generic)})

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

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

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

(type: #export Register Nat)

(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)

## [Values]
(syntax: (config: [type s;local-symbol]
           [none s;local-symbol]
           [++ s;local-symbol]
           [options (s;tuple (p;many s;local-symbol))])
  (let [g!type (code;local-symbol type)
        g!none (code;local-symbol none)
        g!tags+ (L/map code;local-tag options)
        g!_left (code;local-symbol "_left")
        g!_right (code;local-symbol "_right")
        g!options+ (L/map (function [option]
                            (` (def: (~' #export) (~ (code;local-symbol option))
                                 (~ g!type)
                                 (|> (~ g!none)
                                     (set@ (~ (code;local-tag option)) true)))))
                          options)]
    (wrap (list& (` (type: (~' #export) (~ g!type)
                      (~ (code;record (L/map (function [tag]
                                               [tag (` ;Bool)])
                                             g!tags+)))))

                 (` (def: (~' #export) (~ g!none)
                      (~ g!type)
                      (~ (code;record (L/map (function [tag]
                                               [tag (` false)])
                                             g!tags+)))))

                 (` (def: (~' #export) ((~ (code;local-symbol ++)) (~ g!_left) (~ g!_right))
                      (-> (~ g!type) (~ g!type) (~ g!type))
                      (~ (code;record (L/map (function [tag]
                                               [tag (` (and (get@ (~ tag) (~ g!_left))
                                                            (get@ (~ tag) (~ g!_right))))])
                                             g!tags+)))))

                 g!options+))))

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

## Labels
(def: #export new-label
  (-> Unit Label)
  org.objectweb.asm.Label.new)