aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/data/format/binary.lux9
-rw-r--r--stdlib/source/lux/target/jvm/class.lux17
-rw-r--r--stdlib/source/lux/target/jvm/constant.lux2
-rw-r--r--stdlib/source/lux/target/jvm/constant/pool.lux57
-rw-r--r--stdlib/source/lux/target/jvm/descriptor.lux11
-rw-r--r--stdlib/source/lux/target/jvm/method.lux20
-rw-r--r--stdlib/source/lux/target/jvm/program.lux46
-rw-r--r--stdlib/source/lux/target/jvm/program/condition.lux5
-rw-r--r--stdlib/source/lux/target/jvm/program/instruction.lux5
-rw-r--r--stdlib/source/lux/target/jvm/program/resources.lux5
10 files changed, 138 insertions, 39 deletions
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index d7abd617c..5e35829c8 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -33,12 +33,16 @@
(-> [Offset Binary] [Offset Binary]))
(type: #export Specification
- [Size (-> [Offset Binary] [Offset Binary])])
+ [Size Mutation])
(def: #export no-op
Specification
[0 function.identity])
+(def: #export (instance [size mutation])
+ (-> Specification Binary)
+ (|> size binary.create [0] mutation product.right))
+
(structure: #export monoid (Monoid Specification)
(def: identity
@@ -53,8 +57,7 @@
(def: #export (run writer value)
(All [a] (-> (Writer a) a Binary))
- (let [[valueS valueT] (writer value)]
- (|> valueS binary.create [0] valueT product.right)))
+ (instance (writer value)))
(template [<name> <size> <write>]
[(def: #export <name>
diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux
index 516dec1fc..a99637dcd 100644
--- a/stdlib/source/lux/target/jvm/class.lux
+++ b/stdlib/source/lux/target/jvm/class.lux
@@ -74,12 +74,12 @@
(-> 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))
+ [@this (//constant/pool.class this)
+ @super (//constant/pool.class super)
@interfaces (: (State Pool (Row (Index //constant.Class)))
(monad.fold @ (function (_ interface @interfaces)
(do @
- [@interface (//constant/pool.class (//name.read interface))]
+ [@interface (//constant/pool.class interface)]
(wrap (row.add @interface @interfaces))))
row.empty
interfaces))]
@@ -91,15 +91,16 @@
(-> Major (Modifier Class)
Internal Internal (List Internal)
(List (State Pool Field))
- (Row Method)
+ (List (State Pool Method))
(Row Attribute)
Class)
- (let [[pool [@this @super @interfaces] =fields]
+ (let [[pool [@this @super @interfaces] =fields =methods]
(state.run //constant/pool.empty
(do state.monad
[classes (install-classes this super interfaces)
- =fields (monad.seq state.monad fields)]
- (wrap [classes =fields])))]
+ =fields (monad.seq state.monad fields)
+ =methods (monad.seq state.monad methods)]
+ (wrap [classes =fields =methods])))]
{#magic //magic.code
#minor-version //version.default-minor
#major-version version
@@ -109,7 +110,7 @@
#super @super
#interfaces @interfaces
#fields (row.from-list =fields)
- #methods methods
+ #methods (row.from-list =methods)
#attributes attributes}))
(def: #export parser
diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux
index 31dfe3bbb..36c131b00 100644
--- a/stdlib/source/lux/target/jvm/constant.lux
+++ b/stdlib/source/lux/target/jvm/constant.lux
@@ -114,7 +114,7 @@
#name-and-type (Index (Name-And-Type of))})
(template [<type> <equivalence> <parser> <writer>]
- [(def: <equivalence>
+ [(def: #export <equivalence>
(Equivalence (<type> Any))
($_ equivalence.product
//index.equivalence
diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux
index dc500c885..5d8636deb 100644
--- a/stdlib/source/lux/target/jvm/constant/pool.lux
+++ b/stdlib/source/lux/target/jvm/constant/pool.lux
@@ -24,12 +24,13 @@
abstract]
[macro
["." template]]]
- ["." // (#+ UTF8 Class Long Double Constant)
+ ["." // (#+ UTF8 Class Long Double Constant Name-And-Type Reference)
[//
[encoding
- ["." unsigned]]
- ["." index (#+ Index)]
- ["." descriptor (#+ Descriptor)]]])
+ ["#." name (#+ Internal External)]
+ ["#." unsigned]]
+ ["#." index (#+ Index)]
+ ["#." descriptor (#+ Field Method Descriptor)]]])
(def: offset 1)
@@ -41,7 +42,7 @@
(template: (!add <tag> <=> <value>)
(function (_ pool)
- (with-expansions [<index> (as-is (index.index (unsigned.u2 (n/+ offset idx))))
+ (with-expansions [<index> (as-is (//index.index (//unsigned.u2 (n/+ offset idx))))
<try-again> (as-is (recur (.inc idx)))]
(loop [idx 0]
(case (row.nth idx pool)
@@ -61,7 +62,7 @@
<index>])))))
(template: (!raw-index <index>)
- (|> <index> index.number unsigned.nat .nat))
+ (|> <index> //index.number //unsigned.nat .nat))
(exception: #export (invalid-index {index (Index Any)}
{maximum Nat})
@@ -97,7 +98,7 @@
(template: (!find <tag> <=> <%> <expected>)
(function (_ pool)
- (with-expansions [<index> (as-is (index.index (unsigned.u2 (n/+ offset idx))))
+ (with-expansions [<index> (as-is (//index.index (//unsigned.u2 (n/+ offset idx))))
<try-again> (as-is (recur (.inc idx)))]
(loop [idx 0]
(case (row.nth idx pool)
@@ -143,23 +144,49 @@
[utf8 UTF8 #//.UTF8 text.equivalence %.text]
)
-(def: (class' value)
- (Adder Class)
- (!add #//.Class //.class-equivalence value))
-
(def: #export (class name)
- (-> UTF8 (State Pool (Index Class)))
+ (-> Internal (State Pool (Index Class)))
(do state.monad
- [@name (utf8 name)]
- (class' (//.class @name))))
+ [@name (utf8 (//name.read name))
+ #let [value (//.class @name)]]
+ (!add #//.Class //.class-equivalence value)))
(def: #export (descriptor value)
(All [kind]
(-> (Descriptor kind)
(State Pool (Index (Descriptor kind)))))
- (let [value (descriptor.descriptor value)]
+ (let [value (//descriptor.descriptor value)]
(!add #//.UTF8 text.equivalence value)))
+(type: #export (Member of)
+ {#name UTF8
+ #descriptor (Descriptor of)})
+
+(def: #export (name-and-type [name descriptor])
+ (All [of]
+ (-> (Member of) (State Pool (Index (Name-And-Type of)))))
+ (do state.monad
+ [@name (utf8 name)
+ @descriptor (..descriptor descriptor)]
+ (!add #//.Name-And-Type //.name-and-type-equivalence
+ {#//.name @name
+ #//.descriptor @descriptor})))
+
+(template [<name> <tag> <of>]
+ [(def: #export (<name> class member)
+ (-> External (Member <of>) (State Pool (Index (Reference <of>))))
+ (do state.monad
+ [@class (..class (//name.internal class))
+ @name-and-type (name-and-type member)]
+ (!add <tag> //.reference-equivalence
+ {#//.class @class
+ #//.name-and-type @name-and-type})))]
+
+ [field #//.Field Field]
+ [method #//.Method Method]
+ [interface-method #//.Interface-Method Method]
+ )
+
(def: #export parser
(Parser Pool)
(<2>.row/16' ..offset //.parser))
diff --git a/stdlib/source/lux/target/jvm/descriptor.lux b/stdlib/source/lux/target/jvm/descriptor.lux
index c0cb20a61..1ca625bd6 100644
--- a/stdlib/source/lux/target/jvm/descriptor.lux
+++ b/stdlib/source/lux/target/jvm/descriptor.lux
@@ -4,14 +4,14 @@
["." text
["%" format (#+ format)]]
[collection
- ["." list ("#;." functor)]]]
+ ["." list ("#@." functor)]]]
[macro
["." template]]
[type
abstract]]
["." // #_
[encoding
- ["#." name (#+ Internal)]]])
+ ["#." name (#+ External)]]])
(abstract: #export Void' {} Any)
@@ -57,8 +57,9 @@
)
(def: #export object
- (-> Internal (Descriptor Object))
- (|>> //name.read
+ (-> External (Descriptor Object))
+ (|>> //name.internal
+ //name.read
(text.enclose ["L" ";"])
:abstraction))
@@ -75,7 +76,7 @@
(Descriptor Method))
(:abstraction
(format (|> inputs
- (list;map (|>> :representation))
+ (list@map (|>> :representation))
(text.join-with "")
(text.enclose ["(" ")"]))
(:representation output))))
diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux
index e6ee82617..d081d1c81 100644
--- a/stdlib/source/lux/target/jvm/method.lux
+++ b/stdlib/source/lux/target/jvm/method.lux
@@ -1,13 +1,13 @@
(.module:
[lux (#- static)
[abstract
- ["." equivalence (#+ Equivalence)]
[monoid (#+)]
+ ["." equivalence (#+ Equivalence)]
["." monad (#+ do)]]
[control
+ ["." state (#+ State)]
["<>" parser
- ["<2>" binary (#+ Parser)]]
- ["." state (#+ State)]]
+ ["<2>" binary (#+ Parser)]]]
[data
[number (#+)
[i64 (#+)]]
@@ -23,7 +23,7 @@
["#." attribute (#+ Attribute)]
["#." descriptor (#+ Descriptor)]
["#." constant (#+ UTF8)
- [pool (#+ Pool)]]])
+ ["#/." pool (#+ Pool)]]])
(type: #export #rec Method
{#modifier (Modifier Method)
@@ -46,6 +46,18 @@
["1000" synthetic]
)
+(def: #export (method modifier name descriptor attributes)
+ (-> (Modifier Method) UTF8 (Descriptor //descriptor.Method) (List (State Pool Attribute))
+ (State Pool Method))
+ (do state.monad
+ [@name (//constant/pool.utf8 name)
+ @descriptor (//constant/pool.descriptor descriptor)
+ attributes (monad.seq @ attributes)]
+ (wrap {#modifier modifier
+ #name @name
+ #descriptor @descriptor
+ #attributes (row.from-list attributes)})))
+
(def: #export equivalence
(Equivalence Method)
($_ equivalence.product
diff --git a/stdlib/source/lux/target/jvm/program.lux b/stdlib/source/lux/target/jvm/program.lux
index 61e5a9046..fd786d619 100644
--- a/stdlib/source/lux/target/jvm/program.lux
+++ b/stdlib/source/lux/target/jvm/program.lux
@@ -15,6 +15,7 @@
[number
["." nat]]
[collection
+ ["." list ("#@." functor fold)]
["." dictionary (#+ Dictionary)]]]]
["." / #_
["#." condition (#+ Local)]
@@ -22,7 +23,9 @@
["#." instruction (#+ Primitive-Array-Type Instruction) ("#@." monoid)]
["/#" // #_
["#." index]
+ ["#." descriptor (#+ Descriptor Value Return)]
[encoding
+ ["#." name (#+ External)]
["#." unsigned (#+ U1 U2)]
["#." signed]]
["#." constant (#+ UTF8)
@@ -428,7 +431,7 @@
(-> UTF8 (Program Any))
(do ..monad
## TODO: Make sure it"s impossible to have indexes greater than U2.
- [index (..lift (//constant/pool.class class))]
+ [index (..lift (//constant/pool.class (//name.internal class)))]
(..nullary (<instruction> index))))]
[new /instruction.new]
@@ -442,7 +445,44 @@
(..nullary (/instruction.iinc register increase)))
(def: #export (multianewarray class count)
- (-> UTF8 U1 (Program Any))
+ (-> External U1 (Program Any))
(do ..monad
- [index (..lift (//constant/pool.class class))]
+ [index (..lift (//constant/pool.class (//name.internal class)))]
(..nullary (/instruction.multianewarray index count))))
+
+(def: (descriptor-size descriptor)
+ (-> (Descriptor (Return Any)) U1)
+ (//unsigned.u1
+ (cond (is? //descriptor.void descriptor)
+ 0
+
+ (is? //descriptor.long descriptor)
+ 2
+
+ (is? //descriptor.double descriptor)
+ 2
+
+ ## else
+ 1)))
+
+(template [<static?> <name> <instruction>]
+ [(def: #export (<name> class method inputs output)
+ (-> External Text (List (Descriptor (Value Any))) (Descriptor (Return Any)) (Program Any))
+ (do ..monad
+ [index (<| ..lift
+ (//constant/pool.method class)
+ {#//constant/pool.name method
+ #//constant/pool.descriptor (//descriptor.method inputs output)})]
+ (wrap (/instruction.invokestatic
+ index
+ (|> inputs
+ (list@map descriptor-size)
+ (list@fold //unsigned.u1/+ (//unsigned.u1 0))
+ (//unsigned.u1/+ (//unsigned.u1 (if <static?> 0 1))))
+ (descriptor-size output)))))]
+
+ [#1 invokestatic /instruction.invokestatic]
+ [#0 invokevirtual /instruction.invokevirtual]
+ [#0 invokespecial /instruction.invokespecial]
+ [#0 invokeinterface /instruction.invokeinterface]
+ )
diff --git a/stdlib/source/lux/target/jvm/program/condition.lux b/stdlib/source/lux/target/jvm/program/condition.lux
index e0b778c07..04bb8c60b 100644
--- a/stdlib/source/lux/target/jvm/program/condition.lux
+++ b/stdlib/source/lux/target/jvm/program/condition.lux
@@ -23,6 +23,11 @@
{#resources Resources
#stack U2})
+(def: #export start
+ Environment
+ {#resources //resources.start
+ #stack (///unsigned.u2 0)})
+
(type: #export Condition
(-> Environment (Try Environment)))
diff --git a/stdlib/source/lux/target/jvm/program/instruction.lux b/stdlib/source/lux/target/jvm/program/instruction.lux
index 375204cc8..3d0397a14 100644
--- a/stdlib/source/lux/target/jvm/program/instruction.lux
+++ b/stdlib/source/lux/target/jvm/program/instruction.lux
@@ -34,6 +34,11 @@
(type: #export Instruction
[Size (-> [Environment Specification] (Try [Environment Specification]))])
+(def: #export (run instruction)
+ (-> Instruction (Try [Environment Specification]))
+ (let [[_ instruction'] instruction]
+ (instruction' [/.start binaryF.no-op])))
+
(def: (instruction size condition transform)
(-> Size Condition (-> Specification Specification) Instruction)
[size
diff --git a/stdlib/source/lux/target/jvm/program/resources.lux b/stdlib/source/lux/target/jvm/program/resources.lux
index fed6d4ce7..980104e72 100644
--- a/stdlib/source/lux/target/jvm/program/resources.lux
+++ b/stdlib/source/lux/target/jvm/program/resources.lux
@@ -16,6 +16,11 @@
{#max-stack U2
#max-locals U2})
+(def: #export start
+ Resources
+ {#max-stack (///unsigned.u2 0)
+ #max-locals (///unsigned.u2 0)})
+
(def: #export length
($_ n/+
## u2 max_stack;
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 23:33:43 +0000