aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/procedure
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/generator/procedure')
-rw-r--r--new-luxc/source/luxc/generator/procedure/host.jvm.lux72
1 files changed, 72 insertions, 0 deletions
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)
)))