From 3263d2b4cb55d142f32bc4e1c140cbd58d1dc4b9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 3 May 2016 18:40:32 -0400 Subject: - Renamed #DataT to #HostT. - Renamed _lux_host to _lux_proc. --- src/lux/analyser.clj | 2 +- src/lux/analyser/base.clj | 10 ++-- src/lux/analyser/host.clj | 116 +++++++++++++++++++++++----------------------- src/lux/analyser/lux.clj | 25 ++++++---- src/lux/base.clj | 2 +- src/lux/compiler.clj | 2 +- src/lux/compiler/host.clj | 18 +++---- src/lux/compiler/type.clj | 4 +- src/lux/host.clj | 6 +-- src/lux/optimizer.clj | 6 +-- src/lux/type.clj | 26 +++++------ src/lux/type/host.clj | 26 +++++------ 12 files changed, 126 insertions(+), 117 deletions(-) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index f25902a08..1b5c24bc3 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -185,7 +185,7 @@ (&/$Nil))))) (&&lux/analyse-alias analyse ?alias ?module) - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_host")] + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_proc")] (&/$Cons [_ (&/$TupleS (&/$Cons [_ (&/$TextS ?category)] (&/$Cons [_ (&/$TextS ?proc)] (&/$Nil))))] diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 656b13c44..7674f4503 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -21,13 +21,13 @@ ("apply" 2) ("case" 2) ("lambda" 3) - ("ann" 3) + ("ann" 3) ;; Eliminate ("var" 1) ("captured" 1) - ("host" 2) + ("proc" 2) - ("jvm-class" 1) - ("jvm-interface" 1) + ("jvm-class" 1) ;; Eliminate + ("jvm-interface" 1) ;; Eliminate ) ;; [Exports] @@ -75,7 +75,7 @@ (return ?module))] (return (&/T [module* ?name])))) -(let [tag-names #{"DataT" "VoidT" "UnitT" "SumT" "ProdT" "LambdaT" "BoundT" "VarT" "ExT" "UnivQ" "ExQ" "AppT" "NamedT"}] +(let [tag-names #{"HostT" "VoidT" "UnitT" "SumT" "ProdT" "LambdaT" "BoundT" "VarT" "ExT" "UnivQ" "ExQ" "AppT" "NamedT"}] (defn type-tag? [module name] (and (= "lux" module) (contains? tag-names name)))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index c036c7d0c..16b68ad0d 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -60,7 +60,7 @@ (defn ^:private ensure-object [type] "(-> Type (Lux (, Text (List Type))))" (|case type - (&/$DataT payload) + (&/$HostT payload) (return payload) (&/$VarT id) @@ -88,8 +88,8 @@ (defn ^:private as-object [type] "(-> Type Type)" (|case type - (&/$DataT class params) - (&/$DataT (&host-type/as-obj class) params) + (&/$HostT class params) + (&/$HostT (&host-type/as-obj class) params) _ type)) @@ -111,8 +111,8 @@ (defn ^:private as-otype+ [type] "(-> Type Type)" (|case type - (&/$DataT name params) - (&/$DataT (as-otype name) params) + (&/$HostT name params) + (&/$HostT (as-otype name) params) _ type)) @@ -143,14 +143,14 @@ _ base-type)) - (&/$DataT class-name type-args) + (&/$HostT class-name type-args) type-args)) ;; [Resources] (defn ^:private analyse-field-access-helper [obj-type gvars gtype] "(-> Type (List (^ java.lang.reflect.Type)) (^ java.lang.reflect.Type) (Lux Type))" (|case obj-type - (&/$DataT class targs) + (&/$HostT class targs) (if (= (&/|length targs) (&/|length gvars)) (|let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m)) (&/|table) @@ -223,22 +223,22 @@ (&/$GenericClass name params) (case name - "boolean" (return (&/$DataT "java.lang.Boolean" &/$Nil)) - "byte" (return (&/$DataT "java.lang.Byte" &/$Nil)) - "short" (return (&/$DataT "java.lang.Short" &/$Nil)) - "int" (return (&/$DataT "java.lang.Integer" &/$Nil)) - "long" (return (&/$DataT "java.lang.Long" &/$Nil)) - "float" (return (&/$DataT "java.lang.Float" &/$Nil)) - "double" (return (&/$DataT "java.lang.Double" &/$Nil)) - "char" (return (&/$DataT "java.lang.Character" &/$Nil)) + "boolean" (return (&/$HostT "java.lang.Boolean" &/$Nil)) + "byte" (return (&/$HostT "java.lang.Byte" &/$Nil)) + "short" (return (&/$HostT "java.lang.Short" &/$Nil)) + "int" (return (&/$HostT "java.lang.Integer" &/$Nil)) + "long" (return (&/$HostT "java.lang.Long" &/$Nil)) + "float" (return (&/$HostT "java.lang.Float" &/$Nil)) + "double" (return (&/$HostT "java.lang.Double" &/$Nil)) + "char" (return (&/$HostT "java.lang.Character" &/$Nil)) "void" (return &/$UnitT) ;; else (|do [=params (&/map% (partial generic-class->type env) params)] - (return (&/$DataT name =params)))) + (return (&/$HostT name =params)))) (&/$GenericArray param) (|do [=param (generic-class->type env param)] - (return (&/$DataT &host-type/array-data-tag (&/|list =param)))) + (return (&/$HostT &host-type/array-data-tag (&/|list =param)))) (&/$GenericWildcard _) (return (&/$ExQ &/$Nil (&/$BoundT 1))) @@ -297,7 +297,7 @@ (defn ^:private analyse-method [analyse class-decl class-env all-supers method] "(-> Analyser ClassDecl (List (, TypeVar Type)) (List SuperClassDecl) MethodSyntax (Lux MethodAnalysis))" (|let [[?cname ?cparams] class-decl - class-type (&/$DataT ?cname (&/|map &/|second class-env))] + class-type (&/$HostT ?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) @@ -467,7 +467,7 @@ :let [name (&host/location (&/|tail scope)) class-decl (&/T [name &/$Nil]) anon-class (str (string/replace module "/" ".") "." name) - anon-class-type (&/$DataT anon-class &/$Nil)] + anon-class-type (&/$HostT anon-class &/$Nil)] =ctor-args (&/map% (fn [ctor-arg] (|let [[arg-type arg-term] ctor-arg] (|do [=arg-term (&&/analyse-1+ analyse arg-term)] @@ -493,18 +493,18 @@ _ (compile-statement (&&/$jvm-class (&/T [class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args)]))) _cursor &/cursor] (return (&/|list (&&/|meta anon-class-type _cursor - (&&/$host (&/T ["jvm" "new"]) (&/|list anon-class (&/|repeat (&/|length sources) captured-slot-class) sources)) + (&&/$proc (&/T ["jvm" "new"]) (&/|list anon-class (&/|repeat (&/|length sources) captured-slot-class) sources)) ))) )))) (do-template [ ] - (let [output-type (&/$DataT &/$Nil)] + (let [output-type (&/$HostT &/$Nil)] (defn [analyse exo-type _?value] (|do [:let [(&/$Cons ?value (&/$Nil)) _?value] - =value (&&/analyse-1 analyse (&/$DataT &/$Nil) ?value) + =value (&&/analyse-1 analyse (&/$HostT &/$Nil) ?value) _ (&type/check exo-type output-type) _cursor &/cursor] - (return (&/|list (&&/|meta output-type _cursor (&&/$host (&/T ["jvm" ]) (&/|list =value)))))))) + (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" ]) (&/|list =value)))))))) ^:private analyse-jvm-d2f "d2f" "java.lang.Double" "java.lang.Float" ^:private analyse-jvm-d2i "d2i" "java.lang.Double" "java.lang.Integer" @@ -532,14 +532,14 @@ ) (do-template [ ] - (let [output-type (&/$DataT &/$Nil)] + (let [output-type (&/$HostT &/$Nil)] (defn [analyse exo-type ?values] (|do [:let [(&/$Cons ?value1 (&/$Cons ?value2 (&/$Nil))) ?values] - =value1 (&&/analyse-1 analyse (&/$DataT &/$Nil) ?value1) - =value2 (&&/analyse-1 analyse (&/$DataT &/$Nil) ?value2) + =value1 (&&/analyse-1 analyse (&/$HostT &/$Nil) ?value1) + =value2 (&&/analyse-1 analyse (&/$HostT &/$Nil) ?value2) _ (&type/check exo-type output-type) _cursor &/cursor] - (return (&/|list (&&/|meta output-type _cursor (&&/$host (&/T ["jvm" ]) (&/|list =value1 =value2)))))))) + (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" ]) (&/|list =value1 =value2)))))))) ^:private analyse-jvm-iand "iand" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer" ^:private analyse-jvm-ior "ior" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer" @@ -557,8 +557,8 @@ ) (do-template [ ] - (let [input-type (&/$DataT &/$Nil) - output-type (&/$DataT &/$Nil)] + (let [input-type (&/$HostT &/$Nil) + output-type (&/$HostT &/$Nil)] (defn [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] =x (&&/analyse-1 analyse input-type x) @@ -566,7 +566,7 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta output-type _cursor - (&&/$host (&/T ["jvm" ]) (&/|list =x =y)))))))) + (&&/$proc (&/T ["jvm" ]) (&/|list =x =y)))))))) ^:private analyse-jvm-iadd "iadd" "java.lang.Integer" "java.lang.Integer" ^:private analyse-jvm-isub "isub" "java.lang.Integer" "java.lang.Integer" @@ -612,15 +612,15 @@ (let [length-type &type/Int idx-type &type/Int] (do-template [ ] - (let [elem-type (&/$DataT &/$Nil) - array-type (&/$DataT &/$Nil)] + (let [elem-type (&/$HostT &/$Nil) + array-type (&/$HostT &/$Nil)] (defn [analyse exo-type ?values] (|do [:let [(&/$Cons length (&/$Nil)) ?values] =length (&&/analyse-1 analyse length-type length) _ (&type/check exo-type array-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" ]) (&/|list =length))))))) + (&&/$proc (&/T ["jvm" ]) (&/|list =length))))))) (defn [analyse exo-type ?values] (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values] @@ -629,7 +629,7 @@ _ (&type/check exo-type elem-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" ]) (&/|list =array =idx))))))) + (&&/$proc (&/T ["jvm" ]) (&/|list =array =idx))))))) (defn [analyse exo-type ?values] (|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values] @@ -639,7 +639,7 @@ _ (&type/check exo-type array-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" ]) (&/|list =array =idx =elem))))))) + (&&/$proc (&/T ["jvm" ]) (&/|list =array =idx =elem))))))) ) "java.lang.Boolean" "[Z" ^:private analyse-jvm-znewarray "znewarray" analyse-jvm-zaload "zaload" analyse-jvm-zastore "zastore" @@ -666,12 +666,12 @@ gclass (&&a-parser/parse-gclass _gclass) gtype-env &/get-type-env =gclass (&host-type/instance-gtype &type/existential gtype-env gclass) - :let [array-type (&/$DataT &host-type/array-data-tag (&/|list =gclass))] + :let [array-type (&/$HostT &host-type/array-data-tag (&/|list =gclass))] =length (&&/analyse-1 analyse length-type length) _ (&type/check exo-type array-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "anewarray"]) (&/|list gclass =length gtype-env))))))) + (&&/$proc (&/T ["jvm" "anewarray"]) (&/|list gclass =length gtype-env))))))) (defn ^:private analyse-jvm-aaload [analyse exo-type ?values] (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values] @@ -683,7 +683,7 @@ _ (&type/check exo-type inner-arr-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "aaload"]) (&/|list =array =idx))))))) + (&&/$proc (&/T ["jvm" "aaload"]) (&/|list =array =idx))))))) (defn ^:private analyse-jvm-aastore [analyse exo-type ?values] (|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values] @@ -697,7 +697,7 @@ _ (&type/check exo-type array-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem)))))))) + (&&/$proc (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem)))))))) (defn ^:private analyse-jvm-arraylength [analyse exo-type ?values] (|do [:let [(&/$Cons array (&/$Nil)) ?values] @@ -707,7 +707,7 @@ _ (&type/check exo-type &type/Int) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "arraylength"]) (&/|list =array)) + (&&/$proc (&/T ["jvm" "arraylength"]) (&/|list =array)) ))))) (defn ^:private analyse-jvm-null? [analyse exo-type ?values] @@ -718,15 +718,15 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "null?"]) (&/|list =object))))))) + (&&/$proc (&/T ["jvm" "null?"]) (&/|list =object))))))) (defn ^:private analyse-jvm-null [analyse exo-type ?values] (|do [:let [(&/$Nil) ?values] - :let [output-type (&/$DataT &host-type/null-data-tag &/$Nil)] + :let [output-type (&/$HostT &host-type/null-data-tag &/$Nil)] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "null"]) (&/|list))))))) + (&&/$proc (&/T ["jvm" "null"]) (&/|list))))))) (do-template [ ] (defn [analyse exo-type ?values] @@ -737,7 +737,7 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" ]) (&/|list =monitor))))))) + (&&/$proc (&/T ["jvm" ]) (&/|list =monitor))))))) ^:private analyse-jvm-monitorenter "monitorenter" ^:private analyse-jvm-monitorexit "monitorexit" @@ -745,11 +745,11 @@ (defn ^:private analyse-jvm-throw [analyse exo-type ?values] (|do [:let [(&/$Cons ?ex (&/$Nil)) ?values] - =ex (&&/analyse-1 analyse (&/$DataT "java.lang.Throwable" &/$Nil) ?ex) + =ex (&&/analyse-1 analyse (&/$HostT "java.lang.Throwable" &/$Nil) ?ex) _cursor &/cursor _ (&type/check exo-type &/$VoidT)] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "throw"]) (&/|list =ex))))))) + (&&/$proc (&/T ["jvm" "throw"]) (&/|list =ex))))))) (defn ^:private analyse-jvm-getstatic [analyse exo-type class field ?values] (|do [:let [(&/$Nil) ?values] @@ -760,7 +760,7 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "getstatic"]) (&/|list class field output-type))))))) + (&&/$proc (&/T ["jvm" "getstatic"]) (&/|list class field output-type))))))) (defn ^:private analyse-jvm-getfield [analyse exo-type class field ?values] (|do [:let [(&/$Cons object (&/$Nil)) ?values] @@ -773,7 +773,7 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "getfield"]) (&/|list class field =object output-type))))))) + (&&/$proc (&/T ["jvm" "getfield"]) (&/|list class field =object output-type))))))) (defn ^:private analyse-jvm-putstatic [analyse exo-type class field ?values] (|do [:let [(&/$Cons value (&/$Nil)) ?values] @@ -786,7 +786,7 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "putstatic"]) (&/|list class field =value gclass))))))) + (&&/$proc (&/T ["jvm" "putstatic"]) (&/|list class field =value gclass))))))) (defn ^:private analyse-jvm-putfield [analyse exo-type class field ?values] (|do [:let [(&/$Cons object (&/$Cons value (&/$Nil))) ?values] @@ -802,7 +802,7 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "putfield"]) (&/|list class field =object =value gclass =type))))))) + (&&/$proc (&/T ["jvm" "putfield"]) (&/|list class field =object =value gclass =type))))))) (defn ^:private analyse-method-call-helper [analyse gret gtype-env gtype-vars gtype-args args] (|case gtype-vars @@ -823,7 +823,7 @@ (return (&/T [==gret ==args]))))) )) -(let [dummy-type-param (&/$DataT "java.lang.Object" &/$Nil)] +(let [dummy-type-param (&/$HostT "java.lang.Object" &/$Nil)] (do-template [ ] (defn [analyse exo-type class method classes ?values] (|do [:let [(&/$Cons object args) ?values] @@ -841,7 +841,7 @@ _ (ensure-catching exceptions) =object (&&/analyse-1+ analyse object) [sub-class sub-params] (ensure-object (&&/expr-type* =object)) - (&/$DataT super-class* super-params*) (&host-type/->super-type &type/existential class-loader class sub-class sub-params) + (&/$HostT super-class* super-params*) (&host-type/->super-type &type/existential class-loader class sub-class sub-params) :let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m)) (&/|table) parent-gvars @@ -850,7 +850,7 @@ _ (&type/check exo-type (as-otype+ output-type)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" ]) (&/|list class method classes =object =args output-type))))))) + (&&/$proc (&/T ["jvm" ]) (&/|list class method classes =object =args output-type))))))) ^:private analyse-jvm-invokevirtual "invokevirtual" false ^:private analyse-jvm-invokespecial "invokespecial" false @@ -867,7 +867,7 @@ _ (&type/check exo-type (as-otype+ output-type)) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "invokestatic"]) (&/|list class method classes =args output-type))))))) + (&&/$proc (&/T ["jvm" "invokestatic"]) (&/|list class method classes =args output-type))))))) (defn ^:private analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args] (|case gtype-vars @@ -897,16 +897,16 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "new"]) (&/|list class classes =args))))))) + (&&/$proc (&/T ["jvm" "new"]) (&/|list class classes =args))))))) (defn ^:private analyse-jvm-try [analyse exo-type ?values] (|do [:let [(&/$Cons ?body (&/$Cons ?catch (&/$Nil))) ?values] =body (with-catches (&/|list "java.lang.Exception") (&&/analyse-1 analyse exo-type ?body)) - =catch (&&/analyse-1 analyse (&/$LambdaT (&/$DataT "java.lang.Exception" &/$Nil) exo-type) ?catch) + =catch (&&/analyse-1 analyse (&/$LambdaT (&/$HostT "java.lang.Exception" &/$Nil) exo-type) ?catch) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$host (&/T ["jvm" "try"]) (&/|list =body =catch))))))) + (&&/$proc (&/T ["jvm" "try"]) (&/|list =body =catch))))))) (defn ^:private analyse-jvm-instanceof [analyse exo-type class ?values] (|do [:let [(&/$Cons object (&/$Nil)) ?values] @@ -916,7 +916,7 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta output-type _cursor - (&&/$host (&/T ["jvm" "instanceof"]) (&/|list class =object))))))) + (&&/$proc (&/T ["jvm" "instanceof"]) (&/|list class =object))))))) (defn analyse-host [analyse exo-type category proc ?values] (case category diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 065ee643d..382637e4a 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -578,22 +578,31 @@ _ (&&module/alias module-name ex-alias ex-module)] (return &/$Nil))) +(defn ^:private coerce [new-type analysis] + "(-> Type Analysis Analysis)" + (|let [[[_type _cursor] _analysis] analysis] + (&&/|meta new-type _cursor + _analysis))) + (defn analyse-ann [analyse eval! exo-type ?type ?value] (|do [=type (&&/analyse-1 analyse &type/Type ?type) ==type (eval! =type) _ (&type/check exo-type ==type) =value (&&/analyse-1 analyse ==type ?value) - _cursor &/cursor] + _cursor &/cursor + ;; =value (&&/analyse-1 analyse ==type ?value) + ;; :let [_ (prn 0 (&/adt->text =value)) + ;; _ (prn 1 (&/adt->text (coerce ==type =value))) + ;; _ (prn 2 (&/adt->text (&&/|meta ==type _cursor + ;; (&&/$ann =value =type ==type) + ;; )))] + ] + ;; (return (&/|list (coerce ==type =value))) ;; (analyse ==type ?value) (return (&/|list (&&/|meta ==type _cursor (&&/$ann =value =type ==type) - ))))) - -(defn ^:private coerce [new-type analysis] - "(-> Type Analysis Analysis)" - (|let [[[_type _cursor] _analysis] analysis] - (&&/|meta new-type _cursor - _analysis))) + ))) + )) (defn analyse-coerce [analyse eval! exo-type ?type ?value] (|do [=type (&&/analyse-1 analyse &type/Type ?type) diff --git a/src/lux/base.clj b/src/lux/base.clj index 68683e5d3..a507362f9 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -83,7 +83,7 @@ ;; Type (defvariant - ("DataT" 2) + ("HostT" 2) ("VoidT" 0) ("UnitT" 0) ("SumT" 2) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 1a0e617c0..124796788 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -91,7 +91,7 @@ (&o/$ann ?value-ex ?type-ex ?value-type) (&&lux/compile-ann compile-expression ?value-ex ?type-ex ?value-type) - (&o/$host [?proc-category ?proc-name] ?args) + (&o/$proc [?proc-category ?proc-name] ?args) (&&host/compile-host compile-expression ?proc-category ?proc-name ?args) _ diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 097ebc260..4a713d948 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -56,31 +56,31 @@ (&/$UnitT) (.visitLdcInsn *writer* &/unit-tag) - (&/$DataT "boolean" (&/$Nil)) + (&/$HostT "boolean" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name boolean-class) "valueOf" (str "(Z)" (&host-generics/->type-signature boolean-class))) - (&/$DataT "byte" (&/$Nil)) + (&/$HostT "byte" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name byte-class) "valueOf" (str "(B)" (&host-generics/->type-signature byte-class))) - (&/$DataT "short" (&/$Nil)) + (&/$HostT "short" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name short-class) "valueOf" (str "(S)" (&host-generics/->type-signature short-class))) - (&/$DataT "int" (&/$Nil)) + (&/$HostT "int" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name int-class) "valueOf" (str "(I)" (&host-generics/->type-signature int-class))) - (&/$DataT "long" (&/$Nil)) + (&/$HostT "long" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name long-class) "valueOf" (str "(J)" (&host-generics/->type-signature long-class))) - (&/$DataT "float" (&/$Nil)) + (&/$HostT "float" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name float-class) "valueOf" (str "(F)" (&host-generics/->type-signature float-class))) - (&/$DataT "double" (&/$Nil)) + (&/$HostT "double" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name double-class) "valueOf" (str "(D)" (&host-generics/->type-signature double-class))) - (&/$DataT "char" (&/$Nil)) + (&/$HostT "char" (&/$Nil)) (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host-generics/->bytecode-class-name char-class) "valueOf" (str "(C)" (&host-generics/->type-signature char-class))) - (&/$DataT _ _) + (&/$HostT _ _) nil (&/$NamedT ?name ?type) diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj index 4576b33e6..bf6ec5539 100644 --- a/src/lux/compiler/type.clj +++ b/src/lux/compiler/type.clj @@ -60,8 +60,8 @@ (defn type->analysis [type] "(-> Type Analysis)" (|case type - (&/$DataT class params) - (variant$ #'&/$DataT (tuple$ (&/|list (text$ class) + (&/$HostT class params) + (variant$ #'&/$HostT (tuple$ (&/|list (text$ class) (List$ (&/|map type->analysis params))))) (&/$VoidT) diff --git a/src/lux/host.clj b/src/lux/host.clj index 3aabce165..9dade6731 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -35,7 +35,7 @@ (defn unfold-array [type] "(-> Type (, Int Type))" (|case type - (&/$DataT "#Array" (&/$Cons param (&/$Nil))) + (&/$HostT "#Array" (&/$Cons param (&/$Nil))) (|let [[count inner] (unfold-array param)] (&/T [(inc count) inner])) @@ -47,10 +47,10 @@ (defn ->java-sig [^objects type] "(-> Type (Lux Text))" (|case type - (&/$DataT ?name params) + (&/$HostT ?name params) (cond (= &host-type/array-data-tag ?name) (|do [:let [[level base] (unfold-array type)] base-sig (|case base - (&/$DataT base-class _) + (&/$HostT base-class _) (return (&host-generics/->type-signature base-class)) _ diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj index ab11fc8a5..704473935 100644 --- a/src/lux/optimizer.clj +++ b/src/lux/optimizer.clj @@ -23,7 +23,7 @@ ("ann" 1) ("var" 1) ("captured" 1) - ("host" 2) + ("proc" 2) ("jvm-class" 1) ("jvm-interface" 1) @@ -72,8 +72,8 @@ (&-base/$captured value) (return ($captured value)) - (&-base/$host ?proc-ident ?args) - (return ($host ?proc-ident ?args)) + (&-base/$proc ?proc-ident ?args) + (return ($proc ?proc-ident ?args)) (&-base/$jvm-class value) (return ($jvm-class value)) diff --git a/src/lux/type.clj b/src/lux/type.clj index c6e76f66e..614d51eb3 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -27,11 +27,11 @@ (def empty-env &/$Nil) -(def Bool (&/$NamedT (&/T ["lux" "Bool"]) (&/$DataT "java.lang.Boolean" &/$Nil))) -(def Int (&/$NamedT (&/T ["lux" "Int"]) (&/$DataT "java.lang.Long" &/$Nil))) -(def Real (&/$NamedT (&/T ["lux" "Real"]) (&/$DataT "java.lang.Double" &/$Nil))) -(def Char (&/$NamedT (&/T ["lux" "Char"]) (&/$DataT "java.lang.Character" &/$Nil))) -(def Text (&/$NamedT (&/T ["lux" "Text"]) (&/$DataT "java.lang.String" &/$Nil))) +(def Bool (&/$NamedT (&/T ["lux" "Bool"]) (&/$HostT "java.lang.Boolean" &/$Nil))) +(def Int (&/$NamedT (&/T ["lux" "Int"]) (&/$HostT "java.lang.Long" &/$Nil))) +(def Real (&/$NamedT (&/T ["lux" "Real"]) (&/$HostT "java.lang.Double" &/$Nil))) +(def Char (&/$NamedT (&/T ["lux" "Char"]) (&/$HostT "java.lang.Character" &/$Nil))) +(def Text (&/$NamedT (&/T ["lux" "Text"]) (&/$HostT "java.lang.String" &/$Nil))) (def Ident (&/$NamedT (&/T ["lux" "Ident"]) (&/$ProdT Text Text))) (def IO @@ -67,7 +67,7 @@ TypePair (&/$ProdT Type Type)] (&/$AppT (&/$UnivQ empty-env (&/$SumT - ;; DataT + ;; HostT (&/$ProdT Text TypeList) (&/$SumT ;; VoidT @@ -292,9 +292,9 @@ (return type))) ) - (&/$DataT ?name ?params) + (&/$HostT ?name ?params) (|do [=params (&/map% (partial clean* ?tid) ?params)] - (return (&/$DataT ?name =params))) + (return (&/$HostT ?name =params))) (&/$LambdaT ?arg ?return) (|do [=arg (clean* ?tid ?arg) @@ -398,7 +398,7 @@ (defn show-type [^objects type] (|case type - (&/$DataT name params) + (&/$HostT name params) (|case params (&/$Nil) (str "(^ " name ")") @@ -454,7 +454,7 @@ (and (= ?xmodule ?ymodule) (= ?xname ?yname)) - [(&/$DataT xname xparams) (&/$DataT yname yparams)] + [(&/$HostT xname xparams) (&/$HostT yname yparams)] (and (.equals ^Object xname yname) (= (&/|length xparams) (&/|length yparams)) (&/fold2 #(and %1 (type= %2 %3)) true xparams yparams)) @@ -544,8 +544,8 @@ (defn beta-reduce [env type] (|case type - (&/$DataT ?name ?params) - (&/$DataT ?name (&/|map (partial beta-reduce env) ?params)) + (&/$HostT ?name ?params) + (&/$HostT ?name (&/|map (partial beta-reduce env) ?params)) (&/$SumT ?left ?right) (&/$SumT (beta-reduce env ?left) (beta-reduce env ?right)) @@ -772,7 +772,7 @@ a!def)] (check* class-loader fixpoints invariant?? expected actual*))) - [(&/$DataT e!data) (&/$DataT a!data)] + [(&/$HostT e!data) (&/$HostT a!data)] (&&host/check-host-types (partial check* class-loader fixpoints true) check-error fixpoints diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj index 0d1ee274e..de5b3df84 100644 --- a/src/lux/type/host.clj +++ b/src/lux/type/host.clj @@ -79,15 +79,15 @@ (let [gclass-name (.getName class)] (case gclass-name ("[Z" "[B" "[S" "[I" "[J" "[F" "[D" "[C") - (&/$DataT gclass-name (&/|list)) + (&/$HostT 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) &/$UnitT - (reduce (fn [inner _] (&/$DataT array-data-tag (&/|list inner))) - (&/$DataT base (try (-> (Class/forName base) .getTypeParameters - seq count (repeat (&/$DataT "java.lang.Object" &/$Nil)) + (reduce (fn [inner _] (&/$HostT array-data-tag (&/|list inner))) + (&/$HostT base (try (-> (Class/forName base) .getTypeParameters + seq count (repeat (&/$HostT "java.lang.Object" &/$Nil)) &/->list) (catch Exception e (&/|list)))) @@ -101,7 +101,7 @@ (instance? GenericArrayType refl-type) (|do [inner-type (instance-param existential matchings (.getGenericComponentType ^GenericArrayType refl-type))] - (return (&/$DataT array-data-tag (&/|list inner-type)))) + (return (&/$HostT array-data-tag (&/|list inner-type)))) (instance? ParameterizedType refl-type) (|do [:let [refl-type* ^ParameterizedType refl-type] @@ -109,7 +109,7 @@ .getActualTypeArguments seq &/->list (&/map% (partial instance-param existential matchings)))] - (return (&/$DataT (->> refl-type* ^Class (.getRawType) .getName) + (return (&/$HostT (->> refl-type* ^Class (.getRawType) .getName) params*))) (instance? TypeVariable refl-type) @@ -131,14 +131,14 @@ (|case gtype (&/$GenericArray component-type) (|do [inner-type (instance-gtype existential matchings component-type)] - (return (&/$DataT array-data-tag (&/|list inner-type)))) + (return (&/$HostT array-data-tag (&/|list inner-type)))) (&/$GenericClass type-name type-params) (if-let [m-type (&/|get type-name matchings)] (return m-type) (|do [params* (&/map% (partial instance-gtype existential matchings) type-params)] - (return (&/$DataT type-name params*)))) + (return (&/$HostT type-name params*)))) (&/$GenericTypeVar var-name) (if-let [m-type (&/|get var-name matchings)] @@ -198,7 +198,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 (&/$DataT (.getName sub-class*) sub-params*)))) + (return (&/$HostT (.getName sub-class*) sub-params*)))) (fail (str "[Type Error] Classes don't have a subtyping relationship: " sub-class " super-type existential class-loader e!name a!name a!params)] - (check (&/$DataT e!name e!params) actual*)) + (check (&/$HostT e!name e!params) actual*)) :else (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name))))) -- cgit v1.2.3