aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser.clj12
-rw-r--r--src/lux/analyser/host.clj12
-rw-r--r--src/lux/analyser/parser.clj29
-rw-r--r--src/lux/base.clj9
-rw-r--r--src/lux/compiler.clj4
-rw-r--r--src/lux/compiler/host.clj10
-rw-r--r--src/lux/host.clj24
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 18:13:01 +0000