diff options
-rw-r--r-- | stdlib/source/lux/host/jvm.lux | 16 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/attribute.lux | 82 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/constant.lux | 30 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/encoding.lux | 10 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/field.lux | 49 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/modifier.lux | 29 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/modifier/field.lux | 27 |
7 files changed, 178 insertions, 65 deletions
diff --git a/stdlib/source/lux/host/jvm.lux b/stdlib/source/lux/host/jvm.lux index b8139760c..b0030c84f 100644 --- a/stdlib/source/lux/host/jvm.lux +++ b/stdlib/source/lux/host/jvm.lux @@ -14,6 +14,7 @@ ["/." magic (#+ Magic)] ["/." index (#+ Index)] ["/." attribute (#+ Attribute)] + ["/." field (#+ Field)] [modifier ["/.M" class]] ["/." constant (#+ Constant) @@ -22,9 +23,6 @@ (type: #export Interface (Index /constant.Class)) -(type: #export Field - Any) - (type: #export Method Any) @@ -57,8 +55,8 @@ interfaces)] (wrap [@this @super @interfaces]))) -(def: #export (class version access super this interfaces) - (-> Major /classM.Modifier Internal Internal (List Internal) Class) +(def: #export (class version access super this interfaces fields) + (-> Major /classM.Modifier Internal Internal (List Internal) (Row Field) Class) (let [[pool [@this @super @interfaces]] (state.run (: Pool row.empty) (install-classes this super interfaces))] {#magic /magic.code @@ -69,7 +67,7 @@ #this @this #super @super #interfaces @interfaces - #fields row.empty + #fields fields #methods row.empty #attributes row.empty})) @@ -80,10 +78,10 @@ /version.format /version.format /pool.format - /classM.format + /classM.modifier-format /index.format /index.format (binary.row/16 /index.format) + (binary.row/16 /field.format) (binary.row/16 (binary.ignore [])) - (binary.row/16 (binary.ignore [])) - (binary.row/16 (binary.ignore [])))) + (binary.row/16 /attribute.format))) diff --git a/stdlib/source/lux/host/jvm/attribute.lux b/stdlib/source/lux/host/jvm/attribute.lux index 3f0dd9b61..87891f35c 100644 --- a/stdlib/source/lux/host/jvm/attribute.lux +++ b/stdlib/source/lux/host/jvm/attribute.lux @@ -1,22 +1,84 @@ (.module: - [lux #* + [lux (#- Info Code' Code) + [control + [monad (#+ do)] + ["." state (#+ State)]] [data [format - ["." binary (#+ Format)]]]] + ["." binary (#+ Format)]] + [collection + ["." row (#+ Row)]]] + [world + [binary (#+ Binary)]]] [// ["//." encoding (#+ U2 U4)] - ["//." index (#+ Index)]]) + ["//." index (#+ Index)] + ["//." constant (#+ UTF8 Class Value) + ["//." pool (#+ Pool)]]]) -(type: #export Constant-Value - {#name Index +(type: #export (Info about) + {#name (Index UTF8) #length U4 - #index Index}) + #info about}) -(def: #export constant-value +(def: (info-format about) + (All [about] + (-> (Format about) + (Format (Info about)))) ($_ binary.and //index.format //encoding.u4-format - //index.format)) + about)) -(type: #export Attribute - Any) +(type: #export Constant + (Info (Index (Value Any)))) + +(def: constant-format + (Format Constant) + (..info-format //index.format)) + +(type: #export Label U2) + +(type: #export Exception + {#start-pc Label + #end-pc Label + #handler-pc Label + #catch-type (Index Class)}) + +(type: #export (Code' Attribute) + {#max-stack U2 + #max-locals U2 + #code Binary + #exception-table (Row Exception) + #attributes (Row Attribute)}) + +(with-expansions [<Code> (as-is (Info (Code' Attribute)))] + (type: #export #rec Attribute + (#Constant Constant) + ## (#Code <Code>) + ) + + ## (type: #export Code + ## <Code>) + ) + +(def: #export (constant index) + (-> (Index (Value Any)) + (State Pool Attribute)) + (do state.Monad<State> + [@name (//pool.utf8 "ConstantValue")] + (wrap (#Constant {#name @name + #length (//encoding.to-u4 //encoding.u2-bytes) + #info index})))) + +## (def: #export (code specification) +## (-> Code' (State Pool Attribute)) +## (do state.Monad<State> +## [@name (//pool.utf8 "Code")] +## (wrap (#Code {#name @name +## #length (undefined) +## #info specification})))) + +(def: #export format + (Format Attribute) + ..constant-format) diff --git a/stdlib/source/lux/host/jvm/constant.lux b/stdlib/source/lux/host/jvm/constant.lux index d2c9018ae..913c9043b 100644 --- a/stdlib/source/lux/host/jvm/constant.lux +++ b/stdlib/source/lux/host/jvm/constant.lux @@ -10,7 +10,8 @@ [collection ["." row (#+ Row)]]] [type - abstract]] + abstract] + ["." host (#+ import:)]] [// ["//." index (#+ Index)]] [/ @@ -44,6 +45,33 @@ //index.format)) ) +(abstract: #export (Value kind) + + {} + + kind + + (def: #export value + (All [kind] (-> (Value kind) kind)) + (|>> :representation)) + + (do-template [<type> <class> <constructor>] + [(import: #long <class>) + + (type: #export <type> (Value <class>)) + + (def: #export <constructor> + (-> <class> <type>) + (|>> :abstraction))] + + [Integer java/lang/Integer integer] + [Long java/lang/Long long] + [Float java/lang/Float float] + [Double java/lang/Double double] + [String java/lang/String string] + ) + ) + (type: #export Constant (#UTF8 UTF8) (#Class Class)) diff --git a/stdlib/source/lux/host/jvm/encoding.lux b/stdlib/source/lux/host/jvm/encoding.lux index 6d8afe348..2b2c487ec 100644 --- a/stdlib/source/lux/host/jvm/encoding.lux +++ b/stdlib/source/lux/host/jvm/encoding.lux @@ -11,12 +11,14 @@ [type abstract]]) -(do-template [<name> <bytes> <to> <from>] +(do-template [<bytes> <name> <size> <to> <from>] [(abstract: #export <name> {} (I64 Any) + (def: #export <size> Nat <bytes>) + (def: #export <to> (-> (I64 Any) <name>) (let [mask (|> <bytes> @@ -33,9 +35,9 @@ ("lux i64 =" (:representation reference) (:representation sample)))) )] - [U1 1 to-u1 from-u1] - [U2 2 to-u2 from-u2] - [U4 4 to-u4 from-u4] + [1 U1 u1-bytes to-u1 from-u1] + [2 U2 u2-bytes to-u2 from-u2] + [4 U4 u4-bytes to-u4 from-u4] ) (do-template [<name> <type> <format> <pre-write> <post-read>] diff --git a/stdlib/source/lux/host/jvm/field.lux b/stdlib/source/lux/host/jvm/field.lux new file mode 100644 index 000000000..802670780 --- /dev/null +++ b/stdlib/source/lux/host/jvm/field.lux @@ -0,0 +1,49 @@ +(.module: + [lux (#- static) + [control + [monoid (#+)] + [parser (#+)] + ["." monad (#+ do)] + ["." state (#+ State)]] + [data + [number (#+) + [i64 (#+)]] + [format + ["." binary (#+ Format)]] + [collection + ["." row (#+ Row)]]] + [type + [abstract (#+)]]] + [// + [encoding (#+)] + [modifier (#+ modifiers:)] + ["//." constant (#+ UTF8)] + ["//." index (#+ Index)] + ["//." attribute (#+ Attribute)] + ["//." descriptor (#+ Descriptor Value)]]) + +(modifiers: + ["0001" public] + ["0002" private] + ["0004" protected] + ["0008" static] + ["0010" final] + ["0040" volatile] + ["0080" transient] + ["1000" synthetic] + ["4000" enum] + ) + +(type: #export Field + {#modifier Modifier + #name (Index UTF8) + #descriptor (Index (Descriptor (Value Any))) + #attributes (Row Attribute)}) + +(def: #export format + (Format Field) + ($_ binary.and + ..modifier-format + //index.format + //index.format + (binary.row/16 //attribute.format))) diff --git a/stdlib/source/lux/host/jvm/modifier.lux b/stdlib/source/lux/host/jvm/modifier.lux index 5c9280164..0263fc1ec 100644 --- a/stdlib/source/lux/host/jvm/modifier.lux +++ b/stdlib/source/lux/host/jvm/modifier.lux @@ -34,41 +34,42 @@ (syntax: #export (modifiers: {options (parser.many ..modifier)}) (with-gensyms [g!parameter g!subject g!<name> g!<code>] - (let [nameC (' Modifier) - combineC (' combine) - emptyC (' empty) - typeC (` (abstract.abstract: (~' #export) (~ nameC) + (let [g!name (' Modifier) + g!combine (' combine) + g!empty (' empty) + g!format (' modifier-format) + typeC (` (abstract.abstract: (~' #export) (~ g!name) {} //encoding.U2 (.def: (~' #export) (~' code) - (.-> (~ nameC) //encoding.U2) + (.-> (~ g!name) //encoding.U2) (.|>> (~' :representation))) - (.def: (~' #export) ((~ combineC) (~ g!parameter) (~ g!subject)) - (.-> (~ nameC) (~ nameC) (~ nameC)) + (.def: (~' #export) ((~ g!combine) (~ g!parameter) (~ g!subject)) + (.-> (~ g!name) (~ g!name) (~ g!name)) ((~' :abstraction) (//encoding.to-u2 (i64.and (//encoding.from-u2 ((~' :representation) (~ g!parameter))) (//encoding.from-u2 ((~' :representation) (~ g!subject))))))) (.do-template [(~ g!<code>) (~ g!<name>)] [(.def: (~' #export) (~ g!<name>) - (~ nameC) + (~ g!name) (.|> (number.hex (~ g!<code>)) //encoding.to-u2 (~' :abstraction)))] - ["0000" (~ emptyC)] + ["0000" (~ g!empty)] (~+ (list/map ..code options)) ) - (.def: (~' #export) (~' format) - (binary.Format (~ nameC)) + (.def: (~' #export) (~ g!format) + (binary.Format (~ g!name)) (.let [(.^open "_/.") //encoding.u2-format] {#binary.reader (|> (~' _/reader) (:: parser.Functor<Parser> (~' map) (|>> (~' :abstraction)))) #binary.writer (|>> (~' :representation) (~' _/writer))})))) - monoidC (` (.structure: (~' #export) (~' _) (monoid.Monoid (~ nameC)) - (.def: (~' identity) (~ emptyC)) - (.def: (~' compose) (~ combineC))))] + monoidC (` (.structure: (~' #export) (~' _) (monoid.Monoid (~ g!name)) + (.def: (~' identity) (~ g!empty)) + (.def: (~' compose) (~ g!combine))))] (wrap (list typeC monoidC))))) diff --git a/stdlib/source/lux/host/jvm/modifier/field.lux b/stdlib/source/lux/host/jvm/modifier/field.lux deleted file mode 100644 index 6099bc62e..000000000 --- a/stdlib/source/lux/host/jvm/modifier/field.lux +++ /dev/null @@ -1,27 +0,0 @@ -(.module: - [lux (#- static) - [control - [monoid (#+)] - [parser (#+)]] - [data - [number (#+) - [i64 (#+)]] - [format - [binary (#+)]]] - [type - [abstract (#+)]]] - [// (#+ modifiers:) - [// - [encoding (#+)]]]) - -(modifiers: - ["0001" public] - ["0002" private] - ["0004" protected] - ["0008" static] - ["0010" final] - ["0040" volatile] - ["0080" transient] - ["1000" synthetic] - ["4000" enum] - ) |