- Now folding top-level function-classes into their owner def-classes.

4 files changed, 209 insertions, 100 deletions

diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 27bb42e4f..b9acff72a 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -86,7 +86,7 @@
         (&&case/compile-case compile-expression ?value ?match)
 
         (&o/$function ?arity ?scope ?env ?body)
-        (&&lambda/compile-function compile-expression ?arity ?scope ?env ?body)
+        (&&lambda/compile-function compile-expression &/$None ?arity ?scope ?env ?body)
 
         ;; Must get rid of this one...
         (&o/$ann ?value-ex ?type-ex ?value-type)
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 7ba93a32b..d291ebc07 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -237,33 +237,45 @@
 ;; [Exports]
 (let [lambda-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
       datum-flags (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL)]
-  (defn compile-function [compile arity ?scope ?env ?body]
+  (defn compile-function [compile ?prev-writer arity ?scope ?env ?body]
     (|do [[file-name _ _] &/cursor
           :let [name (&host/location (&/|tail ?scope))
                 class-name (str (&host/->module-class (&/|head ?scope)) "/" name)
-                =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
-                         (.visit &host/bytecode-version lambda-flags
-                                 class-name nil &&/function-class (into-array String []))
-                         (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC Opcodes/ACC_FINAL) &&/arity-field "I" nil (int arity))
-                             (doto (.visitEnd)))
-                         (-> (doto (.visitField datum-flags captured-name field-sig nil nil)
-                               (.visitEnd))
-                             (->> (let [captured-name (str &&/closure-prefix ?captured-id)])
-                                  (|case ?name+?captured
-                                    [?name [_ (&o/$captured _ ?captured-id ?source)]])
-                                  (doseq [?name+?captured (&/->seq ?env)])))
-                         (-> (.visitField datum-flags (str &&/partial-prefix idx) field-sig nil nil)
-                             (doto (.visitEnd))
-                             (->> (dotimes [idx (dec arity)])))
-                         (.visitSource file-name nil)
-                         (add-lambda-<init> class-name arity ?env)
-                         (add-lambda-reset class-name arity ?env)
-                         )]
+                [=class save?] (|case ?prev-writer
+                                 (&/$Some _writer)
+                                 (&/T [_writer false])
+
+                                 (&/$None)
+                                 (&/T [(doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+                                         (.visit &host/bytecode-version lambda-flags
+                                                 class-name nil &&/function-class (into-array String [])))
+                                       true]))
+                _ (doto =class
+                    (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC Opcodes/ACC_FINAL) &&/arity-field "I" nil (int arity))
+                        (doto (.visitEnd)))
+                    (-> (doto (.visitField datum-flags captured-name field-sig nil nil)
+                          (.visitEnd))
+                        (->> (let [captured-name (str &&/closure-prefix ?captured-id)])
+                             (|case ?name+?captured
+                               [?name [_ (&o/$captured _ ?captured-id ?source)]])
+                             (doseq [?name+?captured (&/->seq ?env)])))
+                    (-> (.visitField datum-flags (str &&/partial-prefix idx) field-sig nil nil)
+                        (doto (.visitEnd))
+                        (->> (dotimes [idx (dec arity)])))
+                    (-> (.visitSource file-name nil)
+                        (when save?))
+                    (add-lambda-<init> class-name arity ?env)
+                    (add-lambda-reset class-name arity ?env)
+                    )]
           _ (if (> arity 1)
               (add-lambda-impl =class class-name compile arity ?body)
               (return nil))
           _ (&/map% #(add-lambda-apply-n =class % class-name arity ?env compile ?body)
                     (&/|range* 1 (min arity &&/num-apply-variants)))
           :let [_ (.visitEnd =class)]
-          _ (&&/save-class! name (.toByteArray =class))]
-      (instance-closure compile class-name arity ?env))))
+          _ (if save?
+              (&&/save-class! name (.toByteArray =class))
+              (return nil))]
+      (if save?
+        (instance-closure compile class-name arity ?env)
+        (return (instance-closure compile class-name arity ?env))))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index f2c67bfae..2cbfcef54 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -165,6 +165,14 @@
   (|let [analysis (&&type/defmeta->analysis ?meta)]
     (compile analysis)))
 
