- Added support for "final" fields, methods & classes.

7 files changed, 67 insertions, 33 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 25bb09b6d..ae4d81a39 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -162,17 +162,19 @@
                        (&/$Cons ?class-decl
                                 (&/$Cons ?super-class
                                          (&/$Cons [_ (&/$TupleS ?interfaces)]
-                                                  (&/$Cons [_ (&/$TupleS ?anns)]
-                                                           (&/$Cons [_ (&/$TupleS ?fields)]
-                                                                    (&/$Cons [_ (&/$TupleS ?methods)]
-                                                                             (&/$Nil)))))))))
+                                                  (&/$Cons ?inheritance-modifier
+                                                           (&/$Cons [_ (&/$TupleS ?anns)]
+                                                                    (&/$Cons [_ (&/$TupleS ?fields)]
+                                                                             (&/$Cons [_ (&/$TupleS ?methods)]
+                                                                                      (&/$Nil))))))))))
     (|do [=gclass-decl (&&a-parser/parse-gclass-decl ?class-decl)
           =super-class (&&a-parser/parse-gclass-super ?super-class)
           =interfaces (&/map% &&a-parser/parse-gclass-super ?interfaces)
+          =inheritance-modifier (&&a-parser/parse-inheritance-modifier ?inheritance-modifier)
           =anns (&/map% &&a-parser/parse-ann ?anns)
           =fields (&/map% &&a-parser/parse-field ?fields)
           =methods (&/map% &&a-parser/parse-method-def ?methods)]
-      (&&host/analyse-jvm-class analyse compile-token =gclass-decl =super-class =interfaces =anns =fields =methods))
+      (&&host/analyse-jvm-class analyse compile-token =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")]
                        (&/$Cons ?class-decl
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 99a1da65f..80b627ec9 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -589,7 +589,7 @@
                               (&/|reverse ?inputs))))]
         (return (&/V &/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
       
-      (&/$VirtualMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body)
+      (&/$VirtualMethodSyntax ?name =privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output ?body)
       (|do [method-env (&/map% (fn [gvar]
                                  (|do [ex &type/existential]
                                    (return (&/T [gvar ex]))))
@@ -605,7 +605,7 @@
                                     body*)))
                               (&&/analyse-1 analyse output-type ?body)
                               (&/|reverse ?inputs))))]
-        (return (&/V &/$VirtualMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output =body]))))
+        (return (&/V &/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output =body]))))
       
       (&/$OverridenMethodSyntax ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
       (|do [super-env (gen-super-env class-env all-supers ?class-decl)
@@ -688,7 +688,7 @@
       (|let [[am-name am-inputs] missing-method]
         (fail (str "[Analyser Error] Missing method: " am-name " " "(" (->> am-inputs (&/|interpose " ") (&/fold str "")) ")"))))))
 
-(defn analyse-jvm-class [analyse compile-token class-decl super-class interfaces =anns =fields methods]
+(defn analyse-jvm-class [analyse compile-token class-decl super-class interfaces =inheritance-modifier =anns =fields methods]
   (&/with-closure
     (|do [module &/get-module-name
           :let [[?name ?params] class-decl
@@ -701,7 +701,7 @@
           _ (&host/use-dummy-class class-decl super-class interfaces &/None$ =fields methods)
           =methods (&/map% (partial analyse-method analyse class-decl class-env all-supers) methods)
           _ (check-method-completion all-supers =methods)
-          _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces =anns =fields =methods (&/|list) &/None$])))
+          _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces =inheritance-modifier =anns =fields =methods (&/|list) &/None$])))
           :let [_ (println 'DEF full-name)]]
       (return &/Nil$))))
 
@@ -750,12 +750,12 @@
                                     (|let [[idx _] idx+capt]
                                       (&/T [(str &c!base/closure-prefix idx)
                                             (&/V &/$PublicPM &/unit-tag)
-                                            (&/V &/$DefaultSM &/unit-tag)
+                                            (&/V &/$FinalSM &/unit-tag)
                                             (&/|list)
                                             captured-slot-type])))
                                   (&/enumerate =captured))]
             :let [sources (&/|map captured-source =captured)]
