- Added support for strict floating-point arithmetic on methods.

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)