From 88949be34c4e0fcab3902537cad01e060d7ce2c8 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 14 Oct 2017 15:14:02 -0400
Subject: - Compilation for object-based procedures.

---
 .../source/luxc/generator/procedure/host.jvm.lux   | 72 ++++++++++++++++++++++
 1 file changed, 72 insertions(+)

(limited to 'new-luxc/source/luxc/generator/procedure/host.jvm.lux')

diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
index 128e8b517..a6e14659d 100644
--- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
@@ -357,6 +357,77 @@
           (@;install "write" array//write)
           )))
 
+(def: (object//null _)
+  @;Nullary
+  $i;NULL)
+
+(def: (object//null? objectI)
+  @;Unary
+  (<| $i;with-label (function [@then])
+      $i;with-label (function [@end])
+      (|>. objectI
+           ($i;IFNULL @then)
+           ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
+           ($i;GOTO @end)
+           ($i;label @then)
+           ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
+           ($i;label @end))))
+
+(def: (object//synchronized [monitorI exprI])
+  @;Binary
+  (|>. monitorI
+       $i;DUP
+       $i;MONITORENTER
+       exprI
+       $i;SWAP
+       $i;MONITOREXIT))
+
+(def: (object//throw exceptionI)
+  @;Unary
+  (|>. exceptionI
+       $i;ATHROW))
+
+(def: (object//class proc generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list (#ls;Text class)))
+    (do macro;Monad<Lux>
+      []
+      (wrap (|>. ($i;string class)
+                 ($i;INVOKESTATIC "java.lang.Class" "forName"
+                                  ($t;method (list ($t;class "java.lang.String" (list)))
+                                             (#;Some ($t;class "java.lang.Class" (list)))
+                                             (list))
+                                  false))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: (object//instance? proc generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list (#ls;Text class) objectS))
+    (do macro;Monad<Lux>
+      [objectI (generate objectS)]
+      (wrap (|>. objectI
+                 ($i;INSTANCEOF class)
+                 ($i;wrap #$;Boolean))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: object-procs
+  @;Bundle
+  (<| (@;prefix "object")
+      (|> (dict;new text;Hash<Text>)
+          (@;install "null" (@;nullary object//null))
+          (@;install "null?" (@;unary object//null?))
+          (@;install "synchronized" (@;binary object//synchronized))
+          (@;install "throw" (@;unary object//throw))
+          (@;install "class" object//class)
+          (@;install "instance?" object//instance?)
+          )))
+
 (def: #export procedures
   @;Bundle
   (<| (@;prefix "jvm")
@@ -368,4 +439,5 @@
           (dict;merge double-procs)
           (dict;merge char-procs)
           (dict;merge array-procs)
+          (dict;merge object-procs)
           )))
-- 
cgit v1.2.3