Got JVM anonymous classes to compile again.

2 files changed, 96 insertions, 97 deletions

diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 76d8525ba..3b001e9db 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -1925,19 +1925,19 @@
                                                     mapping))
                                   luxT.fresh
                                   parameters)]
-         name (///.lift (do macro.monad
-                          [where macro.current-module-name
-                           id macro.count]
-                          (wrap (..anonymous-class-name where id))))
          super-classT (typeA.with-env
                         (luxT.check (luxT.class mapping) (..signature super-class)))
          super-interfaceT+ (typeA.with-env
                              (monad.map check.monad
                                         (|>> ..signature (luxT.check (luxT.class mapping)))
                                         super-interfaces))
-         #let [selfT (inheritance-relationship-type (#.Primitive name (list))
-                                                    super-classT
-                                                    super-interfaceT+)]
+         selfT (///.lift (do macro.monad
+                           [where macro.current-module-name
+                            id macro.count]
+                           (wrap (inheritance-relationship-type (#.Primitive (..anonymous-class-name where id) (list))
+                                                                super-classT
+                                                                super-interfaceT+))))
+         _ (typeA.infer selfT)
          constructor-argsA+ (monad.map @ (function (_ [type term])
                                            (do @
                                              [argT (reflection-type mapping type)
@@ -1961,14 +1961,12 @@
                                       methods)
          #let [missing-abstract-methods (mismatched-methods overriden-methods required-abstract-methods)
                invalid-overriden-methods (mismatched-methods available-methods overriden-methods)]
-         _ (typeA.infer selfT)
          _ (phase.assert ..missing-abstract-methods missing-abstract-methods
                          (list.empty? missing-abstract-methods))
          _ (phase.assert ..invalid-overriden-methods invalid-overriden-methods
                          (list.empty? invalid-overriden-methods))]
         (wrap (#/////analysis.Extension extension-name
-                                        (list (/////analysis.text name)
-                                              (class-analysis super-class)
+                                        (list (class-analysis super-class)
                                               (/////analysis.tuple (list@map class-analysis super-interfaces))
                                               (/////analysis.tuple (list@map typed-analysis constructor-argsA+))
                                               (/////analysis.tuple methodsA))))))]))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
index 266985b68..ee5bbf4d6 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
@@ -11,7 +11,8 @@
    [data
     ["." product]
     ["." maybe]
-    ["." text ("#@." equivalence)]
+    ["." text ("#@." equivalence)
+     ["%" format (#+ format)]]
     [number
      ["." i32]]
     [collection
@@ -46,7 +47,7 @@
      [extension (#+ Nullary Unary Binary Trinary Variadic
                     nullary unary binary trinary variadic)]
      ["///" jvm
-      [runtime (#+ Operation Bundle Phase Handler)]
+      ["#." runtime (#+ Operation Bundle Phase Handler)]
       ["#." reference]
       [function
        [field
@@ -983,96 +984,96 @@
             ## (:: type.equivalence = type.double returnT)
             _.dreturn))))
 
-## TODO: Uncomment ASAP.
-## (def: class::anonymous
-##   Handler
-##   (..custom
-##    [($_ <>.and
-##         <s>.text
-##         ..class
-##         (<s>.tuple (<>.some ..class))
-##         (<s>.tuple (<>.some ..input))
-##         (<s>.tuple (<>.some ..overriden-method-definition)))
-##     (function (_ extension-name generate archive [class-name
-##                                                   super-class super-interfaces
-##                                                   inputsTS
-##                                                   overriden-methods])
-##       (do //////.monad
-##         [#let [class (type.class class-name (list))
-##                total-environment (|> overriden-methods
-##                                      ## Get all the environments.
-##                                      (list@map product.left)
-##                                      ## Combine them.
-##                                      list@join
-##                                      ## Remove duplicates.
-##                                      (set.from-list //////reference.hash)
-##                                      set.to-list)
-##                global-mapping (|> total-environment
-##                                   ## Give them names as "foreign" variables.
-##                                   list.enumerate
-##                                   (list@map (function (_ [id capture])
-##                                               [capture (#//////reference.Foreign id)]))
-##                                   (dictionary.from-list //////reference.hash))
-##                normalized-methods (list@map (function (_ [environment
-##                                                           [ownerT name
-##                                                            strict-fp? annotations vars
-##                                                            self-name arguments returnT exceptionsT
-##                                                            body]])
-##                                               (let [local-mapping (|> environment
-##                                                                       list.enumerate
-##                                                                       (list@map (function (_ [foreign-id capture])
-##                                                                                   [(#//////reference.Foreign foreign-id)
-##                                                                                    (|> global-mapping
-##                                                                                        (dictionary.get capture)
-##                                                                                        maybe.assume)]))
-##                                                                       (dictionary.from-list //////reference.hash))]
-##                                                 [ownerT name
-##                                                  strict-fp? annotations vars
-##                                                  self-name arguments returnT exceptionsT
-##                                                  (normalize-method-body local-mapping body)]))
-##                                             overriden-methods)]
-##          inputsTI (monad.map @ (generate-input generate archive) inputsTS)
-##          method-definitions (monad.map @ (function (_ [ownerT name
-##                                                        strict-fp? annotations vars
-##                                                        self-name arguments returnT exceptionsT
-##                                                        bodyS])
-##                                            (do @
-##                                              [bodyG (//////generation.with-specific-context class-name
-##                                                       (generate archive bodyS))]
-##                                              (wrap (method.method ($_ modifier@compose
-##                                                                       method.public
-##                                                                       method.final
-##                                                                       (if strict-fp?
-##                                                                         method.strict
-##                                                                         modifier@identity))
-##                                                                   name
-##                                                                   (type.method [(list@map product.right arguments)
-##                                                                                 returnT
-##                                                                                 exceptionsT])
-##                                                                   (list)
-##                                                                   (#.Some ($_ _.compose
-##                                                                               bodyG
-##                                                                               (returnG returnT)))))))
-##                                        normalized-methods)
-##          bytecode (<| (:: @ map (format.run class.writer))
-##                       //////.lift
-##                       (class.class version.v6_0 ($_ modifier@compose class.public class.final)
-##                                    (name.internal class-name)
-##                                    (name.internal (..reflection super-class))
-##                                    (list@map (|>> ..reflection name.internal) super-interfaces)
-##                                    (foreign.variables total-environment)
-##                                    (list& (..with-anonymous-init class total-environment super-class inputsTI)
-##                                           method-definitions)
-##                                    (row.row)))
-##          _ (//////generation.save! true ["" class-name] [class-name bytecode])]
-##         (anonymous-instance class total-environment)))]))
+(def: class::anonymous
+  Handler
+  (..custom
+   [($_ <>.and
+        ..class
+        (<s>.tuple (<>.some ..class))
+        (<s>.tuple (<>.some ..input))
+        (<s>.tuple (<>.some ..overriden-method-definition)))
+    (function (_ extension-name generate archive [super-class super-interfaces
+                                                  inputsTS
+                                                  overriden-methods])
+      (do //////.monad
+        [[context _] (//////generation.with-new-context archive (wrap []))
+         #let [[module-id artifact-id] context
+               anonymous-class-name (///runtime.class-name context)
+               class (type.class anonymous-class-name (list))
+               total-environment (|> overriden-methods
+                                     ## Get all the environments.
+                                     (list@map product.left)
+                                     ## Combine them.
+                                     list@join
+                                     ## Remove duplicates.
+                                     (set.from-list //////reference.hash)
+                                     set.to-list)
+               global-mapping (|> total-environment
+                                  ## Give them names as "foreign" variables.
+                                  list.enumerate
+                                  (list@map (function (_ [id capture])
+                                              [capture (#//////reference.Foreign id)]))
+                                  (dictionary.from-list //////reference.hash))
+               normalized-methods (list@map (function (_ [environment
+                                                          [ownerT name
+                                                           strict-fp? annotations vars
+                                                           self-name arguments returnT exceptionsT
+                                                           body]])
+                                              (let [local-mapping (|> environment
+                                                                      list.enumerate
+                                                                      (list@map (function (_ [foreign-id capture])
+                                                                                  [(#//////reference.Foreign foreign-id)
+                                                                                   (|> global-mapping
+                                                                                       (dictionary.get capture)
+                                                                                       maybe.assume)]))
+                                                                      (dictionary.from-list //////reference.hash))]
+                                                [ownerT name
+                                                 strict-fp? annotations vars
+                                                 self-name arguments returnT exceptionsT
+                                                 (normalize-method-body local-mapping body)]))
+                                            overriden-methods)]
+         inputsTI (monad.map @ (generate-input generate archive) inputsTS)
+         method-definitions (monad.map @ (function (_ [ownerT name
+                                                       strict-fp? annotations vars
+                                                       self-name arguments returnT exceptionsT
+                                                       bodyS])
+                                           (do @
+                                             [bodyG (//////generation.with-context artifact-id
+                                                      (generate archive bodyS))]
+                                             (wrap (method.method ($_ modifier@compose
+                                                                      method.public
+                                                                      method.final
+                                                                      (if strict-fp?
+                                                                        method.strict
+                                                                        modifier@identity))
+                                                                  name
+                                                                  (type.method [(list@map product.right arguments)
+                                                                                returnT
+                                                                                exceptionsT])
+                                                                  (list)
+                                                                  (#.Some ($_ _.compose
+                                                                              bodyG
+                                                                              (returnG returnT)))))))
+                                       normalized-methods)
+         bytecode (<| (:: @ map (format.run class.writer))
+                      //////.lift
+                      (class.class version.v6_0 ($_ modifier@compose class.public class.final)
+                                   (name.internal anonymous-class-name)
+                                   (name.internal (..reflection super-class))
+                                   (list@map (|>> ..reflection name.internal) super-interfaces)
+                                   (foreign.variables total-environment)
+                                   (list& (..with-anonymous-init class total-environment super-class inputsTI)
+                                          method-definitions)
+                                   (row.row)))
+         _ (//////generation.save! true ["" (%.nat artifact-id)]
+                                   [anonymous-class-name bytecode])]
+        (anonymous-instance  archive class total-environment)))]))
 
 (def: bundle::class
   Bundle
   (<| (/////bundle.prefix "class")
       (|> (: Bundle /////bundle.empty)
-          ## TODO: Uncomment ASAP
-          ## (/////bundle.install "anonymous" class::anonymous)
+          (/////bundle.install "anonymous" class::anonymous)
           )))
 
 (def: #export bundle