aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser/host.clj27
-rw-r--r--src/lux/analyser/parser.clj23
-rw-r--r--src/lux/base.clj9
-rw-r--r--src/lux/compiler.clj4
-rw-r--r--src/lux/compiler/host.clj67
-rw-r--r--src/lux/host.clj13
-rw-r--r--src/lux/type/host.clj27
7 files changed, 139 insertions, 31 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 603fccc42..f8d6060d4 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -238,7 +238,7 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&&/$jvm-putstatic (&/T [class field =value gclass =type])))))))
+ (&&/$jvm-putstatic (&/T [class field =value gclass])))))))
(defn analyse-jvm-putfield [analyse exo-type class field value object]
(|do [class-loader &/loader
@@ -694,7 +694,19 @@
(|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 =inheritance-modifier =anns =fields methods]
+(defn ^:private analyse-field [analyse gtype-env field]
+ "(-> Analyser GTypeEnv FieldSyntax (Lux FieldAnalysis))"
+ (|case field
+ (&/$ConstantFieldSyntax ?name ?anns ?gclass ?value)
+ (|do [=gtype (&host-type/instance-gtype &type/existential gtype-env ?gclass)
+ =value (&&/analyse-1 analyse =gtype ?value)]
+ (return (&/$ConstantFieldAnalysis ?name ?anns ?gclass =value)))
+
+ (&/$VariableFieldSyntax ?name ?privacy-modifier ?state-modifier ?anns ?type)
+ (return (&/$VariableFieldAnalysis ?name ?privacy-modifier ?state-modifier ?anns ?type))
+ ))
+
+(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
@@ -704,6 +716,7 @@
(|do [ex &type/existential]
(return (&/T [gvar ex]))))
?params)
+ =fields (&/map% (partial analyse-field analyse class-env) ?fields)
_ (&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)
@@ -755,11 +768,11 @@
=captured &&env/captured-vars
:let [=fields (&/|map (fn [^objects idx+capt]
(|let [[idx _] idx+capt]
- (&/T [(str &c!base/closure-prefix idx)
- &/$PublicPM
- &/$FinalSM
- &/$Nil
- captured-slot-type])))
+ (&/$VariableFieldAnalysis (str &c!base/closure-prefix idx)
+ &/$PublicPM
+ &/$FinalSM
+ &/$Nil
+ captured-slot-type)))
(&/enumerate =captured))]
:let [sources (&/|map captured-source =captured)]
_ (compile-token (&&/$jvm-class (&/T [class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args)])))
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 61f6c5960..85aae913a 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -315,17 +315,28 @@
(defn parse-field [ast]
(|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS ?name)]
- (&/$Cons ?privacy-modifier
- (&/$Cons ?state-modifier
- (&/$Cons [_ (&/$TupleS ?anns)]
- (&/$Cons ?type
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS "constant")]
+ (&/$Cons [_ (&/$TextS ?name)]
+ (&/$Cons [_ (&/$TupleS ?anns)]
+ (&/$Cons ?type
+ (&/$Cons ?value
(&/$Nil)))))))]
+ (|do [=anns (&/map% parse-ann ?anns)
+ =type (parse-gclass ?type)]
+ (return (&/$ConstantFieldSyntax ?name =anns =type ?value)))
+
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS "variable")]
+ (&/$Cons [_ (&/$TextS ?name)]
+ (&/$Cons ?privacy-modifier
+ (&/$Cons ?state-modifier
+ (&/$Cons [_ (&/$TupleS ?anns)]
+ (&/$Cons ?type
+ (&/$Nil))))))))]
(|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
=state-modifier (parse-state-modifier ?state-modifier)
=anns (&/map% parse-ann ?anns)
=type (parse-gclass ?type)]
- (return (&/T [?name =privacy-modifier =state-modifier =anns =type])))
+ (return (&/$VariableFieldSyntax ?name =privacy-modifier =state-modifier =anns =type)))
_
(fail (str "[Analyser Error] Invalid field declaration: " (&/show-ast ast)))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 96c1a82a6..1c7c894b3 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -167,6 +167,15 @@
("AbstractIM" 0)
("FinalIM" 0))
+;; Fields
+(defvariant
+ ("ConstantFieldSyntax" 4)
+ ("VariableFieldSyntax" 5))
+
+(defvariant
+ ("ConstantFieldAnalysis" 4)
+ ("VariableFieldAnalysis" 5))
+
;; Methods
(defvariant
("ConstructorMethodSyntax" 1)
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 157be60bd..4323317cc 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -219,8 +219,8 @@
(&o/$jvm-getfield ?class ?field ?object ?output-type)
(&&host/compile-jvm-getfield compile-expression ?class ?field ?object ?output-type)
- (&o/$jvm-putstatic ?class ?field ?value input-gclass ?input-type)
- (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value input-gclass ?input-type)
+ (&o/$jvm-putstatic ?class ?field ?value input-gclass)
+ (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value input-gclass)
(&o/$jvm-putfield ?class ?field ?value input-gclass ?object ?input-type)
(&&host/compile-jvm-putfield compile-expression ?class ?field ?object ?value input-gclass ?input-type)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 6eeb61355..bddb25f67 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -394,11 +394,11 @@
(prepare-return! ?output-type))]]
(return nil)))
-(defn compile-jvm-putstatic [compile ?class ?field ?value input-gclass ?input-type]
+(defn compile-jvm-putstatic [compile ?class ?field ?value input-gclass]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?value)
- =input-sig (&host/->java-sig ?input-type)
- :let [_ (doto *writer*
+ :let [=input-sig (&host-type/gclass->sig input-gclass)
+ _ (doto *writer*
(prepare-arg! (&host-generics/gclass->class-name input-gclass))
(.visitFieldInsn Opcodes/PUTSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =input-sig)
(.visitInsn Opcodes/ACONST_NULL))]]
@@ -435,16 +435,28 @@
nil)
(defn ^:private compile-field [^ClassWriter writer field]
- (|let [[=name =privacy-modifier =state-modifier =anns =type] field
- =field (.visitField writer
- (+ (&host/privacy-modifier->flag =privacy-modifier)
- (&host/state-modifier->flag =state-modifier))
- =name
- (&host-generics/gclass->simple-signature =type)
- (&host-generics/gclass->signature =type) nil)]
- (do (&/|map (partial compile-annotation =field) =anns)
- (.visitEnd =field)
- nil)))
+ (|case field
+ (&/$ConstantFieldSyntax ?name ?anns ?gclass ?value)
+ (|let [=field (.visitField writer
+ (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC Opcodes/ACC_FINAL)
+ ?name
+ (&host-generics/gclass->simple-signature ?gclass)
+ (&host-generics/gclass->signature ?gclass) nil)]
+ (do (&/|map (partial compile-annotation =field) ?anns)
+ (.visitEnd =field)
+ nil))
+
+ (&/$VariableFieldSyntax =name =privacy-modifier =state-modifier =anns =type)
+ (|let [=field (.visitField writer
+ (+ (&host/privacy-modifier->flag =privacy-modifier)
+ (&host/state-modifier->flag =state-modifier))
+ =name
+ (&host-generics/gclass->simple-signature =type)
+ (&host-generics/gclass->signature =type) nil)]
+ (do (&/|map (partial compile-annotation =field) =anns)
+ (.visitEnd =field)
+ nil))
+ ))
(defn ^:private compile-method-return [^MethodVisitor writer output]
(|case output
@@ -680,6 +692,20 @@
(return nil)))))
)
+(defn ^:private constant-inits [fields]
+ "(-> (List FieldAnalysis) (List [Text GenericClass Analysis]))"
+ (&/fold &/|++
+ &/$Nil
+ (&/|map (fn [field]
+ (|case field
+ (&/$ConstantFieldSyntax ?name ?anns ?gclass ?value)
+ (&/|list (&/T [?name ?gclass ?value]))
+
+ (&/$VariableFieldSyntax _)
+ (&/|list)
+ ))
+ fields)))
+
(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
@@ -701,7 +727,20 @@
(add-anon-class-<init> =class compile full-name ?super-class env ctor-args)
_
- (return nil))]
+ (return nil))
+ _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
+ (|do [^MethodVisitor =method &/get-writer
+ :let [_ (doto =method
+ (.visitCode))]
+ _ (&/map% (fn [ftriple]
+ (|let [[fname fgclass fvalue] ftriple]
+ (compile-jvm-putstatic compile ?name fname fvalue fgclass)))
+ (constant-inits ?fields))
+ :let [_ (doto =method
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil)))]
(&&/save-class! ?name (.toByteArray (doto =class .visitEnd)))))
(defn compile-jvm-interface [compile interface-decl ?supers ?anns ?methods]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index d98e1154f..6bbf752f2 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -376,12 +376,21 @@
(&host-generics/->bytecode-class-name (&host-generics/super-class-name super-class))
(->> interfaces (&/|map (comp &host-generics/->bytecode-class-name &host-generics/super-class-name)) &/->seq (into-array String))))
_ (&/|map (fn [field]
- (|let [[=name =privacy-modifier =state-modifier =anns =type] field]
+ (|case field
+ (&/$ConstantFieldAnalysis =name =anns =type ?value)
+ (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC Opcodes/ACC_FINAL) =name
+ (&host-generics/gclass->simple-signature =type)
+ (&host-generics/gclass->signature =type)
+ nil)
+ (.visitEnd))
+
+ (&/$VariableFieldAnalysis =name =privacy-modifier =state-modifier =anns =type)
(doto (.visitField =class (+ Opcodes/ACC_PUBLIC (state-modifier->flag =state-modifier)) =name
(&host-generics/gclass->simple-signature =type)
(&host-generics/gclass->signature =type)
nil)
- (.visitEnd))))
+ (.visitEnd))
+ ))
fields)
_ (&/|map (partial compile-dummy-method =class super-class) methods)
bytecode (.toByteArray (doto =class .visitEnd))]
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index 531169538..1a174bb27 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -271,3 +271,30 @@
(if-let [bound (->> ^WildcardType gtype .getUpperBounds seq first)]
(gtype->gclass bound)
&/$GenericWildcard)))
+
+(let [generic-type-sig "Ljava/lang/Object;"]
+ (defn gclass->sig [gclass]
+ "(-> GenericClass Text)"
+ (|case gclass
+ (&/$GenericClass gclass-name (&/$Nil))
+ (|case gclass-name
+ "void" "V"
+ "boolean" "Z"
+ "byte" "B"
+ "short" "S"
+ "int" "I"
+ "long" "J"
+ "float" "F"
+ "double" "D"
+ "char" "C"
+ _ (str "L" (clojure.string/replace gclass-name #"\." "/") ";"))
+
+ (&/$GenericArray inner-gtype)
+ (str "[" (gclass->sig inner-gtype))
+
+ (&/$GenericTypeVar ?vname)
+ generic-type-sig
+
+ (&/$GenericWildcard)
+ generic-type-sig
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 19:11:10 +0000