- Added the ability to define constant fields in classes.

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
+      )))