aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2016-05-03 01:30:27 -0400
committerEduardo Julian2016-05-03 01:30:27 -0400
commita67cdf04aadb9876a995aab4331001e2f4e19e6c (patch)
tree8367ab4514a339bfd37f19cab1b5b86279f101da
parent4d14d395d4861ee6a82d4ef9ee54e946cf3c46bc (diff)
- Removed _jvm_instanceof from the list of special forms.
-rw-r--r--src/lux/analyser.clj107
-rw-r--r--src/lux/analyser/base.clj1
-rw-r--r--src/lux/analyser/host.clj21
-rw-r--r--src/lux/compiler.clj4
-rw-r--r--src/lux/compiler/host.clj20
-rw-r--r--src/lux/optimizer.clj4
6 files changed, 67 insertions, 90 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 7e71ad922..0cae05eac 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -54,7 +54,7 @@
(fn [state]
(fail* (add-loc (&/get$ &/$cursor state) msg))))
-(defn ^:private aba4 [analyse eval! compile-module compile-statement exo-type token]
+(defn ^:private aba2 [analyse eval! compile-module compile-statement exo-type token]
(|case token
;; Classes & interfaces
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_class")]
@@ -104,24 +104,50 @@
(&/$Cons ?body
(&/$Nil)))))
(&&host/analyse-jvm-program analyse compile-statement ?args ?body)
-
+
_
(fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token])))))))
-(defn ^:private aba3 [analyse eval! compile-module compile-statement exo-type token]
+(defn ^:private aba1 [analyse eval! compile-module compile-statement exo-type token]
(|case token
- ;; Objects
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_instanceof")]
- (&/$Cons [_ (&/$TextS ?class)]
- (&/$Cons ?object
- (&/$Nil)))))
- (&&host/analyse-jvm-instanceof analyse exo-type ?class ?object)
-
- _
- (aba4 analyse eval! compile-module compile-statement exo-type token)))
+ ;; Standard special forms
+ (&/$BoolS ?value)
+ (|do [_ (&type/check exo-type &type/Bool)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$bool ?value)))))
+
+ (&/$IntS ?value)
+ (|do [_ (&type/check exo-type &type/Int)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$int ?value)))))
+
+ (&/$RealS ?value)
+ (|do [_ (&type/check exo-type &type/Real)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$real ?value)))))
+
+ (&/$CharS ?value)
+ (|do [_ (&type/check exo-type &type/Char)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$char ?value)))))
+
+ (&/$TextS ?value)
+ (|do [_ (&type/check exo-type &type/Text)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$text ?value)))))
+
+ (&/$TupleS ?elems)
+ (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems)
+
+ (&/$RecordS ?elems)
+ (&&lux/analyse-record analyse exo-type ?elems)
+
+ (&/$TagS ?ident)
+ (analyse-variant+ analyse exo-type ?ident &/$Nil)
+
+ (&/$SymbolS ?ident)
+ (&&lux/analyse-symbol analyse exo-type ?ident)
-(defn ^:private aba2 [analyse eval! compile-module compile-statement exo-type token]
- (|case token
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_case")]
(&/$Cons ?value ?branches)))
(&&lux/analyse-case analyse exo-type ?value ?branches)
@@ -173,49 +199,6 @@
(&&host/analyse-host analyse exo-type ?category ?proc ?args)
_
- (aba3 analyse eval! compile-module compile-statement exo-type token)))
-
-(defn ^:private aba1 [analyse eval! compile-module compile-statement exo-type token]
- (|case token
- ;; Standard special forms
- (&/$BoolS ?value)
- (|do [_ (&type/check exo-type &type/Bool)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&&/$bool ?value)))))
-
- (&/$IntS ?value)
- (|do [_ (&type/check exo-type &type/Int)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&&/$int ?value)))))
-
- (&/$RealS ?value)
- (|do [_ (&type/check exo-type &type/Real)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&&/$real ?value)))))
-
- (&/$CharS ?value)
- (|do [_ (&type/check exo-type &type/Char)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&&/$char ?value)))))
-
- (&/$TextS ?value)
- (|do [_ (&type/check exo-type &type/Text)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&&/$text ?value)))))
-
- (&/$TupleS ?elems)
- (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems)
-
- (&/$RecordS ?elems)
- (&&lux/analyse-record analyse exo-type ?elems)
-
- (&/$TagS ?ident)
- (analyse-variant+ analyse exo-type ?ident &/$Nil)
-
- (&/$SymbolS ?ident)
- (&&lux/analyse-symbol analyse exo-type ?ident)
-
- _
(aba2 analyse eval! compile-module compile-statement exo-type token)
))
@@ -227,13 +210,11 @@
(&/$Right state* output)
(return* state* output)
- (&/$Left "")
- (fail* (add-loc (&/get$ &/$cursor state) (str "[Analyser Error] Unrecognized token: " (&/show-ast token))))
-
(&/$Left msg)
- (fail* (add-loc (&/get$ &/$cursor state) msg))
- ))
- ))
+ (if (= "" msg)
+ (fail* (add-loc (&/get$ &/$cursor state) (str "[Analyser Error] Unrecognized token: " (&/show-ast token))))
+ (fail* (add-loc (&/get$ &/$cursor state) msg)))
+ ))))
(defn ^:private just-analyse [analyser syntax]
(&type/with-var
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 651fb4cea..9faa36939 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -27,7 +27,6 @@
("captured" 1)
("host" 2)
- ("jvm-instanceof" 1)
("jvm-class" 1)
("jvm-interface" 1)
("jvm-program" 1)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index f80ae1266..8b691ea67 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -162,15 +162,6 @@
_
(fail (str "[Type Error] Type is not an object type: " (&type/show-type obj-type)))))
-(defn analyse-jvm-instanceof [analyse exo-type class object]
- (|do [=object (&&/analyse-1+ analyse object)
- _ (ensure-object (&&/expr-type* =object))
- :let [output-type &type/Bool]
- _ (&type/check exo-type output-type)
- _cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor
- (&&/$jvm-instanceof (&/T [class =object])))))))
-
(defn generic-class->simple-class [gclass]
"(-> GenericClass Text)"
(|case gclass
@@ -917,6 +908,16 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$host (&/T ["jvm" "try"]) (&/|list =body =catch)))))))
+(defn ^:private analyse-jvm-instanceof [analyse exo-type class ?values]
+ (|do [:let [(&/$Cons object (&/$Nil)) ?values]
+ =object (&&/analyse-1+ analyse object)
+ _ (ensure-object (&&/expr-type* =object))
+ :let [output-type &type/Bool]
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&&/$host (&/T ["jvm" "instanceof"]) (&/|list class =object)))))))
+
(defn analyse-host [analyse exo-type category proc ?values]
(case category
"jvm"
@@ -1007,6 +1008,8 @@
"c2l" (analyse-jvm-c2l analyse exo-type ?values)
;; else
(->> (fail (str "[Analyser Error] Unknown host procedure: " [category proc]))
+ (if-let [[_ _class] (re-find #"^instanceof:([^:]+)$" proc)]
+ (analyse-jvm-instanceof analyse exo-type _class ?values))
(if-let [[_ _class _arg-classes] (re-find #"^new:([^:]+):([^:]*)$" proc)]
(analyse-jvm-new analyse exo-type _class (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
(if-let [[_ _class _method _arg-classes] (re-find #"^invokestatic:([^:]+):([^:]+):([^:]*)$" proc)]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 4ee8c0bf3..5d7b03b51 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -94,10 +94,6 @@
(&o/$host [?proc-category ?proc-name] ?args)
(&&host/compile-host compile-expression ?proc-category ?proc-name ?args)
- ;; JVM
- (&o/$jvm-instanceof ?class ?object)
- (&&host/compile-jvm-instanceof compile-expression ?class ?object)
-
_
(assert false (prn-str 'compile-expression (&/adt->text syntax)))
))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 9b120c831..70218055b 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -94,15 +94,6 @@
*writer*))
;; [Resources]
-(defn compile-jvm-instanceof [compile class object]
- (|do [:let [class* (&host-generics/->bytecode-class-name class)]
- ^MethodVisitor *writer* &/get-writer
- _ (compile object)
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/INSTANCEOF class*)
- (&&/wrap-boolean))]]
- (return nil)))
-
(defn ^:private compile-annotation [writer ann]
(doto ^AnnotationVisitor (.visitAnnotation writer (&host-generics/->type-signature (:name ann)) true)
(-> (.visit param-name param-value)
@@ -1191,10 +1182,21 @@
:let [_ (.visitLabel *writer* $end)]]
(return nil)))
+(defn ^:private compile-jvm-instanceof [compile ?values]
+ (|do [:let [(&/$Cons class (&/$Cons object (&/$Nil))) ?values]
+ :let [class* (&host-generics/->bytecode-class-name class)]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile object)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/INSTANCEOF class*)
+ (&&/wrap-boolean))]]
+ (return nil)))
+
(defn compile-host [compile proc-category proc-name ?values]
(case proc-category
"jvm"
(case proc-name
+ "instanceof" (compile-jvm-instanceof compile ?values)
"try" (compile-jvm-try compile ?values)
"new" (compile-jvm-new compile ?values)
"invokestatic" (compile-jvm-invokestatic compile ?values)
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index c0aad5203..6fc551cae 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -26,7 +26,6 @@
("captured" 1)
("host" 2)
- ("jvm-instanceof" 1)
("jvm-class" 1)
("jvm-interface" 1)
("jvm-program" 1)
@@ -81,9 +80,6 @@
(&-base/$host ?proc-ident ?args)
(return ($host ?proc-ident ?args))
- (&-base/$jvm-instanceof value)
- (return ($jvm-instanceof value))
-
(&-base/$jvm-class value)
(return ($jvm-class value))