diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/test/test/lux/lang/analysis/procedure/common.lux (renamed from new-luxc/test/test/luxc/lang/analysis/procedure/common.lux) | 134 | ||||
-rw-r--r-- | stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux (renamed from new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux) | 119 |
2 files changed, 120 insertions, 133 deletions
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux b/stdlib/test/test/lux/lang/analysis/procedure/common.lux index fba355a79..898376045 100644 --- a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/lang/analysis/procedure/common.lux @@ -11,25 +11,21 @@ ["r" math/random "r/" Monad<Random>] [macro #+ Monad<Meta>] (macro [code]) - (lang [type "type/" Eq<Type>]) + [lang] + (lang [type "type/" Eq<Type>] + [".L" scope] + [".L" init] + (analysis [".A" type])) test) - (luxc ["&" lang] - (lang ["&." scope] - ["&." module] - ["~" analysis] - (analysis [".A" expression] - ["@." common]) - [".L" eval])) - (/// common) - (test/luxc common)) + (/// ["_." primitive])) (do-template [<name> <success> <failure>] [(def: (<name> procedure params output-type) (-> Text (List Code) Type Bool) - (|> (&.with-scope - (&.with-type output-type - (analyse (` ((~ (code.text procedure)) (~+ params)))))) - (macro.run (io.run init-jvm)) + (|> (lang.with-scope + (typeA.with-type output-type + (_primitive.analyse (` ((~ (code.text procedure)) (~+ params)))))) + (macro.run (initL.compiler [])) (case> (#e.Success _) <success> @@ -43,8 +39,8 @@ (context: "Lux procedures" (<| (times +100) (do @ - [[primT primC] gen-primitive - [antiT antiC] (|> gen-primitive + [[primT primC] _primitive.primitive + [antiT antiC] (|> _primitive.primitive (r.filter (|>> product.left (type/= primT) not)))] ($_ seq (test "Can test for reference equality." @@ -64,8 +60,6 @@ signedC (|> r.int (:: @ map code.int)) paramC (|> r.nat (:: @ map code.nat))] ($_ seq - (test "Can count the number of 1 bits in a bit pattern." - (check-success+ "lux bit count" (list subjectC) Nat)) (test "Can perform bit 'and'." (check-success+ "lux bit and" (list subjectC paramC) Nat)) (test "Can perform bit 'or'." @@ -117,7 +111,7 @@ (do @ [subjectC (|> r.frac (:: @ map code.frac)) paramC (|> r.frac (:: @ map code.frac)) - encodedC (|> (r.text +5) (:: @ map code.text))] + encodedC (|> (r.unicode +5) (:: @ map code.text))] ($_ seq (test "Can add frac numbers." (check-success+ "lux frac +" (list subjectC paramC) Frac)) @@ -156,9 +150,9 @@ (context: "Text procedures" (<| (times +100) (do @ - [subjectC (|> (r.text +5) (:: @ map code.text)) - paramC (|> (r.text +5) (:: @ map code.text)) - replacementC (|> (r.text +5) (:: @ map code.text)) + [subjectC (|> (r.unicode +5) (:: @ map code.text)) + paramC (|> (r.unicode +5) (:: @ map code.text)) + replacementC (|> (r.unicode +5) (:: @ map code.text)) fromC (|> r.nat (:: @ map code.nat)) toC (|> r.nat (:: @ map code.nat))] ($_ seq @@ -187,18 +181,18 @@ (context: "Array procedures" (<| (times +100) (do @ - [[elemT elemC] gen-primitive + [[elemT elemC] _primitive.primitive sizeC (|> r.nat (:: @ map code.nat)) idxC (|> r.nat (:: @ map code.nat)) - var-name (r.text +5) + var-name (r.unicode +5) #let [arrayT (type (Array elemT)) g!array (code.local-symbol var-name) array-operation (function (_ output-type code) - (|> (&scope.with-scope "" - (&scope.with-local [var-name arrayT] - (&.with-type output-type - (analyse code)))) - (macro.run (io.run init-jvm)) + (|> (scopeL.with-scope "" + (scopeL.with-local [var-name arrayT] + (typeA.with-type output-type + (_primitive.analyse code)))) + (macro.run (initL.compiler [])) (case> (#e.Success _) true @@ -226,65 +220,63 @@ (do @ [subjectC (|> r.frac (:: @ map code.frac)) paramC (|> r.frac (:: @ map code.frac))] - (with-expansions [<unary> (do-template [<proc> <desc>] - [(test (format "Can calculate " <desc> ".") - (check-success+ <proc> (list subjectC) Frac))] + (`` ($_ seq + (~~ (do-template [<proc> <desc>] + [(test (format "Can calculate " <desc> ".") + (check-success+ <proc> (list subjectC) Frac))] - ["lux math cos" "cosine"] - ["lux math sin" "sine"] - ["lux math tan" "tangent"] - ["lux math acos" "inverse/arc cosine"] - ["lux math asin" "inverse/arc sine"] - ["lux math atan" "inverse/arc tangent"] - ["lux math cosh" "hyperbolic cosine"] - ["lux math sinh" "hyperbolic sine"] - ["lux math tanh" "hyperbolic tangent"] - ["lux math exp" "exponentiation"] - ["lux math log" "logarithm"] - ["lux math ceil" "ceiling"] - ["lux math floor" "floor"] - ["lux math round" "rounding"]) - <binary> (do-template [<proc> <desc>] - [(test (format "Can calculate " <desc> ".") - (check-success+ <proc> (list subjectC paramC) Frac))] + ["lux math cos" "cosine"] + ["lux math sin" "sine"] + ["lux math tan" "tangent"] + ["lux math acos" "inverse/arc cosine"] + ["lux math asin" "inverse/arc sine"] + ["lux math atan" "inverse/arc tangent"] + ["lux math cosh" "hyperbolic cosine"] + ["lux math sinh" "hyperbolic sine"] + ["lux math tanh" "hyperbolic tangent"] + ["lux math exp" "exponentiation"] + ["lux math log" "logarithm"] + ["lux math ceil" "ceiling"] + ["lux math floor" "floor"] + ["lux math round" "rounding"])) + (~~ (do-template [<proc> <desc>] + [(test (format "Can calculate " <desc> ".") + (check-success+ <proc> (list subjectC paramC) Frac))] - ["lux math atan2" "inverse/arc tangent (with 2 arguments)"] - ["lux math pow" "power"])] - ($_ seq - <unary> - <binary>))))) + ["lux math atan2" "inverse/arc tangent (with 2 arguments)"] + ["lux math pow" "power"]))))))) (context: "Atom procedures" (<| (times +100) (do @ - [[elemT elemC] gen-primitive + [[elemT elemC] _primitive.primitive sizeC (|> r.nat (:: @ map code.nat)) idxC (|> r.nat (:: @ map code.nat)) - var-name (r.text +5) + var-name (r.unicode +5) #let [atomT (type (atom.Atom elemT))]] ($_ seq (test "Can create atomic reference." (check-success+ "lux atom new" (list elemC) atomT)) (test "Can read the value of an atomic reference." - (|> (&scope.with-scope "" - (&scope.with-local [var-name atomT] - (&.with-type elemT - (analyse (` ("lux atom read" (~ (code.symbol ["" var-name])))))))) - (macro.run (io.run init-jvm)) + (|> (scopeL.with-scope "" + (scopeL.with-local [var-name atomT] + (typeA.with-type elemT + (_primitive.analyse (` ("lux atom read" (~ (code.symbol ["" var-name])))))))) + (macro.run (initL.compiler [])) (case> (#e.Success _) true (#e.Error _) false))) (test "Can swap the value of an atomic reference." - (|> (&scope.with-scope "" - (&scope.with-local [var-name atomT] - (&.with-type Bool - (analyse (` ("lux atom compare-and-swap" - (~ (code.symbol ["" var-name])) - (~ elemC) - (~ elemC))))))) - (macro.run (io.run init-jvm)) + (|> (scopeL.with-scope "" + (scopeL.with-local [var-name atomT] + (typeA.with-type Bool + (_primitive.analyse (` ("lux atom compare-and-swap" + (~ (code.symbol ["" var-name])) + (~ elemC) + (~ elemC))))))) + (macro.run (initL.compiler [])) (case> (#e.Success _) true @@ -295,7 +287,7 @@ (context: "Process procedures" (<| (times +100) (do @ - [[primT primC] gen-primitive + [[primT primC] _primitive.primitive timeC (|> r.nat (:: @ map code.nat))] ($_ seq (test "Can query the level of concurrency." @@ -310,7 +302,7 @@ (context: "IO procedures" (<| (times +100) (do @ - [logC (|> (r.text +5) (:: @ map code.text)) + [logC (|> (r.unicode +5) (:: @ map code.text)) exitC (|> r.int (:: @ map code.int))] ($_ seq (test "Can log messages to standard output." diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux b/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux index 3d0c76777..0a60149d5 100644 --- a/new-luxc/test/test/luxc/lang/analysis/procedure/host.jvm.lux +++ b/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux @@ -15,31 +15,25 @@ ["r" math/random "r/" Monad<Random>] [macro #+ Monad<Meta>] (macro [code]) - (lang [type]) + [lang] + (lang [type] + [".L" init] + (analysis [".A" type]) + (extension (analysis [".AE" host]))) test) - (luxc ["&" lang] - (lang ["&." scope] - ["&." module] - ["~" analysis] - (analysis [".A" expression] - ["@." common]) - (translation (jvm ["@." runtime])) - (extension (analysis ["@." host])) - [".L" eval])) - (/// common) - (test/luxc common)) + (/// ["_." primitive])) (do-template [<name> <success> <failure>] [(def: (<name> procedure params output-type) (-> Text (List Code) Type Bool) (|> (do Monad<Meta> - [runtime-bytecode @runtime.translate] - (&.with-scope - (&.with-type output-type - ((expressionA.analyser evalL.eval) - (` ((~ (code.text procedure)) (~+ params))))))) - (&.with-current-module "") - (macro.run (io.run init-jvm)) + [## runtime-bytecode @runtime.translate + ] + (lang.with-scope + (typeA.with-type output-type + (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))) + (lang.with-current-module "") + (macro.run (initL.compiler [])) (case> (#e.Success _) <success> @@ -54,12 +48,13 @@ [(def: (<name> syntax output-type) (-> Code Type Bool) (|> (do Monad<Meta> - [runtime-bytecode @runtime.translate] - (&.with-scope - (&.with-type output-type - (expressionA.analyser evalL.eval syntax)))) - (&.with-current-module "") - (macro.run (io.run init-jvm)) + [## runtime-bytecode @runtime.translate + ] + (lang.with-scope + (typeA.with-type output-type + (_primitive.analyse syntax)))) + (lang.with-current-module "") + (macro.run (initL.compiler [])) (case> (#e.Success _) <success> @@ -77,12 +72,12 @@ (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] + ["jvm convert double-to-float" "java.lang.Double" hostAE.Float] + ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer] + ["jvm convert double-to-long" "java.lang.Double" hostAE.Long] + ["jvm convert float-to-double" "java.lang.Float" hostAE.Double] + ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer] + ["jvm convert float-to-long" "java.lang.Float" hostAE.Long] )] ($_ seq <conversions> @@ -95,12 +90,12 @@ (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] + ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte] + ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character] + ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double] + ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float] + ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long] + ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short] )] ($_ seq <conversions> @@ -113,11 +108,11 @@ (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] + ["jvm convert long-to-double" "java.lang.Long" hostAE.Double] + ["jvm convert long-to-float" "java.lang.Long" hostAE.Float] + ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer] + ["jvm convert long-to-short" "java.lang.Long" hostAE.Short] + ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte] )] ($_ seq <conversions> @@ -130,12 +125,12 @@ (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] + ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte] + ["jvm convert char-to-short" "java.lang.Character" hostAE.Short] + ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer] + ["jvm convert char-to-long" "java.lang.Character" hostAE.Long] + ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long] + ["jvm convert short-to-long" "java.lang.Short" hostAE.Long] )] ($_ seq <conversions> @@ -168,8 +163,8 @@ (' ("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> hostAE.Boolean] + [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean] )] ($_ seq <instructions> @@ -195,8 +190,8 @@ )))] - ["int" "java.lang.Integer" @host.Integer] - ["long" "java.lang.Long" @host.Long] + ["int" "java.lang.Integer" hostAE.Integer] + ["long" "java.lang.Long" hostAE.Long] ) (do-template [<domain> <boxed> <type>] @@ -226,16 +221,16 @@ (' ("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> hostAE.Boolean] + [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean] )] ($_ seq <instructions> )))] - ["float" "java.lang.Float" @host.Float] - ["double" "java.lang.Double" @host.Double] + ["float" "java.lang.Float" hostAE.Float] + ["double" "java.lang.Double" hostAE.Double] ) (do-template [<domain> <boxed> <type>] @@ -247,23 +242,23 @@ (' ("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> hostAE.Boolean] + [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean] )] ($_ seq <instructions> )))] - ["char" "java.lang.Character" @host.Character] + ["char" "java.lang.Character" hostAE.Character] ) (def: array-type (r.Random [Text Text]) - (let [entries (dict.entries @host.boxes) + (let [entries (dict.entries hostAE.boxes) num-entries (list.size entries)] (do r.Monad<Random> - [choice (|> r.nat (:: @ map (n/% (n/inc num-entries)))) + [choice (|> r.nat (:: @ map (n/% (inc num-entries)))) #let [[unboxed boxed] (: [Text Text] (|> entries (list.nth choice) @@ -340,7 +335,7 @@ unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0)) ("jvm object null")))] throwable (|> r.nat - (:: @ map (n/% (n/inc (list.size throwables)))) + (:: @ map (n/% (inc (list.size throwables)))) (:: @ map (function (_ idx) (|> throwables (list.nth idx) |