From f22c2feb55cdd8bf77c345abdf64700c6558fb05 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 8 Feb 2016 09:14:42 -0400 Subject: - Added support for strict floating-point arithmetic on methods. --- src/lux/analyser/base.clj | 12 ++++----- src/lux/analyser/host.clj | 19 +++++++------- src/lux/analyser/lux.clj | 27 ++++++++++---------- src/lux/analyser/parser.clj | 60 ++++++++++++++++++++++++--------------------- src/lux/compiler/host.clj | 18 ++++++++------ src/lux/host.clj | 8 +++--- 6 files changed, 77 insertions(+), 67 deletions(-) (limited to 'src') 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- (&/$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) -- cgit v1.2.3