-            _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces (&/|list) =fields =methods =captured (&/Some$ =ctor-args)])))
+            _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces (&/V &/$DefaultIM &/unit-tag) (&/|list) =fields =methods =captured (&/Some$ =ctor-args)])))
             _cursor &/cursor]
         (return (&/|list (&&/|meta anon-class-type _cursor
                                    (&/V &&/$jvm-new (&/T [anon-class (&/|repeat (&/|length sources) captured-slot-class) sources]))
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index eebfb6693..28b8d93c6 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -171,9 +171,23 @@
     [_ (&/$TextS "volatile")]
     (return (&/V &/$VolatileSM &/unit-tag))
 
+    [_ (&/$TextS "final")]
+    (return (&/V &/$FinalSM &/unit-tag))
+
     _
     (fail (str "[Analyser Error] Invalid state modifier: " (&/show-ast ast)))))
 
+(defn parse-inheritance-modifier [ast]
+  (|case ast
+    [_ (&/$TextS "default")]
+    (return (&/V &/$DefaultIM &/unit-tag))
+
+    [_ (&/$TextS "final")]
+    (return (&/V &/$FinalIM &/unit-tag))
+
+    _
+    (fail (str "[Analyser Error] Invalid inheritance modifier: " (&/show-ast ast)))))
+
 (defn ^:private parse-method-init-def [ast]
   (|case ast
     [_ (&/$FormS (&/$Cons [_ (&/$TextS "init")]
@@ -200,19 +214,20 @@
     [_ (&/$FormS (&/$Cons [_ (&/$TextS "virtual")]
                           (&/$Cons [_ (&/$TextS ?name)]
                                    (&/$Cons ?privacy-modifier
-                                            (&/$Cons [_ (&/$TupleS anns)]
-                                                     (&/$Cons [_ (&/$TupleS gvars)]
-                                                              (&/$Cons [_ (&/$TupleS exceptions)]
-                                                                       (&/$Cons [_ (&/$TupleS inputs)]
-                                                                                (&/$Cons output
-                                                                                         (&/$Cons body (&/$Nil)))))))))))]
+                                            (&/$Cons [_ (&/$BoolS =final?)]
+                                                     (&/$Cons [_ (&/$TupleS anns)]
+                                                              (&/$Cons [_ (&/$TupleS gvars)]
+                                                                       (&/$Cons [_ (&/$TupleS exceptions)]
+                                                                                (&/$Cons [_ (&/$TupleS inputs)]
+                                                                                         (&/$Cons output
+                                                                                                  (&/$Cons body (&/$Nil))))))))))))]
     (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
           =anns (&/map% parse-ann anns)
           =gvars (&/map% parse-text gvars)
           =exceptions (&/map% parse-gclass exceptions)
           =inputs (&/map% parse-arg-decl inputs)
           =output (parse-gclass output)]
-      (return (&/V &/$VirtualMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output body]))))
+      (return (&/V &/$VirtualMethodSyntax (&/T [?name =privacy-modifier =final? =anns =gvars =exceptions =inputs =output body]))))
 
     _
     (fail "")))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 3a03ddf9a..bbd610b5c 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -116,9 +116,16 @@
    "PrivatePM"
    "ProtectedPM"])
 
+;; State Modifiers
 (deftags
   ["DefaultSM"
-   "VolatileSM"])
+   "VolatileSM"
+   "FinalSM"])
+
+;; Inheritance Modifiers
+(deftags
+  ["DefaultIM"
+   "FinalIM"])
 
 ;; Methods
 (deftags
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 31e0ca3a2..157be60bd 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -433,8 +433,8 @@
     (&o/$jvm-interface ?name ?supers ?anns ?methods)
     (&&host/compile-jvm-interface compile-expression ?name ?supers ?anns ?methods)
 
-    (&o/$jvm-class ?name ?super-class ?interfaces ?anns ?fields ?methods ??env ??ctor-args)
-    (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?anns ?fields ?methods ??env ??ctor-args)
+    (&o/$jvm-class ?name ?super-class ?interfaces ?anns ?inheritance-modifier ?fields ?methods ??env ??ctor-args)
+    (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?anns ?inheritance-modifier ?fields ?methods ??env ??ctor-args)
 
     _
     (compile-expression syntax)))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 4fd3b7e0f..b7f5c8679 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -524,11 +524,12 @@
                         (.visitEnd))]]
           (return nil))))
     
