aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/analyser/procedure/host.jvm.lux222
-rw-r--r--new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux353
-rw-r--r--new-luxc/test/tests.lux3
3 files changed, 473 insertions, 105 deletions
diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
index c8dc5a38a..c75d6efd4 100644
--- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
@@ -11,6 +11,7 @@
[array #+ Array]
["d" dict]))
[macro #+ Monad<Lux>]
+ [type]
(type ["TC" check])
[host])
(luxc ["&" base]
@@ -20,26 +21,32 @@
["@" ../common]
)
-(def: Boolean Type (host java.lang.Boolean))
-(def: Byte Type (host java.lang.Byte))
-(def: Short Type (host java.lang.Short))
-(def: Integer Type (host java.lang.Integer))
-(def: Long Type (host java.lang.Long))
-(def: Float Type (host java.lang.Float))
-(def: Double Type (host java.lang.Double))
-(def: Character Type (host java.lang.Character))
-(def: String Type (host java.lang.String))
-
-(def: boolean Type (host boolean))
-(def: byte Type (host byte))
-(def: short Type (host short))
-(def: int Type (host int))
-(def: long Type (host long))
-(def: float Type (host float))
-(def: double Type (host double))
-(def: char Type (host char))
-
-(def: converter-procs
+(do-template [<name> <class>]
+ [(def: #export <name> Type (#;Host <class> (list)))]
+
+ ## Boxes
+ [Boolean "java.lang.Boolean"]
+ [Byte "java.lang.Byte"]
+ [Short "java.lang.Short"]
+ [Integer "java.lang.Integer"]
+ [Long "java.lang.Long"]
+ [Float "java.lang.Float"]
+ [Double "java.lang.Double"]
+ [Character "java.lang.Character"]
+ [String "java.lang.String"]
+
+ ## Primitives
+ [boolean "boolean"]
+ [byte "byte"]
+ [short "short"]
+ [int "int"]
+ [long "long"]
+ [float "float"]
+ [double "double"]
+ [char "char"]
+ )
+
+(def: conversion-procs
@;Bundle
(<| (@;prefix "convert")
(|> (d;new text;Hash<Text>)
@@ -73,14 +80,14 @@
@;Bundle
(<| (@;prefix <prefix>)
(|> (d;new text;Hash<Text>)
- (@;install "add" (@;binary <type> <type> <type>))
- (@;install "sub" (@;binary <type> <type> <type>))
- (@;install "mul" (@;binary <type> <type> <type>))
- (@;install "div" (@;binary <type> <type> <type>))
- (@;install "rem" (@;binary <type> <type> <type>))
- (@;install "eq" (@;binary <type> <type> Boolean))
- (@;install "lt" (@;binary <type> <type> Boolean))
- (@;install "gt" (@;binary <type> <type> Boolean))
+ (@;install "+" (@;binary <type> <type> <type>))
+ (@;install "-" (@;binary <type> <type> <type>))
+ (@;install "*" (@;binary <type> <type> <type>))
+ (@;install "/" (@;binary <type> <type> <type>))
+ (@;install "%" (@;binary <type> <type> <type>))
+ (@;install "=" (@;binary <type> <type> Boolean))
+ (@;install "<" (@;binary <type> <type> Boolean))
+ (@;install ">" (@;binary <type> <type> Boolean))
(@;install "and" (@;binary <type> <type> <type>))
(@;install "or" (@;binary <type> <type> <type>))
(@;install "xor" (@;binary <type> <type> <type>))
@@ -98,14 +105,14 @@
@;Bundle
(<| (@;prefix <prefix>)
(|> (d;new text;Hash<Text>)
- (@;install "add" (@;binary <type> <type> <type>))
- (@;install "sub" (@;binary <type> <type> <type>))
- (@;install "mul" (@;binary <type> <type> <type>))
- (@;install "div" (@;binary <type> <type> <type>))
- (@;install "rem" (@;binary <type> <type> <type>))
- (@;install "eq" (@;binary <type> <type> Boolean))
- (@;install "lt" (@;binary <type> <type> Boolean))
- (@;install "gt" (@;binary <type> <type> Boolean))
+ (@;install "+" (@;binary <type> <type> <type>))
+ (@;install "-" (@;binary <type> <type> <type>))
+ (@;install "*" (@;binary <type> <type> <type>))
+ (@;install "/" (@;binary <type> <type> <type>))
+ (@;install "%" (@;binary <type> <type> <type>))
+ (@;install "=" (@;binary <type> <type> Boolean))
+ (@;install "<" (@;binary <type> <type> Boolean))
+ (@;install ">" (@;binary <type> <type> Boolean))
)))]
[float-procs "float" Float]
@@ -116,12 +123,12 @@
@;Bundle
(<| (@;prefix "char")
(|> (d;new text;Hash<Text>)
- (@;install "ceq" (@;binary Character Character Boolean))
- (@;install "clt" (@;binary Character Character Boolean))
- (@;install "cgt" (@;binary Character Character Boolean))
+ (@;install "=" (@;binary Character Character Boolean))
+ (@;install "<" (@;binary Character Character Boolean))
+ (@;install ">" (@;binary Character Character Boolean))
)))
-(def: primitive-boxes
+(def: #export boxes
(d;Dict Text Text)
(|> (list ["boolean" "java.lang.Boolean"]
["byte" "java.lang.Byte"]
@@ -133,21 +140,6 @@
["char" "java.lang.Character"])
(d;from-list text;Hash<Text>)))
-(def: array-type
- (l;Lexer [Type Nat Text])
- (do p;Monad<Parser>
- [subs (p;some (l;this "["))
- #let [level (list;size subs)]
- class (l;many l;any)]
- (wrap [(list/fold (function [_ inner]
- (type (Array inner)))
- (#;Host (|> (d;get class primitive-boxes)
- (default class))
- (list))
- (list;n.range +1 level))
- level
- class])))
-
(def: (array-length proc)
(-> Text @;Proc)
(function [analyse args]
@@ -166,34 +158,77 @@
_
(&;fail (@;wrong-amount-error proc +1 (list;size args))))))))
+(def: (invalid-array-type arrayT)
+ (-> Type Text)
+ (format "Invalid type for array: " (%type arrayT)))
+
(def: (array-new proc)
(-> Text @;Proc)
(function [analyse args]
(case args
- (^ (list classC lengthC))
- (case classC
- [_ (#;Text classC)]
- (do Monad<Lux>
- [lengthA (&;with-expected-type Nat
- (analyse lengthC))
- arrayT (case (l;run classC array-type)
- (#R;Success [innerT level elem-class])
- (wrap (type (Array innerT)))
-
- (#R;Error error)
- (&;fail error))
- expectedT macro;expected-type
- _ (&;within-type-env
- (TC;check expectedT arrayT))]
- (wrap (#la;Procedure proc (list (#la;Text classC) lengthA))))
-
- _
- (&;fail (format "Wrong syntax for '" proc "'.")))
+ (^ (list lengthC))
+ (do Monad<Lux>
+ [lengthA (&;with-expected-type Nat
+ (analyse lengthC))
+ expectedT macro;expected-type
+ [level elem-class] (: (Lux [Nat Text])
+ (loop [analysisT expectedT
+ level +0]
+ (case analysisT
+ (#;Apply inputT funcT)
+ (case (type;apply (list inputT) funcT)
+ (#;Some outputT)
+ (recur outputT level)
+
+ #;None
+ (&;fail (invalid-array-type expectedT)))
+
+ (^ (#;Host "#Array" (list elemT)))
+ (recur elemT (n.inc level))
+
+ (#;Host class _)
+ (wrap [level class])
+
+ _
+ (&;fail (invalid-array-type expectedT)))))
+ _ (&;assert "Must have at least 1 level of nesting in array type."
+ (n.> +0 level))]
+ (wrap (#la;Procedure proc (list (#la;Nat level) (#la;Text elem-class) lengthA))))
_
- (&;fail (@;wrong-amount-error proc +2 (list;size args))))))
+ (&;fail (@;wrong-amount-error proc +1 (list;size args))))))
+
+(def: (check-object objectT)
+ (-> Type (Lux Text))
+ (case objectT
+ (#;Host name _)
+ (if (d;contains? name boxes)
+ (&;fail (format "Primitives are not objects: " name))
+ (:: Monad<Lux> wrap name))
-(def: (array-load proc)
+ _
+ (&;fail (format "Non-object type: " (%type objectT)))))
+
+(def: (box-array-element-type elemT)
+ (-> Type (Lux [Type Text]))
+ (do Monad<Lux>
+ []
+ (case elemT
+ (#;Host name #;Nil)
+ (let [boxed-name (|> (d;get name boxes)
+ (default name))]
+ (wrap [(#;Host boxed-name #;Nil)
+ boxed-name]))
+
+ (#;Host name _)
+ (if (d;contains? name boxes)
+ (&;fail (format "Primitives cannot be parameterized: " name))
+ (:: Monad<Lux> wrap [elemT name]))
+
+ _
+ (&;fail (format "Invalid type for array element: " (%type elemT))))))
+
+(def: (array-read proc)
(-> Text @;Proc)
(function [analyse args]
(&common;with-var
@@ -205,12 +240,7 @@
(analyse arrayC))
elemT (&;within-type-env
(TC;read-var var-id))
- elem-class (case elemT
- (#;Host name _)
- (wrap name)
-
- _
- (&;fail (format "Invalid type for array element: " (%type elemT))))
+ [elemT elem-class] (box-array-element-type elemT)
idxA (&;with-expected-type Nat
(analyse idxC))
expectedT macro;expected-type
@@ -221,7 +251,7 @@
_
(&;fail (@;wrong-amount-error proc +2 (list;size args))))))))
-(def: (array-store proc)
+(def: (array-write proc)
(-> Text @;Proc)
(function [analyse args]
(&common;with-var
@@ -233,15 +263,10 @@
(analyse arrayC))
elemT (&;within-type-env
(TC;read-var var-id))
- elem-class (case elemT
- (#;Host name _)
- (wrap name)
-
- _
- (&;fail (format "Invalid type for array element: " (%type elemT))))
+ [valueT elem-class] (box-array-element-type elemT)
idxA (&;with-expected-type Nat
(analyse idxC))
- valueA (&;with-expected-type elemT
+ valueA (&;with-expected-type valueT
(analyse valueC))
expectedT macro;expected-type
_ (&;within-type-env
@@ -257,21 +282,10 @@
(|> (d;new text;Hash<Text>)
(@;install "length" array-length)
(@;install "new" array-new)
- (@;install "load" array-load)
- (@;install "store" array-store)
+ (@;install "read" array-read)
+ (@;install "write" array-write)
)))
-(def: (check-object objectT)
- (-> Type (Lux Text))
- (case objectT
- (#;Host name _)
- (if (d;contains? name primitive-boxes)
- (&;fail (format "Primitives are not objects: " name))
- (:: Monad<Lux> wrap name))
-
- _
- (&;fail (format "Non-object type: " (%type objectT)))))
-
(def: (object-null proc)
(-> Text @;Proc)
(function [analyse args]
@@ -414,7 +428,7 @@
@;Bundle
(<| (@;prefix "jvm")
(|> (d;new text;Hash<Text>)
- (d;merge converter-procs)
+ (d;merge conversion-procs)
(d;merge int-procs)
(d;merge long-procs)
(d;merge float-procs)
diff --git a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux
new file mode 100644
index 000000000..eec4ec723
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux
@@ -0,0 +1,353 @@
+(;module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (concurrency [atom])
+ (data text/format
+ [text "text/" Eq<Text>]
+ ["R" result]
+ [product]
+ (coll [array]
+ [list "list/" Fold<List>]
+ [dict]))
+ ["r" math/random "r/" Monad<Random>]
+ [type]
+ [macro #+ Monad<Lux>]
+ (macro [code])
+ test)
+ (luxc ["&" base]
+ ["&;" scope]
+ ["&;" module]
+ (lang ["~" analysis])
+ [analyser]
+ (analyser ["@" procedure]
+ ["@;" common]
+ (procedure ["@;" host]))
+ (generator ["@;" runtime]))
+ (../.. common)
+ (test/luxc common))
+
+(do-template [<name> <success> <failure>]
+ [(def: (<name> procedure params output-type)
+ (-> Text (List Code) Type Bool)
+ (|> (do Monad<Lux>
+ [runtime-bytecode @runtime;generate]
+ (&;with-scope
+ (&;with-expected-type output-type
+ (@;analyse-procedure analyse procedure params))))
+ (macro;run (init-compiler []))
+ (case> (#R;Success _)
+ <success>
+
+ (#R;Error error)
+ <failure>)))]
+
+ [success true false]
+ [failure false true]
+ )
+
+(context: "Conversions [double + float]."
+ (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+ [(test (format <procedure> " SUCCESS")
+ (success <procedure> (list (' (_lux_coerce (+0 <from> (+0)) []))) <to>))
+ (test (format <procedure> " FAILURE")
+ (failure <procedure> (list (' [])) <to>))]
+
+ ["jvm convert double-to-float" "java.lang.Double" @host;Float]
+ ["jvm convert double-to-int" "java.lang.Double" @host;Integer]
+ ["jvm convert double-to-long" "java.lang.Double" @host;Long]
+ ["jvm convert float-to-double" "java.lang.Float" @host;Double]
+ ["jvm convert float-to-int" "java.lang.Float" @host;Integer]
+ ["jvm convert float-to-long" "java.lang.Float" @host;Long]
+ )]
+ ($_ seq
+ <conversions>
+ )))
+
+(context: "Conversions [int]."
+ (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+ [(test (format <procedure> " SUCCESS")
+ (success <procedure> (list (' (_lux_coerce (+0 <from> (+0)) []))) <to>))
+ (test (format <procedure> " FAILURE")
+ (failure <procedure> (list (' [])) <to>))]
+
+ ["jvm convert int-to-byte" "java.lang.Integer" @host;Byte]
+ ["jvm convert int-to-char" "java.lang.Integer" @host;Character]
+ ["jvm convert int-to-double" "java.lang.Integer" @host;Double]
+ ["jvm convert int-to-float" "java.lang.Integer" @host;Float]
+ ["jvm convert int-to-long" "java.lang.Integer" @host;Long]
+ ["jvm convert int-to-short" "java.lang.Integer" @host;Short]
+ )]
+ ($_ seq
+ <conversions>
+ )))
+
+(context: "Conversions [long]."
+ (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+ [(test (format <procedure> " SUCCESS")
+ (success <procedure> (list (' (_lux_coerce (+0 <from> (+0)) []))) <to>))
+ (test (format <procedure> " FAILURE")
+ (failure <procedure> (list (' [])) <to>))]
+
+ ["jvm convert long-to-double" "java.lang.Long" @host;Double]
+ ["jvm convert long-to-float" "java.lang.Long" @host;Float]
+ ["jvm convert long-to-int" "java.lang.Long" @host;Integer]
+ ["jvm convert long-to-short" "java.lang.Long" @host;Short]
+ ["jvm convert long-to-byte" "java.lang.Long" @host;Byte]
+ )]
+ ($_ seq
+ <conversions>
+ )))
+
+(context: "Conversions [char + byte + short]."
+ (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+ [(test (format <procedure> " SUCCESS")
+ (success <procedure> (list (' (_lux_coerce (+0 <from> (+0)) []))) <to>))
+ (test (format <procedure> " FAILURE")
+ (failure <procedure> (list (' [])) <to>))]
+
+ ["jvm convert char-to-byte" "java.lang.Character" @host;Byte]
+ ["jvm convert char-to-short" "java.lang.Character" @host;Short]
+ ["jvm convert char-to-int" "java.lang.Character" @host;Integer]
+ ["jvm convert char-to-long" "java.lang.Character" @host;Long]
+ ["jvm convert byte-to-long" "java.lang.Byte" @host;Long]
+ ["jvm convert short-to-long" "java.lang.Short" @host;Long]
+ )]
+ ($_ seq
+ <conversions>
+ )))
+
+(do-template [<domain> <boxed> <type>]
+ [(context: (format "Arithmetic " "[" <domain> "].")
+ (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' (_lux_coerce (+0 <subject> (+0)) []))
+ (' (_lux_coerce (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
+ )]
+ ($_ seq
+ <instructions>
+ )))
+
+ (context: (format "Order " "[" <domain> "].")
+ (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' (_lux_coerce (+0 <subject> (+0)) []))
+ (' (_lux_coerce (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean]
+ [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean]
+ [(format "jvm " <domain> " >") <boxed> <boxed> @host;Boolean]
+ )]
+ ($_ seq
+ <instructions>
+ )))
+
+ (context: (format "Bitwise " "[" <domain> "].")
+ (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' (_lux_coerce (+0 <subject> (+0)) []))
+ (' (_lux_coerce (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " and") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " or") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " xor") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " shl") <boxed> "java.lang.Integer" <type>]
+ [(format "jvm " <domain> " shr") <boxed> "java.lang.Integer" <type>]
+ [(format "jvm " <domain> " ushr") <boxed> "java.lang.Integer" <type>]
+ )]
+ ($_ seq
+ <instructions>
+ )))]
+
+
+ ["int" "java.lang.Integer" @host;Integer]
+ ["long" "java.lang.Long" @host;Long]
+ )
+
+(do-template [<domain> <boxed> <type>]
+ [(context: (format "Arithmetic " "[" <domain> "].")
+ (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' (_lux_coerce (+0 <subject> (+0)) []))
+ (' (_lux_coerce (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
+ [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
+ )]
+ ($_ seq
+ <instructions>
+ )))
+
+ (context: (format "Order " "[" <domain> "].")
+ (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' (_lux_coerce (+0 <subject> (+0)) []))
+ (' (_lux_coerce (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean]
+ [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean]
+ [(format "jvm " <domain> " >") <boxed> <boxed> @host;Boolean]
+ )]
+ ($_ seq
+ <instructions>
+ )))]
+
+
+ ["float" "java.lang.Float" @host;Float]
+ ["double" "java.lang.Double" @host;Double]
+ )
+
+(do-template [<domain> <boxed> <type>]
+ [(context: (format "Order " "[" <domain> "].")
+ (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+ [(test <procedure>
+ (success <procedure>
+ (list (' (_lux_coerce (+0 <subject> (+0)) []))
+ (' (_lux_coerce (+0 <param> (+0)) [])))
+ <output>))]
+
+ [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean]
+ [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean]
+ [(format "jvm " <domain> " >") <boxed> <boxed> @host;Boolean]
+ )]
+ ($_ seq
+ <instructions>
+ )))]
+
+
+ ["char" "java.lang.Character" @host;Character]
+ )
+
+(def: array-type
+ (r;Random [Text Text])
+ (let [entries (dict;entries @host;boxes)
+ num-entries (list;size entries)]
+ (do r;Monad<Random>
+ [choice (|> r;nat (:: @ map (n.% (n.inc num-entries))))
+ #let [[unboxed boxed] (: [Text Text]
+ (|> entries
+ (list;nth choice)
+ (default ["java.lang.Object" "java.lang.Object"])))]]
+ (wrap [unboxed boxed]))))
+
+(context: "Array."
+ [#let [cap (|>. (n.% +10) (n.max +1))]
+ [unboxed boxed] array-type
+ size (|> r;nat (:: @ map cap))
+ idx (|> r;nat (:: @ map (n.% size)))
+ level (|> r;nat (:: @ map cap))
+ #let [unboxedT (#;Host unboxed (list))
+ arrayT (#;Host "#Array" (list unboxedT))
+ arrayC (`' (_lux_check (+0 "#Array" (+1 (+0 (~ (code;text unboxed)) (+0)) (+0)))
+ ("jvm array new" (~ (code;nat size)))))
+ boxedT (#;Host boxed (list))
+ boxedTC (` (+0 (~ (code;text boxed)) (+0)))
+ multi-arrayT (list/fold (function [_ innerT]
+ (|> innerT (list) (#;Host "#Array")))
+ boxedT
+ (list;n.range +1 level))]]
+ ($_ seq
+ (test "jvm array new"
+ (success "jvm array new"
+ (list (code;nat size))
+ arrayT))
+ (test "jvm array new (no nesting)"
+ (failure "jvm array new"
+ (list (code;nat size))
+ unboxedT))
+ (test "jvm array new (nested/multi-level)"
+ (success "jvm array new"
+ (list (code;nat size))
+ multi-arrayT))
+ (test "jvm array length"
+ (success "jvm array length"
+ (list arrayC)
+ Nat))
+ (test "jvm array read"
+ (success "jvm array read"
+ (list arrayC (code;nat idx))
+ boxedT))
+ (test "jvm array write"
+ (success "jvm array write"
+ (list arrayC (code;nat idx) (`' (_lux_coerce (~ boxedTC) [])))
+ arrayT))
+ ))
+
+(def: throwables
+ (List Text)
+ (list "java.lang.Throwable"
+ "java.lang.Error"
+ "java.io.IOError"
+ "java.lang.VirtualMachineError"
+ "java.lang.Exception"
+ "java.io.IOException"
+ "java.lang.RuntimeException"))
+
+(context: "Object."
+ [[unboxed boxed] array-type
+ #let [boxedT (#;Host boxed (list))
+ boxedC (`' (_lux_check (+0 (~ (code;text boxed)) (+0))
+ ("jvm object null")))
+ unboxedC (`' (_lux_check (+0 (~ (code;text unboxed)) (+0))
+ ("jvm object null")))]
+ throwable (|> r;nat
+ (:: @ map (n.% (n.inc (list;size throwables))))
+ (:: @ map (function [idx]
+ (|> throwables
+ (list;nth idx)
+ (default "java.lang.Object")))))
+ #let [throwableC (`' (_lux_check (+0 (~ (code;text throwable)) (+0))
+ ("jvm object null")))]]
+ ($_ seq
+ (test "jvm object null"
+ (success "jvm object null"
+ (list)
+ (#;Host boxed (list))))
+ (test "jvm object null (no primitives)"
+ (or (text/= "java.lang.Object" boxed)
+ (failure "jvm object null"
+ (list)
+ (#;Host unboxed (list)))))
+ (test "jvm object null?"
+ (success "jvm object null?"
+ (list boxedC)
+ Bool))
+ (test "jvm object synchronized"
+ (success "jvm object synchronized"
+ (list boxedC boxedC)
+ boxedT))
+ (test "jvm object synchronized (no primitives)"
+ (or (text/= "java.lang.Object" boxed)
+ (failure "jvm object synchronized"
+ (list unboxedC boxedC)
+ boxedT)))
+ (test "jvm object throw"
+ (or (text/= "java.lang.Object" throwable)
+ (success "jvm object throw"
+ (list throwableC)
+ Bottom)))
+ (test "jvm object class"
+ (success "jvm object class"
+ (list (code;text boxed))
+ (#;Host "java.lang.Class" (list boxedT))))
+ ))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 28ccefc42..311b6666f 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -12,7 +12,8 @@
["_;A" case]
["_;A" function]
["_;A" type]
- (procedure ["_;A" common]))
+ (procedure ["_;A" common]
+ ["_;A" host]))
(synthesizer ["_;S" primitive]
["_;S" structure]
(case ["_;S" special])