- Removed _jvm_instanceof from the list of special forms.

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))