+(defn ^:private de-ann [optim]
+  (|case optim
+    [_ (&o/$ann value-expr _ _)]
+    value-expr
+
+    _
+    optim))
+
 (let [class-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
       field-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC)]
   (defn compile-def [compile ?name ?body ?meta]
@@ -186,85 +194,171 @@
         (fail "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be an Ident.")
         
         _
-        (|do [:let [=value-type (&a/expr-type* ?body)]
-              ;; ^ClassWriter *writer* &/get-writer
-              [file-name _ _] &/cursor
-              :let [datum-sig "Ljava/lang/Object;"
-                    def-name (&host/def-name ?name)
-                    current-class (str (&host/->module-class module-name) "/" def-name)
-                    =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
-                             (.visit &host/bytecode-version class-flags
-                                     current-class nil "java/lang/Object" (into-array String []))
-                             (-> (.visitField field-flags &/name-field "Ljava/lang/String;" nil ?name)
-                                 (doto (.visitEnd)))
-                             (-> (.visitField field-flags &/type-field datum-sig nil nil)
-                                 (doto (.visitEnd)))
-                             (-> (.visitField field-flags &/meta-field datum-sig nil nil)
-                                 (doto (.visitEnd)))
-                             (-> (.visitField field-flags &/value-field datum-sig nil nil)
-                                 (doto (.visitEnd)))
-                             (.visitSource file-name nil))]
-              _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
-                  (|do [^MethodVisitor **writer** &/get-writer
-                        :let [_ (.visitCode **writer**)]
-                        _ (compile-def-type compile ?body)
-                        :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/type-field datum-sig)]
-                        _ (compile-def-meta compile ?meta)
-                        :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/meta-field datum-sig)]
-                        _ (compile ?body)
-                        :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
-                        :let [_ (doto **writer**
-                                  (.visitInsn Opcodes/RETURN)
-                                  (.visitMaxs 0 0)
-                                  (.visitEnd))]]
-                    (return nil)))
-              ;; :let [_ (.visitEnd *writer*)]
-              :let [_ (.visitEnd =class)]
-              _ (&&/save-class! def-name (.toByteArray =class))
-              :let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class))
-                    [def-type is-type?] (|case (&a-meta/meta-get &a-meta/type?-tag ?meta)
-                                          (&/$Some (&/$BoolM true))
-                                          (&/T [&type/Type
-                                                true])
-
-                                          _
-                                          (if (&type/type= &type/Type =value-type)
-                                            (&/T [&type/Type
-                                                  false])
-                                            (&/T [(-> def-class (.getField &/type-field) (.get nil))
-                                                  false])))
-                    def-meta ?meta
-                    def-value (-> def-class (.getField &/value-field) (.get nil))]
-              _ (&a-module/define module-name ?name def-type def-meta def-value)
-              _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)])
-                  [true (&/$Some (&/$ListM tags*))]
-                  (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta)
-                                              (&/$Some _)
-                                              true
+        (|case (de-ann ?body)
+          [_ (&o/$function _ _ _ _)]
+          (|let [[_ (&o/$function _arity _scope _captured ?body+)] (&o/shift-function-body false (de-ann ?body))]
+            (|do [:let [=value-type (&a/expr-type* ?body)]
+                  ;; ^ClassWriter *writer* &/get-writer
+                  [file-name _ _] &/cursor
+                  :let [datum-sig "Ljava/lang/Object;"
+                        def-name (&host/def-name ?name)
+                        current-class (str (&host/->module-class module-name) "/" def-name)
+                        =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+                                 (.visit &host/bytecode-version class-flags
+                                         current-class nil &&/function-class (into-array String []))
+                                 (-> (.visitField field-flags &/name-field "Ljava/lang/String;" nil ?name)
+                                     (doto (.visitEnd)))
+                                 (-> (.visitField field-flags &/type-field datum-sig nil nil)
+                                     (doto (.visitEnd)))
+                                 (-> (.visitField field-flags &/meta-field datum-sig nil nil)
+                                     (doto (.visitEnd)))
+                                 (-> (.visitField field-flags &/value-field datum-sig nil nil)
+                                     (doto (.visitEnd)))
+                                 (.visitSource file-name nil))]
+                  instancer (&&lambda/compile-function compile (&/$Some =class) _arity _scope _captured ?body+)
+                  _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
+                      (|do [^MethodVisitor **writer** &/get-writer
+                            :let [_ (.visitCode **writer**)]
+                            _ (compile-def-type compile ?body)
+                            :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/type-field datum-sig)]
+                            _ (compile-def-meta compile ?meta)
+                            :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/meta-field datum-sig)]
+                            _ instancer
+                            :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
+                            :let [_ (doto **writer**
+                                      (.visitInsn Opcodes/RETURN)
+                                      (.visitMaxs 0 0)
+                                      (.visitEnd))]]
+                        (return nil)))
+                  ;; :let [_ (.visitEnd *writer*)]
+                  :let [_ (.visitEnd =class)]
+                  _ (&&/save-class! def-name (.toByteArray =class))
+                  :let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class))
+                        [def-type is-type?] (|case (&a-meta/meta-get &a-meta/type?-tag ?meta)
+                                              (&/$Some (&/$BoolM true))
+                                              (&/T [&type/Type
+                                                    true])
 
                                               _
-                                              false)]
-                        tags (&/map% (fn [tag*]
-                                       (|case tag*
-                                         (&/$TextM tag)
-                                         (return tag)
-
-                                         _
-                                         (fail "[Compiler Error] Incorrect format for tags.")))
-                                     tags*)
-                        _ (&a-module/declare-tags module-name tags was-exported? def-value)]
-                    (return nil))
+                                              (if (&type/type= &type/Type =value-type)
+                                                (&/T [&type/Type
+                                                      false])
+                                                (&/T [(-> def-class (.getField &/type-field) (.get nil))
+                                                      false])))
+                        def-meta ?meta
+                        def-value (-> def-class (.getField &/value-field) (.get nil))]
+                  _ (&a-module/define module-name ?name def-type def-meta def-value)
+                  _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)])
+                      [true (&/$Some (&/$ListM tags*))]
+                      (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta)
+                                                  (&/$Some _)
+                                                  true
 