-    (&/$VirtualMethodAnalysis ?name ?privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body)
+    (&/$VirtualMethodAnalysis ?name ?privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output ?body)
     (|let [=method-decl (&/T [?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output])
            [simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
       (&/with-writer (.visitMethod class-writer
-                                   (&host/privacy-modifier->flag ?privacy-modifier)
+                                   (+ (&host/privacy-modifier->flag ?privacy-modifier)
+                                      (if =final? Opcodes/ACC_FINAL 0))
                                    ?name
                                    simple-signature
                                    generic-signature
@@ -661,7 +662,7 @@
           (return nil)))))
   )
 
-(defn compile-jvm-class [compile class-decl ?super-class ?interfaces ?anns ?fields ?methods env ??ctor-args]
+(defn compile-jvm-class [compile class-decl ?super-class ?interfaces ?inheritance-modifier ?anns ?fields ?methods env ??ctor-args]
   (|do [module &/get-module-name
         [file-name line column] &/cursor
         :let [[?name ?params] class-decl
@@ -669,7 +670,8 @@
               full-name (str module "/" ?name)
               super-class* (&host-generics/->bytecode-class-name (&host-generics/super-class-name ?super-class))
               =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
-                       (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+                       (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER
+                                                         (&host/inheritance-modifier->flag ?inheritance-modifier))
                                full-name (if (= "" class-signature) nil class-signature) super-class* (->> ?interfaces (&/|map (comp &host-generics/->bytecode-class-name &host-generics/super-class-name)) &/->seq (into-array String)))
                        (.visitSource file-name nil))
               _ (&/|map (partial compile-annotation =class) ?anns)
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 0e39aa6df..241a975ea 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -287,10 +287,11 @@
         (.visitMaxs 0 0)
         (.visitEnd)))
 
-    (&/$VirtualMethodSyntax =name =privacy-modifier =anns =gvars =exceptions =inputs =output body)
+    (&/$VirtualMethodSyntax =name =privacy-modifier =final? =anns =gvars =exceptions =inputs =output body)
     (|let [method-decl [=name =anns =gvars =exceptions (&/|map &/|second =inputs) =output]
            [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
-      (doto (.visitMethod =class Opcodes/ACC_PUBLIC
+      (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC
+                                    (if =final? Opcodes/ACC_FINAL 0))
                           =name
                           simple-signature
                           generic-signature
@@ -330,12 +331,6 @@
     (assert false (println-str 'compile-dummy-method (&/adt->text method-def)))
     ))
 
-(defn state-modifier->flag [state-modifier]
-  "(-> State Int)"
-  (|case state-modifier
-    (&/$DefaultSM)  0
-    (&/$VolatileSM) Opcodes/ACC_VOLATILE))
-
 (defn privacy-modifier->flag [privacy-modifier]
   "(-> PrivacyModifier Int)"
   (|case privacy-modifier
@@ -345,6 +340,19 @@
     (&/$DefaultPM)   0
     ))
 
+(defn state-modifier->flag [state-modifier]
+  "(-> StateModifier Int)"
+  (|case state-modifier
+    (&/$DefaultSM)  0
+    (&/$VolatileSM) Opcodes/ACC_VOLATILE
+    (&/$FinalSM)    Opcodes/ACC_FINAL))
+
+(defn inheritance-modifier->flag [inheritance-modifier]
+  "(-> InheritanceModifier Int)"
+  (|case inheritance-modifier
+    (&/$DefaultIM)  0
+    (&/$FinalIM)    Opcodes/ACC_FINAL))
+
 (defn use-dummy-class [class-decl super-class interfaces ctor-args fields methods]
   (|do [module &/get-module-name
         :let [[?name ?params] class-decl