Compilers for scripting languages now only depend on new JVM compiler.

6 files changed, 136 insertions, 139 deletions

diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 132ceca10..df3c8bd71 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -2172,26 +2172,28 @@
         bodyA
         
         2
-        {/////analysis.#Case (/////analysis.unit)
-                             [[/////analysis.#when
-                               {pattern.#Bind 2}
-                               
-                               /////analysis.#then
-                               bodyA]
-                              (list)]}
+        (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices arity)))]
+          {/////analysis.#Case (/////analysis.unit)
+                               [[/////analysis.#when
+                                 {pattern.#Bind 2}
+                                 
+                                 /////analysis.#then
+                                 (/////analysis.tuple (list forced_refencing bodyA))]
+                                (list)]})
 
         _
-        {/////analysis.#Case (/////analysis.unit)
-                             [[/////analysis.#when
-                               {pattern.#Complex
-                                {complex.#Tuple
-                                 (|> (-- arity)
-                                     list.indices
-                                     (list#each (|>> (n.+ 2) {pattern.#Bind})))}}
-                               
-                               /////analysis.#then
-                               bodyA]
-                              (list)]})))
+        (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices arity)))]
+          {/////analysis.#Case (/////analysis.unit)
+                               [[/////analysis.#when
+                                 {pattern.#Complex
+                                  {complex.#Tuple
+                                   (|> (-- arity)
+                                       list.indices
+                                       (list#each (|>> (n.+ 2) {pattern.#Bind})))}}
+                                 
+                                 /////analysis.#then
+                                 (/////analysis.tuple (list forced_refencing bodyA))]
+                                (list)]}))))
 
 (def: .public (analyse_overriden_method analyse archive selfT mapping supers method)
   (-> Phase Archive .Type Mapping (List (Type Class)) (Overriden_Method Code) (Operation Analysis))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
index 8a2acf43e..27b3cf9d2 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
@@ -79,6 +79,9 @@
          ["[0]" bundle]
          [analysis
           ["[0]" jvm]]
+         [generation
+          [jvm
+           ["[0]" host]]]
          [directive
           ["/" lux]]]]]]]]
    [type
@@ -278,37 +281,6 @@
   (<synthesis>.Parser (Typed Synthesis))
   (<synthesis>.tuple (<>.and ..value_type_synthesis <synthesis>.any)))
 
