aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/target/jvm/constant/pool.lux11
-rw-r--r--stdlib/source/lux/target/jvm/method.lux33
-rw-r--r--stdlib/source/lux/target/jvm/modifier.lux2
-rw-r--r--stdlib/source/lux/target/jvm/program.lux28
-rw-r--r--stdlib/source/lux/target/jvm/program/instruction.lux1
5 files changed, 57 insertions, 18 deletions
diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux
index 5d8636deb..212c3cb9e 100644
--- a/stdlib/source/lux/target/jvm/constant/pool.lux
+++ b/stdlib/source/lux/target/jvm/constant/pool.lux
@@ -14,7 +14,7 @@
["." int]
["." frac]]
["." text
- ["%" format]]
+ ["%" format (#+ format)]]
[format
[".F" binary (#+ Writer)]]
[collection
@@ -24,7 +24,7 @@
abstract]
[macro
["." template]]]
- ["." // (#+ UTF8 Class Long Double Constant Name-And-Type Reference)
+ ["." // (#+ UTF8 String Class Long Double Constant Name-And-Type Reference)
[//
[encoding
["#." name (#+ Internal External)]
@@ -144,6 +144,13 @@
[utf8 UTF8 #//.UTF8 text.equivalence %.text]
)
+(def: #export (string value)
+ (-> Text (State Pool (Index String)))
+ (do state.monad
+ [@value (utf8 value)
+ #let [value (//.string @value)]]
+ (!add #//.String (//.value-equivalence //index.equivalence) value)))
+
(def: #export (class name)
(-> Internal (State Pool (Index Class)))
(do state.monad
diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux
index d081d1c81..88d43f5b4 100644
--- a/stdlib/source/lux/target/jvm/method.lux
+++ b/stdlib/source/lux/target/jvm/method.lux
@@ -5,6 +5,7 @@
["." equivalence (#+ Equivalence)]
["." monad (#+ do)]]
[control
+ ["." try]
["." state (#+ State)]
["<>" parser
["<2>" binary (#+ Parser)]]]
@@ -20,10 +21,14 @@
["." // #_
["#." modifier (#+ Modifier modifiers:)]
["#." index (#+ Index)]
- ["#." attribute (#+ Attribute)]
["#." descriptor (#+ Descriptor)]
+ ["#." attribute (#+ Attribute)
+ ["#/." code]]
["#." constant (#+ UTF8)
- ["#/." pool (#+ Pool)]]])
+ ["#/." pool (#+ Pool)]]
+ ["#." program (#+ Program)
+ ["#/." condition]
+ ["#/." instruction]]])
(type: #export #rec Method
{#modifier (Modifier Method)
@@ -46,17 +51,33 @@
["1000" synthetic]
)
-(def: #export (method modifier name descriptor attributes)
- (-> (Modifier Method) UTF8 (Descriptor //descriptor.Method) (List (State Pool Attribute))
+(def: #export (method modifier name descriptor attributes code)
+ (-> (Modifier Method) UTF8 (Descriptor //descriptor.Method) (List (State Pool Attribute)) (Program Any)
(State Pool Method))
(do state.monad
[@name (//constant/pool.utf8 name)
@descriptor (//constant/pool.descriptor descriptor)
- attributes (monad.seq @ attributes)]
+ attributes (monad.seq @ attributes)
+ ?code (//program.resolve code)
+ [environment bytecode] (case (do try.monad
+ [[instruction output] ?code
+ [environment specification] (//program/instruction.run instruction)]
+ (wrap [environment (binaryF.instance specification)]))
+ (#try.Success [environment bytecode])
+ (wrap [environment bytecode])
+
+ (#try.Failure error)
+ ## TODO: Allow error-management within
+ ## the monad.
+ (undefined))
+ @code (//attribute.code {#//attribute/code.resources (get@ #//program/condition.resources environment)
+ #//attribute/code.code bytecode
+ #//attribute/code.exception-table (row.row)
+ #//attribute/code.attributes (row.row)})]
(wrap {#modifier modifier
#name @name
#descriptor @descriptor
- #attributes (row.from-list attributes)})))
+ #attributes (|> attributes row.from-list (row.add @code))})))
(def: #export equivalence
(Equivalence Method)
diff --git a/stdlib/source/lux/target/jvm/modifier.lux b/stdlib/source/lux/target/jvm/modifier.lux
index a84ba38bc..0b2770b94 100644
--- a/stdlib/source/lux/target/jvm/modifier.lux
+++ b/stdlib/source/lux/target/jvm/modifier.lux
@@ -59,7 +59,7 @@
(!wrap (hex "0000")))
(def: (compose left right)
- (!wrap (i64.and (!unwrap left) (!unwrap right)))))
+ (!wrap (i64.or (!unwrap left) (!unwrap right)))))
(def: #export empty
Modifier
diff --git a/stdlib/source/lux/target/jvm/program.lux b/stdlib/source/lux/target/jvm/program.lux
index fd786d619..85f21a152 100644
--- a/stdlib/source/lux/target/jvm/program.lux
+++ b/stdlib/source/lux/target/jvm/program.lux
@@ -11,7 +11,7 @@
["." exception (#+ exception:)]]
[data
[text
- ["%" format]]
+ ["%" format (#+ format)]]
[number
["." nat]]
[collection
@@ -103,12 +103,13 @@
(: (Monad (State [Pool Tracker]))
state.monad))))
-(def: #export (resolve pool program)
- (All [a] (-> Pool (Program a) (Try [Pool Instruction a])))
- (let [[[pool tracker] [partial output]] (state.run [pool ..fresh] program)]
- (do try.monad
- [instruction (partial (get@ #known-labels tracker))]
- (wrap [pool instruction output]))))
+(def: #export (resolve program)
+ (All [a] (-> (Program a) (State Pool (Try [Instruction a]))))
+ (function (_ pool)
+ (let [[[pool tracker] [partial output]] (state.run [pool ..fresh] program)]
+ [pool (do try.monad
+ [instruction (partial (get@ #known-labels tracker))]
+ (wrap [instruction output]))])))
(def: (nullary instruction)
(-> Instruction (Program Any))
@@ -309,6 +310,16 @@
(/instruction.ldc (|> index' //unsigned.nat //unsigned.u1))
(<ldc> index)))))]
+ [ldc/string //constant.UTF8 //constant/pool.string /instruction.ldc-w/string]
+ )
+
+(template [<name> <type> <constant> <ldc>]
+ [(def: #export (<name> value)
+ (-> <type> (Program Any))
+ (do ..monad
+ [index (..lift (<constant> value))]
+ (..nullary (<ldc> index))))]
+
[ldc/long //constant.Long //constant/pool.long /instruction.ldc2-w/long]
[ldc/double //constant.Double //constant/pool.double /instruction.ldc2-w/double]
)
@@ -477,8 +488,7 @@
index
(|> inputs
(list@map descriptor-size)
- (list@fold //unsigned.u1/+ (//unsigned.u1 0))
- (//unsigned.u1/+ (//unsigned.u1 (if <static?> 0 1))))
+ (list@fold //unsigned.u1/+ (//unsigned.u1 (if <static?> 0 1))))
(descriptor-size output)))))]
[#1 invokestatic /instruction.invokestatic]
diff --git a/stdlib/source/lux/target/jvm/program/instruction.lux b/stdlib/source/lux/target/jvm/program/instruction.lux
index 3d0397a14..07f769082 100644
--- a/stdlib/source/lux/target/jvm/program/instruction.lux
+++ b/stdlib/source/lux/target/jvm/program/instruction.lux
@@ -448,6 +448,7 @@
[["11" sipush [[short U2]] [short] 0 1 []]
["13" ldc-w/integer [[index (Index ///constant.Integer)]] [(///index.number index)] 0 1 []]
["13" ldc-w/float [[index (Index ///constant.Float)]] [(///index.number index)] 0 1 []]
+ ["13" ldc-w/string [[index (Index ///constant.String)]] [(///index.number index)] 0 1 []]
["14" ldc2-w/long [[index (Index ///constant.Long)]] [(///index.number index)] 0 1 []]
["14" ldc2-w/double [[index (Index ///constant.Double)]] [(///index.number index)] 0 1 []]
<fields>