aboutsummaryrefslogtreecommitdiff
path: root/lux-bootstrapper
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-bootstrapper/src/lux/analyser/case.clj10
-rw-r--r--lux-bootstrapper/src/lux/base.clj43
-rw-r--r--lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj19
3 files changed, 46 insertions, 26 deletions
diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj
index 39adc09f5..ef339587b 100644
--- a/lux-bootstrapper/src/lux/analyser/case.clj
+++ b/lux-bootstrapper/src/lux/analyser/case.clj
@@ -48,13 +48,15 @@
(&/$UnivQ _)
(|do [$var &type/existential
- =type (&type/apply-type type $var)]
- (&type/actual-type =type))
+ =type (&type/apply-type type $var)
+ ==type (&type/actual-type =type)]
+ (resolve-type ==type))
(&/$ExQ _ _)
(|do [$var &type/existential
- =type (&type/apply-type type $var)]
- (&type/actual-type =type))
+ =type (&type/apply-type type $var)
+ ==type (&type/actual-type =type)]
+ (resolve-type ==type))
_
(&type/actual-type type))))
diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj
index 1cc169c28..88f06d928 100644
--- a/lux-bootstrapper/src/lux/base.clj
+++ b/lux-bootstrapper/src/lux/base.clj
@@ -295,12 +295,6 @@
`$End
(reverse elems)))
-(defmacro |table [& elems]
- (reduce (fn [table [k v]]
- `(|put ~k ~v ~table))
- `$End
- (reverse (partition 2 elems))))
-
(defn |get [slot table]
(|case table
($End)
@@ -311,17 +305,6 @@
v
(recur slot table*))))
-(defn |put [slot value table]
- (|case table
- ($End)
- ($Item (T [slot value]) $End)
-
- ($Item [k v] table*)
- (if (= k slot)
- ($Item (T [slot value]) table*)
- ($Item (T [k v]) (|put slot value table*)))
- ))
-
(defn |remove [slot table]
(|case table
($End)
@@ -486,6 +469,32 @@
($Item x xs*)
(recur f (f init x) xs*)))
+(defn |put [slot value table]
+ (loop [prefix $End
+ input table]
+ (|case input
+ ($End)
+ (fold (fn [tail head]
+ ($Item head tail))
+ ($Item (T [slot value]) $End)
+ prefix)
+
+ ($Item [k v] input*)
+ (if (= k slot)
+ (fold (fn [tail head]
+ ($Item head tail))
+ ($Item (T [slot value]) input*)
+ prefix)
+ (recur ($Item (T [k v]) prefix)
+ input*))
+ )))
+
+(defmacro |table [& elems]
+ (reduce (fn [table [k v]]
+ `(|put ~k ~v ~table))
+ `$End
+ (reverse (partition 2 elems))))
+
(defn fold% [f init xs]
(|case xs
($End)
diff --git a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj
index 619e4b6f9..22f889aeb 100644
--- a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj
+++ b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj
@@ -83,6 +83,10 @@
(&/$Ex _)
nil
+ ;; &type/Any
+ (&/$ExQ _ (&/$Parameter 1))
+ (.visitLdcInsn *writer* &/unit-tag)
+
_
(assert false (str 'prepare-return! " " (&type/show-type *type*)))))
*writer*))
@@ -884,8 +888,9 @@
(defn ^:private compile-jvm-getstatic [compile ?values special-args]
(|do [:let [;; (&/$End) ?values
- (&/$Item ?class (&/$Item ?field (&/$Item ?output-type (&/$End)))) special-args]
+ (&/$Item ?class (&/$Item ?field (&/$Item ?output-type* (&/$End)))) special-args]
^MethodVisitor *writer* &/get-writer
+ ?output-type (&type/normal ?output-type*)
=output-type (&host/->java-sig ?output-type)
:let [_ (doto *writer*
(.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =output-type)
@@ -894,10 +899,11 @@
(defn ^:private compile-jvm-getfield [compile ?values special-args]
(|do [:let [(&/$Item ?object (&/$End)) ?values
- (&/$Item ?class (&/$Item ?field (&/$Item ?output-type (&/$End)))) special-args]
+ (&/$Item ?class (&/$Item ?field (&/$Item ?output-type* (&/$End)))) special-args]
:let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))]
^MethodVisitor *writer* &/get-writer
_ (compile ?object)
+ ?output-type (&type/normal ?output-type*)
=output-type (&host/->java-sig ?output-type)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST class*)
@@ -934,7 +940,7 @@
(defn ^:private compile-jvm-invokestatic [compile ?values special-args]
(|do [:let [?args ?values
- (&/$Item ?class (&/$Item ?method (&/$Item ?classes (&/$Item ?output-type (&/$Item ?gret (&/$End)))))) special-args]
+ (&/$Item ?class (&/$Item ?method (&/$Item ?classes (&/$Item ?output-type* (&/$Item ?gret (&/$End)))))) special-args]
^MethodVisitor *writer* &/get-writer
:let [method-sig (str "(" (&/fold str "" (&/|map &host-generics/->type-signature ?classes)) ")" (&host-type/principal-class ?gret))]
_ (&/map2% (fn [class-name arg]
@@ -942,6 +948,7 @@
:let [_ (prepare-arg! *writer* class-name)]]
(return ret)))
?classes ?args)
+ ?output-type (&type/normal ?output-type*)
:let [_ (doto *writer*
(.visitMethodInsn Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?method method-sig)
(prepare-return! ?output-type))]]
@@ -950,7 +957,7 @@
(do-template [<name> <op>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Item ?object ?args) ?values
- (&/$Item ?class (&/$Item ?method (&/$Item ?classes (&/$Item ?output-type (&/$Item ?gret (&/$End)))))) special-args]
+ (&/$Item ?class (&/$Item ?method (&/$Item ?classes (&/$Item ?output-type* (&/$Item ?gret (&/$End)))))) special-args]
:let [?class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))]
^MethodVisitor *writer* &/get-writer
:let [method-sig (str "(" (&/fold str "" (&/|map &host-generics/->type-signature ?classes)) ")" (&host-type/principal-class ?gret))]
@@ -962,6 +969,7 @@
:let [_ (prepare-arg! *writer* class-name)]]
(return ret)))
?classes ?args)
+ ?output-type (&type/normal ?output-type*)
:let [_ (doto *writer*
(.visitMethodInsn <op> ?class* ?method method-sig)
(prepare-return! ?output-type))]]
@@ -992,8 +1000,9 @@
(return nil)))
(defn ^:private compile-jvm-object-class [compile ?values special-args]
- (|do [:let [(&/$Item _class-name (&/$Item ?output-type (&/$End))) special-args]
+ (|do [:let [(&/$Item _class-name (&/$Item ?output-type* (&/$End))) special-args]
^MethodVisitor *writer* &/get-writer
+ ?output-type (&type/normal ?output-type*)
:let [_ (doto *writer*
(.visitLdcInsn _class-name)
(.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Class" "forName" "(Ljava/lang/String;)Ljava/lang/Class;")
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 08:15:53 +0000