From a386d0c4688b8749db3e4d612658774a24bc61a2 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 9 Mar 2015 00:58:45 -0400 Subject: - Implemented record compilation, alongside get@' and set@'. - Made a small change in float & double comparisons to make sure NaN < n. --- src/lux/analyser.clj | 9 ++++ src/lux/analyser/base.clj | 2 +- src/lux/analyser/lux.clj | 22 +++++++++ src/lux/compiler.clj | 9 ++++ src/lux/compiler/host.clj | 12 ++--- src/lux/compiler/lux.clj | 115 ++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 162 insertions(+), 7 deletions(-) (limited to 'src') 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 -- cgit v1.2.3