aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux57
-rw-r--r--src/lux/analyser.clj2
-rw-r--r--src/lux/analyser/host.clj108
-rw-r--r--src/lux/compiler/host.clj422
-rw-r--r--src/lux/compiler/lambda.clj2
-rw-r--r--src/lux/host.clj8
-rw-r--r--src/lux/type.clj34
7 files changed, 307 insertions, 326 deletions
diff --git a/source/lux.lux b/source/lux.lux
index aab80ed7e..f46a9f66d 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -4,9 +4,6 @@
apply))
## Basic types
-(def' Any #AnyT)
-(def' Nothing #NothingT)
-
(def' Bool (#DataT "java.lang.Boolean"))
(export' Bool)
@@ -48,9 +45,7 @@
(export' Maybe)
## (deftype #rec Type
-## (| #AnyT
-## #NothingT
-## (#DataT Text)
+## (| (#DataT Text)
## (#TupleT (List Type))
## (#VariantT (List (, Text Type)))
## (#RecordT (List (, Text Type)))
@@ -65,19 +60,17 @@
(case' (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))])
TypeEnv
(#AppT [(#AllT [#None "Type" ""
- (#VariantT (#Cons [["lux;AnyT" (#TupleT #Nil)]
- (#Cons [["lux;NothingT" (#TupleT #Nil)]
- (#Cons [["lux;DataT" Text]
- (#Cons [["lux;TupleT" (#AppT [List Type])]
- (#Cons [["lux;VariantT" TypeEnv]
- (#Cons [["lux;RecordT" TypeEnv]
- (#Cons [["lux;LambdaT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))]
- (#Cons [["lux;BoundT" Text]
- (#Cons [["lux;VarT" Int]
- (#Cons [["lux;AllT" (#TupleT (#Cons [(#AppT [Maybe TypeEnv]) (#Cons [Text (#Cons [Text (#Cons [Type #Nil])])])]))]
- (#Cons [["lux;AppT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))]
- #Nil])])])])])])])])])])]))])
- #NothingT]))))
+ (#VariantT (#Cons [["lux;DataT" Text]
+ (#Cons [["lux;TupleT" (#AppT [List Type])]
+ (#Cons [["lux;VariantT" TypeEnv]
+ (#Cons [["lux;RecordT" TypeEnv]
+ (#Cons [["lux;LambdaT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))]
+ (#Cons [["lux;BoundT" Text]
+ (#Cons [["lux;VarT" Int]
+ (#Cons [["lux;AllT" (#TupleT (#Cons [(#AppT [Maybe TypeEnv]) (#Cons [Text (#Cons [Text (#Cons [Type #Nil])])])]))]
+ (#Cons [["lux;AppT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))]
+ #Nil])])])])])])])])]))])
+ Void]))))
(export' Type)
## (deftype (Bindings k v)
@@ -151,17 +144,17 @@
## (deftype CompilerState
## (& #source (Maybe Reader)
-## #modules (List Any)
-## #module-aliases (List Any)
-## #envs (List (Env Text Any))
+## #modules (List Void)
+## #module-aliases (List Void)
+## #envs (List (Env Text Void))
## #types (Bindings Int Type)
## #host HostState))
(def' CompilerState
(:' Type
(#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])]
- (#Cons [["lux;modules" (#AppT [List Any])]
- (#Cons [["lux;module-aliases" (#AppT [List Any])]
- (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])]
+ (#Cons [["lux;modules" (#AppT [List Void])]
+ (#Cons [["lux;module-aliases" (#AppT [List Void])]
+ (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) Void])])]
(#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
(#Cons [["lux;host" HostState]
#Nil])])])])])]))))
@@ -824,18 +817,18 @@
## (deftype CompilerState
## (& #source (Maybe Reader)
-## #modules (List Any)
-## #module-aliases (List Any)
-## #envs (List (Env Text Any))
+## #modules (List Void)
+## #module-aliases (List Void)
+## #envs (List (Env Text Void))
## #types (Bindings Int Type)
## #writer (^ org.objectweb.asm.ClassWriter)
## #loader (^ java.net.URLClassLoader)
## #eval-ctor Int))
## (deftype CompilerState
## (& (#source (Maybe Reader))
-## (#modules (PList Text Any))
+## (#modules (PList Text Void))
## (#module-aliases (PList Text Text))
-## (#envs (List (Env Text Any)))
+## (#envs (List (Env Text Void)))
## (#types (Bindings Int Type))
## (#host (& (#writer (^ org.objectweb.asm.ClassWriter))
## (#loader (^ java.net.URLClassLoader))
@@ -1073,8 +1066,8 @@
## args)))))
## (def (const x)
-## (All [a]
-## (-> a (-> Any a)))
+## (All [a b]
+## (-> a (-> b a)))
## (lambda [_]
## x))
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]]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 13:44:27 +0000