From 2006e4787f113bccecbc8b27142e051f0d1678b8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 13 Oct 2015 15:38:21 -0400 Subject: - Separated type coercions from type annotations. - Enriched type annotatins. - Improved class->type convertions. - Improved showing AST. --- src/lux/analyser/base.clj | 1 + src/lux/analyser/case.clj | 6 ++--- src/lux/analyser/lux.clj | 7 ++++-- src/lux/base.clj | 4 ++- src/lux/compiler.clj | 7 ++++-- src/lux/compiler/host.clj | 2 +- src/lux/compiler/io.clj | 3 ++- src/lux/compiler/lux.clj | 23 +++++++++++++++-- src/lux/host.clj | 63 ++++++++++++++++++++++++++--------------------- src/lux/type/host.clj | 24 ++++++++++++++---- 10 files changed, 95 insertions(+), 45 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 664ba4450..2e431770a 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -22,6 +22,7 @@ "case" "lambda" "ann" + "coerce" "def" "declare-macro" "var" diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index ca4e0edeb..f19a33acc 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -112,7 +112,7 @@ (adjust-type* up ?type) _ - (assert false (prn-str 'adjust-type* (&type/show-type type))) + (fail (str "[Pattern-matching Error] Can't adjust type: " (&type/show-type type))) )) (defn adjust-type [type] @@ -161,7 +161,7 @@ (|case value-type* (&/$TupleT ?member-types) (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members))) - (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]")) + (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]" " -- " (&/show-ast pattern))) (|do [[=tests =kont] (&/fold (fn [kont* vm] (|let [[v m] vm] (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] @@ -172,7 +172,7 @@ (return (&/T (&/V $TupleTestAC =tests) =kont)))) _ - (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*))))) + (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*) " -- " (&/show-ast pattern))))) (&/$RecordS pairs) (|do [[rec-members rec-type] (&&record/order-record pairs)] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index e938fa343..6d7551ac0 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -524,15 +524,18 @@ _cursor &/cursor ] (return (&/|list (&&/|meta ==type _cursor - (&/V &&/$ann (&/T =value =type)) + (&/V &&/$ann (&/T =value =type ==type)) ))))) (defn analyse-coerce [analyse eval! exo-type ?type ?value] (|do [=type (&&/analyse-1 analyse &type/Type ?type) ==type (eval! =type) _ (&type/check exo-type ==type) + ;; :let [_ (prn 'analyse-coerce/_0 (&/show-ast ?value) (&type/show-type ==type))] =value (&&/analyse-1+ analyse ?value) + ;; =value (&&/analyse-1* analyse ?value) + ;; :let [_ (prn 'analyse-coerce/_1 (&/show-ast ?value) (&type/show-type ==type))] _cursor &/cursor] (return (&/|list (&&/|meta ==type _cursor - (&/V &&/$ann (&/T =value =type)) + (&/V &&/$coerce (&/T =value =type ==type)) ))))) diff --git a/src/lux/base.clj b/src/lux/base.clj index e9b8896bf..3abb3e363 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -815,7 +815,9 @@ (str "\"" ?value "\"") [_ ($TagS ?module ?tag)] - (str "#" ?module ";" ?tag) + (if (.equals "" ?module) + (str "#" ?tag) + (str "#" ?module ";" ?tag)) [_ ($SymbolS ?module ?name)] (if (.equals "" ?module) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 3052ead09..e095a3547 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -86,8 +86,11 @@ (&a/$lambda ?scope ?env ?body) (&&lambda/compile-lambda compile-expression ?scope ?env ?body) - (&a/$ann ?value-ex ?type-ex) - (&&lux/compile-ann compile-expression ?value-ex ?type-ex) + (&a/$ann ?value-ex ?type-ex ?value-type) + (&&lux/compile-ann compile-expression ?value-ex ?type-ex ?value-type) + + (&a/$coerce ?value-ex ?type-ex ?value-type) + (&&lux/compile-coerce compile-expression ?value-ex ?type-ex ?value-type) ;; Characters (&a/$jvm-ceq ?x ?y) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 1cefef555..6b05f0c8a 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -353,7 +353,7 @@ (defn compile-jvm-arraylength [compile ?array] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?array) - :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")] + ;; :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")] :let [_ (doto *writer* (.visitInsn Opcodes/ARRAYLENGTH) (.visitInsn Opcodes/I2L) diff --git a/src/lux/compiler/io.clj b/src/lux/compiler/io.clj index bc6fa854d..fbef27b0f 100644 --- a/src/lux/compiler/io.clj +++ b/src/lux/compiler/io.clj @@ -26,4 +26,5 @@ (init-libs!)) (if-let [code (get @!libs file-name)] (return code) - (fail (str "[I/O Error] File doesn't exist: " file-name))))))) + (fail (str "[I/O Error] File doesn't exist: " file-name)))) + ))) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index ef80d89aa..a2dc3fe73 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -138,7 +138,7 @@ "value" (|let [?def-type (|case ?body - [[?def-type ?def-cursor] (&a/$ann ?def-value ?type-expr)] + [[?def-type ?def-cursor] (&a/$ann ?def-value ?type-expr ?def-value-type)] ?type-expr [[?def-type ?def-cursor] ?def-value] @@ -215,9 +215,28 @@ _ (&a-module/define module-name ?name (-> def-class (.getField &/meta-field) (.get nil)) =value-type)] (return nil)))) -(defn compile-ann [compile ?value-ex ?type-ex] +(defn check-cast [type] + "(-> Type (Lux (,)))" + (|do [^MethodVisitor writer &/get-writer] + (let [^String type-class* (&host/->java-sig type) + type-class (cond (.startsWith type-class* "[") + type-class* + + (.endsWith type-class* ";") + (.substring type-class* 1 (- (.length type-class*) 1)) + + :else + type-class*) + _ (.visitTypeInsn writer Opcodes/CHECKCAST type-class)] + (return nil)))) + +(defn compile-ann [compile ?value-ex ?type-ex ?value-type] (compile ?value-ex)) +(defn compile-coerce [compile ?value-ex ?type-ex ?value-type] + (|do [_ (compile ?value-ex)] + (check-cast ?value-type))) + (defn compile-declare-macro [compile module name] (|do [_ (&a-module/declare-macro module name)] (return nil))) diff --git a/src/lux/host.clj b/src/lux/host.clj index c58698bb3..12af574fb 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -67,34 +67,41 @@ _ (&/T 0 type))) -(defn ->java-sig [^objects type] - "(-> Type Text)" - (|case type - (&/$DataT ?name params) - (cond (= &host-type/array-data-tag ?name) (|let [[level base] (unfold-array type) - base-sig (|case base - (&/$DataT base-class _) - (->class base-class) - - _ - (->java-sig base))] - (str (->> (&/|repeat level "[") (&/fold str "")) - "L" base-sig ";")) - (= &host-type/null-data-tag ?name) (->type-signature "java.lang.Object") - :else (->type-signature ?name)) - - (&/$LambdaT _ _) - (->type-signature function-class) - - (&/$TupleT (&/$Nil)) - "V" - - (&/$NamedT ?name ?type) - (->java-sig ?type) - - _ - (assert false (str '->java-sig " " (&type/show-type type))) - )) +(let [object-array (str "[" "L" (->class "java.lang.Object") ";")] + (defn ->java-sig [^objects type] + "(-> Type Text)" + (|case type + (&/$DataT ?name params) + (cond (= &host-type/array-data-tag ?name) (|let [[level base] (unfold-array type) + base-sig (|case base + (&/$DataT base-class _) + (->type-signature base-class) + + _ + (->java-sig base))] + (str (->> (&/|repeat level "[") (&/fold str "")) + base-sig)) + (= &host-type/null-data-tag ?name) (->type-signature "java.lang.Object") + :else (->type-signature ?name)) + + (&/$LambdaT _ _) + (->type-signature function-class) + + (&/$TupleT (&/$Nil)) + "V" + + (&/$VariantT _) + object-array + + (&/$TupleT _) + object-array + + (&/$NamedT ?name ?type) + (->java-sig ?type) + + _ + (assert false (str '->java-sig " " (&type/show-type type))) + ))) (do-template [ ] (defn [class-loader target field] diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj index 38acf8162..9d83e0b58 100644 --- a/src/lux/type/host.clj +++ b/src/lux/type/host.clj @@ -64,19 +64,33 @@ (&/fold2 matcher (&/|table) sub-type-params params))) ;; [Exports] -(let [class-name-re #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+))" - Unit (&/V &/$TupleT (&/|list))] +(let [class-name-re #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+)|(\[+)([ZBSIJFDC]))" + Unit (&/V &/$TupleT (&/|list)) + jprim->lprim (fn [prim] + (case prim + "Z" "boolean" + "B" "byte" + "S" "short" + "I" "int" + "J" "long" + "F" "float" + "D" "double" + "C" "char"))] (defn class->type [^Class class] "(-> Class Type)" - (if-let [[_ _ arr-brackets arr-base simple-base] (re-find class-name-re (.getName class))] - (let [base (or arr-base simple-base)] + (if-let [[_ _ arr-obrackets arr-obase simple-base arr-pbrackets arr-pbase] (re-find class-name-re (.getName class))] + (let [base (or arr-obase simple-base (jprim->lprim arr-pbase))] (if (.equals "void" base) Unit (reduce (fn [inner _] (&/V &/$DataT (&/T array-data-tag (&/|list inner)))) (&/V &/$DataT (&/T base &/Nil$)) - (range (count (or arr-brackets ""))))) + (range (count (or arr-obrackets arr-pbrackets ""))))) )))) +;; (-> String (.getMethod "getBytes" (into-array Class [])) .getReturnType) +;; (-> String (.getMethod "getBytes" (into-array Class [])) ^Class (.getGenericReturnType) +;; .getName (->> (re-find #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+)|(\[+)([ZBSIJFDC]))"))) + (defn instance-param [existential matchings refl-type] "(-> (List (, Text Type)) (^ java.lang.reflect.Type) (Lux Type))" (cond (instance? Class refl-type) -- cgit v1.2.3