-                  [false (&/$Some _)]
-                  (fail "[Compiler Error] Can't define tags for non-type.")
+                                                  _
+                                                  false)]
+                            tags (&/map% (fn [tag*]
+                                           (|case tag*
+                                             (&/$TextM tag)
+                                             (return tag)
 
-                  [true (&/$Some _)]
-                  (fail "[Compiler Error] Incorrect format for tags.")
+                                             _
+                                             (fail "[Compiler Error] Incorrect format for tags.")))
+                                         tags*)
+                            _ (&a-module/declare-tags module-name tags was-exported? def-value)]
+                        (return nil))
 
-                  [_ (&/$None)]
-                  (return nil))
-              :let [_ (println 'DEF (str module-name ";" ?name))]]
-          (return nil))))))
+                      [false (&/$Some _)]
+                      (fail "[Compiler Error] Can't define tags for non-type.")
+
+                      [true (&/$Some _)]
+                      (fail "[Compiler Error] Incorrect format for tags.")
+
+                      [_ (&/$None)]
+                      (return nil))
+                  :let [_ (println 'DEF (str module-name ";" ?name))]]
+              (return nil)))
+
+          _
+          (|do [:let [=value-type (&a/expr-type* ?body)]
+                ;; ^ClassWriter *writer* &/get-writer
+                [file-name _ _] &/cursor
+                :let [datum-sig "Ljava/lang/Object;"
+                      def-name (&host/def-name ?name)
+                      current-class (str (&host/->module-class module-name) "/" def-name)
+                      =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+                               (.visit &host/bytecode-version class-flags
+                                       current-class nil "java/lang/Object" (into-array String []))
+                               (-> (.visitField field-flags &/name-field "Ljava/lang/String;" nil ?name)
+                                   (doto (.visitEnd)))
+                               (-> (.visitField field-flags &/type-field datum-sig nil nil)
+                                   (doto (.visitEnd)))
+                               (-> (.visitField field-flags &/meta-field datum-sig nil nil)
+                                   (doto (.visitEnd)))
+                               (-> (.visitField field-flags &/value-field datum-sig nil nil)
+                                   (doto (.visitEnd)))
+                               (.visitSource file-name nil))]
+                _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
+                    (|do [^MethodVisitor **writer** &/get-writer
+                          :let [_ (.visitCode **writer**)]
+                          _ (compile-def-type compile ?body)
+                          :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/type-field datum-sig)]
+                          _ (compile-def-meta compile ?meta)
+                          :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/meta-field datum-sig)]
+                          _ (compile ?body)
+                          :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
+                          :let [_ (doto **writer**
+                                    (.visitInsn Opcodes/RETURN)
+                                    (.visitMaxs 0 0)
+                                    (.visitEnd))]]
+                      (return nil)))
+                ;; :let [_ (.visitEnd *writer*)]
+                :let [_ (.visitEnd =class)]
+                _ (&&/save-class! def-name (.toByteArray =class))
+                :let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class))
+                      [def-type is-type?] (|case (&a-meta/meta-get &a-meta/type?-tag ?meta)
+                                            (&/$Some (&/$BoolM true))
+                                            (&/T [&type/Type
+                                                  true])
+
+                                            _
+                                            (if (&type/type= &type/Type =value-type)
+                                              (&/T [&type/Type
+                                                    false])
+                                              (&/T [(-> def-class (.getField &/type-field) (.get nil))
+                                                    false])))
+                      def-meta ?meta
+                      def-value (-> def-class (.getField &/value-field) (.get nil))]
+                _ (&a-module/define module-name ?name def-type def-meta def-value)
+                _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)])
+                    [true (&/$Some (&/$ListM tags*))]
+                    (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta)
+                                                (&/$Some _)
+                                                true
+
+                                                _
+                                                false)]
+                          tags (&/map% (fn [tag*]
+                                         (|case tag*
+                                           (&/$TextM tag)
+                                           (return tag)
+
+                                           _
+                                           (fail "[Compiler Error] Incorrect format for tags.")))
+                                       tags*)
+                          _ (&a-module/declare-tags module-name tags was-exported? def-value)]
+                      (return nil))
+
+                    [false (&/$Some _)]
+                    (fail "[Compiler Error] Can't define tags for non-type.")
+
+                    [true (&/$Some _)]
+                    (fail "[Compiler Error] Incorrect format for tags.")
+
+                    [_ (&/$None)]
+                    (return nil))
+                :let [_ (println 'DEF (str module-name ";" ?name))]]
+            (return nil)))
+        ))))
 
 (defn compile-program [compile ?body]
   (|do [module-name &/get-module-name
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index e774f4216..9b4dd7548 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -57,7 +57,7 @@
     (&/$Cons _module (&/$Cons _def (&/$Cons _level-to-remove _levels-to-keep)))
     (&/$Cons _module (&/$Cons _def _levels-to-keep))))
 
-(defn ^:private shift-function-body [own-body? body]
+(defn shift-function-body [own-body? body]
   "(-> Optimized Optimized)"
   (|let [[meta body-] body]
     (|case body-
@@ -106,9 +106,12 @@
         body)
 
       ($apply [meta-0 ($var (&/$Local 0))] args)
-      (&/T [meta ($apply (&/T [meta-0 ($var (&/$Local 0))])
-                         (&/$Cons (&/T [meta-0 ($var (&/$Local 1))])
-                                  (&/|map (partial shift-function-body own-body?) args)))])
+      (if own-body?
+        (&/T [meta ($apply (&/T [meta-0 ($var (&/$Local 0))])
+                           (&/$Cons (&/T [meta-0 ($var (&/$Local 1))])
+                                    (&/|map (partial shift-function-body own-body?) args)))])
+        (&/T [meta ($apply (&/T [meta-0 ($var (&/$Local 0))])
+                           (&/|map (partial shift-function-body own-body?) args))]))
 
       ($apply func args)
       (&/T [meta ($apply (shift-function-body own-body? func)