-(def: (hidden_method_body arity body)
-  (-> Nat Synthesis Synthesis)
-  (case [arity body]
-    [0 _] body
-    [1 _] body
-    
-    [2 {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 hidden}}}]
-    hidden
-    
-    [_ {synthesis.#Control {synthesis.#Branch {synthesis.#Case _ path}}}]
-    (loop [path (: synthesis.Path path)]
-      (case path
-        (^or {synthesis.#Pop}
-             {synthesis.#Access _}
-             {synthesis.#Bind _}
-             {synthesis.#Bit_Fork _}
-             {synthesis.#I64_Fork _}
-             {synthesis.#F64_Fork _}
-             {synthesis.#Text_Fork _}
-             {synthesis.#Alt _})
-        body
-        
-        {synthesis.#Seq _ next}
-        (again next)
-        
-        {synthesis.#Then hidden}
-        hidden))
-
-    _
-    body))
-
 (def: (method_body arity)
   (-> Nat (<synthesis>.Parser Synthesis))
   (<| (<>#each (function (_ [env offset inits it]) it))
@@ -317,7 +289,7 @@
       <synthesis>.tuple
       ($_ <>.either
           (<| (<>.after (<synthesis>.text! ""))
-              (<>#each (..hidden_method_body arity))
+              (<>#each (host.hidden_method_body arity))
               <synthesis>.any)
           <synthesis>.any)))
 
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
index cbcfac6ec..296f0394b 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
@@ -853,31 +853,23 @@
          [1 _])
     body
     
-    (^or [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Let _ 2 hidden}}}]
-         [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Exec _ hidden}}}])
+    (^ [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Let _ 2 (//////synthesis.tuple (list _ hidden))}}}])
     hidden
     
     [_ {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Case _ path}}}]
     (loop [path (: Path path)]
       (case path
-        (^or {//////synthesis.#Pop}
-             {//////synthesis.#Access _}
-             {//////synthesis.#Bind _}
-             {//////synthesis.#Bit_Fork _}
-             {//////synthesis.#I64_Fork _}
-             {//////synthesis.#F64_Fork _}
-             {//////synthesis.#Text_Fork _}
-             {//////synthesis.#Alt _})
-        body
-        
         {//////synthesis.#Seq _ next}
         (again next)
         
-        {//////synthesis.#Then hidden}
-        hidden))
+        (^ {//////synthesis.#Then (//////synthesis.tuple (list _ hidden))})
+        hidden
+        
+        _
+        (undefined)))
 
     _
-    body))
+    (undefined)))
 
 (def: overriden_method_definition
   (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)])
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
index f6a61ca8c..99a2784cb 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
@@ -22,7 +22,8 @@
     ["[0]" code]]
    [math
     [number {"+" hex}
-     ["[0]" i64]]]
+     ["[0]" i64]
+     ["[0]" int ("[1]#[0]" interval)]]]
    ["@" target
     ["_" ruby {"+" Expression LVar Computation Literal Statement}]]]]
  ["[0]" /// "_"
@@ -393,10 +394,13 @@
                            (|> input i32##high (_.bit_shr (_.- (_.int +32) shift)))))))))
 
 (runtime: (i64##/ parameter subject)
-  (let [extra (_.do "remainder" (list parameter) {.#None} subject)]
-    (_.return (|> subject
-                  (_.- extra)
-                  (_./ parameter)))))
+  (_.return (_.? (_.and (_.= (_.int -1) parameter)
+                        (_.= (_.int int#bottom) subject))
+                 subject
+                 (let [extra (_.do "remainder" (list parameter) {.#None} subject)]
+                   (|> subject
+                       (_.- extra)
+                       (_./ parameter))))))
 
 (runtime: (i64##+ parameter subject)
   [..normal_ruby? (_.return (i64##i64 (_.+ parameter subject)))]
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux
new file mode 100644
index 000000000..c5f2f577a
--- /dev/null
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux
@@ -0,0 +1,82 @@
+(.using
+ [library
+  [lux "*"
+   [abstract
+    [predicate {"+" Predicate}]
+    ["[0]" monad {"+" Monad do}]]
+   [control
+    ["[0]" try {"+" Try} ("[1]#[0]" functor)]
+    [concurrency
+     ["[0]" async {"+" Async}]]]
+   [data
+    ["[0]" text ("[1]#[0]" equivalence)]
+    [collection
+     ["[0]" list ("[1]#[0]" mix functor)]
+     ["[0]" dictionary {"+" Dictionary}]
+     ["[0]" set]]]
+   [math
+    [number
+     ["n" nat]]]
+   [world
+    ["[0]" file]]]]
+ ["[0]" // "_"
+  ["[1][0]" module]
+  ["[0]" dependency "_"
+   ["[1]" module]]
+  ["/[1]" // "_"
+   [context {"+" Context}]
+   ["/[1]" // {"+" Input}]
+   ["[0]" archive
+    [registry {"+" Registry}]
+    ["[0]" module
+     ["[0]" descriptor {"+" Descriptor}]]]]])
+
+(type: .public Cache
+  [Bit descriptor.Module module.ID (module.Module Any) Registry])
+
+(type: .public Purge
+  (Dictionary descriptor.Module module.ID))
+
+... TODO: Make the monad parameterizable.
+(def: .public (purge! fs context @module)
+  (-> (file.System Async) Context module.ID (Async (Try Any)))
+  (do [! (try.with async.monad)]
+    [.let [cache (//module.path fs context @module)]
+     _ (|> cache
+           (# fs directory_files)
+           (# ! each (monad.each ! (# fs delete)))
+           (# ! conjoint))]
+    (# fs delete cache)))
+
+(def: .public (valid? expected actual)
+  (-> Descriptor Input Bit)
+  (and (text#= (value@ descriptor.#name expected)
+               (value@ ////.#module actual))
+       (text#= (value@ descriptor.#file expected)
+               (value@ ////.#file actual))
+       (n.= (value@ descriptor.#hash expected)
+            (value@ ////.#hash actual))))
+
+(def: initial
+  (-> (List Cache) Purge)
+  (|>> (list.all (function (_ [valid? module_name @module _])
+                   (if valid?
+                     {.#None}
+                     {.#Some [module_name @module]})))
+       (dictionary.of_list text.hash)))
+
+(def: .public (purge caches load_order)
+  (-> (List Cache) (dependency.Order Any) Purge)
+  (list#mix (function (_ [module_name [@module entry]] purge)
+              (let [purged? (: (Predicate descriptor.Module)
+                               (dictionary.key? purge))]
+                (if (purged? module_name)
+                  purge
+                  (if (|> entry
+                          (value@ [archive.#module module.#descriptor descriptor.#references])
+                          set.list
+                          (list.any? purged?))
+                    (dictionary.has module_name @module purge)
+                    purge))))
+            (..initial caches)
+            load_order))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
index 346a05e56..f625ba952 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
@@ -3,8 +3,7 @@
   [lux "*"
    [target {"+" Target}]
    [abstract
-    [predicate {"+" Predicate}]
-    ["[0]" monad {"+" do}]]
+    ["[0]" monad {"+" Monad do}]]
    [control
     ["[0]" try {"+" Try}]
     [concurrency
@@ -17,13 +16,10 @@
     ["[0]" text ("[1]#[0]" equivalence)
      ["%" format {"+" format}]]
     [collection
-     ["[0]" list ("[1]#[0]" functor mix)]
+     [set {"+" Set}]
+     ["[0]" list ("[1]#[0]" mix)]
      ["[0]" dictionary {"+" Dictionary}]
-     ["[0]" sequence {"+" Sequence}]
-     ["[0]" set {"+" Set}]]]
-   [math
-    [number
-     ["n" nat]]]
+     ["[0]" sequence {"+" Sequence}]]]
    [meta
     ["[0]" configuration {"+" Configuration}]
     ["[0]" version]]
@@ -45,9 +41,10 @@
    ["[0]" cache
     ["[1]/[0]" archive]
     ["[1]/[0]" module]
+    ["[1]/[0]" purge {"+" Cache Purge}]
     ["[0]" dependency "_"
      ["[1]" module]]]
-   ["/[1]" // {"+" Input}
+   [//
     [language
      ["$" lux
       ["[0]" analysis]
@@ -261,58 +258,6 @@
              (with@ archive.#output output))
          bundles])))
 
-(def: (purge! fs context [module_name @module])
-  (-> (file.System Async) Context [descriptor.Module module.ID] (Async (Try Any)))
-  (do [! (try.with async.monad)]
-    [.let [cache (cache/module.path fs context @module)]
-     _ (|> cache
-           (# fs directory_files)
-           (# ! each (monad.each ! (# fs delete)))
-           (# ! conjoint))]
-    (# fs delete cache)))
-
-(def: (valid_cache? expected actual)
-  (-> Descriptor Input Bit)
-  (and (text#= (value@ descriptor.#name expected)
-               (value@ ////.#module actual))
-       (text#= (value@ descriptor.#file expected)
-               (value@ ////.#file actual))
-       (n.= (value@ descriptor.#hash expected)
-            (value@ ////.#hash actual))))
-
-(type: Cache
-  [descriptor.Module [module.ID [(module.Module .Module) Registry]]])
-
-(type: Purge
-  (Dictionary descriptor.Module module.ID))
-
-(def: initial_purge
-  (-> (List [Bit Cache])
-      Purge)
-  (|>> (list.all (function (_ [valid_cache? [module_name [@module _]]])
-                   (if valid_cache?
-                     {.#None}
-                     {.#Some [module_name @module]})))
-       (dictionary.of_list text.hash)))
-
-(def: (full_purge caches load_order)
-  (-> (List [Bit Cache])
-      (dependency.Order .Module)
-      Purge)
-  (list#mix (function (_ [module_name [@module entry]] purge)
-              (let [purged? (: (Predicate descriptor.Module)
-                               (dictionary.key? purge))]
-                (if (purged? module_name)
-                  purge
-                  (if (|> entry
-                          (value@ [archive.#module module.#descriptor descriptor.#references])
-                          set.list
-                          (list.any? purged?))
-                    (dictionary.has module_name @module purge)
-                    purge))))
-            (..initial_purge caches)
-            load_order))
-
 (def: pseudo_module
   Text
   "(Lux Caching System)")
@@ -320,8 +265,8 @@
 (def: (valid_cache fs context import contexts [module_name @module])
   (-> (file.System Async) Context Import (List //.Context)
       [descriptor.Module module.ID]
-      (Async (Try [Bit Cache])))
-  (with_expansions [<cache> [module_name [@module [module registry]]]]
+      (Async (Try Cache)))
+  (with_expansions [<cache> (as_is module_name @module module registry)]
     (do [! (try.with async.monad)]
       [data (: (Async (Try Binary))
                (cache/module.cache fs context @module))
@@ -330,11 +275,11 @@
         (in [true <cache>])
         (do !
           [input (//context.read fs ..pseudo_module import contexts (value@ context.#host_module_extension context) module_name)]
-          (in [(..valid_cache? (value@ module.#descriptor module) input) <cache>]))))))
+          (in [(cache/purge.valid? (value@ module.#descriptor module) input) <cache>]))))))
 
 (def: (pre_loaded_caches fs context import contexts archive)
   (-> (file.System Async) Context Import (List //.Context) Archive
-      (Async (Try (List [Bit Cache]))))
+      (Async (Try (List Cache))))
   (do [! (try.with async.monad)]
     [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression.
      it (|> archive
@@ -344,11 +289,11 @@
     (in it)))
 
 (def: (load_order archive pre_loaded_caches)
-  (-> Archive (List [Bit Cache])
+  (-> Archive (List Cache)
       (Try (dependency.Order .Module)))
   (|> pre_loaded_caches
       (monad.mix try.monad
-                 (function (_ [_ [module [@module [|module| registry]]]] archive)
+                 (function (_ [_ [module @module |module| registry]] archive)
                    (archive.has module
                                 [archive.#module |module|
                                  archive.#output (: Output sequence.empty)
@@ -381,10 +326,10 @@
   (do [! (try.with async.monad)]
     [pre_loaded_caches (..pre_loaded_caches fs context import contexts archive)
      load_order (async#in (load_order archive pre_loaded_caches))
-     .let [purge (..full_purge pre_loaded_caches load_order)]
+     .let [purge (cache/purge.purge pre_loaded_caches load_order)]
      _ (|> purge
            dictionary.entries
-           (monad.each ! (..purge! fs context)))
+           (monad.each ! (|>> product.right (cache/purge.purge! fs context))))
      loaded_caches (..loaded_caches host_environment fs context purge load_order)]
     (async#in
      (do [! try.monad]