+ Support for string constants.

* Some fixes.
* Better method definition.

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>