From 085c9a6ef151531cb01b842ed2f4366a49b78367 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 8 Sep 2021 23:14:59 -0400 Subject: De-bracing | part 2 --- stdlib/source/test/lux.lux | 26 ++--- .../source/test/lux/control/concurrency/async.lux | 4 +- .../test/lux/control/concurrency/semaphore.lux | 4 +- stdlib/source/test/lux/debug.lux | 2 +- stdlib/source/test/lux/extension.lux | 20 ++-- stdlib/source/test/lux/math/number/frac.lux | 8 +- stdlib/source/test/lux/static.lux | 2 +- stdlib/source/test/lux/target/jvm.lux | 108 ++++++++++----------- stdlib/source/test/lux/type/poly/equivalence.lux | 4 +- stdlib/source/test/lux/type/poly/functor.lux | 2 +- stdlib/source/test/lux/type/poly/json.lux | 4 +- 11 files changed, 92 insertions(+), 92 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 238bf666d..d40709cf6 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1,5 +1,5 @@ -(.with_expansions [' (.for {"{old}" (.as_is ["[1]/[0]" jvm]) - "JVM" (.as_is ["[1]/[0]" jvm])} +(.with_expansions [' (.for ["{old}" (.as_is ["[1]/[0]" jvm]) + "JVM" (.as_is ["[1]/[0]" jvm])] (.as_is)) '] (.module: @@ -78,10 +78,10 @@ (def: sub_tests Test (with_expansions [... TODO: Update & expand tests for this - (for {@.jvm (~~ (as_is /target/jvm.test)) - @.old (~~ (as_is /target/jvm.test))} + (for [@.jvm (~~ (as_is /target/jvm.test)) + @.old (~~ (as_is /target/jvm.test))] (~~ (as_is))) - (for {@.old (~~ (as_is))} + (for [@.old (~~ (as_is))] (~~ (as_is /extension.test)))] (`` (_.in_parallel (list /abstract.test /control.test @@ -443,7 +443,7 @@ (#.Right [lux (list)])))] (do random.monad [expected random.nat] - (with_expansions [ (for {@.old (~~ (as_is))} + (with_expansions [ (for [@.old (~~ (as_is))] (_.cover [/.Source] (..found_crosshair?)))] (`` ($_ _.and @@ -807,16 +807,16 @@ (~~ (/.comment dummy)))))) (_.cover [/.for] (and (n.= expected - (/.for {"fake host" dummy} + (/.for ["fake host" dummy] expected)) (n.= expected - (/.for {@.old expected + (/.for [@.old expected @.jvm expected @.js expected @.python expected @.lua expected @.ruby expected - @.php expected} + @.php expected] dummy)))) ))) @@ -1109,7 +1109,7 @@ (bit\= /.private /.local))) )) -(for {@.old (as_is)} +(for [@.old (as_is)] (as_is (syntax: (for_bindings|test [fn/0 .local_identifier var/0 .local_identifier let/0 .local_identifier @@ -1193,7 +1193,7 @@ Test (<| (_.covering /._) (with_expansions - [ (for {@.old (~~ (as_is))} + [ (for [@.old (~~ (as_is))] (~~ (as_is ..for_bindings)))] (`` ($_ _.and ..for_bit @@ -1224,12 +1224,12 @@ ))))) (program: args - (let [times (for {@.old 100 + (let [times (for [@.old 100 @.jvm 100 @.js 10 @.python 1 @.lua 1 - @.ruby 1} + @.ruby 1] 100)] (<| io.io _.run! diff --git a/stdlib/source/test/lux/control/concurrency/async.lux b/stdlib/source/test/lux/control/concurrency/async.lux index 0709aff61..2194854b5 100644 --- a/stdlib/source/test/lux/control/concurrency/async.lux +++ b/stdlib/source/test/lux/control/concurrency/async.lux @@ -46,8 +46,8 @@ false)))))) (def: delay - (for {@.js - (i64.left_shifted 4 1)} + (for [@.js + (i64.left_shifted 4 1)] (i64.left_shifted 3 1))) (def: .public test diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 50b35b437..6f87f0889 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -30,8 +30,8 @@ ["[0]" /]]) (def: delay - (for {@.js - (i64.left_shifted 4 1)} + (for [@.js + (i64.left_shifted 4 1)] (i64.left_shifted 3 1))) (def: semaphore diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index 155df06fc..fbd5a9b12 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -245,7 +245,7 @@ bar random.nat baz random.bit] (_.cover [/.here] - (with_expansions [ (for {@.js (~~ (as_is))} + (with_expansions [ (for [@.js (~~ (as_is))] (~~ (as_is (/.here))))] (`` (exec diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 983ac2c3d..52994d6a1 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -51,8 +51,8 @@ (def: my_directive "my directive") ... Generation -(for {@.old - (as_is)} +(for [@.old + (as_is)] (as_is ... Analysis @@ -83,9 +83,9 @@ (\ ! each (|>> (#synthesis.Extension self)))))) (generation: (..my_generation self phase archive [pass_through .any]) - (for {@.jvm + (for [@.jvm (\ phase.monad each (|>> #jvm.Embedded row.row) - (phase archive pass_through))} + (phase archive pass_through))] (phase archive pass_through))) (analysis: (..dummy_generation self phase archive []) @@ -96,7 +96,7 @@ (generation: (..dummy_generation self phase archive []) (\ phase.monad in - (for {@.jvm + (for [@.jvm (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self)))) @.js (js.string self) @@ -104,7 +104,7 @@ @.lua (lua.string self) @.ruby (ruby.string self) @.php (php.string self) - @.scheme (scheme.string self)}))) + @.scheme (scheme.string self)]))) ... Directive (directive: (..my_directive self phase archive [parameters (<>.some .any)]) @@ -123,16 +123,16 @@ (`` ($_ _.and (~~ (template [ ] [(_.cover [] - (for {@.old - false} + (for [@.old + false] (n.= expected (`` ((~~ (static )) expected)))))] [/.analysis: ..my_analysis] [/.synthesis: ..my_synthesis])) (_.cover [/.generation:] - (for {@.old - false} + (for [@.old + false] (and (n.= expected (`` ((~~ (static ..my_generation)) expected))) (text\= ..dummy_generation diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index df89b033a..459edd275 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -122,8 +122,8 @@ ["[1]::[0]" ("static" doubleToRawLongBits [double] long) ("static" longBitsToDouble [long] double)]))] - (for {@.old (as_is ) - @.jvm (as_is )} + (for [@.old (as_is ) + @.jvm (as_is )] (as_is))) (def: .public test @@ -210,8 +210,8 @@ (and (/.not_a_number? expected) (/.not_a_number? actual)))))) )] - (for {@.old - @.jvm } + (for [@.old + @.jvm ] (let [test (: (-> Frac Bit) (function (_ expected) (let [actual (|> expected /.bits /.of_bits)] diff --git a/stdlib/source/test/lux/static.lux b/stdlib/source/test/lux/static.lux index cc63a2913..048d0511b 100644 --- a/stdlib/source/test/lux/static.lux +++ b/stdlib/source/test/lux/static.lux @@ -22,7 +22,7 @@ (def: .public test Test (<| (_.covering /._) - (for {@.old (_.test "PLACEHOLDER" true)} + (for [@.old (_.test "PLACEHOLDER" true)] (_.for [meta.eval] (`` ($_ _.and (~~ (template [ <=> <+> ] diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 190c2f65e..9fa008544 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -308,10 +308,10 @@ (do [! random.monad] [expected (\ ! each (i64.and (i64.mask )) random.nat)] (<| (_.lifted ) - (..bytecode (for {@.old + (..bytecode (for [@.old (|>> (:as ) ("jvm leq" expected)) @.jvm - (|>> (:as ) "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))})) + (|>> (:as ) "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))])) (do /.monad [_ ( (|> expected .int try.trusted))] ))))] @@ -324,13 +324,13 @@ [(template: ( ) [(: (-> ) (function (_ parameter subject) - (for {@.old + (for [@.old ( subject parameter) @.jvm ("jvm object cast" ( ("jvm object cast" parameter) - ("jvm object cast" subject)))})))])] + ("jvm object cast" subject)))])))])] [int/2 java/lang/Integer] [long/2 java/lang/Long] @@ -341,23 +341,23 @@ (template: (int+long/2 ) [(: (-> java/lang/Integer java/lang/Long java/lang/Long) (function (_ parameter subject) - (for {@.old + (for [@.old ( subject parameter) @.jvm ("jvm object cast" ( ("jvm object cast" parameter) - ("jvm object cast" subject)))})))]) + ("jvm object cast" subject)))])))]) (def: int Test (let [int (: (-> java/lang/Integer (Bytecode Any) (Random Bit)) (function (_ expected bytecode) - (<| (..bytecode (for {@.old + (<| (..bytecode (for [@.old (|>> (:as java/lang/Integer) ("jvm ieq" expected)) @.jvm - (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))])) (do /.monad [_ bytecode] ..$Integer::wrap)))) @@ -434,11 +434,11 @@ Test (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit)) (function (_ expected bytecode) - (<| (..bytecode (for {@.old + (<| (..bytecode (for [@.old (|>> (:as Int) (i.= expected)) @.jvm - (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))])) (do /.monad [_ bytecode] ..$Long::wrap)))) @@ -507,11 +507,11 @@ ... (i.< (:as Int reference) (:as Int subject)) (:as java/lang/Long -1))]] - (<| (..bytecode (for {@.old + (<| (..bytecode (for [@.old (|>> (:as Int) (i.= expected)) @.jvm - (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))])) (do /.monad [_ (..$Long::literal subject) _ (..$Long::literal reference) @@ -533,7 +533,7 @@ Test (let [float (: (-> java/lang/Float (Bytecode Any) (Random Bit)) (function (_ expected bytecode) - (<| (..bytecode (for {@.old + (<| (..bytecode (for [@.old (function (_ actual) (or (|> actual (:as java/lang/Float) ("jvm feq" expected)) (and (f.not_a_number? (:as Frac (ffi.float_to_double expected))) @@ -543,7 +543,7 @@ (function (_ actual) (or (|> actual (:as java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" expected))) (and (f.not_a_number? (:as Frac (ffi.float_to_double expected))) - (f.not_a_number? (:as Frac (ffi.float_to_double (:as java/lang/Float actual)))))))})) + (f.not_a_number? (:as Frac (ffi.float_to_double (:as java/lang/Float actual)))))))])) (do /.monad [_ bytecode] ..$Float::wrap)))) @@ -595,11 +595,11 @@ ..$Float::random)] reference valid_float subject valid_float - .let [expected (if (for {@.old + .let [expected (if (for [@.old ("jvm feq" reference subject) @.jvm - ("jvm float =" ("jvm object cast" reference) ("jvm object cast" subject))}) + ("jvm float =" ("jvm object cast" reference) ("jvm object cast" subject))]) +0 (if (standard reference subject) +1 @@ -613,11 +613,11 @@ ..$Long::wrap))))) comparison_standard (: (-> java/lang/Float java/lang/Float Bit) (function (_ reference subject) - (for {@.old + (for [@.old ("jvm fgt" subject reference) @.jvm - ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))}))) + ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))]))) comparison ($_ _.and (_.lifted "FCMPL" (comparison /.fcmpl comparison_standard)) (_.lifted "FCMPG" (comparison /.fcmpg comparison_standard)))] @@ -634,7 +634,7 @@ Test (let [double (: (-> java/lang/Double (Bytecode Any) (Random Bit)) (function (_ expected bytecode) - (<| (..bytecode (for {@.old + (<| (..bytecode (for [@.old (function (_ actual) (or (|> actual (:as java/lang/Double) ("jvm deq" expected)) (and (f.not_a_number? (:as Frac expected)) @@ -644,7 +644,7 @@ (function (_ actual) (or (|> actual (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))) (and (f.not_a_number? (:as Frac expected)) - (f.not_a_number? (:as Frac actual)))))})) + (f.not_a_number? (:as Frac actual)))))])) (do /.monad [_ bytecode] ..$Double::wrap)))) @@ -689,11 +689,11 @@ (do random.monad [reference ..valid_double subject ..valid_double - .let [expected (if (for {@.old + .let [expected (if (for [@.old ("jvm deq" reference subject) @.jvm - ("jvm double =" ("jvm object cast" reference) ("jvm object cast" subject))}) + ("jvm double =" ("jvm object cast" reference) ("jvm object cast" subject))]) +0 (if (standard reference subject) +1 @@ -708,11 +708,11 @@ ... https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-6.html#jvms-6.5.dcmp_op comparison_standard (: (-> java/lang/Double java/lang/Double Bit) (function (_ reference subject) - (for {@.old + (for [@.old ("jvm dgt" subject reference) @.jvm - ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))}))) + ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))]))) comparison ($_ _.and (_.lifted "DCMPL" (comparison /.dcmpl comparison_standard)) (_.lifted "DCMPG" (comparison /.dcmpg comparison_standard)))] @@ -790,11 +790,11 @@ (do random.monad [expected (random.only (|>> (:as Frac) f.not_a_number? not) ..$Double::random)]) - (..bytecode (for {@.old + (..bytecode (for [@.old (|>> (:as java/lang/Double) ("jvm deq" expected)) @.jvm - (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))])) (do /.monad [_ (/.double expected)] (/.invokestatic ..$Double "valueOf" (/type.method [(list) (list /type.double) ..$Double (list)])))) @@ -811,11 +811,11 @@ (do random.monad [expected (random.only (|>> (:as Frac) f.not_a_number? not) ..$Double::random)]) - (..bytecode (for {@.old + (..bytecode (for [@.old (|>> (:as java/lang/Double) ("jvm deq" expected)) @.jvm - (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))])) (do /.monad [_ (/.new ..$Double) _ /.dup @@ -839,12 +839,12 @@ part0 ..$Long::random part1 ..$Long::random .let [expected (: java/lang/Long - (for {@.old + (for [@.old ("jvm ladd" part0 part1) @.jvm ("jvm object cast" - ("jvm long +" ("jvm object cast" part0) ("jvm object cast" part1)))})) + ("jvm long +" ("jvm object cast" part0) ("jvm object cast" part1)))])) $Self (/type.class class_name (list)) class_field "class_field" object_field "object_field" @@ -958,59 +958,59 @@ (_.context "byte" (array (/.newarray /instruction.t_byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap] (function (_ expected) - (for {@.old + (for [@.old (|>> (:as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) @.jvm - (|>> (:as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:as java/lang/Byte expected)))))})))) + (|>> (:as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:as java/lang/Byte expected)))))])))) (_.context "short" (array (/.newarray /instruction.t_short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap] (function (_ expected) - (for {@.old + (for [@.old (|>> (:as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) @.jvm - (|>> (:as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:as java/lang/Short expected)))))})))) + (|>> (:as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:as java/lang/Short expected)))))])))) (_.context "int" (array (/.newarray /instruction.t_int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap] (function (_ expected) - (for {@.old + (for [@.old (|>> (:as java/lang/Integer) ("jvm ieq" (:as java/lang/Integer expected))) @.jvm - (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (:as java/lang/Integer expected))))})))) + (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (:as java/lang/Integer expected))))])))) (_.context "long" (array (/.newarray /instruction.t_long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap] (function (_ expected) - (for {@.old + (for [@.old (|>> (:as java/lang/Long) ("jvm leq" expected)) @.jvm - (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))})))) + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))])))) (_.context "float" (array (/.newarray /instruction.t_float) ..valid_float $Float::literal [/.fastore /.faload $Float::wrap] (function (_ expected) - (for {@.old + (for [@.old (|>> (:as java/lang/Float) ("jvm feq" expected)) @.jvm - (|>> (:as java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:as java/lang/Float expected))))})))) + (|>> (:as java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:as java/lang/Float expected))))])))) (_.context "double" (array (/.newarray /instruction.t_double) ..valid_double $Double::literal [/.dastore /.daload $Double::wrap] (function (_ expected) - (for {@.old + (for [@.old (|>> (:as java/lang/Double) ("jvm deq" expected)) @.jvm - (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (:as java/lang/Double expected))))})))) + (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (:as java/lang/Double expected))))])))) (_.context "char" (array (/.newarray /instruction.t_char) $Character::random $Character::literal [/.castore /.caload $Character::wrap] (function (_ expected) - (for {@.old + (for [@.old (|>> (:as java/lang/Character) ("jvm ceq" expected)) @.jvm - (|>> (:as java/lang/Character) "jvm object cast" ("jvm char =" ("jvm object cast" (:as java/lang/Character expected))))})))) + (|>> (:as java/lang/Character) "jvm object cast" ("jvm char =" ("jvm object cast" (:as java/lang/Character expected))))])))) (_.context "object" (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop] (function (_ expected) (|>> (:as Text) (text\= (:as Text expected)))))) @@ -1040,11 +1040,11 @@ (template: (!::= ) [(: (-> Any Bit) (function (_ expected) - (for {@.old + (for [@.old (|>> (:as ) ( expected)) @.jvm - (|>> (:as ) "jvm object cast" ( ("jvm object cast" (:as expected))))})))]) + (|>> (:as ) "jvm object cast" ( ("jvm object cast" (:as expected))))])))]) (def: conversion Test @@ -1071,20 +1071,20 @@ (_.lifted "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> ffi.int_to_double) double::=)) (_.lifted "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> ffi.int_to_byte) (function (_ expected) - (for {@.old + (for [@.old (|>> (:as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) @.jvm - (|>> (:as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:as java/lang/Byte expected)))))})))) + (|>> (:as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:as java/lang/Byte expected)))))])))) (_.lifted "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> ffi.int_to_char) (!::= java/lang/Character "jvm ceq" "jvm char ="))) (_.lifted "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> ffi.int_to_short) (function (_ expected) - (for {@.old + (for [@.old (|>> (:as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) @.jvm - (|>> (:as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:as java/lang/Short expected)))))})))))) + (|>> (:as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:as java/lang/Short expected)))))])))))) (<| (_.context "long") ($_ _.and (_.lifted "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> ffi.long_to_int) int::=)) @@ -1156,7 +1156,7 @@ increment (\ ! each (|>> (n.% 100) /unsigned.u1 try.trusted) random.nat) .let [expected (: java/lang/Long - (for {@.old + (for [@.old ("jvm ladd" (ffi.byte_to_long base) (.int (/unsigned.value increment))) @@ -1165,7 +1165,7 @@ ("jvm object cast" ("jvm long +" ("jvm object cast" (ffi.byte_to_long base)) - ("jvm object cast" (:as java/lang/Long (/unsigned.value increment)))))}))]] + ("jvm object cast" (:as java/lang/Long (/unsigned.value increment)))))]))]] (..bytecode (|>> (:as Int) (i.= (:as Int expected))) (do /.monad [_ (..$Byte::literal base) @@ -1416,11 +1416,11 @@ reference ..$Integer::random subject (|> ..$Integer::random (random.only (|>> ((!::= java/lang/Integer "jvm ieq" "jvm int =") reference) not))) - .let [[lesser greater] (if (for {@.old + .let [[lesser greater] (if (for [@.old ("jvm ilt" reference subject) @.jvm - ("jvm int <" ("jvm object cast" subject) ("jvm object cast" reference))}) + ("jvm int <" ("jvm object cast" subject) ("jvm object cast" reference))]) [reference subject] [subject reference]) int_comparison ($_ _.and diff --git a/stdlib/source/test/lux/type/poly/equivalence.lux b/stdlib/source/test/lux/type/poly/equivalence.lux index 5bfb8e39d..63854e535 100644 --- a/stdlib/source/test/lux/type/poly/equivalence.lux +++ b/stdlib/source/test/lux/type/poly/equivalence.lux @@ -76,7 +76,7 @@ (random.unicode size)) gen_recursive))) -(for {@.old (as_is)} +(for [@.old (as_is)] (as_is (def: equivalence (Equivalence ..Record) (/.equivalence ..Record)))) @@ -85,5 +85,5 @@ Test (<| (_.covering /._) (_.for [/.equivalence] - (for {@.old (_.test "PLACEHOLDER" true)} + (for [@.old (_.test "PLACEHOLDER" true)] ($equivalence.spec ..equivalence ..random))))) diff --git a/stdlib/source/test/lux/type/poly/functor.lux b/stdlib/source/test/lux/type/poly/functor.lux index d9892b02c..4aec871cf 100644 --- a/stdlib/source/test/lux/type/poly/functor.lux +++ b/stdlib/source/test/lux/type/poly/functor.lux @@ -14,7 +14,7 @@ [data ["[0]" identity]]]]) -(for {@.old (as_is)} +(for [@.old (as_is)] (as_is (def: maybe_functor (Functor .Maybe) (/.functor .Maybe)) diff --git a/stdlib/source/test/lux/type/poly/json.lux b/stdlib/source/test/lux/type/poly/json.lux index 259a25b95..0f78aa976 100644 --- a/stdlib/source/test/lux/type/poly/json.lux +++ b/stdlib/source/test/lux/type/poly/json.lux @@ -108,7 +108,7 @@ ..qty ))) -(for {@.old (as_is)} +(for [@.old (as_is)] (as_is (def: equivalence (Equivalence Record) (poly/equivalence.equivalence Record)) @@ -121,5 +121,5 @@ Test (<| (_.covering /._) (_.for [/.codec] - (for {@.old (_.test "PLACEHOLDER" true)} + (for [@.old (_.test "PLACEHOLDER" true)] ($codec.spec ..equivalence ..codec ..gen_record))))) -- cgit v1.2.3