- Implemented record compilation, alongside get@' and set@'.

- Made a small change in float & double comparisons to make sure NaN < n.

6 files changed, 162 insertions, 7 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 8f05232a2..a26ee44b2 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -35,6 +35,9 @@
     [::&parser/Tuple ?elems]
     (&&lux/analyse-tuple analyse-ast ?elems)
 
+    [::&parser/Record ?elems]
+    (&&lux/analyse-record analyse-ast ?elems)
+
     [::&parser/Tag ?tag]
     (let [tuple-type [::&type/Tuple (list)]]
       (return (list [::&&/Expression [::&&/variant ?tag [::&&/Expression [::&&/tuple (list)] tuple-type]]
@@ -49,6 +52,12 @@
     [::&parser/Form ([[::&parser/Ident "lambda'"] [::&parser/Ident ?self] [::&parser/Ident ?arg] ?body] :seq)]
     (&&lux/analyse-lambda analyse-ast ?self ?arg ?body)
 
+    [::&parser/Form ([[::&parser/Ident "get@'"] [::&parser/Tag ?slot] ?record] :seq)]
+    (&&lux/analyse-get analyse-ast ?slot ?record)
+
+    [::&parser/Form ([[::&parser/Ident "set@'"] [::&parser/Tag ?slot] ?value ?record] :seq)]
+    (&&lux/analyse-set analyse-ast ?slot ?value ?record)
+
     [::&parser/Form ([[::&parser/Ident "def'"] [::&parser/Ident ?name] ?value] :seq)]
     (&&lux/analyse-def analyse-ast ?name ?value)
 
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index f9028673d..66451e97b 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -12,7 +12,7 @@
     (return type)
 
     _
-    (fail "[Analyser Error] Can't retrieve the type of a non-expression.")))
+    (fail (str "[Analyser Error] Can't retrieve the type of a non-expression: " (pr-str syntax+)))))
 
 (defn analyse-1 [analyse elem]
   (exec [output (analyse elem)]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 75b6f375a..82f6eb4da 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -22,6 +22,19 @@
          ]
     (return (list [::&&/Expression [::&&/tuple =elems] [::&type/Tuple =elems-types]]))))
 
+(defn analyse-record [analyse ?elems]
+  (exec [=elems (mapcat-m (fn [[k v]]
+                            (exec [=v (&&/analyse-1 analyse v)]
+                              (return [k =v])))
+                          ?elems)
+         =elems-types (map-m (fn [[k v]]
+                               (exec [=v (&&/expr-type v)]
+                                 (return [k =v])))
+                             =elems)
+         ;; :let [_ (prn 'analyse-tuple =elems)]
+         ]
+    (return (list [::&&/Expression [::&&/record =elems] [::&type/Record =elems-types]]))))
+
 (defn analyse-ident [analyse ident]
   (exec [module-name &/get-module-name]
     (fn [state]
@@ -108,6 +121,15 @@
                         (&type/clean =lambda-type))]
     (return (list [::&&/Expression [::&&/lambda =scope =captured ?arg =body] =lambda-type]))))
 
+(defn analyse-get [analyse ?slot ?record]
+  (exec [=record (&&/analyse-1 analyse ?record)]
+    (return (list [::&&/Expression [::&&/get ?slot =record] &type/+dont-care-type+]))))
+
+(defn analyse-set [analyse ?slot ?value ?record]
+  (exec [=value (&&/analyse-1 analyse ?value)
+         =record (&&/analyse-1 analyse ?record)]
+    (return (list [::&&/Expression [::&&/set ?slot =value =record] &type/+dont-care-type+]))))
+
 (defn analyse-def [analyse ?name ?value]
   ;; (prn 'analyse-def ?name ?value)
   (exec [module-name &/get-module-name]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 79682754c..cef1cb710 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -51,6 +51,9 @@
       [::&a/tuple ?elems]
       (&&lux/compile-tuple compile-expression ?type ?elems)
 
+      [::&a/record ?elems]
+      (&&lux/compile-record compile-expression ?type ?elems)
+
       [::&a/local ?idx]
       (&&lux/compile-local compile-expression ?type ?idx)
 
@@ -72,6 +75,12 @@
       [::&a/lambda ?scope ?env ?args ?body]
       (&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body)
 
+      [::&a/get ?slot ?record]
+      (&&lux/compile-get compile-expression ?type ?slot ?record)
+
+      [::&a/set ?slot ?value ?record]
+      (&&lux/compile-set compile-expression ?type ?slot ?value ?record)
+
       ;; Integer arithmetic
       [::&a/jvm-iadd ?x ?y]
       (&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index f1a6492b9..f50ab719f 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -161,13 +161,13 @@
   compile-jvm-llt Opcodes/LCMP  Opcodes/IFLT "java.lang.Long"   "longValue"   "()J"
   compile-jvm-lgt Opcodes/LCMP  Opcodes/IFGT "java.lang.Long"   "longValue"   "()J"
 
-  compile-jvm-feq Opcodes/FCMPL Opcodes/IFEQ "java.lang.Float"  "floatValue"  "()F"
-  compile-jvm-flt Opcodes/FCMPL Opcodes/IFLT "java.lang.Float"  "floatValue"  "()F"
-  compile-jvm-fgt Opcodes/FCMPL Opcodes/IFGT "java.lang.Float"  "floatValue"  "()F"
+  compile-jvm-feq Opcodes/FCMPG Opcodes/IFEQ "java.lang.Float"  "floatValue"  "()F"
+  compile-jvm-flt Opcodes/FCMPG Opcodes/IFLT "java.lang.Float"  "floatValue"  "()F"
+  compile-jvm-fgt Opcodes/FCMPG Opcodes/IFGT "java.lang.Float"  "floatValue"  "()F"
   
-  compile-jvm-deq Opcodes/DCMPL Opcodes/IFEQ "java.lang.Double" "doubleValue" "()I"
-  compile-jvm-dlt Opcodes/DCMPL Opcodes/IFLT "java.lang.Double" "doubleValue" "()I"
-  compile-jvm-dgt Opcodes/FCMPL Opcodes/IFGT "java.lang.Double" "doubleValue" "()I"
+  compile-jvm-deq Opcodes/DCMPG Opcodes/IFEQ "java.lang.Double" "doubleValue" "()I"
+  compile-jvm-dlt Opcodes/DCMPG Opcodes/IFLT "java.lang.Double" "doubleValue" "()I"
+  compile-jvm-dgt Opcodes/FCMPG Opcodes/IFGT "java.lang.Double" "doubleValue" "()I"
   )
 
 (defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args]
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 2b6c7909e..0aff48750 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -66,6 +66,28 @@
                   (map vector (range num-elems) ?elems))]
     (return nil)))
 
