diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 108 | ||||
| -rw-r--r-- | src/lux/compiler/host.clj | 422 | ||||
| -rw-r--r-- | src/lux/compiler/lambda.clj | 2 | ||||
| -rw-r--r-- | src/lux/host.clj | 8 | ||||
| -rw-r--r-- | src/lux/type.clj | 34 |
6 files changed, 282 insertions, 294 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index f4c7cce86..e85123032 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -455,4 +455,4 @@ ;; [Resources] (defn analyse [eval!] (|do [asts &parser/parse] - (&/flat-map% (partial analyse-ast eval! &type/Nothing) asts))) + (&/flat-map% (partial analyse-ast eval! &type/$Void) asts))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 7b27a2a92..7d9aaae2f 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -66,54 +66,54 @@ (defn analyse-jvm-getstatic [analyse ?class ?field] (|do [=class (&host/full-class-name ?class) - ;; :let [_ (prn 'analyse-jvm-getstatic/=class =class)] - =type (&host/lookup-static-field =class ?field) - ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] - ] + ;; :let [_ (prn 'analyse-jvm-getstatic/=class =class)] + =type (&host/lookup-static-field =class ?field) + ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] + ] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-getstatic" (&/T =class ?field)) =type)))))) (defn analyse-jvm-getfield [analyse ?class ?field ?object] (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field) - =object (&&/analyse-1 analyse ?object)] + =type (&host/lookup-static-field =class ?field) + =object (&&/analyse-1 analyse ?object)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-getfield" (&/T =class ?field =object)) =type)))))) (defn analyse-jvm-putstatic [analyse ?class ?field ?value] (|do [=class (&host/full-class-name ?class) - ;; :let [_ (prn 'analyse-jvm-getstatic/=class =class)] - =type (&host/lookup-static-field =class ?field) - ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] - =value (&&/analyse-1 analyse ?value)] + ;; :let [_ (prn 'analyse-jvm-getstatic/=class =class)] + =type (&host/lookup-static-field =class ?field) + ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] + =value (&&/analyse-1 analyse ?value)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-putstatic" (&/T =class ?field =value)) =type)))))) (defn analyse-jvm-putfield [analyse ?class ?field ?object ?value] (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field) - =object (&&/analyse-1 analyse ?object) - =value (&&/analyse-1 analyse ?value)] + =type (&host/lookup-static-field =class ?field) + =object (&&/analyse-1 analyse ?object) + =value (&&/analyse-1 analyse ?value)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-putfield" (&/T =class ?field =object =value)) =type)))))) (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] (|do [=class (&host/full-class-name ?class) - =classes (&/map% &host/extract-jvm-param ?classes) - =return (&host/lookup-static-method =class ?method =classes) - =args (&/flat-map% analyse ?args)] + =classes (&/map% &host/extract-jvm-param ?classes) + =return (&host/lookup-static-method =class ?method =classes) + =args (&/flat-map% analyse ?args)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-invokestatic" (&/T =class ?method =classes =args)) =return)))))) (do-template [<name> <tag>] (defn <name> [analyse ?class ?method ?classes ?object ?args] ;; (prn '<name> ?class ?method) (|do [=class (&host/full-class-name ?class) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)] - =classes (&/map% &host/extract-jvm-param ?classes) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)] - =return (&host/lookup-virtual-method =class ?method =classes) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)] - =object (&&/analyse-1 analyse ?object) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)] - =args (&/flat-map% analyse ?args) - ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)] - ] + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)] + =classes (&/map% &host/extract-jvm-param ?classes) + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)] + =return (&host/lookup-virtual-method =class ?method =classes) + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)] + =object (&&/analyse-1 analyse ?object) + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)] + =args (&/flat-map% analyse ?args) + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)] + ] (return (&/|list (&/V "Expression" (&/T (&/V <tag> (&/T =class ?method =classes =object =args)) =return)))))) analyse-jvm-invokevirtual "jvm-invokevirtual" @@ -127,8 +127,8 @@ (defn analyse-jvm-new [analyse ?class ?classes ?args] (|do [=class (&host/full-class-name ?class) - =classes (&/map% &host/extract-jvm-param ?classes) - =args (&/flat-map% analyse ?args)] + =classes (&/map% &host/extract-jvm-param ?classes) + =args (&/flat-map% analyse ?args)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-new" (&/T =class =classes =args)) (&/V "lux;DataT" =class))))))) (defn analyse-jvm-new-array [analyse ?class ?length] @@ -137,31 +137,31 @@ (&/V "lux;Nil" nil))))))))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] - (|do [=array (&&/analyse-1 analyse &type/Nothing ?array) - =elem (&&/analyse-1 analyse &type/Nothing ?elem) + (|do [=array (&&/analyse-1 analyse &type/$Void ?array) + =elem (&&/analyse-1 analyse &type/$Void ?elem) =array-type (&&/expr-type =array)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type)))))) (defn analyse-jvm-aaload [analyse ?array ?idx] (|do [=array (&&/analyse-1 analyse ?array) - =array-type (&&/expr-type =array)] + =array-type (&&/expr-type =array)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-aaload" (&/T =array ?idx)) =array-type)))))) (defn analyse-jvm-class [analyse ?name ?super-class ?fields] (|do [?fields (&/map% (fn [?field] - (matchv ::M/objects [?field] - [["lux;Meta" [_ ["lux;Tuple" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?class]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?field-name]]] - ["lux;Nil" _]]]]]]]]] - (return [?class ?field-name]) - - [_] - (fail "[Analyser Error] Fields must be Tuple2 of [Symbol, Symbol]"))) - ?fields) - :let [=fields (into {} (for [[class field] ?fields] - [field {:access :public - :type class}]))] - $module &/get-module-name] + (matchv ::M/objects [?field] + [["lux;Meta" [_ ["lux;Tuple" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?field-name]]] + ["lux;Nil" _]]]]]]]]] + (return [?class ?field-name]) + + [_] + (fail "[Analyser Error] Fields must be Tuple2 of [Symbol, Symbol]"))) + ?fields) + :let [=fields (into {} (for [[class field] ?fields] + [field {:access :public + :type class}]))] + $module &/get-module-name] (return (&/|list (&/V "Statement" (&/V "jvm-class" (&/T $module ?name ?super-class =fields {}))))))) (defn analyse-jvm-interface [analyse ?name ?members] @@ -192,18 +192,18 @@ (defn analyse-jvm-try [analyse ?body [?catches ?finally]] (|do [=body (&&/analyse-1 analyse ?body) - =catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]] - (&&env/with-local ?ex-arg (&/V "lux;DataT" ?ex-class) - (|do [=catch-body (&&/analyse-1 analyse ?catch-body)] - (return [?ex-class ?ex-arg =catch-body])))) - ?catches) - =finally (&&/analyse-1 analyse ?finally) - =body-type (&&/expr-type =body)] + =catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]] + (&&env/with-local ?ex-arg (&/V "lux;DataT" ?ex-class) + (|do [=catch-body (&&/analyse-1 analyse ?catch-body)] + (return [?ex-class ?ex-arg =catch-body])))) + ?catches) + =finally (&&/analyse-1 analyse ?finally) + =body-type (&&/expr-type =body)] (return (&/|list (&/V "Expression" (&/T (&/V "jvm-try" (&/T =body =catches =finally)) =body-type)))))) (defn analyse-jvm-throw [analyse ?ex] (|do [=ex (&&/analyse-1 analyse ?ex)] - (return (&/|list (&/V "Expression" (&/T (&/V "jvm-throw" =ex) (&/V "lux;NothingT" nil))))))) + (return (&/|list (&/V "Expression" (&/T (&/V "jvm-throw" =ex) &type/$Void)))))) (defn analyse-jvm-monitorenter [analyse ?monitor] (|do [=monitor (&&/analyse-1 analyse ?monitor)] @@ -256,6 +256,6 @@ ) (defn analyse-jvm-program [analyse ?args ?body] - (|do [=body (&&env/with-local ?args (&/V "lux;AnyT" nil) - (&&/analyse-1 analyse ?body))] + (|do [=body (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text)) + (&&/analyse-1 analyse ?body))] (return (&/|list (&/V "Statement" (&/V "jvm-program" =body)))))) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 184c6a4f4..c51714c31 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -35,26 +35,42 @@ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class class-name))))) (let [boolean-class "java.lang.Boolean" - integer-class "java.lang.Integer" + byte-class "java.lang.Byte" + short-class "java.lang.Short" + int-class "java.lang.Integer" long-class "java.lang.Long" + float-class "java.lang.Float" + double-class "java.lang.Double" char-class "java.lang.Character"] (defn prepare-return! [*writer* *type*] (matchv ::M/objects [*type*] - [["lux;NothingT" nil]] + [["lux;VariantT" ["lux;Nil" _]]] (.visitInsn *writer* Opcodes/ACONST_NULL) - [["lux;DataT" "char"]] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class char-class) "valueOf" (str "(C)" (&host/->type-signature char-class))) + [["lux;DataT" "boolean"]] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class boolean-class) "valueOf" (str "(Z)" (&host/->type-signature boolean-class))) + + [["lux;DataT" "byte"]] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class byte-class) "valueOf" (str "(J)" (&host/->type-signature byte-class))) + + [["lux;DataT" "short"]] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class short-class) "valueOf" (str "(J)" (&host/->type-signature short-class))) [["lux;DataT" "int"]] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class integer-class) "valueOf" (str "(I)" (&host/->type-signature integer-class))) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class int-class) "valueOf" (str "(J)" (&host/->type-signature int-class))) [["lux;DataT" "long"]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class long-class) "valueOf" (str "(J)" (&host/->type-signature long-class))) - [["lux;DataT" "boolean"]] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class boolean-class) "valueOf" (str "(Z)" (&host/->type-signature boolean-class))) + [["lux;DataT" "float"]] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class float-class) "valueOf" (str "(D)" (&host/->type-signature float-class))) + + [["lux;DataT" "double"]] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class double-class) "valueOf" (str "(D)" (&host/->type-signature double-class))) + [["lux;DataT" "char"]] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class char-class) "valueOf" (str "(C)" (&host/->type-signature char-class))) + [["lux;DataT" _]] nil) *writer*)) @@ -63,18 +79,18 @@ (do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig> <wrapper-method> <wrapper-method-sig>] (defn <name> [compile *type* ?x ?y] (|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)] - *writer* &/get-writer - _ (compile ?x) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))] - _ (compile ?y) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>)) - _ (doto *writer* - (.visitInsn <opcode>) - (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ <wrapper-method> (str <wrapper-method-sig> (&host/->type-signature <wrapper-class>))))]] + *writer* &/get-writer + _ (compile ?x) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))] + _ (compile ?y) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>)) + _ (doto *writer* + (.visitInsn <opcode>) + (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ <wrapper-method> (str <wrapper-method-sig> (&host/->type-signature <wrapper-class>))))]] (return nil))) compile-jvm-iadd Opcodes/IADD "java.lang.Integer" "intValue" "()I" "valueOf" "(I)" @@ -105,24 +121,24 @@ (do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig>] (defn <name> [compile *type* ?x ?y] (|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)] - *writer* &/get-writer - _ (compile ?x) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))] - _ (compile ?y) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>)) - $then (new Label) - $end (new Label) - _ (doto *writer* - (.visitJumpInsn <opcode> $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean")) - (.visitJumpInsn Opcodes/GOTO $end) - (.visitLabel $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean")) - (.visitLabel $end))]] + *writer* &/get-writer + _ (compile ?x) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))] + _ (compile ?y) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>)) + $then (new Label) + $end (new Label) + _ (doto *writer* + (.visitJumpInsn <opcode> $then) + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean")) + (.visitJumpInsn Opcodes/GOTO $end) + (.visitLabel $then) + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean")) + (.visitLabel $end))]] (return nil))) compile-jvm-ieq Opcodes/IF_ICMPEQ "java.lang.Integer" "intValue" "()I" @@ -133,25 +149,25 @@ (do-template [<name> <cmpcode> <ifcode> <wrapper-class> <value-method> <value-method-sig>] (defn <name> [compile *type* ?x ?y] (|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)] - *writer* &/get-writer - _ (compile ?x) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))] - _ (compile ?y) - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>)) - $then (new Label) - $end (new Label) - _ (doto *writer* - (.visitInsn <cmpcode>) - (.visitJumpInsn <ifcode> $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean")) - (.visitJumpInsn Opcodes/GOTO $end) - (.visitLabel $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean")) - (.visitLabel $end))]] + *writer* &/get-writer + _ (compile ?x) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))] + _ (compile ?y) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>)) + $then (new Label) + $end (new Label) + _ (doto *writer* + (.visitInsn <cmpcode>) + (.visitJumpInsn <ifcode> $then) + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean")) + (.visitJumpInsn Opcodes/GOTO $end) + (.visitLabel $then) + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean")) + (.visitLabel $end))]] (return nil))) compile-jvm-leq Opcodes/LCMP Opcodes/IFEQ "java.lang.Long" "longValue" "()J" @@ -169,33 +185,33 @@ (defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args] (|do [*writer* &/get-writer - :let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] - _ (&/map% (fn [[class-name arg]] - (|do [ret (compile arg) - :let [_ (prepare-arg! *writer* class-name)]] - (return ret))) - (map vector ?classes ?args)) - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class ?class) ?method method-sig) - (prepare-return! *type*))]] + :let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] + _ (&/map% (fn [[class-name arg]] + (|do [ret (compile arg) + :let [_ (prepare-arg! *writer* class-name)]] + (return ret))) + (map vector ?classes ?args)) + :let [_ (doto *writer* + (.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class ?class) ?method method-sig) + (prepare-return! *type*))]] (return nil))) (do-template [<name> <op>] (defn <name> [compile *type* ?class ?method ?classes ?object ?args] ;; (prn 'compile-jvm-invokevirtual ?classes *type*) (|do [*writer* &/get-writer - :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] - _ (compile ?object) - :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] - _ (&/map% (fn [class-name+arg] - (|let [[class-name arg] class-name+arg] - (|do [ret (compile arg) - :let [_ (prepare-arg! *writer* class-name)]] - (return ret)))) - (&/zip2 ?classes ?args)) - :let [_ (doto *writer* - (.visitMethodInsn <op> (&host/->class ?class) ?method method-sig) - (prepare-return! *type*))]] + :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] + _ (compile ?object) + :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] + _ (&/map% (fn [class-name+arg] + (|let [[class-name arg] class-name+arg] + (|do [ret (compile arg) + :let [_ (prepare-arg! *writer* class-name)]] + (return ret)))) + (&/zip2 ?classes ?args)) + :let [_ (doto *writer* + (.visitMethodInsn <op> (&host/->class ?class) ?method method-sig) + (prepare-return! *type*))]] (return nil))) compile-jvm-invokevirtual Opcodes/INVOKEVIRTUAL @@ -205,88 +221,88 @@ (defn compile-jvm-null [compile *type*] (|do [*writer* &/get-writer - :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]] + :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]] (return nil))) (defn compile-jvm-null? [compile *type* ?object] (|do [*writer* &/get-writer - _ (compile ?object) - :let [$then (new Label) - $end (new Label) - _ (doto *writer* - (.visitJumpInsn Opcodes/IFNULL $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean")) - (.visitJumpInsn Opcodes/GOTO $end) - (.visitLabel $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean")) - (.visitLabel $end))]] + _ (compile ?object) + :let [$then (new Label) + $end (new Label) + _ (doto *writer* + (.visitJumpInsn Opcodes/IFNULL $then) + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean")) + (.visitJumpInsn Opcodes/GOTO $end) + (.visitLabel $then) + (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean")) + (.visitLabel $end))]] (return nil))) (defn compile-jvm-new [compile *type* ?class ?classes ?args] (|do [*writer* &/get-writer - :let [init-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")V") - class* (&host/->class ?class) - _ (doto *writer* - (.visitTypeInsn Opcodes/NEW class*) - (.visitInsn Opcodes/DUP))] - _ (&/map% (fn [[class-name arg]] - (|do [ret (compile arg) - :let [_ (prepare-arg! *writer* class-name)]] - (return ret))) - (map vector ?classes ?args)) - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESPECIAL class* "<init>" init-sig))]] + :let [init-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")V") + class* (&host/->class ?class) + _ (doto *writer* + (.visitTypeInsn Opcodes/NEW class*) + (.visitInsn Opcodes/DUP))] + _ (&/map% (fn [[class-name arg]] + (|do [ret (compile arg) + :let [_ (prepare-arg! *writer* class-name)]] + (return ret))) + (map vector ?classes ?args)) + :let [_ (doto *writer* + (.visitMethodInsn Opcodes/INVOKESPECIAL class* "<init>" init-sig))]] (return nil))) (defn compile-jvm-new-array [compile *type* ?class ?length] (|do [*writer* &/get-writer - :let [_ (doto *writer* - (.visitLdcInsn (int ?length)) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class ?class)))]] + :let [_ (doto *writer* + (.visitLdcInsn (int ?length)) + (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class ?class)))]] (return nil))) (defn compile-jvm-aastore [compile *type* ?array ?idx ?elem] (|do [*writer* &/get-writer - _ (compile ?array) - :let [_ (doto *writer* - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int ?idx)))] - _ (compile ?elem) - :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] + _ (compile ?array) + :let [_ (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int ?idx)))] + _ (compile ?elem) + :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return nil))) (defn compile-jvm-aaload [compile *type* ?array ?idx] (|do [*writer* &/get-writer - _ (compile ?array) - :let [_ (doto *writer* - (.visitLdcInsn (int ?idx)) - (.visitInsn Opcodes/AALOAD))]] + _ (compile ?array) + :let [_ (doto *writer* + (.visitLdcInsn (int ?idx)) + (.visitInsn Opcodes/AALOAD))]] (return nil))) (defn compile-jvm-getstatic [compile *type* ?class ?field] (|do [*writer* &/get-writer - :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*))]] + :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*))]] (return nil))) (defn compile-jvm-getfield [compile *type* ?class ?field ?object] (|do [*writer* &/get-writer - _ (compile ?object) - :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] - :let [_ (.visitFieldInsn *writer* Opcodes/GETFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]] + _ (compile ?object) + :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] + :let [_ (.visitFieldInsn *writer* Opcodes/GETFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]] (return nil))) (defn compile-jvm-putstatic [compile *type* ?class ?field ?value] (|do [*writer* &/get-writer - _ (compile ?value) - :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*))]] + _ (compile ?value) + :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*))]] (return nil))) (defn compile-jvm-putfield [compile *type* ?class ?field ?object ?value] (|do [*writer* &/get-writer - _ (compile ?object) - _ (compile ?value) - :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] - :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]] + _ (compile ?object) + _ (compile ?value) + :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))] + :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]] (return nil))) (defn compile-jvm-class [compile ?package ?name ?super-class ?fields ?methods] @@ -330,75 +346,75 @@ (defn compile-|do [compile *type* ?exprs] (|do [*writer* &/get-writer - _ (&/map% (fn [expr] - (|do [ret (compile expr) - :let [_ (.visitInsn *writer* Opcodes/POP)]] - (return ret))) - (butlast ?exprs)) - _ (compile (last ?exprs))] + _ (&/map% (fn [expr] + (|do [ret (compile expr) + :let [_ (.visitInsn *writer* Opcodes/POP)]] + (return ret))) + (butlast ?exprs)) + _ (compile (last ?exprs))] (return nil))) (defn compile-jvm-try [compile *type* ?body ?catches ?finally] (|do [*writer* &/get-writer - :let [$from (new Label) - $to (new Label) - $end (new Label) - $catch-finally (new Label) - compile-finally (if ?finally - (|do [_ (return nil) - _ (compile ?finally) - :let [_ (doto *writer* - (.visitInsn Opcodes/POP) - (.visitJumpInsn Opcodes/GOTO $end))]] - (return nil)) - (|do [_ (return nil) - :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]] - (return nil))) - _ (.visitLabel *writer* $from)] - _ (compile ?body) - :let [_ (.visitLabel *writer* $to)] - _ compile-finally - handlers (&/map% (fn [[?ex-class ?ex-arg ?catch-body]] - (|do [:let [$handler-start (new Label) - $handler-end (new Label)] - _ (compile ?catch-body) - :let [_ (.visitLabel *writer* $handler-end)] - _ compile-finally] - (return [?ex-class $handler-start $handler-end]))) - ?catches) - :let [_ (.visitLabel *writer* $catch-finally)] - _ (if ?finally - (|do [_ (compile ?finally) - :let [_ (doto *writer* - (.visitInsn Opcodes/POP) - (.visitInsn Opcodes/ATHROW))]] - (return nil)) - (|do [_ (return nil) - :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] - (return nil))) - :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)] - :let [_ (.visitLabel *writer* $end)] - :let [_ (doseq [[?ex-class $handler-start $handler-end] handlers] - (doto *writer* - (.visitTryCatchBlock $from $to $handler-start ?ex-class) - (.visitTryCatchBlock $handler-start $handler-end $catch-finally nil)) - ) - _ (.visitTryCatchBlock *writer* $from $to $catch-finally nil)]] + :let [$from (new Label) + $to (new Label) + $end (new Label) + $catch-finally (new Label) + compile-finally (if ?finally + (|do [_ (return nil) + _ (compile ?finally) + :let [_ (doto *writer* + (.visitInsn Opcodes/POP) + (.visitJumpInsn Opcodes/GOTO $end))]] + (return nil)) + (|do [_ (return nil) + :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]] + (return nil))) + _ (.visitLabel *writer* $from)] + _ (compile ?body) + :let [_ (.visitLabel *writer* $to)] + _ compile-finally + handlers (&/map% (fn [[?ex-class ?ex-arg ?catch-body]] + (|do [:let [$handler-start (new Label) + $handler-end (new Label)] + _ (compile ?catch-body) + :let [_ (.visitLabel *writer* $handler-end)] + _ compile-finally] + (return [?ex-class $handler-start $handler-end]))) + ?catches) + :let [_ (.visitLabel *writer* $catch-finally)] + _ (if ?finally + (|do [_ (compile ?finally) + :let [_ (doto *writer* + (.visitInsn Opcodes/POP) + (.visitInsn Opcodes/ATHROW))]] + (return nil)) + (|do [_ (return nil) + :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] + (return nil))) + :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)] + :let [_ (.visitLabel *writer* $end)] + :let [_ (doseq [[?ex-class $handler-start $handler-end] handlers] + (doto *writer* + (.visitTryCatchBlock $from $to $handler-start ?ex-class) + (.visitTryCatchBlock $handler-start $handler-end $catch-finally nil)) + ) + _ (.visitTryCatchBlock *writer* $from $to $catch-finally nil)]] (return nil))) (defn compile-jvm-throw [compile *type* ?ex] (|do [*writer* &/get-writer - _ (compile ?ex) - :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] + _ (compile ?ex) + :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] (return nil))) (do-template [<name> <op>] (defn <name> [compile *type* ?monitor] (|do [*writer* &/get-writer - _ (compile ?monitor) - :let [_ (doto *writer* - (.visitInsn <op>) - (.visitInsn Opcodes/ACONST_NULL))]] + _ (compile ?monitor) + :let [_ (doto *writer* + (.visitInsn <op>) + (.visitInsn Opcodes/ACONST_NULL))]] (return nil))) compile-jvm-monitorenter Opcodes/MONITORENTER @@ -408,14 +424,14 @@ (do-template [<name> <op> <from-class> <from-method> <from-sig> <to-class> <to-sig>] (defn <name> [compile *type* ?value] (|do [*writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW (&host/->class <to-class>)) - (.visitInsn Opcodes/DUP))] - _ (compile ?value) - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class <from-class>) <from-method> <from-sig>) - (.visitInsn <op>) - (.visitMethodInsn Opcodes/INVOKESPECIAL (&host/->class <to-class>) "<init>" <to-sig>))]] + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW (&host/->class <to-class>)) + (.visitInsn Opcodes/DUP))] + _ (compile ?value) + :let [_ (doto *writer* + (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class <from-class>) <from-method> <from-sig>) + (.visitInsn <op>) + (.visitMethodInsn Opcodes/INVOKESPECIAL (&host/->class <to-class>) "<init>" <to-sig>))]] (return nil))) compile-jvm-d2f Opcodes/D2F "java.lang.Double" "doubleValue" "()D" "java.lang.Float" "(F)V" @@ -441,16 +457,16 @@ (do-template [<name> <op> <from1-method> <from1-sig> <from1-class> <from2-method> <from2-sig> <from2-class> <to-class> <to-sig>] (defn <name> [compile *type* ?x ?y] (|do [*writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW (&host/->class <to-class>)) - (.visitInsn Opcodes/DUP))] - _ (compile ?x) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (&host/->class <from1-class>) <from1-method> <from1-sig>)] - _ (compile ?y) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (&host/->class <from2-class>) <from2-method> <from2-sig>)] - :let [_ (doto *writer* - (.visitInsn <op>) - (.visitMethodInsn Opcodes/INVOKESPECIAL (&host/->class <to-class>) "<init>" <to-sig>))]] + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW (&host/->class <to-class>)) + (.visitInsn Opcodes/DUP))] + _ (compile ?x) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (&host/->class <from1-class>) <from1-method> <from1-sig>)] + _ (compile ?y) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (&host/->class <from2-class>) <from2-method> <from2-sig>)] + :let [_ (doto *writer* + (.visitInsn <op>) + (.visitMethodInsn Opcodes/INVOKESPECIAL (&host/->class <to-class>) "<init>" <to-sig>))]] (return nil))) compile-jvm-iand Opcodes/IAND "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V" @@ -470,10 +486,10 @@ (&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil) (.visitCode)) (|do [*writer* &/get-writer - _ (compile ?body) - :let [_ (doto *writer* - (.visitInsn Opcodes/POP) - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))]] + _ (compile ?body) + :let [_ (doto *writer* + (.visitInsn Opcodes/POP) + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] (return nil))))) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 3c3774e7e..f13578653 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -67,7 +67,7 @@ $start (new Label) $end (new Label) _ (doto *writer* - (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig (&/V "lux;AnyT" nil)) nil $start $end (+ 2 idx)) + (-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig (&/V "lux;DataT" "java.lang.Object")) nil $start $end (+ 2 idx)) (->> (dotimes [idx num-locals]))) (.visitLabel $start))] ret (compile impl-body) diff --git a/src/lux/host.clj b/src/lux/host.clj index 4d1fef04a..5b02c8192 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -19,7 +19,7 @@ "") (.getSimpleName class)))] (if (= "void" base) - (return (&/V "lux;NothingT" nil)) + (return &type/$Void) (return (&/V "lux;DataT" (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "[")) base))) ))) @@ -76,12 +76,6 @@ (defn ->java-sig [type] (matchv ::M/objects [type] - [["lux;AnyT" _]] - (->type-signature "java.lang.Object") - - [["lux;NothingT" _]] - "V" - [["lux;DataT" ?name]] (->type-signature ?name) diff --git a/src/lux/type.clj b/src/lux/type.clj index 17db11b43..cd7d5be1e 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -7,14 +7,13 @@ (declare show-type) ;; [Util] -(def Any (&/V "lux;AnyT" nil)) -(def Nothing (&/V "lux;NothingT" nil)) (def Bool (&/V "lux;DataT" "java.lang.Boolean")) (def Int (&/V "lux;DataT" "java.lang.Long")) (def Real (&/V "lux;DataT" "java.lang.Double")) (def Char (&/V "lux;DataT" "java.lang.Character")) (def Text (&/V "lux;DataT" "java.lang.String")) (def Unit (&/V "lux;TupleT" (&/|list))) +(def $Void (&/V "lux;VariantT" (&/|list))) (def List (&/V "lux;AllT" (&/T (&/V "lux;None" nil) "List" "a" @@ -33,9 +32,7 @@ TypeEnv (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Type)))) TypePair (&/V "lux;TupleT" (&/|list Type Type))] (&/V "lux;AppT" (&/T (&/V "lux;AllT" (&/T (&/V "lux;None" nil) "Type" "_" - (&/V "lux;VariantT" (&/|list (&/T "lux;AnyT" Unit) - (&/T "lux;NothingT" Unit) - (&/T "lux;DataT" Text) + (&/V "lux;VariantT" (&/|list (&/T "lux;DataT" Text) (&/T "lux;TupleT" (&/V "lux;AppT" (&/T List Type))) (&/T "lux;VariantT" TypeEnv) (&/T "lux;RecordT" TypeEnv) @@ -45,7 +42,7 @@ (&/T "lux;AllT" (&/V "lux;TupleT" (&/|list (&/V "lux;AppT" (&/T Maybe TypeEnv)) Text Text Type))) (&/T "lux;AppT" TypePair) )))) - (&/V "lux;NothingT" nil))))) + $Void)))) (defn bound? [id] (fn [state] @@ -187,12 +184,6 @@ (defn show-type [type] ;; (prn 'show-type (aget type 0)) (matchv ::M/objects [type] - [["lux;AnyT" _]] - "Any" - - [["lux;NothingT" _]] - "Nothing" - [["lux;DataT" name]] (str "(^ " name ")") @@ -242,12 +233,6 @@ (defn type= [x y] ;; (prn "^^ type= ^^") (let [output (matchv ::M/objects [x y] - [["lux;AnyT" _] ["lux;AnyT" _]] - true - - [["lux;NothingT" _] ["lux;NothingT" _]] - true - [["lux;DataT" xname] ["lux;DataT" yname]] (= xname yname) @@ -418,12 +403,6 @@ ;; (prn 'check* (aget expected 0) (aget actual 0)) ;; (prn 'check* (show-type expected) (show-type actual)) (matchv ::M/objects [expected actual] - [["lux;AnyT" _] _] - (return (&/T fixpoints nil)) - - [_ ["lux;NothingT" _]] - (return (&/T fixpoints nil)) - [["lux;VarT" ?eid] ["lux;VarT" ?aid]] (if (= ?eid ?aid) (return (&/T fixpoints nil)) @@ -610,10 +589,9 @@ [_] (fail (str "[Type Error] Type is not a variant: " (show-type type))))) -(let [type-cases #{"lux;AnyT" , "lux;NothingT", "lux;DataT" - "lux;TupleT" , "lux;VariantT", "lux;RecordT" - "lux;LambdaT", "lux;BoundT" , "lux;VarT" - "lux;AllT" , "lux;AppT"}] +(let [type-cases #{"lux;DataT" , "lux;LambdaT" , "lux;AppT" + "lux;TupleT", "lux;VariantT", "lux;RecordT" + "lux;AllT" , "lux;VarT" , "lux;BoundT"}] (defn is-Type? [type] (matchv ::M/objects [type] [["lux;VarT" ?id]] |