aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/host/jvm/class.lux
blob: 6fb6f48d48e553f15282e7349a87bb64ea3786cf (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
(.module:
  [lux #*
   [abstract
    ["." equivalence (#+ Equivalence)]
    [monoid (#+)]
    ["." monad (#+ do)]]
   [control
    [parser (#+)]
    ["." state (#+ State)]]
   [data
    [number (#+)
     [i64 (#+)]]
    [format
     ["." binary (#+ Format)]]
    [collection
     ["." row (#+ Row)]]]
   [type
    [abstract (#+)]]]
  ["." // #_
   ["#." encoding (#+)]
   ["#." modifier (#+ modifiers:)]
   ["#." version (#+ Version Minor Major)]
   ["#." name (#+ Internal)]
   ["#." magic (#+ Magic)]
   ["#." index (#+ Index)]
   ["#." attribute (#+ Attribute)]
   ["#." field (#+ Field)]
   ["#." method (#+ Method)]
   ["#." constant (#+ Constant)
    ["#/." pool (#+ Pool)]]])

(modifiers:
  ["0001" public]
  ["0010" final]
  ["0020" super]
  ["0200" interface]
  ["0400" abstract]
  ["1000" synthetic]
  ["2000" annotation]
  ["4000" enum]
  )

(type: #export Class
  {#magic Magic
   #minor-version Minor
   #major-version Major
   #constant-pool Pool
   #modifier Modifier
   #this (Index //constant.Class)
   #super (Index //constant.Class)
   #interfaces (Row (Index //constant.Class))
   #fields (Row Field)
   #methods (Row Method)
   #attributes (Row Attribute)})

(def: #export equivalence
  (Equivalence Class)
  ($_ equivalence.product
      //encoding.u4-equivalence
      //encoding.u2-equivalence
      //encoding.u2-equivalence
      //constant/pool.equivalence
      ..modifier-equivalence
      //index.equivalence
      //index.equivalence
      (row.equivalence //index.equivalence)
      (row.equivalence //field.equivalence)
      (row.equivalence //method.equivalence)
      (row.equivalence //attribute.equivalence)))

(def: default-minor-version Minor (//version.version 0))

(def: (install-classes this super interfaces)
  (-> Internal Internal (List Internal)
      (State Pool [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))]))
  (do state.monad
    [@this (//constant/pool.class (//name.read this))
     @super (//constant/pool.class (//name.read super))
     @interfaces (: (State Pool (Row (Index //constant.Class)))
                    (monad.fold @ (function (_ interface @interfaces)
                                    (do @
                                      [@interface (//constant/pool.class (//name.read interface))]
                                      (wrap (row.add @interface @interfaces))))
                                row.empty
                                interfaces))]
    (wrap [@this @super @interfaces])))

(def: #export (class version modifier
                     super this interfaces
                     fields methods attributes)
  (-> Major Modifier
      Internal Internal (List Internal)
      (List (State Pool Field))
      (Row Method)
      (Row Attribute)
      Class)
  (let [[pool [@this @super @interfaces] =fields]
        (state.run //constant/pool.empty
                   (do state.monad
                     [classes (install-classes this super interfaces)
                      =fields (monad.seq state.monad fields)]
                     (wrap [classes =fields])))]
    {#magic //magic.code
     #minor-version ..default-minor-version
     #major-version version
     #constant-pool pool
     #modifier modifier
     #this @this
     #super @super
     #interfaces @interfaces
     #fields (row.from-list =fields)
     #methods methods
     #attributes attributes}))

(def: #export format
  (Format Class)
  ($_ binary.and
      //magic.format
      //version.format
      //version.format
      //constant/pool.format
      ..modifier-format
      //index.format
      //index.format
      (binary.row/16 //index.format)
      (binary.row/16 //field.format)
      (binary.row/16 //method.format)
      (binary.row/16 //attribute.format)))