aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/base.clj13
-rw-r--r--src/lux/analyser/host.clj34
-rw-r--r--src/lux/analyser/parser.clj23
-rw-r--r--src/lux/base.clj6
-rw-r--r--src/lux/compiler/host.clj20
-rw-r--r--src/lux/host.clj13
-rw-r--r--src/lux/type.clj6
7 files changed, 103 insertions, 12 deletions
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 5149456aa..318149b9f 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -152,10 +152,19 @@
"jvm-lushr"])
;; [Exports]
-(defn expr-type* [syntax+]
- (|let [[[type _] _] syntax+]
+(defn expr-type* [analysis]
+ (|let [[[type _] _] analysis]
type))
+(defn with-type [new-type analysis]
+ (|let [[[type cursor] adt] analysis]
+ (&/T [(&/T [new-type cursor]) adt])))
+
+(defn clean-analysis [$var an]
+ "(-> Type Analysis (Lux Analysis))"
+ (|do [=an-type (&type/clean $var (expr-type* an))]
+ (return (with-type =an-type an))))
+
(def jvm-this "_jvm_this")
(defn cap-1 [action]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index bce75bea7..a467e7822 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -268,6 +268,7 @@
(|case gtype-vars
(&/$Nil)
(|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
+ =arg-types (&/map% &type/show-type+ arg-types)
=args (&/map2% (partial &&/analyse-1 analyse) arg-types args)
=gret (&host-type/instance-param &type/existential gtype-env gret)]
(return (&/T [=gret =args])))
@@ -275,8 +276,11 @@
(&/$Cons ^TypeVariable gtv gtype-vars*)
(&type/with-var
(fn [$var]
- (|let [gtype-env* (&/Cons$ (&/T [(.getName gtv) $var]) gtype-env)]
- (analyse-method-call-helper analyse gret gtype-env* gtype-vars* gtype-args args))))
+ (|do [:let [gtype-env* (&/Cons$ (&/T [(.getName gtv) $var]) gtype-env)]
+ [=gret =args] (analyse-method-call-helper analyse gret gtype-env* gtype-vars* gtype-args args)
+ ==gret (&type/clean $var =gret)
+ ==args (&/map% (partial &&/clean-analysis $var) =args)]
+ (return (&/T [==gret ==args])))))
))
(let [dummy-type-param (&type/Data$ "java.lang.Object" (&/|list))]
@@ -316,11 +320,7 @@
(|do [class-loader &/loader
[gret exceptions parent-gvars gvars gargs] (&host/lookup-static-method class-loader class method classes)
_ (ensure-catching exceptions)
- gtype-env (&/fold% (fn [m ^TypeVariable g]
- (|do [=var-type &type/existential]
- (return (&/Cons$ (&/T [(.getName g) =var-type]) m))))
- (&/|table)
- parent-gvars)
+ :let [gtype-env (&/|table)]
[output-type =args] (analyse-method-call-helper analyse gret gtype-env gvars gargs args)
_ (&type/check exo-type (as-otype+ output-type))
_cursor &/cursor]
@@ -622,6 +622,23 @@
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
(return (&/V &/$OverridenMethodAnalysis (&/T [?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body]))))
+
+ (&/$StaticMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body)
+ (|do [method-env (&/map% (fn [gvar]
+ (|do [ex &type/existential]
+ (return (&/T [gvar ex]))))
+ ?gvars)
+ :let [full-env method-env]
+ output-type (generic-class->type full-env ?output)
+ =body (&/with-type-env full-env
+ (&/fold (fn [body* input*]
+ (|do [:let [[iname itype*] input*]
+ itype (generic-class->type full-env itype*)]
+ (&&env/with-local iname itype
+ body*)))
+ (&&/analyse-1 analyse output-type ?body)
+ (&/|reverse ?inputs)))]
+ (return (&/V &/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output =body]))))
)))
(defn ^:private mandatory-methods [supers]
@@ -641,6 +658,9 @@
(&/$OverridenMethodAnalysis =class-decl =name =anns =gvars =exceptions =inputs =output body)
(assoc mmap =name =inputs)
+
+ (&/$StaticMethodAnalysis _)
+ mmap
))
{}
methods)
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 3c4d4413d..26b161aba 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -229,10 +229,33 @@
_
(fail "")))
+(defn ^:private parse-method-static-def [ast]
+ (|case ast
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS "static")]
+ (&/$Cons [_ (&/$TextS ?name)]
+ (&/$Cons ?privacy-modifier
+ (&/$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 &/$StaticMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output body]))))
+
+ _
+ (fail "")))
+
(defn parse-method-def [ast]
(&/try-all% (&/|list #((parse-method-init-def ast) %)
#((parse-method-virtual-def ast) %)
#((parse-method-override-def ast) %)
+ #((parse-method-static-def ast) %)
(fn [state]
(fail* (str "[Analyser Error] Invalid method definition: " (&/show-ast ast)))))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 9bfd60350..dc8dc0081 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -120,12 +120,14 @@
(deftags
["ConstructorMethodSyntax"
"VirtualMethodSyntax"
- "OverridenMethodSyntax"])
+ "OverridenMethodSyntax"
+ "StaticMethodSyntax"])
(deftags
["ConstructorMethodAnalysis"
"VirtualMethodAnalysis"
- "OverridenMethodAnalysis"])
+ "OverridenMethodAnalysis"
+ "StaticMethodAnalysis"])
;; Meta-data
(deftags
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 291d78ee2..deeb529b5 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -570,6 +570,26 @@
(.visitMaxs 0 0)
(.visitEnd))]]
(return nil))))
+
+ (&/$StaticMethodAnalysis ?name ?privacy-modifier ?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
+ (+ (privacy-modifer->flag ?privacy-modifier)
+ Opcodes/ACC_STATIC)
+ ?name
+ simple-signature
+ generic-signature
+ (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+ (|do [^MethodVisitor =method &/get-writer
+ :let [_ (&/|map (partial compile-annotation =method) ?anns)
+ _ (.visitCode =method)]
+ _ (compile ?body)
+ :let [_ (doto =method
+ (compile-method-return ?output)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil))))
))
(defn ^:private compile-method-decl [^ClassWriter class-writer =method-decl]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 36375ae0f..fe648c8ff 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -313,6 +313,19 @@
(.visitMaxs 0 0)
(.visitEnd)))
+ (&/$StaticMethodSyntax =name =privacy-modifier =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 Opcodes/ACC_STATIC)
+ =name
+ simple-signature
+ generic-signature
+ (->> =exceptions (&/|map &host-generics/gclass->bytecode-class-name) &/->seq (into-array java.lang.String)))
+ .visitCode
+ (dummy-return =output)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+
_
(assert false (println-str 'compile-dummy-method (&/adt->text method-def)))
))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 936fe9409..d3a5f1493 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -279,6 +279,10 @@
(deref ?id)
(return type)))
(return type))
+
+ (&/$DataT ?name ?params)
+ (|do [=params (&/map% (partial clean* ?tid) ?params)]
+ (return (Data$ ?name =params)))
(&/$LambdaT ?arg ?return)
(|do [=arg (clean* ?tid ?arg)
@@ -503,7 +507,7 @@
(defn ^:private fp-put [k v fixpoints]
(&/Cons$ (&/T [k v]) fixpoints))
-(defn ^:private show-type+ [type]
+(defn show-type+ [type]
(|case type
(&/$VarT ?id)
(fn [state]