1 files changed, 150 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/meta/target/jvm/attribute.lux b/stdlib/source/library/lux/meta/target/jvm/attribute.lux
new file mode 100644
index 000000000..0b0af146e
--- /dev/null
+++ b/stdlib/source/library/lux/meta/target/jvm/attribute.lux
@@ -0,0 +1,150 @@
+(.require
+ [library
+  [lux (.except Info Code Type)
+   [abstract
+    [monad (.only do)]
+    ["[0]" equivalence (.only Equivalence)]]
+   [control
+    ["[0]" try]]
+   [data
+    ["[0]" sum]
+    ["[0]" product]
+    ["[0]" binary
+     ["[1]F" \\format (.only Format)]]]
+   [math
+    [number
+     ["n" nat]]]
+   [meta
+    [macro
+     ["^" pattern]]]]]
+ ["[0]" //
+  ["[1][0]" index (.only Index)]
+  ["[1][0]" type (.only Type)
+   ["[2][0]" signature (.only Signature)]]
+  [encoding
+   ["[1][0]" unsigned (.only U2 U4)]]
+  ["[1][0]" constant (.only UTF8 Class Value)
+   ["[2][0]" pool (.only Pool Resource) (.use "[1]#[0]" monad)]]]
+ ["[0]" /
+  ["[1][0]" constant (.only 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))))
+  (all product.equivalence
+       //index.equivalence
+       //unsigned.equivalence
+       Equivalence<about>))
+
+(def (info_format format)
+  (All (_ about)
+    (-> (Format about)
+        (Format (Info about))))
+  (function (_ [name length info])
+    (let [[nameS nameT] (//index.format name)
+          [lengthS lengthT] (//unsigned.format/4 length)
+          [infoS infoT] (format info)]
+      [(all n.+ nameS lengthS infoS)
+       (|>> nameT lengthT infoT)])))
+
+(with_expansions [<Code> (these (/code.Code Attribute))]
+  (type .public Attribute
+    (Rec Attribute
+      (Variant
+       {#Constant (Info (Constant Any))}
+       {#Code (Info <Code>)}
+       {#Signature (Info (Index UTF8))})))
+
+  (type .public Code
+    <Code>)
+  )
+
+(def .public equivalence
+  (Equivalence Attribute)
+  (equivalence.rec
+   (function (_ equivalence)
+     (all sum.equivalence
+          (info_equivalence /constant.equivalence)
+          (info_equivalence (/code.equivalence equivalence))
+          (info_equivalence //index.equivalence)
+          ))))
+
+(def common_attribute_length
+  (all n.+
+       ... u2 attribute_name_index;
+       //unsigned.bytes/2
+       ... u4 attribute_length;
+       //unsigned.bytes/4
+       ))
+
+(def (length attribute)
+  (-> Attribute Nat)
+  (case attribute
+    (^.with_template [<tag>]
+      [{<tag> [name length info]}
+       (|> length //unsigned.value (n.+ ..common_attribute_length))])
+    ([#Constant]
+     [#Code]
+     [#Signature])))
+
+... TODO: Inline ASAP
+(def (constant' index @name)
+  (-> (Constant Any) (Index UTF8) Attribute)
+  {#Constant [#name @name
+              ... https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.7.2
+              #length (|> /constant.length //unsigned.u4 try.trusted)
+              #info index]})
+
+(def .public (constant index)
+  (-> (Constant Any) (Resource Attribute))
+  (//pool#each (constant' index) (//pool.utf8 "ConstantValue")))
+
+... TODO: Inline ASAP
+(def (code' specification @name)
+  (-> Code (Index UTF8) 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))
+  (//pool#each (code' specification) (//pool.utf8 "Code")))
+
+... TODO: Inline ASAP
+(def (signature' it @name)
+  (-> (Index UTF8) (Index UTF8) Attribute)
+  {#Signature [#name @name
+               ... https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.7.9
+               #length (|> //index.length //unsigned.u4 try.trusted)
+               #info it]})
+
+(def .public (signature it)
+  (All (_ category)
+    (-> (Signature category) (Resource Attribute)))
+  (do [! //pool.monad]
+    [it (|> it //signature.signature //pool.utf8)]
+    (at ! each (signature' it) (//pool.utf8 "Signature"))))
+
+(def .public (format it)
+  (Format Attribute)
+  (case it
+    {#Constant it}
+    ((info_format /constant.format) it)
+    
+    {#Code it}
+    ((info_format (/code.format format)) it)
+
+    {#Signature it}
+    ((info_format //index.format) it)))