diff options
Diffstat (limited to '')
| -rw-r--r-- | lux-bootstrapper/src/lux/analyser/base.clj | 2 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/analyser/case.clj | 10 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/analyser/proc/jvm.clj | 74 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/base.clj | 2 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/compiler/cache/type.clj | 4 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj | 38 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/host.clj | 12 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/type.clj | 52 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/type/host.clj | 44 |
9 files changed, 119 insertions, 119 deletions
diff --git a/lux-bootstrapper/src/lux/analyser/base.clj b/lux-bootstrapper/src/lux/analyser/base.clj index 1a61bcfa5..0b11a238d 100644 --- a/lux-bootstrapper/src/lux/analyser/base.clj +++ b/lux-bootstrapper/src/lux/analyser/base.clj @@ -75,7 +75,7 @@ (return ?module))] (return (&/T [module* ?name])))) -(let [tag-names #{"Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"}] +(let [tag-names #{"Nominal" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"}] (defn type-tag? [module name] (and (= &/prelude module) (contains? tag-names name)))) diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj index 42ab446ca..bf5f17f38 100644 --- a/lux-bootstrapper/src/lux/analyser/case.clj +++ b/lux-bootstrapper/src/lux/analyser/case.clj @@ -72,9 +72,9 @@ (&/$Parameter (+ (* 2 level) parameter-idx)) type) - (&/$Primitive ?name ?params) - (&/$Primitive ?name (&/|map (partial clean! level ?tid parameter-idx) - ?params)) + (&/$Nominal ?name ?params) + (&/$Nominal ?name (&/|map (partial clean! level ?tid parameter-idx) + ?params)) (&/$Function ?arg ?return) (&/$Function (clean! level ?tid parameter-idx ?arg) @@ -106,8 +106,8 @@ (defn beta-reduce! [level env type] (|case type - (&/$Primitive ?name ?params) - (&/$Primitive ?name (&/|map (partial beta-reduce! level env) ?params)) + (&/$Nominal ?name ?params) + (&/$Nominal ?name (&/|map (partial beta-reduce! level env) ?params)) (&/$Sum ?left ?right) (&/$Sum (beta-reduce! level env ?left) diff --git a/lux-bootstrapper/src/lux/analyser/proc/jvm.clj b/lux-bootstrapper/src/lux/analyser/proc/jvm.clj index 9dba428d5..5f2e1afc3 100644 --- a/lux-bootstrapper/src/lux/analyser/proc/jvm.clj +++ b/lux-bootstrapper/src/lux/analyser/proc/jvm.clj @@ -22,7 +22,7 @@ "(-> Type (Lux (, Text (List Type))))" [type] (|case type - (&/$Primitive payload) + (&/$Nominal payload) (return payload) (&/$Var id) @@ -51,8 +51,8 @@ "(-> Type Type)" [type] (|case type - (&/$Primitive class params) - (&/$Primitive (&host-type/as-obj class) params) + (&/$Nominal class params) + (&/$Nominal (&host-type/as-obj class) params) _ type)) @@ -75,8 +75,8 @@ "(-> Type Type)" [type] (|case type - (&/$Primitive name params) - (&/$Primitive (as-otype name) params) + (&/$Nominal name params) + (&/$Nominal (as-otype name) params) _ type)) @@ -108,7 +108,7 @@ _ base-type)) - (&/$Primitive class-name type-args) + (&/$Nominal class-name type-args) type-args)) ;; [Resources] @@ -116,7 +116,7 @@ "(-> Type (List (^ java.lang.reflect.Type)) (^ java.lang.reflect.Type) (Lux Type))" [obj-type gvars gtype] (|case obj-type - (&/$Primitive class targs) + (&/$Nominal class targs) (if (= (&/|length targs) (&/|length gvars)) (|let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Item (&/T [(.getName g) t]) m)) (&/|table) @@ -191,18 +191,18 @@ (&/$GenericClass name params) (case name - "boolean" (return (&/$Primitive "java.lang.Boolean" &/$End)) - "byte" (return (&/$Primitive "java.lang.Byte" &/$End)) - "short" (return (&/$Primitive "java.lang.Short" &/$End)) - "int" (return (&/$Primitive "java.lang.Integer" &/$End)) - "long" (return (&/$Primitive "java.lang.Long" &/$End)) - "float" (return (&/$Primitive "java.lang.Float" &/$End)) - "double" (return (&/$Primitive "java.lang.Double" &/$End)) - "char" (return (&/$Primitive "java.lang.Character" &/$End)) + "boolean" (return (&/$Nominal "java.lang.Boolean" &/$End)) + "byte" (return (&/$Nominal "java.lang.Byte" &/$End)) + "short" (return (&/$Nominal "java.lang.Short" &/$End)) + "int" (return (&/$Nominal "java.lang.Integer" &/$End)) + "long" (return (&/$Nominal "java.lang.Long" &/$End)) + "float" (return (&/$Nominal "java.lang.Float" &/$End)) + "double" (return (&/$Nominal "java.lang.Double" &/$End)) + "char" (return (&/$Nominal "java.lang.Character" &/$End)) "void" (return &type/Any) ;; else (|do [=params (&/map% (partial generic-class->type env) params)] - (return (&/$Primitive name =params)))) + (return (&/$Nominal name =params)))) (&/$GenericArray param) (|do [=param (generic-class->type env param)] @@ -268,7 +268,7 @@ "(-> Analyser ClassDecl (List (, TypeVar Type)) (List SuperClassDecl) MethodSyntax (Lux MethodAnalysis))" [analyse class-decl class-env all-supers method] (|let [[?cname ?cparams] class-decl - class-type (&/$Primitive ?cname (&/|map &/|second class-env))] + class-type (&/$Nominal ?cname (&/|map &/|second class-env))] (|case method (&/$ConstructorMethodSyntax =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body) (|do [method-env (make-type-env ?gvars) @@ -393,10 +393,10 @@ )) (do-template [<name> <proc> <from-class> <to-class>] - (let [output-type (&/$Primitive <to-class> &/$End)] + (let [output-type (&/$Nominal <to-class> &/$End)] (defn- <name> [analyse exo-type _?value] (|do [:let [(&/$Item ?value (&/$End)) _?value] - =value (&&/analyse-1 analyse (&/$Primitive <from-class> &/$End) ?value) + =value (&&/analyse-1 analyse (&/$Nominal <from-class> &/$End) ?value) _ (&type/check exo-type output-type) _location &/location] (return (&/|list (&&/|meta output-type _location (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value) (&/|list)))))))) @@ -433,11 +433,11 @@ ) (do-template [<name> <proc> <v1-class> <v2-class> <to-class>] - (let [output-type (&/$Primitive <to-class> &/$End)] + (let [output-type (&/$Nominal <to-class> &/$End)] (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Item ?value1 (&/$Item ?value2 (&/$End))) ?values] - =value1 (&&/analyse-1 analyse (&/$Primitive <v1-class> &/$End) ?value1) - =value2 (&&/analyse-1 analyse (&/$Primitive <v2-class> &/$End) ?value2) + =value1 (&&/analyse-1 analyse (&/$Nominal <v1-class> &/$End) ?value1) + =value2 (&&/analyse-1 analyse (&/$Nominal <v2-class> &/$End) ?value2) _ (&type/check exo-type output-type) _location &/location] (return (&/|list (&&/|meta output-type _location (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value1 =value2) (&/|list)))))))) @@ -458,8 +458,8 @@ ) (do-template [<name> <proc> <input-class> <output-class>] - (let [input-type (&/$Primitive <input-class> &/$End) - output-type (&/$Primitive <output-class> &/$End)] + (let [input-type (&/$Nominal <input-class> &/$End) + output-type (&/$Nominal <output-class> &/$End)] (defn- <name> [analyse exo-type ?values] (|do [:let [(&/$Item x (&/$Item y (&/$End))) ?values] =x (&&/analyse-1 analyse input-type x) @@ -513,8 +513,8 @@ (let [length-type &type/Nat idx-type &type/Nat] (do-template [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>] - (let [elem-type (&/$Primitive <elem-class> &/$End) - array-type (&/$Primitive <array-class> &/$End)] + (let [elem-type (&/$Nominal <elem-class> &/$End) + array-type (&/$Nominal <array-class> &/$End)] (defn- <new-name> [analyse exo-type ?values] (|do [:let [(&/$Item length (&/$End)) ?values] =length (&&/analyse-1 analyse length-type length) @@ -582,7 +582,7 @@ [arr-class arr-params] (ensure-object array-type) _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class)) :let [(&/$Item mutable_type (&/$End)) arr-params - (&/$Primitive "#Mutable" (&/$Item type_variance (&/$End))) mutable_type + (&/$Nominal "#Mutable" (&/$Item type_variance (&/$End))) mutable_type (&/$Function write_type read_type) type_variance] =idx (&&/analyse-1 analyse idx-type idx) _ (&type/check exo-type read_type) @@ -597,7 +597,7 @@ [arr-class arr-params] (ensure-object array-type) _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class)) :let [(&/$Item mutable_type (&/$End)) arr-params - (&/$Primitive "#Mutable" (&/$Item type_variance (&/$End))) mutable_type + (&/$Nominal "#Mutable" (&/$Item type_variance (&/$End))) mutable_type (&/$Function write_type read_type) type_variance] =idx (&&/analyse-1 analyse idx-type idx) =elem (&&/analyse-1 analyse write_type elem) @@ -629,7 +629,7 @@ (defn- analyse-jvm-object-null [analyse exo-type ?values] (|do [:let [(&/$End) ?values] - :let [output-type (&/$Primitive &host-type/null-data-tag &/$End)] + :let [output-type (&/$Nominal &host-type/null-data-tag &/$End)] _ (&type/check exo-type output-type) _location &/location] (return (&/|list (&&/|meta exo-type _location @@ -647,7 +647,7 @@ (defn- analyse-jvm-throw [analyse exo-type ?values] (|do [:let [(&/$Item ?ex (&/$End)) ?values] =ex (&&/analyse-1+ analyse ?ex) - _ (&type/check (&/$Primitive "java.lang.Throwable" &/$End) (&&/expr-type* =ex)) + _ (&type/check (&/$Nominal "java.lang.Throwable" &/$End) (&&/expr-type* =ex)) [throw-class throw-params] (ensure-object (&&/expr-type* =ex)) _location &/location _ (&type/check exo-type &type/Nothing)] @@ -734,10 +734,10 @@ (defn- up-cast [class parent-gvars class-loader !class! object-type] (|do [[sub-class sub-params] (ensure-object object-type) - (&/$Primitive super-class* super-params*) (&host-type/->super-type &type/existential class-loader !class! (if (= sub-class class) - !class! - sub-class) - sub-params)] + (&/$Nominal super-class* super-params*) (&host-type/->super-type &type/existential class-loader !class! (if (= sub-class class) + !class! + sub-class) + sub-params)] (return (&/fold2 (fn [m ^TypeVariable g t] (&/$Item (&/T [(.getName g) t]) m)) (&/|table) parent-gvars @@ -756,7 +756,7 @@ (&/fail-with-loc (str "[Analyser Error] Unknown class: " !class!))))] (return (&/T [!class! class-loader])))) -(let [dummy-type-param (&/$Primitive "java.lang.Object" &/$End)] +(let [dummy-type-param (&/$Nominal "java.lang.Object" &/$End)] (do-template [<name> <tag> <only-interface?>] (defn- <name> [analyse exo-type class method classes ?values] (|do [:let [(&/$Item object args) ?values] @@ -834,7 +834,7 @@ (return nil)) (catch Exception e (&/fail-with-loc (str "[Analyser Error] Unknown class: " _class-name)))) - :let [output-type (&/$Primitive "java.lang.Class" (&/|list (&/$Primitive _class-name (&/|list))))] + :let [output-type (&/$Nominal "java.lang.Class" (&/|list (&/$Nominal _class-name (&/|list))))] _ (&type/check exo-type output-type) _location &/location] (return (&/|list (&&/|meta output-type _location @@ -904,7 +904,7 @@ class-decl (&/T [name &/$End]) anon-class (str (string/replace module "/" ".") "." name) class-type-decl (&/T [anon-class &/$End]) - anon-class-type (&/$Primitive anon-class &/$End)] + anon-class-type (&/$Nominal anon-class &/$End)] =ctor-args (&/map% (fn [ctor-arg] (|let [[arg-type arg-term] ctor-arg] (|do [=arg-term (&&/analyse-1+ analyse arg-term)] diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj index 2265c49af..ef7838e77 100644 --- a/lux-bootstrapper/src/lux/base.clj +++ b/lux-bootstrapper/src/lux/base.clj @@ -88,7 +88,7 @@ ;; Type (defvariant - ("Primitive" 2) + ("Nominal" 2) ("Sum" 2) ("Product" 2) ("Function" 2) diff --git a/lux-bootstrapper/src/lux/compiler/cache/type.clj b/lux-bootstrapper/src/lux/compiler/cache/type.clj index 50e943b73..6a6374b9a 100644 --- a/lux-bootstrapper/src/lux/compiler/cache/type.clj +++ b/lux-bootstrapper/src/lux/compiler/cache/type.clj @@ -23,7 +23,7 @@ (if (&type/type= &type/Type type) "T" (|case type - (&/$Primitive name params) + (&/$Nominal name params) (str "^" name stop (serialize-list serialize-type params)) (&/$Product left right) @@ -123,7 +123,7 @@ (when (.startsWith input "^") (let [[name ^String input*] (.split (.substring input 1) stop 2)] (when-let [[params ^String input*] (deserialize-list input*)] - [(&/$Primitive name params) input*])))) + [(&/$Nominal name params) input*])))) (defn deserialize-type "(-> Text Type)" diff --git a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj index 22f889aeb..66070351d 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj @@ -50,31 +50,31 @@ (if (&type/type= &type/Any *type*) (.visitLdcInsn *writer* &/unit-tag) (|case *type* - (&/$Primitive "boolean" (&/$End)) + (&/$Nominal "boolean" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name boolean-class) "valueOf" (str "(Z)" (&host-generics/->type-signature boolean-class))) - (&/$Primitive "byte" (&/$End)) + (&/$Nominal "byte" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name byte-class) "valueOf" (str "(B)" (&host-generics/->type-signature byte-class))) - (&/$Primitive "short" (&/$End)) + (&/$Nominal "short" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name short-class) "valueOf" (str "(S)" (&host-generics/->type-signature short-class))) - (&/$Primitive "int" (&/$End)) + (&/$Nominal "int" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name int-class) "valueOf" (str "(I)" (&host-generics/->type-signature int-class))) - (&/$Primitive "long" (&/$End)) + (&/$Nominal "long" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name long-class) "valueOf" (str "(J)" (&host-generics/->type-signature long-class))) - (&/$Primitive "float" (&/$End)) + (&/$Nominal "float" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name float-class) "valueOf" (str "(F)" (&host-generics/->type-signature float-class))) - (&/$Primitive "double" (&/$End)) + (&/$Nominal "double" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name double-class) "valueOf" (str "(D)" (&host-generics/->type-signature double-class))) - (&/$Primitive "char" (&/$End)) + (&/$Nominal "char" (&/$End)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name char-class) "valueOf" (str "(C)" (&host-generics/->type-signature char-class))) - (&/$Primitive _ _) + (&/$Nominal _ _) nil (&/$Named ?name ?type) @@ -782,10 +782,10 @@ ] ^MethodVisitor *writer* &/get-writer normal_array_type (&type/normal (&a/expr-type* ?array)) - :let [(&/$Primitive "#Array" (&/$Item mutable_type (&/$End))) normal_array_type - (&/$Primitive "#Mutable" (&/$Item type_variance (&/$End))) mutable_type + :let [(&/$Nominal "#Array" (&/$Item mutable_type (&/$End))) normal_array_type + (&/$Nominal "#Mutable" (&/$Item type_variance (&/$End))) mutable_type (&/$Function write_type read_type) type_variance] - array-type (&host/->java-sig (&/$Primitive "#Array" (&/|list read_type))) + array-type (&host/->java-sig (&/$Nominal "#Array" (&/|list read_type))) _ (compile ?array) :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST array-type)] _ (compile ?idx) @@ -801,10 +801,10 @@ ] ^MethodVisitor *writer* &/get-writer normal_array_type (&type/normal (&a/expr-type* ?array)) - :let [(&/$Primitive "#Array" (&/$Item mutable_type (&/$End))) normal_array_type - (&/$Primitive "#Mutable" (&/$Item type_variance (&/$End))) mutable_type + :let [(&/$Nominal "#Array" (&/$Item mutable_type (&/$End))) normal_array_type + (&/$Nominal "#Mutable" (&/$Item type_variance (&/$End))) mutable_type (&/$Function write_type read_type) type_variance] - array-type (&host/->java-sig (&/$Primitive "#Array" (&/|list write_type))) + array-type (&host/->java-sig (&/$Nominal "#Array" (&/|list write_type))) _ (compile ?array) :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST array-type)] :let [_ (.visitInsn *writer* Opcodes/DUP)] @@ -823,13 +823,13 @@ ^MethodVisitor *writer* &/get-writer normal_array_type (&type/normal (&a/expr-type* ?array)) array-type (|case normal_array_type - (&/$Primitive ?name (&/$End)) + (&/$Nominal ?name (&/$End)) (&host/->java-sig normal_array_type) - (&/$Primitive "#Array" (&/$Item mutable_type (&/$End))) - (|let [(&/$Primitive "#Mutable" (&/$Item type_variance (&/$End))) mutable_type + (&/$Nominal "#Array" (&/$Item mutable_type (&/$End))) + (|let [(&/$Nominal "#Mutable" (&/$Item type_variance (&/$End))) mutable_type (&/$Function write_type read_type) type_variance] - (&host/->java-sig (&/$Primitive "#Array" (&/|list read_type))))) + (&host/->java-sig (&/$Nominal "#Array" (&/|list read_type))))) _ (compile ?array) :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST array-type)] :let [_ (doto *writer* diff --git a/lux-bootstrapper/src/lux/host.clj b/lux-bootstrapper/src/lux/host.clj index 0abba888a..14ac6565c 100644 --- a/lux-bootstrapper/src/lux/host.clj +++ b/lux-bootstrapper/src/lux/host.clj @@ -45,13 +45,13 @@ "(-> Type [Nat Type])" [type] (|case type - (&/$Primitive "#Array" (&/$Item (&/$Primitive "#Mutable" (&/$Item (&/$Function _ param) - (&/$End))) - (&/$End))) + (&/$Nominal "#Array" (&/$Item (&/$Nominal "#Mutable" (&/$Item (&/$Function _ param) + (&/$End))) + (&/$End))) (|let [[count inner] (unfold-array param)] (&/T [(inc count) inner])) - (&/$Primitive "#Array" (&/$Item param (&/$End))) + (&/$Nominal "#Array" (&/$Item param (&/$End))) (|let [[count inner] (unfold-array param)] (&/T [(inc count) inner])) @@ -64,11 +64,11 @@ "(-> Type (Lux Text))" [^objects type] (|case type - (&/$Primitive ?name params) + (&/$Nominal ?name params) (cond (= &host-type/array-data-tag ?name) (|do [normal_type (&type/normal type) :let [[level base] (unfold-array normal_type)] base-sig (|case base - (&/$Primitive base-class _) + (&/$Nominal base-class _) (return (&host-generics/->type-signature base-class)) _ diff --git a/lux-bootstrapper/src/lux/type.clj b/lux-bootstrapper/src/lux/type.clj index 35a9a4b8e..479065170 100644 --- a/lux-bootstrapper/src/lux/type.clj +++ b/lux-bootstrapper/src/lux/type.clj @@ -27,13 +27,13 @@ (def I64 (&/$Named (&/T [&/prelude "I64"]) (&/$UnivQ empty-env - (&/$Primitive "#I64" (&/|list (&/$Parameter 1)))))) -(def Bit (&/$Named (&/T [&/prelude "Bit"]) (&/$Primitive "#Bit" &/$End))) -(def Nat (&/$Named (&/T [&/prelude "Nat"]) (&/$Primitive "#I64" (&/|list (&/$Primitive &&host/nat-data-tag &/$End))))) -(def Int (&/$Named (&/T [&/prelude "Int"]) (&/$Primitive "#I64" (&/|list (&/$Primitive &&host/int-data-tag &/$End))))) -(def Rev (&/$Named (&/T [&/prelude "Rev"]) (&/$Primitive "#I64" (&/|list (&/$Primitive &&host/rev-data-tag &/$End))))) -(def Frac (&/$Named (&/T [&/prelude "Frac"]) (&/$Primitive "#Frac" &/$End))) -(def Text (&/$Named (&/T [&/prelude "Text"]) (&/$Primitive "#Text" &/$End))) + (&/$Nominal "#I64" (&/|list (&/$Parameter 1)))))) +(def Bit (&/$Named (&/T [&/prelude "Bit"]) (&/$Nominal "#Bit" &/$End))) +(def Nat (&/$Named (&/T [&/prelude "Nat"]) (&/$Nominal "#I64" (&/|list (&/$Nominal &&host/nat-data-tag &/$End))))) +(def Int (&/$Named (&/T [&/prelude "Int"]) (&/$Nominal "#I64" (&/|list (&/$Nominal &&host/int-data-tag &/$End))))) +(def Rev (&/$Named (&/T [&/prelude "Rev"]) (&/$Nominal "#I64" (&/|list (&/$Nominal &&host/rev-data-tag &/$End))))) +(def Frac (&/$Named (&/T [&/prelude "Frac"]) (&/$Nominal "#Frac" &/$End))) +(def Text (&/$Named (&/T [&/prelude "Text"]) (&/$Nominal "#Text" &/$End))) (def Symbol (&/$Named (&/T [&/prelude "Symbol"]) (&/$Product Text Text))) (def Array &&host/Array) @@ -51,8 +51,8 @@ (def IO (&/$Named (&/T [(str &/prelude "/control/io") "IO"]) (&/$UnivQ empty-env - (&/$Primitive (str &/prelude "/control/io.IO") - (&/|list (&/$Parameter 1)))))) + (&/$Nominal (str &/prelude "/control/io.IO") + (&/|list (&/$Parameter 1)))))) (def List (&/$Named (&/T [&/prelude "List"]) @@ -77,13 +77,13 @@ (def Type (&/$Named (&/T [&/prelude "Type"]) - (let [Type (&/$Apply (&/$Primitive "" &/$End) (&/$Parameter 0)) + (let [Type (&/$Apply (&/$Nominal "" &/$End) (&/$Parameter 0)) TypeList (&/$Apply Type List) TypePair (&/$Product Type Type)] - (&/$Apply (&/$Primitive "" &/$End) + (&/$Apply (&/$Nominal "" &/$End) (&/$UnivQ empty-env (&/$Sum - ;; Primitive + ;; Nominal (&/$Product Text TypeList) (&/$Sum ;; Sum @@ -118,15 +118,15 @@ (def Macro (&/$Named (&/T [&/prelude "Macro"]) - (&/$Primitive "#Macro" &/$End))) + (&/$Nominal "#Macro" &/$End))) (def Tag (&/$Named (&/T [&/prelude "Tag"]) - (&/$Primitive "#Tag" &/$End))) + (&/$Nominal "#Tag" &/$End))) (def Slot (&/$Named (&/T [&/prelude "Slot"]) - (&/$Primitive "#Slot" &/$End))) + (&/$Nominal "#Slot" &/$End))) (defn bound? [id] (fn [state] @@ -261,9 +261,9 @@ (return type))) ) - (&/$Primitive ?name ?params) + (&/$Nominal ?name ?params) (|do [=params (&/map% (partial clean* ?tid) ?params)] - (return (&/$Primitive ?name =params))) + (return (&/$Nominal ?name =params))) (&/$Function ?arg ?return) (|do [=arg (clean* ?tid ?arg) @@ -377,13 +377,13 @@ (defn show-type [^objects type] (|case type - (&/$Primitive name params) + (&/$Nominal name params) (|case params (&/$End) - (str "(Primitive " (pr-str name) ")") + (str "(Nominal " (pr-str name) ")") _ - (str "(Primitive " (pr-str name) " " (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) + (str "(Nominal " (pr-str name) " " (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")) (&/$Product _) (str "[" (->> (flatten-prod type) (&/|map show-type) (&/|interpose " ") (&/fold str "")) "]") @@ -429,7 +429,7 @@ (and (= ?xmodule ?ymodule) (= ?xname ?yname)) - [(&/$Primitive xname xparams) (&/$Primitive yname yparams)] + [(&/$Nominal xname xparams) (&/$Nominal yname yparams)] (and (.equals ^Object xname yname) (= (&/|length xparams) (&/|length yparams)) (&/fold2 #(and %1 (type= %2 %3)) true xparams yparams)) @@ -513,8 +513,8 @@ (defn beta-reduce [env type] (|case type - (&/$Primitive ?name ?params) - (&/$Primitive ?name (&/|map (partial beta-reduce env) ?params)) + (&/$Nominal ?name ?params) + (&/$Nominal ?name (&/|map (partial beta-reduce env) ?params)) (&/$Sum ?left ?right) (&/$Sum (beta-reduce env ?left) (beta-reduce env ?right)) @@ -750,7 +750,7 @@ actual* (apply-type actual $arg)] (check* fixpoints invariant?? expected actual*)) - [(&/$Primitive e!data) (&/$Primitive a!data)] + [(&/$Nominal e!data) (&/$Nominal a!data)] (|do [? &/jvm?] (if ? (|do [class-loader &/loader] @@ -935,9 +935,9 @@ (&/$Named _ ?it) (normal ?it) - (&/$Primitive ?name ?parameters) + (&/$Nominal ?name ?parameters) (|do [=parameters (&/map% normal ?parameters)] - (return (&/$Primitive ?name =parameters))) + (return (&/$Nominal ?name =parameters))) (&/$Apply ?parameter ?abstraction) (|do [reification (apply-type ?abstraction ?parameter)] diff --git a/lux-bootstrapper/src/lux/type/host.clj b/lux-bootstrapper/src/lux/type/host.clj index 0ea72c98f..96337d19e 100644 --- a/lux-bootstrapper/src/lux/type/host.clj +++ b/lux-bootstrapper/src/lux/type/host.clj @@ -15,7 +15,7 @@ (and (= ?xmodule ?ymodule) (= ?xname ?yname)) - [(&/$Primitive xname xparams) (&/$Primitive yname yparams)] + [(&/$Nominal xname xparams) (&/$Nominal yname yparams)] (and (.equals ^Object xname yname) (= (&/|length xparams) (&/|length yparams)) (&/fold2 #(and %1 (type= %2 %3)) true xparams yparams)) @@ -67,7 +67,7 @@ (def mutable-data-tag "#Mutable") (def array-data-tag "#Array") (defn Array [item] - (&/$Primitive array-data-tag (&/|list (&/$Primitive mutable-data-tag (&/|list (&/$Function item item)))))) + (&/$Nominal array-data-tag (&/|list (&/$Nominal mutable-data-tag (&/|list (&/$Function item item)))))) (def null-data-tag "#Null") (def i64-data-tag "#I64") @@ -133,18 +133,18 @@ (let [gclass-name (.getName class)] (case gclass-name ("[Z" "[B" "[S" "[I" "[J" "[F" "[D" "[C") - (&/$Primitive gclass-name (&/|list)) + (&/$Nominal gclass-name (&/|list)) ;; else (if-let [[_ _ arr-obrackets arr-obase simple-base arr-pbrackets arr-pbase] (re-find class-name-re gclass-name)] (let [base (or arr-obase simple-base (jprim->lprim arr-pbase))] (if (.equals "void" base) Any (reduce (fn [inner _] (Array inner)) - (&/$Primitive base (try (-> (Class/forName base) .getTypeParameters - seq count (repeat (&/$Primitive "java.lang.Object" &/$End)) - &/->list) - (catch Exception e - (&/|list)))) + (&/$Nominal base (try (-> (Class/forName base) .getTypeParameters + seq count (repeat (&/$Nominal "java.lang.Object" &/$End)) + &/->list) + (catch Exception e + (&/|list)))) (range (count (or arr-obrackets arr-pbrackets ""))))) )))))) @@ -164,8 +164,8 @@ .getActualTypeArguments seq &/->list (&/map% (partial instance-param existential matchings)))] - (return (&/$Primitive (->> refl-type* ^Class (.getRawType) .getName) - params*))) + (return (&/$Nominal (->> refl-type* ^Class (.getRawType) .getName) + params*))) (instance? TypeVariable refl-type) (let [gvar (.getName ^TypeVariable refl-type)] @@ -187,14 +187,14 @@ (if (type= Any class-type) "V" (|case class-type - (&/$Primitive "#Array" - (&/$Item (&/$Primitive "#Mutable" - (&/$Item (&/$Function _ (&/$Primitive class-name _)) - (&/$End))) - (&/$End))) + (&/$Nominal "#Array" + (&/$Item (&/$Nominal "#Mutable" + (&/$Item (&/$Function _ (&/$Nominal class-name _)) + (&/$End))) + (&/$End))) (str "[" (&host-generics/->type-signature class-name)) - (&/$Primitive class-name _) + (&/$Nominal class-name _) (&host-generics/->type-signature class-name)))) (instance? GenericArrayType refl-type) @@ -233,7 +233,7 @@ (return m-type) (|do [params* (&/map% (partial instance-gtype existential matchings) type-params)] - (return (&/$Primitive type-name params*)))) + (return (&/$Nominal type-name params*)))) (&/$GenericTypeVar var-name) (if-let [m-type (&/|get var-name matchings)] @@ -303,7 +303,7 @@ (if (.isAssignableFrom super-class+ sub-class+) (let [lineage (trace-lineage sub-class+ super-class+)] (|do [[^Class sub-class* sub-params*] (raise existential lineage sub-class+ sub-params)] - (return (&/$Primitive (.getName sub-class*) sub-params*)))) + (return (&/$Nominal (.getName sub-class*) sub-params*)))) (&/fail-with-loc (str "[Host Error] Classes do not have a subtyping relationship: " sub-class " </= " super-class))))) (defn as-obj [class] @@ -341,7 +341,7 @@ (if (= (&/|length e!params) (&/|length a!params)) (|do [_ (&/map2% check e!params a!params)] (return fixpoints)) - (check-error "" (&/$Primitive e!name e!params) (&/$Primitive a!name a!params))) + (check-error "" (&/$Nominal e!name e!params) (&/$Nominal a!name a!params))) (or (lux-type? e!name) (lux-type? a!name)) @@ -350,14 +350,14 @@ (and (not (primitive-type? e!name)) (= null-data-tag a!name))) (return fixpoints) - (check-error "" (&/$Primitive e!name e!params) (&/$Primitive a!name a!params))) + (check-error "" (&/$Nominal e!name e!params) (&/$Nominal a!name a!params))) (not invariant??) (|do [actual* (->super-type existential class-loader e!name a!name a!params)] - (check (&/$Primitive e!name e!params) actual*)) + (check (&/$Nominal e!name e!params) actual*)) :else - (check-error "" (&/$Primitive e!name e!params) (&/$Primitive a!name a!params)))) + (check-error "" (&/$Nominal e!name e!params) (&/$Nominal a!name a!params)))) (catch Exception e (throw e))))) |