aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser/base.clj1
-rw-r--r--src/lux/analyser/case.clj6
-rw-r--r--src/lux/analyser/lux.clj7
-rw-r--r--src/lux/base.clj4
-rw-r--r--src/lux/compiler.clj7
-rw-r--r--src/lux/compiler/host.clj2
-rw-r--r--src/lux/compiler/io.clj3
-rw-r--r--src/lux/compiler/lux.clj23
-rw-r--r--src/lux/host.clj63
-rw-r--r--src/lux/type/host.clj24
10 files changed, 95 insertions, 45 deletions
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 [<name> <static?>]
(defn <name> [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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 19:40:16 +0000