diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser/host.clj | 222 |
1 files changed, 141 insertions, 81 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 11d43ce9e..5033f4f2c 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -36,13 +36,32 @@ (return (&/T ?item =type))) ))))) +(defn ^:private ensure-object [token] + "(-> Analysis (Lux (,)))" + (matchv ::M/objects [token] + [[_ ["lux;DataT" _]]] + (return nil) + + [_] + (fail "[Analyser Error] Expecting object"))) + +(defn ^:private as-object [type] + "(-> Type Type)" + (matchv ::M/objects [type] + [["lux;DataT" class]] + (&/V "lux;DataT" (&type/as-obj class)) + + [_] + type)) + ;; [Resources] (do-template [<name> <output-tag> <input-class> <output-class>] (let [input-type (&/V "lux;DataT" <input-class>) output-type (&/V "lux;DataT" <output-class>)] - (defn <name> [analyse ?x ?y] + (defn <name> [analyse exo-type ?x ?y] (|do [=x (&&/analyse-1 analyse input-type ?x) - =y (&&/analyse-1 analyse input-type ?y)] + =y (&&/analyse-1 analyse input-type ?y) + _ (&type/check exo-type output-type)] (return (&/|list (&/T (&/V <output-tag> (&/T =x =y)) output-type)))))) analyse-jvm-iadd "jvm-iadd" "java.lang.Integer" "java.lang.Integer" @@ -86,94 +105,121 @@ analyse-jvm-dgt "jvm-dgt" "java.lang.Double" "java.lang.Boolean" ) -(defn analyse-jvm-getstatic [analyse ?class ?field] - (|do [=type (&host/lookup-static-field ?class ?field)] - (return (&/|list (&/T (&/V "jvm-getstatic" (&/T ?class ?field)) =type))))) - -(defn analyse-jvm-getfield [analyse ?class ?field ?object] - (|do [=type (&host/lookup-static-field ?class ?field) - =object (&&/analyse-1 analyse ?object)] - (return (&/|list (&/T (&/V "jvm-getfield" (&/T ?class ?field =object)) =type))))) - -(defn analyse-jvm-putstatic [analyse ?class ?field ?value] - (|do [=type (&host/lookup-static-field ?class ?field) - =value (&&/analyse-1 analyse =type ?value)] - (return (&/|list (&/T (&/V "jvm-putstatic" (&/T ?class ?field =value)) =type))))) +(defn analyse-jvm-getstatic [analyse exo-type ?class ?field] + (|do [class-loader &/loader + =type (&host/lookup-static-field class-loader ?class ?field) + :let [output-type =type] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-getstatic" (&/T ?class ?field)) output-type))))) -(defn analyse-jvm-putfield [analyse ?class ?field ?object ?value] - (|do [=type (&host/lookup-static-field ?class ?field) +(defn analyse-jvm-getfield [analyse exo-type ?class ?field ?object] + (|do [class-loader &/loader + =type (&host/lookup-static-field class-loader ?class ?field) =object (&&/analyse-1 analyse ?object) - =value (&&/analyse-1 analyse =type ?value)] - (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) =type))))) - -(defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] - (|do [=classes (&/map% extract-text ?classes) - =return (&host/lookup-static-method ?class ?method =classes) + :let [output-type =type] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-getfield" (&/T ?class ?field =object)) output-type))))) + +(defn analyse-jvm-putstatic [analyse exo-type ?class ?field ?value] + (|do [class-loader &/loader + =type (&host/lookup-static-field class-loader ?class ?field) + =value (&&/analyse-1 analyse =type ?value) + :let [output-type &type/Unit] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-putstatic" (&/T ?class ?field =value)) output-type))))) + +(defn analyse-jvm-putfield [analyse exo-type ?class ?field ?object ?value] + (|do [class-loader &/loader + =type (&host/lookup-static-field class-loader ?class ?field) + =object (&&/analyse-1 analyse ?object) + =value (&&/analyse-1 analyse =type ?value) + :let [output-type &type/Unit] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) output-type))))) + +(defn analyse-jvm-invokestatic [analyse exo-type ?class ?method ?classes ?args] + (|do [class-loader &/loader + =classes (&/map% extract-text ?classes) + =return (&host/lookup-static-method class-loader ?class ?method =classes) ;; :let [_ (matchv ::M/objects [=return] ;; [["lux;DataT" _return-class]] ;; (prn 'analyse-jvm-invokestatic ?class ?method _return-class))] =args (&/map2% (fn [_class _arg] (&&/analyse-1 analyse (&/V "lux;DataT" _class) _arg)) =classes - ?args)] - (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T ?class ?method =classes =args)) =return))))) + ?args) + :let [output-type =return] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T ?class ?method =classes =args)) output-type))))) -(defn analyse-jvm-instanceof [analyse ?class ?object] +(defn analyse-jvm-instanceof [analyse exo-type ?class ?object] (|do [=object (analyse-1+ analyse ?object) - :let [[_obj _type] =object]] - (matchv ::M/objects [_type] - [["lux;DataT" _]] - (return (&/|list (&/T (&/V "jvm-instanceof" (&/T ?class ?object)) (&/V "lux;DataT" "java.lang.Boolean")))) - - [_] - (fail "[Analyser Error] Can only use instanceof with object types.")))) + _ (ensure-object =object) + :let [output-type &type/Bool] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-instanceof" (&/T ?class =object)) output-type))))) (do-template [<name> <tag>] - (defn <name> [analyse ?class ?method ?classes ?object ?args] - (|do [=classes (&/map% extract-text ?classes) - =return (&host/lookup-virtual-method ?class ?method =classes) + (defn <name> [analyse exo-type ?class ?method ?classes ?object ?args] + (|do [class-loader &/loader + =classes (&/map% extract-text ?classes) + =return (&host/lookup-virtual-method class-loader ?class ?method =classes) =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) - =args (&/map2% (fn [?c ?o] - (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) - =classes ?args)] - (return (&/|list (&/T (&/V <tag> (&/T ?class ?method =classes =object =args)) =return))))) + =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) + =classes ?args) + :let [output-type =return] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V <tag> (&/T ?class ?method =classes =object =args)) output-type))))) analyse-jvm-invokevirtual "jvm-invokevirtual" analyse-jvm-invokeinterface "jvm-invokeinterface" ) -(defn analyse-jvm-invokespecial [analyse ?class ?method ?classes ?object ?args] - (|do [=classes (&/map% extract-text ?classes) +(defn analyse-jvm-invokespecial [analyse exo-type ?class ?method ?classes ?object ?args] + (|do [class-loader &/loader + =classes (&/map% extract-text ?classes) =return (if (= "<init>" ?method) - (return &type/$Void) - (&host/lookup-virtual-method ?class ?method =classes)) + (return &type/Unit) + (&host/lookup-virtual-method class-loader ?class ?method =classes)) =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) - =classes ?args)] - (return (&/|list (&/T (&/V "jvm-invokespecial" (&/T ?class ?method =classes =object =args)) =return))))) + =classes ?args) + :let [output-type =return] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-invokespecial" (&/T ?class ?method =classes =object =args)) output-type))))) + +(defn analyse-jvm-null? [analyse exo-type ?object] + (|do [=object (analyse-1+ analyse ?object) + _ (ensure-object =object) + :let [output-type &type/Bool] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-null?" =object) output-type))))) -(defn analyse-jvm-null? [analyse ?object] - (|do [=object (&&/analyse-1 analyse ?object)] - (return (&/|list (&/T (&/V "jvm-null?" =object) (&/V "lux;DataT" "java.lang.Boolean")))))) +(defn analyse-jvm-null [analyse exo-type] + (|do [:let [output-type (&/V "lux;DataT" "null")] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-null" nil) output-type))))) -(defn analyse-jvm-new [analyse ?class ?classes ?args] +(defn analyse-jvm-new [analyse exo-type ?class ?classes ?args] (|do [=classes (&/map% extract-text ?classes) - =args (&/flat-map% analyse ?args)] - (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) (&/V "lux;DataT" ?class)))))) + =args (&/map% (partial analyse-1+ analyse) ?args) + :let [output-type (&/V "lux;DataT" ?class)] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) output-type))))) (defn analyse-jvm-new-array [analyse ?class ?length] (return (&/|list (&/T (&/V "jvm-new-array" (&/T ?class ?length)) (&/V "array" (&/T (&/V "lux;DataT" ?class) (&/V "lux;Nil" nil))))))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] - (|do [=array (&&/analyse-1 analyse &type/$Void ?array) - =elem (&&/analyse-1 analyse &type/$Void ?elem) + (|do [=array (analyse-1+ analyse ?array) + =elem (analyse-1+ analyse ?elem) =array-type (&&/expr-type =array)] (return (&/|list (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type))))) (defn analyse-jvm-aaload [analyse ?array ?idx] - (|do [=array (&&/analyse-1 analyse ?array) + (|do [=array (analyse-1+ analyse ?array) =array-type (&&/expr-type =array)] (return (&/|list (&/T (&/V "jvm-aaload" (&/T =array ?idx)) =array-type))))) @@ -259,7 +305,7 @@ (return (&/T (&/ident->text ?input-name) ?input-type)) [_] - (fail "[Analyser Error] Wrong syntax for method."))) + (fail "[Analyser Error] Wrong syntax for method input."))) ?method-inputs) =method-modifiers (analyse-modifiers ?method-modifiers) =method-body (&/with-scope (str ?name "_" ?idx) @@ -302,37 +348,49 @@ :output ?output})) [_] - (fail "[Analyser Error] Invalid method signature!"))) + (fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method))))) ?methods)] (return (&/|list (&/V "jvm-interface" (&/T ?name =supers =methods)))))) -(defn analyse-jvm-try [analyse ?body [?catches ?finally]] - (|do [=body (&&/analyse-1 analyse ?body) +(defn analyse-jvm-try [analyse exo-type ?body ?catches+?finally] + (|do [:let [[?catches ?finally] ?catches+?finally] + =body (&&/analyse-1 analyse exo-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])))) + (|do [=catch-body (&&env/with-local (str ";" ?ex-arg) (&/V "lux;DataT" ?ex-class) + (&&/analyse-1 analyse exo-type ?catch-body)) + idx &&env/next-local-idx] + (return (&/T ?ex-class idx =catch-body)))) ?catches) - =finally (&&/analyse-1 analyse ?finally) - =body-type (&&/expr-type =body)] - (return (&/|list (&/T (&/V "jvm-try" (&/T =body =catches =finally)) =body-type))))) - -(defn analyse-jvm-throw [analyse ?ex] - (|do [=ex (&&/analyse-1 analyse ?ex)] + =finally (matchv ::M/objects [?finally] + [["lux;None" _]] (return (&/V "lux;None" nil)) + [["lux;Some" ?finally*]] (|do [=finally (analyse-1+ analyse ?finally*)] + (return (&/V "lux;Some" =finally))))] + (return (&/|list (&/T (&/V "jvm-try" (&/T =body =catches =finally)) exo-type))))) + +(defn analyse-jvm-throw [analyse exo-type ?ex] + (|do [=ex (analyse-1+ analyse ?ex) + :let [[_obj _type] =ex] + _ (&type/check (&/V "lux;DataT" "java.lang.Throwable") _type)] (return (&/|list (&/T (&/V "jvm-throw" =ex) &type/$Void))))) -(defn analyse-jvm-monitorenter [analyse ?monitor] - (|do [=monitor (&&/analyse-1 analyse ?monitor)] - (return (&/|list (&/T (&/V "jvm-monitorenter" =monitor) (&/V "lux;TupleT" (&/V "lux;Nil" nil))))))) - -(defn analyse-jvm-monitorexit [analyse ?monitor] - (|do [=monitor (&&/analyse-1 analyse ?monitor)] - (return (&/|list (&/T (&/V "jvm-monitorexit" =monitor) (&/V "lux;TupleT" (&/V "lux;Nil" nil))))))) +(do-template [<name> <tag>] + (defn <name> [analyse exo-type ?monitor] + (|do [=monitor (analyse-1+ analyse ?monitor) + _ (ensure-object =monitor) + :let [output-type &type/Unit] + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V <tag> =monitor) output-type))))) + + analyse-jvm-monitorenter "jvm-monitorenter" + analyse-jvm-monitorexit "jvm-monitorexit" + ) (do-template [<name> <tag> <from-class> <to-class>] - (defn <name> [analyse ?value] - (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value)] - (return (&/|list (&/T (&/V <tag> =value) (&/V "lux;DataT" <to-class>)))))) + (let [output-type (&/V "lux;DataT" <to-class>)] + (defn <name> [analyse exo-type ?value] + (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value) + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V <tag> =value) output-type)))))) analyse-jvm-d2f "jvm-d2f" "java.lang.Double" "java.lang.Float" analyse-jvm-d2i "jvm-d2i" "java.lang.Double" "java.lang.Integer" @@ -355,9 +413,11 @@ ) (do-template [<name> <tag> <from-class> <to-class>] - (defn <name> [analyse ?value] - (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value)] - (return (&/|list (&/T (&/V <tag> =value) (&/V "lux;DataT" <to-class>)))))) + (let [output-type (&/V "lux;DataT" <to-class>)] + (defn <name> [analyse exo-type ?value] + (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value) + _ (&type/check exo-type output-type)] + (return (&/|list (&/T (&/V <tag> =value) output-type)))))) analyse-jvm-iand "jvm-iand" "java.lang.Integer" "java.lang.Integer" analyse-jvm-ior "jvm-ior" "java.lang.Integer" "java.lang.Integer" |