aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/target/jvm/attribute.lux
blob: ed10a42c6f07b9c0cd65bdf445e2ee550b1e4d83 (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:
  [library
   [lux {"-" [Info Code]}
    [abstract
     [monad {"+" [do]}]
     ["[0]" equivalence {"+" [Equivalence]}]]
    [control
     ["[0]" try]
     ["[0]" exception {"+" [exception:]}]]
    [data
     ["[0]" sum]
     ["[0]" product]
     [format
      ["[0]F" binary {"+" [Writer]}]]]
    [math
     [number
      ["n" nat]]]]]
  ["[0]" // "_"
   ["[1][0]" index {"+" [Index]}]
   [encoding
    ["[1][0]" unsigned {"+" [U2 U4]}]]
   ["[1][0]" constant {"+" [UTF8 Class Value]}
    ["[1]/[0]" pool {"+" [Pool Resource]}]]]
  ["[0]" / "_"
   ["[1][0]" constant {"+" [Constant]}]
   ["[1][0]" code]])

(type: .public (Info about)
  (Record
   [#name (Index UTF8)
    #length U4
    #info about]))

(def: .public (info_equivalence Equivalence<about>)
  (All (_ about)
    (-> (Equivalence about)
        (Equivalence (Info about))))
  ($_ product.equivalence
      //index.equivalence
      //unsigned.equivalence
      Equivalence<about>))

(def: (info_writer writer)
  (All (_ about)
    (-> (Writer about)
        (Writer (Info about))))
  (function (_ [name length info])
    (let [[nameS nameT] (//index.writer name)
          [lengthS lengthT] (//unsigned.writer/4 length)
          [infoS infoT] (writer info)]
      [($_ n.+ nameS lengthS infoS)
       (|>> nameT lengthT infoT)])))

(with_expansions [<Code> (as_is (/code.Code Attribute))]
  (type: .public Attribute
    (Rec Attribute
      (Variant
       {#Constant (Info (Constant Any))}
       {#Code (Info <Code>)})))

  (type: .public Code
    <Code>)
  )

(def: .public equivalence
  (Equivalence Attribute)
  (equivalence.rec
   (function (_ equivalence)
     ($_ sum.equivalence
         (info_equivalence /constant.equivalence)
         (info_equivalence (/code.equivalence equivalence))))))

(def: common_attribute_length
  ($_ n.+
      ... u2 attribute_name_index;
      //unsigned.bytes/2
      ... u4 attribute_length;
      //unsigned.bytes/4
      ))

(def: (length attribute)
  (-> Attribute Nat)
  (case attribute
    (^template [<tag>]
      [{<tag> [name length info]}
       (|> length //unsigned.value (n.+ ..common_attribute_length))])
    ([#Constant] [#Code])))

... TODO: Inline ASAP
(def: (constant' @name index)
  (-> (Index UTF8) (Constant Any) Attribute)
  {#Constant [#name @name
              #length (|> /constant.length //unsigned.u4 try.trusted)
              #info index]})

(def: .public (constant index)
  (-> (Constant Any) (Resource Attribute))
  (do //constant/pool.monad
    [@name (//constant/pool.utf8 "ConstantValue")]
    (in (constant' @name index))))

... TODO: Inline ASAP
(def: (code' @name specification)
  (-> (Index UTF8) Code Attribute)
  {#Code [#name @name
          ... https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3
          #length (|> specification
                      (/code.length ..length)
                      //unsigned.u4
                      try.trusted)
          #info specification]})

(def: .public (code specification)
  (-> Code (Resource Attribute))
  (do //constant/pool.monad
    [@name (//constant/pool.utf8 "Code")]
    (in (code' @name specification))))

(def: .public (writer value)
  (Writer Attribute)
  (case value
    {#Constant attribute}
    ((info_writer /constant.writer) attribute)
    
    {#Code attribute}
    ((info_writer (/code.writer writer)) attribute)))