WIP: Fix new-luxc's JVM back-end.

7 files changed, 143 insertions, 53 deletions

diff --git a/stdlib/source/lux/control/predicate.lux b/stdlib/source/lux/control/predicate.lux
index 72fe8165f..1d683bf5a 100644
--- a/stdlib/source/lux/control/predicate.lux
+++ b/stdlib/source/lux/control/predicate.lux
@@ -1,7 +1,6 @@
 (.module:
   [lux #*
    [control [monoid (#+ Monoid)]]
-   [data [collection [set (#+ Set)]]]
    [function]])
 
 (type: #export (Predicate a)
@@ -41,10 +40,6 @@
     (and (base value)
          (not (sub value)))))
 
-(def: #export (set set)
-  (All [a] (-> (Set a) (Predicate a)))
-  (set.member? set))
-
 (def: #export (rec predicate)
   (All [a]
     (-> (-> (Predicate a) (Predicate a))
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index a4fe01a35..7093de9a1 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -4,7 +4,8 @@
     [monoid (#+ Monoid)]
     [functor (#+ Functor)]
     [equivalence (#+ Equivalence)]
-    fold]
+    fold
+    [predicate (#+ Predicate)]]
    [data
     [collection [list ("list/" Fold<List>)]]
     [product]]
@@ -211,3 +212,23 @@
             (#.Some value)
             (recur (f value so-far) (inc idx)))
           so-far)))))
+
+(do-template [<name> <init> <op>]
+  [(def: #export (<name> predicate array)
+     (All [a]
+       (-> (Predicate a) (Array a) Bit))
+     (let [size (..size array)]
+       (loop [idx +0]
+         (if (n/< size idx)
+           (case (..read idx array)
+             (#.Some value)
+             (<op> (predicate value)
+                   (recur (inc idx)))
+             
+             #.None
+             (recur (inc idx)))
+           <init>))))]
+
+  [every? #1 and]
+  [any?   #0 or]
+  )
diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux
index 7ae37ebea..23e5ded20 100644
--- a/stdlib/source/lux/data/collection/row.lux
+++ b/stdlib/source/lux/data/collection/row.lux
@@ -7,7 +7,8 @@
     [equivalence (#+ Equivalence)]
     monoid
     fold
-    ["p" parser]]
+    ["p" parser]
+    [predicate (#+ Predicate)]]
    [data
     [maybe]
     [product]
@@ -15,7 +16,7 @@
      [i64]]
     [collection
      [list ("list/" Fold<List> Functor<List> Monoid<List>)]
-     [array ("array/" Functor<Array> Fold<Array>)]]]
+     ["." array ("array/" Functor<Array> Fold<Array>)]]]
    [macro (#+ with-gensyms)
     [code]
     ["s" syntax (#+ syntax: Syntax)]]
@@ -434,8 +435,30 @@
           (^open) Monoid<Row>]
       (fold (function (_ post pre) (compose pre post)) identity))))
 
-(def: #export (reverse xs)
+(def: #export reverse
   (All [a] (-> (Row a) (Row a)))
   (let [(^open) Fold<Row>
         (^open) Monoid<Row>]
-    (fold add identity xs)))
+    (fold add identity)))
+
+(do-template [<name> <array> <init> <op>]
+  [(def: #export <name>
+     (All [a]
+       (-> (Predicate a) (Row a) Bit))
+     (let [help (: (All [a]
+                     (-> (Predicate a) (Node a) Bit))
+                   (function (help predicate node)
+                     (case node
+                       (#Base base)
+                       (<array> predicate base)
+
+                       (#Hierarchy hierarchy)
+                       (<array> (help predicate) hierarchy))))]
+       (function (<name> predicate row)
+         (let [(^slots [#root #tail]) row]
+           (<op> (help predicate (#Hierarchy root))
+                 (help predicate (#Base tail)))))))]
+
+  [every? array.every? #1 and]
+  [any?   array.any?   #0 or]
+  )
diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux
index 11381c683..d78ae6d19 100644
--- a/stdlib/source/lux/data/collection/set.lux
+++ b/stdlib/source/lux/data/collection/set.lux
@@ -2,7 +2,8 @@
   [lux #*
    [control
     [equivalence (#+ Equivalence)]
-    [hash (#+ Hash)]]
+    [hash (#+ Hash)]
+    [predicate (#+ Predicate)]]
    [data
     [collection
      ["dict" dictionary (#+ Dictionary)]
@@ -82,3 +83,7 @@
 (def: #export (super? sub super)
   (All [a] (-> (Set a) (Set a) Bit))
   (sub? super sub))
+
+(def: #export predicate
+  (All [a] (-> (Set a) (Predicate a)))
+  ..member?)
diff --git a/stdlib/source/lux/language/compiler/synthesis.lux b/stdlib/source/lux/language/compiler/synthesis.lux
index 3d6762342..baea48c30 100644
--- a/stdlib/source/lux/language/compiler/synthesis.lux
+++ b/stdlib/source/lux/language/compiler/synthesis.lux
@@ -227,6 +227,16 @@
   [variable/foreign reference.foreign]
   )
 
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Reference
+          <tag>
+          content))]
+
+  [variable reference.variable]
+  [constant reference.constant]
+  )
+
 (do-template [<name> <family> <tag>]
   [(template: #export (<name> content)
      (.<| #..Control
diff --git a/stdlib/source/lux/language/compiler/translation.lux b/stdlib/source/lux/language/compiler/translation.lux
index 077076d2f..b822d3cf8 100644
--- a/stdlib/source/lux/language/compiler/translation.lux
+++ b/stdlib/source/lux/language/compiler/translation.lux
@@ -4,8 +4,9 @@
     ["ex" exception (#+ exception:)]
     [monad (#+ do)]]
    [data
-    [maybe ("maybe/" Functor<Maybe>)]
+    [product]
     [error (#+ Error)]
+    [ident ("ident/" Equivalence<Ident> Codec<Text,Ident>)]
     ["." text
      format]
     [collection
@@ -28,46 +29,58 @@
 (exception: #export (cannot-interpret {message Text})
   message)
 
+(do-template [<name>]
+  [(exception: #export (<name> {name Ident})
+     (ex.report ["Artifact" (ident/encode name)]))]
+
+  [cannot-overwrite-artifact]
+  [no-buffer-for-saving-code]
+  )
+
 (type: #export Context
   {#scope-name Text
    #inner-functions Nat})
 
-(signature: #export (Host code)
-  (: (-> code (Error Any))
-     execute!)
-  (: (-> code (Error Any))
-     evaluate!))
+(signature: #export (Host expression statement)
+  (: (-> expression (Error Any))
+     evaluate!)
+  (: (-> statement (Error Any))
+     execute!))
 
-(type: #export (Buffer code) (Row [Ident code]))
+(type: #export (Buffer statement) (Row [Ident statement]))
 
-(type: #export (Artifacts code) (Dictionary File (Buffer code)))
+(type: #export (Artifacts statement) (Dictionary File (Buffer statement)))
 
-(type: #export (State anchor code)
+(type: #export (State anchor expression statement)
   {#context Context
    #anchor (Maybe anchor)
-   #host (Host code)
-   #buffer (Maybe (Buffer code))
-   #artifacts (Artifacts code)})
+   #host (Host expression statement)
+   #buffer (Maybe (Buffer statement))
+   #artifacts (Artifacts statement)
+   #counter Nat})
 
-(type: #export (Operation anchor code)
-  (extension.Operation (State anchor code) Synthesis code))
+(type: #export (Operation anchor expression statement)
+  (extension.Operation (State anchor expression statement) Synthesis expression))
 
-(type: #export (Compiler anchor code)
-  (extension.Compiler (State anchor code) Synthesis code))
+(type: #export (Compiler anchor expression statement)
+  (extension.Compiler (State anchor expression statement) Synthesis expression))
 
 (def: #export (init host)
-  (All [anchor code] (-> (Host code) (..State anchor code)))
+  (All [anchor expression statement]
+    (-> (Host expression statement)
+        (..State anchor expression statement)))
   {#context {#scope-name ""
              #inner-functions +0}
    #anchor #.None
    #host host
    #buffer #.None
-   #artifacts (dict.new text.Hash<Text>)})
+   #artifacts (dict.new text.Hash<Text>)
+   #counter +0})
 
 (def: #export (with-context expr)
-  (All [anchor code output]
-    (-> (Operation anchor code output)
-        (Operation anchor code [Text output])))
+  (All [anchor expression statement output]
+    (-> (Operation anchor expression statement output)
+        (Operation anchor expression statement [Text output])))
   (function (_ [bundle state])
     (let [[old-scope old-inner] (get@ #context state)
           new-scope (format old-scope "c___" (%i (.int old-inner)))]
@@ -80,7 +93,8 @@
         (#error.Error error)))))
 
 (def: #export context
-  (All [anchor code] (Operation anchor code Text))
+  (All [anchor expression statement]
+    (Operation anchor expression statement Text))
   (extension.read (|>> (get@ #context)
                        (get@ #scope-name))))
 
@@ -88,7 +102,7 @@
               <with-declaration> <with-type> <with-value>
               <get> <get-type> <exception>]
   [(def: #export <with-declaration>
-     (All [anchor code output] <with-type>)
+     (All [anchor expression statement output] <with-type>)
      (function (_ body)
        (function (_ [bundle state])
          (case (body [bundle (set@ <tag> (#.Some <with-value>) state)])
@@ -100,7 +114,8 @@
            (#error.Error error)))))
 
    (def: #export <get>
-     (All [anchor code] (Operation anchor code <get-type>))
+     (All [anchor expression statement]
+       (Operation anchor expression statement <get-type>))
      (function (_ (^@ stateE [bundle state]))
        (case (get@ <tag> state)
          (#.Some output)
@@ -111,28 +126,35 @@
 
   [#anchor
    (with-anchor anchor)
-   (-> anchor (Operation anchor code output)
-       (Operation anchor code output))
+   (-> anchor (Operation anchor expression statement output)
+       (Operation anchor expression statement output))
    anchor
    anchor anchor no-anchor]
 
   [#buffer
    with-buffer
-   (-> (Operation anchor code output)
-       (Operation anchor code output))
+   (-> (Operation anchor expression statement output)
+       (Operation anchor expression statement output))
    row.empty
-   buffer (Buffer code) no-active-buffer]
+   buffer (Buffer statement) no-active-buffer]
   )
 
 (def: #export artifacts
-  (All [anchor code]
-    (Operation anchor code (Artifacts code)))
+  (All [anchor expression statement]
+    (Operation anchor expression statement (Artifacts statement)))
   (extension.read (get@ #artifacts)))
 
-(do-template [<name>]
+(def: #export next
+  (All [anchor expression statement]
+    (Operation anchor expression statement Nat))
+  (do //.Monad<Operation>
+    [_ (extension.update (update@ #counter inc))]
+    (extension.read (get@ #counter))))
+
+(do-template [<name> <inputT>]
   [(def: #export (<name> code)
-     (All [anchor code]
-       (-> code (Operation anchor code Any)))
+     (All [anchor expression statement]
+       (-> <inputT> (Operation anchor expression statement Any)))
      (function (_ (^@ stateE [bundle state]))
        (case (:: (get@ #host state) <name> code)
          (#error.Error error)
@@ -141,20 +163,28 @@
          (#error.Success output)
          (#error.Success [stateE output]))))]
 
-  [execute!]
-  [evaluate!]
+  [evaluate! expression]
+  [execute!  statement]
   )
 
 (def: #export (save! name code)
-  (All [anchor code]
-    (-> Ident code (Operation anchor code Any)))
+  (All [anchor expression statement]
+    (-> Ident statement (Operation anchor expression statement Any)))
   (do //.Monad<Operation>
-    [_ (execute! code)]
-    (extension.update (update@ #buffer (maybe/map (row.add [name code]))))))
+    [_ (execute! code)
+     ?buffer (extension.read (get@ #buffer))]
+    (case ?buffer
+      (#.Some buffer)
+      (if (row.any? (|>> product.left (ident/= name)) buffer)
+        (//.throw cannot-overwrite-artifact name)
+        (extension.update (set@ #buffer (#.Some (row.add [name code] buffer)))))
+      
+      #.None
+      (//.throw no-buffer-for-saving-code name))))
 
 (def: #export (save-buffer! target)
-  (All [anchor code]
-    (-> File (Operation anchor code Any)))
+  (All [anchor expression statement]
+    (-> File (Operation anchor expression statement Any)))
   (do //.Monad<Operation>
     [buffer ..buffer]
     (extension.update (update@ #artifacts (dict.put target buffer)))))
diff --git a/stdlib/test/test/lux/data/collection/row.lux b/stdlib/test/test/lux/data/collection/row.lux
index f8850447a..dbe9280b6 100644
--- a/stdlib/test/test/lux/data/collection/row.lux
+++ b/stdlib/test/test/lux/data/collection/row.lux
@@ -73,4 +73,10 @@
             (test "Row concatenation is a monad."
                   (&/= (&/compose sample other-sample)
                        (&/join (&.row sample other-sample))))
+
+            (test "Can reverse."
+                  (and (not (&/= sample
+                                 (&.reverse sample)))
+                       (not (&/= sample
+                                 (&.reverse (&.reverse sample))))))
             ))))