+(defn compile-record [compile *type* ?elems]
+  (exec [*writer* &/get-writer
+         :let [num-elems (count ?elems)
+               _ (doto *writer*
+                   (.visitLdcInsn (int (* 2 num-elems)))
+                   (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
+         _ (map-m (fn [[idx [k v]]]
+                    (exec [:let [idx* (* 2 idx)
+                                 _ (doto *writer*
+                                     (.visitInsn Opcodes/DUP)
+                                     (.visitLdcInsn (int idx*))
+                                     (.visitLdcInsn k)
+                                     (.visitInsn Opcodes/AASTORE))]
+                           :let [_ (doto *writer*
+                                     (.visitInsn Opcodes/DUP)
+                                     (.visitLdcInsn (int (inc idx*))))]
+                           ret (compile v)
+                           :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+                      (return ret)))
+                  (map vector (range num-elems) ?elems))]
+    (return nil)))
+
 (defn compile-variant [compile *type* ?tag ?value]
   (exec [*writer* &/get-writer
          :let [_ (doto *writer*
@@ -112,6 +134,99 @@
                   ?args)]
     (return nil)))
 
+(defn compile-get [compile *type* ?slot ?record]
+  (exec [*writer* &/get-writer
+         _ (compile ?record)
+         :let [$then (new Label)
+               $test-else (new Label)
+               $end (new Label)
+               $start (new Label)
+               _ (doto *writer* ;; record
+                   (.visitInsn Opcodes/DUP) ;; record, record
+                   (.visitInsn Opcodes/ARRAYLENGTH) ;; record, length
+                   (.visitInsn Opcodes/ICONST_2) ;; record, length, 2
+                   (.visitInsn Opcodes/ISUB) ;; record, length--
+
+                   (.visitLabel $start)
+                   (.visitInsn Opcodes/DUP) ;; record, length, length
+                   (.visitLdcInsn (int -2)) ;; record, length, length, -2
+                   (.visitJumpInsn Opcodes/IF_ICMPEQ $then) ;; record, length
+                   ;;;
+                   (.visitInsn Opcodes/DUP2) ;; record, length, record, length
+                   (.visitInsn Opcodes/AALOAD) ;; record, length, aslot
+                   (.visitLdcInsn ?slot) ;; record, length, aslot, eslot
+                   (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Object") "equals" (str "(" (&host/->type-signature "java.lang.Object") ")Z")) ;; record, length, Z
+                   (.visitJumpInsn Opcodes/IFEQ $test-else) ;; record, length
+                   (.visitInsn Opcodes/ICONST_1) ;; record, length, 1
+                   (.visitInsn Opcodes/IADD) ;; record, length+
+                   (.visitInsn Opcodes/AALOAD) ;; value
+                   (.visitJumpInsn Opcodes/GOTO $end)
+                   (.visitLabel $test-else)
+                   (.visitInsn Opcodes/ICONST_2) ;; record, length, 2
+                   (.visitInsn Opcodes/ISUB) ;; record, length--
+                   (.visitJumpInsn Opcodes/GOTO $start)
+                   ;;;
+                   (.visitLabel $then)
+                   (.visitInsn Opcodes/POP) ;; record
+                   (.visitInsn Opcodes/POP) ;;
+                   (.visitInsn Opcodes/ACONST_NULL) ;; null
+                   (.visitLabel $end))]]
+    (return nil)))
+
+(let [o-sig (&host/->type-signature "java.lang.Object")]
+  (defn compile-set [compile *type* ?slot ?value ?record]
+    (exec [*writer* &/get-writer
+           _ (compile ?record)
+           :let [$then (new Label)
+                 $test-else (new Label)
+                 $end (new Label)
+                 $start (new Label)
+                 _ (doto *writer* ;; record1
+                     ;;;
+                     (.visitInsn Opcodes/DUP) ;; record1, record1
+                     (.visitInsn Opcodes/ARRAYLENGTH) ;; record1, length1
+                     (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")) ;; record1, record2
+                     (.visitInsn Opcodes/DUP_X1) ;; record2, record1, record2
+                     (.visitInsn Opcodes/ICONST_0) ;; record2, record1, record2, 0
+                     (.visitInsn Opcodes/SWAP) ;; record2, record1, 0, record2
+                     (.visitInsn Opcodes/DUP) ;; record2, record1, 0, record2, record2
+                     (.visitInsn Opcodes/ARRAYLENGTH) ;; record2, record1, 0, record2, length2
+                     (.visitInsn Opcodes/ICONST_0) ;; record2, record1, 0, record2, length2, 0
+                     (.visitInsn Opcodes/SWAP) ;; record2, record1, 0, record2, 0, length2
+                     (.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class "java.lang.System") "arraycopy" (str "(" o-sig "I" o-sig "I" "I" ")V")) ;; record2
+                     ;;;
+                     (.visitInsn Opcodes/DUP) ;; record, record
+                     (.visitInsn Opcodes/ARRAYLENGTH) ;; record, length
+                     (.visitInsn Opcodes/ICONST_2) ;; record, length, 2
+                     (.visitInsn Opcodes/ISUB) ;; record, length--
+
+                     (.visitLabel $start)
+                     (.visitInsn Opcodes/DUP) ;; record, length, length
+                     (.visitLdcInsn (int -2)) ;; record, length, length, -2
+                     (.visitJumpInsn Opcodes/IF_ICMPEQ $then) ;; record, length
+                     ;;;
+                     (.visitInsn Opcodes/DUP2) ;; record, length, record, length
+                     (.visitInsn Opcodes/AALOAD) ;; record, length, aslot
+                     (.visitLdcInsn ?slot) ;; record, length, aslot, eslot
+                     (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Object") "equals" (str "(" (&host/->type-signature "java.lang.Object") ")Z")) ;; record, length, Z
+                     (.visitJumpInsn Opcodes/IFEQ $test-else) ;; record, length
+                     (.visitInsn Opcodes/DUP2) ;; record, length, record, length
+                     (.visitInsn Opcodes/ICONST_1) ;; record, length, record, length, 1
+                     (.visitInsn Opcodes/IADD) ;; record, length, record, length+
+                     (do (compile ?value)) ;; record, length, record, length+, value
+                     (.visitInsn Opcodes/AASTORE) ;; record, length
+                     (.visitInsn Opcodes/POP) ;; record
+                     (.visitJumpInsn Opcodes/GOTO $end)
+                     (.visitLabel $test-else)
+                     (.visitInsn Opcodes/ICONST_2) ;; record, length, 2
+                     (.visitInsn Opcodes/ISUB) ;; record, length--
+                     (.visitJumpInsn Opcodes/GOTO $start)
+                     ;;;
+                     (.visitLabel $then)
+                     (.visitInsn Opcodes/POP) ;; record
+                     (.visitLabel $end))]]
+      (return nil))))
+
 (defn compile-def [compile ?name ?body]
   (exec [*writer* &/get-writer
          module-name &/get-module-name