diff options
Diffstat (limited to 'lux-bootstrapper/src')
-rw-r--r-- | lux-bootstrapper/src/lux/analyser/case.clj | 10 | ||||
-rw-r--r-- | lux-bootstrapper/src/lux/base.clj | 43 | ||||
-rw-r--r-- | lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj | 19 |
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;") |