From 5806d33abd8b8f42d27225b6321c03eaa3a11592 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 6 Jul 2019 20:56:31 -0400 Subject: + Support for string constants. * Some fixes. * Better method definition. --- stdlib/source/lux/target/jvm/constant/pool.lux | 11 ++++++-- stdlib/source/lux/target/jvm/method.lux | 33 ++++++++++++++++++---- stdlib/source/lux/target/jvm/modifier.lux | 2 +- stdlib/source/lux/target/jvm/program.lux | 28 ++++++++++++------ .../source/lux/target/jvm/program/instruction.lux | 1 + 5 files changed, 57 insertions(+), 18 deletions(-) (limited to 'stdlib') 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)) ( index)))))] + [ldc/string //constant.UTF8 //constant/pool.string /instruction.ldc-w/string] + ) + +(template [ ] + [(def: #export ( value) + (-> (Program Any)) + (do ..monad + [index (..lift ( value))] + (..nullary ( 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 0 1)))) + (list@fold //unsigned.u1/+ (//unsigned.u1 (if 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 []] -- cgit v1.2.3