aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser/base.clj12
-rw-r--r--src/lux/analyser/host.clj19
-rw-r--r--src/lux/analyser/lux.clj27
-rw-r--r--src/lux/analyser/parser.clj60
-rw-r--r--src/lux/compiler/host.clj18
-rw-r--r--src/lux/host.clj8
6 files changed, 77 insertions, 67 deletions
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 00dbfb977..7634ce74b 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -18,12 +18,12 @@
("text" 1)
("variant" 3)
("tuple" 1)
- ("apply" 1)
- ("case" 1)
- ("lambda" 1)
- ("ann" 1)
- ("coerce" 1)
- ("def" 1)
+ ("apply" 2)
+ ("case" 2)
+ ("lambda" 3)
+ ("ann" 3)
+ ("coerce" 3)
+ ("def" 3)
("declare-macro" 1)
("var" 1)
("captured" 1)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 42257e352..603fccc42 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -565,7 +565,7 @@
(|let [[?cname ?cparams] class-decl
class-type (&/$DataT ?cname (&/|map &/|second class-env))]
(|case method
- (&/$ConstructorMethodSyntax =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
+ (&/$ConstructorMethodSyntax =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
(|do [method-env (&/map% (fn [gvar]
(|do [ex &type/existential]
(return (&/T [gvar ex]))))
@@ -587,9 +587,9 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
- (return (&/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
+ (return (&/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
- (&/$VirtualMethodSyntax ?name =privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output ?body)
+ (&/$VirtualMethodSyntax ?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
(|do [method-env (&/map% (fn [gvar]
(|do [ex &type/existential]
(return (&/T [gvar ex]))))
@@ -605,9 +605,9 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
- (return (&/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output =body]))))
+ (return (&/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
- (&/$OverridenMethodSyntax ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
+ (&/$OverridenMethodSyntax ?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
(|do [super-env (gen-super-env class-env all-supers ?class-decl)
method-env (&/map% (fn [gvar]
(|do [ex &type/existential]
@@ -624,9 +624,9 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
- (return (&/$OverridenMethodAnalysis (&/T [?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body]))))
+ (return (&/$OverridenMethodAnalysis (&/T [?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
- (&/$StaticMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body)
+ (&/$StaticMethodSyntax ?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
(|do [method-env (&/map% (fn [gvar]
(|do [ex &type/existential]
(return (&/T [gvar ex]))))
@@ -641,7 +641,7 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs)))]
- (return (&/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output =body]))))
+ (return (&/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
(&/$AbstractMethodSyntax ?name ?anns ?gvars ?exceptions ?inputs ?output)
(return (&/$AbstractMethodAnalysis (&/T [?name ?anns ?gvars ?exceptions ?inputs ?output])))
@@ -662,7 +662,7 @@
(&/$VirtualMethodAnalysis _)
mmap
- (&/$OverridenMethodAnalysis =class-decl =name =anns =gvars =exceptions =inputs =output body)
+ (&/$OverridenMethodAnalysis =class-decl =name ?strict =anns =gvars =exceptions =inputs =output body)
(assoc mmap =name =inputs)
(&/$StaticMethodAnalysis _)
@@ -723,6 +723,7 @@
source))
(let [default-<init> (&/$ConstructorMethodSyntax (&/T [&/$PublicPM
+ false
&/$Nil
&/$Nil
&/$Nil
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index a5e3b3290..98c734372 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -367,7 +367,7 @@
(|do [:let [[[=fn-type =fn-cursor] =fn-form] =fn]
[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
(return (&/|list (&&/|meta =output-t =fn-cursor
- (&&/$apply (&/T [=fn =args]))
+ (&&/$apply =fn =args)
)))))
(defn analyse-apply [analyse exo-type =fn ?args]
@@ -380,13 +380,14 @@
(&/$Some _)
(|do [macro-expansion (fn [state] (-> ?value (.apply ?args) (.apply state)))
:let [[r-prefix r-name] real-name
- _ (when (or (= "defclass" r-name)
- ;; (= "@type" r-name)
- )
- (->> (&/|map &/show-ast macro-expansion)
- (&/|interpose "\n")
- (&/fold str "")
- (prn (&/ident->text real-name))))]
+ ;; _ (when (or (= "defclass" r-name)
+ ;; ;; (= "@type" r-name)
+ ;; )
+ ;; (->> (&/|map &/show-ast macro-expansion)
+ ;; (&/|interpose "\n")
+ ;; (&/fold str "")
+ ;; (prn (&/ident->text real-name))))
+ ]
]
(&/flat-map% (partial analyse exo-type) macro-expansion))
@@ -411,7 +412,7 @@
=match (&&case/analyse-branches analyse exo-type var?? (&&/expr-type* =value) (&/|as-pairs ?branches))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&&/$case (&/T [=value =match]))
+ (&&/$case =value =match)
)))))
(defn analyse-lambda* [analyse exo-type ?self ?arg ?body]
@@ -468,7 +469,7 @@
(&&/analyse-1 analyse ?return-t ?body))
_cursor &/cursor]
(return (&&/|meta exo-type* _cursor
- (&&/$lambda (&/T [=scope =captured =body])))))
+ (&&/$lambda =scope =captured =body))))
@@ -515,7 +516,7 @@
==meta (eval! =meta)
_ (&&module/test-type module-name ?name ==meta (&&/expr-type* =value))
_ (&&module/test-macro module-name ?name ==meta (&&/expr-type* =value))
- _ (compile-token (&&/$def (&/T [?name =value ==meta])))]
+ _ (compile-token (&&/$def ?name =value ==meta))]
(return &/$Nil))
)))
@@ -546,7 +547,7 @@
=value (&&/analyse-1 analyse ==type ?value)
_cursor &/cursor]
(return (&/|list (&&/|meta ==type _cursor
- (&&/$ann (&/T [=value =type ==type]))
+ (&&/$ann =value =type ==type)
)))))
(defn analyse-coerce [analyse eval! exo-type ?type ?value]
@@ -556,5 +557,5 @@
=value (&&/analyse-1+ analyse ?value)
_cursor &/cursor]
(return (&/|list (&&/|meta ==type _cursor
- (&&/$coerce (&/T [=value =type ==type]))
+ (&&/$coerce =value =type ==type)
)))))
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 359894e75..61f6c5960 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -195,19 +195,20 @@
(|case ast
[_ (&/$FormS (&/$Cons [_ (&/$TextS "init")]
(&/$Cons ?privacy-modifier
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons [_ (&/$TupleS ?ctor-args)]
- (&/$Cons body (&/$Nil))))))))))]
+ (&/$Cons [_ (&/$BoolS ?strict)]
+ (&/$Cons [_ (&/$TupleS anns)]
+ (&/$Cons [_ (&/$TupleS gvars)]
+ (&/$Cons [_ (&/$TupleS exceptions)]
+ (&/$Cons [_ (&/$TupleS inputs)]
+ (&/$Cons [_ (&/$TupleS ?ctor-args)]
+ (&/$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)
=ctor-args (&/map% parse-ctor-arg ?ctor-args)]
- (return (&/$ConstructorMethodSyntax (&/T [=privacy-modifier =anns =gvars =exceptions =inputs =ctor-args body]))))
+ (return (&/$ConstructorMethodSyntax (&/T [=privacy-modifier ?strict =anns =gvars =exceptions =inputs =ctor-args body]))))
_
(fail "")))
@@ -218,19 +219,20 @@
(&/$Cons [_ (&/$TextS ?name)]
(&/$Cons ?privacy-modifier
(&/$Cons [_ (&/$BoolS =final?)]
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons output
- (&/$Cons body (&/$Nil))))))))))))]
+ (&/$Cons [_ (&/$BoolS ?strict)]
+ (&/$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 (&/$VirtualMethodSyntax (&/T [?name =privacy-modifier =final? =anns =gvars =exceptions =inputs =output body]))))
+ (return (&/$VirtualMethodSyntax (&/T [?name =privacy-modifier =final? ?strict =anns =gvars =exceptions =inputs =output body]))))
_
(fail "")))
@@ -240,12 +242,13 @@
[_ (&/$FormS (&/$Cons [_ (&/$TextS "override")]
(&/$Cons ?class-decl
(&/$Cons ?name
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons output
- (&/$Cons body (&/$Nil)))))))))))]
+ (&/$Cons [_ (&/$BoolS ?strict)]
+ (&/$Cons [_ (&/$TupleS anns)]
+ (&/$Cons [_ (&/$TupleS gvars)]
+ (&/$Cons [_ (&/$TupleS exceptions)]
+ (&/$Cons [_ (&/$TupleS inputs)]
+ (&/$Cons output
+ (&/$Cons body (&/$Nil))))))))))))]
(|do [=name (parse-text ?name)
=class-decl (parse-gclass-decl ?class-decl)
=anns (&/map% parse-ann anns)
@@ -253,7 +256,7 @@
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-arg-decl inputs)
=output (parse-gclass output)]
- (return (&/$OverridenMethodSyntax (&/T [=class-decl =name =anns =gvars =exceptions =inputs =output body]))))
+ (return (&/$OverridenMethodSyntax (&/T [=class-decl =name ?strict =anns =gvars =exceptions =inputs =output body]))))
_
(fail "")))
@@ -263,19 +266,20 @@
[_ (&/$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)))))))))))]
+ (&/$Cons [_ (&/$BoolS ?strict)]
+ (&/$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 (&/$StaticMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output body]))))
+ (return (&/$StaticMethodSyntax (&/T [?name =privacy-modifier ?strict =anns =gvars =exceptions =inputs =output body]))))
_
(fail "")))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 76e88e79f..6eeb61355 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -496,12 +496,13 @@
(defn ^:private compile-method-def [compile ^ClassWriter class-writer ?super-class method-def]
(|case method-def
- (&/$ConstructorMethodAnalysis ?privacy-modifier ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
+ (&/$ConstructorMethodAnalysis ?privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
(|let [?output (&/$GenericClass "void" (&/|list))
=method-decl (&/T [init-method ?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 ?strict Opcodes/ACC_STRICT 0))
init-method
simple-signature
generic-signature
@@ -524,12 +525,13 @@
(.visitEnd))]]
(return nil))))
- (&/$VirtualMethodAnalysis ?name ?privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output ?body)
+ (&/$VirtualMethodAnalysis ?name ?privacy-modifier =final? ?strict ?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)
- (if =final? Opcodes/ACC_FINAL 0))
+ (if =final? Opcodes/ACC_FINAL 0)
+ (if ?strict Opcodes/ACC_STRICT 0))
?name
simple-signature
generic-signature
@@ -544,11 +546,12 @@
(.visitEnd))]]
(return nil))))
- (&/$OverridenMethodAnalysis ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
+ (&/$OverridenMethodAnalysis ?class-decl ?name ?strict ?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
- Opcodes/ACC_PUBLIC
+ (+ Opcodes/ACC_PUBLIC
+ (if ?strict Opcodes/ACC_STRICT 0))
?name
simple-signature
generic-signature
@@ -563,11 +566,12 @@
(.visitEnd))]]
(return nil))))
- (&/$StaticMethodAnalysis ?name ?privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body)
+ (&/$StaticMethodAnalysis ?name ?privacy-modifier ?strict ?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)
+ (if ?strict Opcodes/ACC_STRICT 0)
Opcodes/ACC_STATIC)
?name
simple-signature
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 8b8996f52..d98e1154f 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -273,7 +273,7 @@
(defn ^:private compile-dummy-method [^ClassWriter =class super-class method-def]
(|case method-def
- (&/$ConstructorMethodSyntax =privacy-modifier =anns =gvars =exceptions =inputs =ctor-args body)
+ (&/$ConstructorMethodSyntax =privacy-modifier ?strict =anns =gvars =exceptions =inputs =ctor-args body)
(|let [=output (&/$GenericClass "void" (&/|list))
method-decl [init-method-name =anns =gvars =exceptions (&/|map &/|second =inputs) =output]
[simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
@@ -287,7 +287,7 @@
(.visitMaxs 0 0)
(.visitEnd)))
- (&/$VirtualMethodSyntax =name =privacy-modifier =final? =anns =gvars =exceptions =inputs =output body)
+ (&/$VirtualMethodSyntax =name =privacy-modifier =final? ?strict =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
@@ -301,7 +301,7 @@
(.visitMaxs 0 0)
(.visitEnd)))
- (&/$OverridenMethodSyntax =class-decl =name =anns =gvars =exceptions =inputs =output body)
+ (&/$OverridenMethodSyntax =class-decl =name ?strict =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
@@ -314,7 +314,7 @@
(.visitMaxs 0 0)
(.visitEnd)))
- (&/$StaticMethodSyntax =name =privacy-modifier =anns =gvars =exceptions =inputs =output body)
+ (&/$StaticMethodSyntax =name =privacy-modifier ?strict =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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 02:19:57 +0000