aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj2
-rw-r--r--src/lux/analyser/base.clj10
-rw-r--r--src/lux/analyser/host.clj116
-rw-r--r--src/lux/analyser/lux.clj25
-rw-r--r--src/lux/base.clj2
-rw-r--r--src/lux/compiler.clj2
-rw-r--r--src/lux/compiler/host.clj18
-rw-r--r--src/lux/compiler/type.clj4
-rw-r--r--src/lux/host.clj6
-rw-r--r--src/lux/optimizer.clj6
-rw-r--r--src/lux/type.clj26
-rw-r--r--src/lux/type/host.clj26
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 [<name> <proc> <from-class> <to-class>]
- (let [output-type (&/$DataT <to-class> &/$Nil)]
+ (let [output-type (&/$HostT <to-class> &/$Nil)]
(defn <name> [analyse exo-type _?value]
(|do [:let [(&/$Cons ?value (&/$Nil)) _?value]
- =value (&&/analyse-1 analyse (&/$DataT <from-class> &/$Nil) ?value)
+ =value (&&/analyse-1 analyse (&/$HostT <from-class> &/$Nil) ?value)
_ (&type/check exo-type output-type)
_cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor (&&/$host (&/T ["jvm" <proc>]) (&/|list =value))))))))
+ (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|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 [<name> <proc> <v1-class> <v2-class> <to-class>]
- (let [output-type (&/$DataT <to-class> &/$Nil)]
+ (let [output-type (&/$HostT <to-class> &/$Nil)]
(defn <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons ?value1 (&/$Cons ?value2 (&/$Nil))) ?values]
- =value1 (&&/analyse-1 analyse (&/$DataT <v1-class> &/$Nil) ?value1)
- =value2 (&&/analyse-1 analyse (&/$DataT <v2-class> &/$Nil) ?value2)
+ =value1 (&&/analyse-1 analyse (&/$HostT <v1-class> &/$Nil) ?value1)
+ =value2 (&&/analyse-1 analyse (&/$HostT <v2-class> &/$Nil) ?value2)
_ (&type/check exo-type output-type)
_cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor (&&/$host (&/T ["jvm" <proc>]) (&/|list =value1 =value2))))))))
+ (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|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 [<name> <proc> <input-class> <output-class>]
- (let [input-type (&/$DataT <input-class> &/$Nil)
- output-type (&/$DataT <output-class> &/$Nil)]
+ (let [input-type (&/$HostT <input-class> &/$Nil)
+ output-type (&/$HostT <output-class> &/$Nil)]
(defn <name> [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" <proc>]) (&/|list =x =y))))))))
+ (&&/$proc (&/T ["jvm" <proc>]) (&/|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 [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
- (let [elem-type (&/$DataT <elem-class> &/$Nil)
- array-type (&/$DataT <array-class> &/$Nil)]
+ (let [elem-type (&/$HostT <elem-class> &/$Nil)
+ array-type (&/$HostT <array-class> &/$Nil)]
(defn <new-name> [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" <new-tag>]) (&/|list =length)))))))
+ (&&/$proc (&/T ["jvm" <new-tag>]) (&/|list =length)))))))
(defn <load-name> [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" <load-tag>]) (&/|list =array =idx)))))))
+ (&&/$proc (&/T ["jvm" <load-tag>]) (&/|list =array =idx)))))))
(defn <store-name> [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" <store-tag>]) (&/|list =array =idx =elem)))))))
+ (&&/$proc (&/T ["jvm" <store-tag>]) (&/|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 [<name> <tag>]
(defn <name> [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" <tag>]) (&/|list =monitor)))))))
+ (&&/$proc (&/T ["jvm" <tag>]) (&/|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 [<name> <tag> <only-interface?>]
(defn <name> [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" <tag>]) (&/|list class method classes =object =args output-type)))))))
+ (&&/$proc (&/T ["jvm" <tag>]) (&/|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-class)))))
(defn as-obj [class]
@@ -227,16 +227,16 @@
(= null-data-tag a!name)
(if (not (primitive-type? e!name))
(return (&/T [fixpoints nil]))
- (check-error "" (&/$DataT e!name e!params) (&/$DataT a!name a!params)))
+ (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params)))
(= null-data-tag e!name)
(if (= null-data-tag a!name)
(return (&/T [fixpoints nil]))
- (check-error "" (&/$DataT e!name e!params) (&/$DataT a!name a!params)))
+ (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params)))
(and (= array-data-tag e!name)
(not= array-data-tag a!name))
- (check-error "" (&/$DataT e!name e!params) (&/$DataT a!name a!params))
+ (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params))
:else
(let [e!name (as-obj e!name)
@@ -249,7 +249,7 @@
(not invariant??)
(|do [actual* (->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)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 00:37:06 +0000