aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux.lux76
-rw-r--r--stdlib/source/test/lux/control/concurrency/async.lux55
-rw-r--r--stdlib/source/test/lux/control/concurrency/semaphore.lux61
-rw-r--r--stdlib/source/test/lux/debug.lux90
-rw-r--r--stdlib/source/test/lux/extension.lux96
-rw-r--r--stdlib/source/test/lux/math/number/frac.lux8
-rw-r--r--stdlib/source/test/lux/meta/configuration.lux33
-rw-r--r--stdlib/source/test/lux/meta/version.lux8
-rw-r--r--stdlib/source/test/lux/static.lux2
-rw-r--r--stdlib/source/test/lux/target/jvm.lux313
-rw-r--r--stdlib/source/test/lux/type/poly/equivalence.lux50
-rw-r--r--stdlib/source/test/lux/type/poly/functor.lux30
-rw-r--r--stdlib/source/test/lux/type/poly/json.lux100
13 files changed, 460 insertions, 462 deletions
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 743c108f7..bd30cf30e 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -62,12 +62,12 @@
["[1][0]" ffi]
["[1][0]" extension]
["[1][0]" target "_"
- (~~ (.for ["{old}" (~~ (.as_is ["[1]/[0]" jvm]))
- "JVM" (~~ (.as_is ["[1]/[0]" jvm]))
- "JavaScript" (~~ (.as_is ["[1]/[0]" js]))
- "Lua" (~~ (.as_is ["[1]/[0]" lua]))
- "Python" (~~ (.as_is ["[1]/[0]" python]))
- "Ruby" (~~ (.as_is ["[1]/[0]" ruby]))]
+ (~~ (.for "{old}" (~~ (.as_is ["[1]/[0]" jvm]))
+ "JVM" (~~ (.as_is ["[1]/[0]" jvm]))
+ "JavaScript" (~~ (.as_is ["[1]/[0]" js]))
+ "Lua" (~~ (.as_is ["[1]/[0]" lua]))
+ "Python" (~~ (.as_is ["[1]/[0]" python]))
+ "Ruby" (~~ (.as_is ["[1]/[0]" ruby]))
(~~ (.as_is))))]])))
(def: for_bit
@@ -421,7 +421,7 @@
(same? (: Any macro))))
(_.cover [/.macro:]
(same? expected (..identity_macro expected)))
- (~~ (for [@.old (~~ (as_is))]
+ (~~ (for @.old (~~ (as_is))
(_.cover [/.Source]
(..found_crosshair?))))
(_.cover [/.macro]
@@ -454,14 +454,14 @@
(let [scenario (: (-> Any Bit)
(function (_ _)
... TODO: Remove this hack once Jython is no longer being used as the Python interpreter.
- (`` (for [@.python (case (' [<input>'])
- (^code [<module>
- ("lux def" (~ [_ {.#Symbol ["" _]}]) [] #0)
- (~~ (template.spliced <referrals>))])
- true
-
- _
- false)]
+ (`` (for @.python (case (' [<input>'])
+ (^code [<module>
+ ("lux def" (~ [_ {.#Symbol ["" _]}]) [] #0)
+ (~~ (template.spliced <referrals>))])
+ true
+
+ _
+ false)
(case (' [<input>'])
(^code [<module> (~~ (template.spliced <referrals>))])
true
@@ -880,16 +880,16 @@
(~~ (/.comment dummy))))))
(_.cover [/.for]
(and (n.= expected
- (/.for ["fake host" dummy]
+ (/.for "fake host" dummy
expected))
(n.= expected
- (/.for [@.old expected
- @.jvm expected
- @.js expected
- @.python expected
- @.lua expected
- @.ruby expected
- @.php expected]
+ (/.for @.old expected
+ @.jvm expected
+ @.js expected
+ @.python expected
+ @.lua expected
+ @.ruby expected
+ @.php expected
dummy))))
)))
@@ -1178,7 +1178,7 @@
(bit#= /.private /.local)))
))
-(for [@.old (as_is)]
+(for @.old (as_is)
(as_is (syntax: (for_bindings|test [fn/0 <code>.local_symbol
var/0 <code>.local_symbol
let/0 <code>.local_symbol
@@ -1283,7 +1283,7 @@
..for_def:
..for_meta
..for_export
- (~~ (for [@.old (~~ (as_is))]
+ (~~ (for @.old (~~ (as_is))
(~~ (as_is ..for_bindings))))
))))
@@ -1316,23 +1316,23 @@
/world.test
/ffi.test
- (~~ (for [@.old (~~ (as_is))]
+ (~~ (for @.old (~~ (as_is))
(~~ (as_is /extension.test))))
- (~~ (for [@.jvm (~~ (as_is /target/jvm.test))
- @.old (~~ (as_is /target/jvm.test))
- @.js (~~ (as_is /target/js.test))
- @.lua (~~ (as_is /target/lua.test))
- @.python (~~ (as_is /target/python.test))
- @.ruby (~~ (as_is /target/ruby.test))]))
+ (~~ (for @.jvm (~~ (as_is /target/jvm.test))
+ @.old (~~ (as_is /target/jvm.test))
+ @.js (~~ (as_is /target/js.test))
+ @.lua (~~ (as_is /target/lua.test))
+ @.python (~~ (as_is /target/python.test))
+ @.ruby (~~ (as_is /target/ruby.test))))
))))))
(program: args
- (let [times (for [@.old 100
- @.jvm 100
- @.js 10
- @.python 1
- @.lua 1
- @.ruby 1]
+ (let [times (for @.old 100
+ @.jvm 100
+ @.js 10
+ @.python 1
+ @.lua 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 76b331bb9..7f844f558 100644
--- a/stdlib/source/test/lux/control/concurrency/async.lux
+++ b/stdlib/source/test/lux/control/concurrency/async.lux
@@ -1,30 +1,30 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- ["@" target]
- [abstract
- [monad {"+" do}]
- [\\specification
- ["$[0]" functor {"+" Injection Comparison}]
- ["$[0]" apply]
- ["$[0]" monad]]]
- [control
- [pipe {"+" case>}]
- ["[0]" io]]
- [time
- ["[0]" instant]
- ["[0]" duration]]
- [math
- ["[0]" random]
- [number
- ["n" nat]
- ["i" int]
- ["[0]" i64]]]]]
- [\\library
- ["[0]" /
- [//
- ["[0]" atom {"+" Atom}]]]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ ["@" target]
+ [abstract
+ [monad {"+" do}]
+ [\\specification
+ ["$[0]" functor {"+" Injection Comparison}]
+ ["$[0]" apply]
+ ["$[0]" monad]]]
+ [control
+ [pipe {"+" case>}]
+ ["[0]" io]]
+ [time
+ ["[0]" instant]
+ ["[0]" duration]]
+ [math
+ ["[0]" random]
+ [number
+ ["n" nat]
+ ["i" int]
+ ["[0]" i64]]]]]
+ [\\library
+ ["[0]" /
+ [//
+ ["[0]" atom {"+" Atom}]]]])
(def: injection
(Injection /.Async)
@@ -46,8 +46,7 @@
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 91646488c..1b07c0e65 100644
--- a/stdlib/source/test/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux
@@ -1,37 +1,36 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- ["@" target]
- [abstract
- ["[0]" monad {"+" do}]
- ["[0]" enum]]
- [control
- ["[0]" io]
- ["[0]" maybe]
- ["[0]" try]
- ["[0]" exception {"+" exception:}]
- [concurrency
- ["[0]" async {"+" Async}]
- ["[0]" atom {"+" Atom}]]]
- [data
- ["[0]" text ("[1]#[0]" equivalence)
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" functor)]]]
- [math
- ["[0]" random]
- [number
- ["n" nat]
- ["[0]" i64]]]
- [type
- ["[0]" refinement]]]]
- [\\library
- ["[0]" /]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ ["@" target]
+ [abstract
+ ["[0]" monad {"+" do}]
+ ["[0]" enum]]
+ [control
+ ["[0]" io]
+ ["[0]" maybe]
+ ["[0]" try]
+ ["[0]" exception {"+" exception:}]
+ [concurrency
+ ["[0]" async {"+" Async}]
+ ["[0]" atom {"+" Atom}]]]
+ [data
+ ["[0]" text ("[1]#[0]" equivalence)
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" functor)]]]
+ [math
+ ["[0]" random]
+ [number
+ ["n" nat]
+ ["[0]" i64]]]
+ [type
+ ["[0]" refinement]]]]
+ [\\library
+ ["[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 f815d485e..9f619b3c0 100644
--- a/stdlib/source/test/lux/debug.lux
+++ b/stdlib/source/test/lux/debug.lux
@@ -1,52 +1,52 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- ["@" target]
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" try ("[1]#[0]" functor)]
- ["[0]" exception]
- [parser
- ["<[0]>" code]]]
- [data
- ["[0]" text ("[1]#[0]" equivalence)
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" functor)]]
- [format
- [json {"+" JSON}]
- [xml {"+" XML}]]]
- ["[0]" macro
- [syntax {"+" syntax:}]
- ["[0]" code]]
- [math
- ["[0]" random {"+" Random}]
- [number
- [ratio {"+" Ratio}]]]
- [time {"+" Time}
- [instant {"+" Instant}]
- [date {"+" Date}]
- [duration {"+" Duration}]
- [month {"+" Month}]
- [day {"+" Day}]]]]
- [\\library
- ["[0]" /]]
- ["$[0]" // "_"
- ["[1][0]" type]
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ ["@" target]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" try ("[1]#[0]" functor)]
+ ["[0]" exception]
+ [parser
+ ["<[0]>" code]]]
[data
+ ["[0]" text ("[1]#[0]" equivalence)
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" functor)]]
[format
- ["[1][0]" json]
- ["[1][0]" xml]]]
- [macro
- ["[1][0]" code]]
+ [json {"+" JSON}]
+ [xml {"+" XML}]]]
+ ["[0]" macro
+ [syntax {"+" syntax:}]
+ ["[0]" code]]
[math
+ ["[0]" random {"+" Random}]
[number
- ["[1][0]" ratio]]]
- [meta
- ["[1][0]" location]
- ["[1][0]" symbol]]])
+ [ratio {"+" Ratio}]]]
+ [time {"+" Time}
+ [instant {"+" Instant}]
+ [date {"+" Date}]
+ [duration {"+" Duration}]
+ [month {"+" Month}]
+ [day {"+" Day}]]]]
+ [\\library
+ ["[0]" /]]
+ ["$[0]" // "_"
+ ["[1][0]" type]
+ [data
+ [format
+ ["[1][0]" json]
+ ["[1][0]" xml]]]
+ [macro
+ ["[1][0]" code]]
+ [math
+ [number
+ ["[1][0]" ratio]]]
+ [meta
+ ["[1][0]" location]
+ ["[1][0]" symbol]]])
(def: can_represent_simple_types
(Random Bit)
@@ -245,7 +245,7 @@
bar random.nat
baz random.bit]
(_.cover [/.here]
- (with_expansions [<no_parameters> (for [@.js (~~ (as_is))]
+ (with_expansions [<no_parameters> (for @.js (~~ (as_is))
(~~ (as_is (/.here))))]
(`` (exec
<no_parameters>
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index b2dde4019..410d006b4 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -10,11 +10,11 @@
["[0]" php]
["[0]" scheme]
["[0]" jvm "_"
- (~~ (.for ["JVM" (~~ (.as_is ["[1]" bytecode]
- ["[0]" class]
- ["[0]" version]
- [encoding
- ["[0]" name]]))]
+ (~~ (.for "JVM" (~~ (.as_is ["[1]" bytecode]
+ ["[0]" class]
+ ["[0]" version]
+ [encoding
+ ["[0]" name]]))
(~~ (.as_is))))]]
[abstract
["[0]" monad {"+" do}]]
@@ -55,8 +55,8 @@
["[0]" type]]
[phase
[generation
- (~~ (.for ["JVM" (~~ (.as_is ["[0]" jvm "_"
- ["[1]/[0]" runtime]]))]
+ (~~ (.for "JVM" (~~ (.as_is ["[0]" jvm "_"
+ ["[1]/[0]" runtime]]))
(~~ (.as_is))))]]]]]]
["_" test {"+" Test}]]]
[\\library
@@ -76,14 +76,15 @@
)
... Generation
-(for [@.old
- (as_is)]
+(for @.old
+ (as_is)
(as_is
- (for [@.python
- ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter.
- (analysis: ("dummy dum dum" self phase archive [])
- (undefined))]
+ (for @.python
+ ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter.
+ (analysis: ("dummy dum dum" self phase archive [])
+ (undefined))
+
(as_is))
... Analysis
@@ -114,11 +115,7 @@
(# ! each (|>> {synthesis.#Extension self})))))
(generation: (..generation self phase archive [pass_through <synthesis>.any])
- (for [... @.jvm
- ... (# phase.monad each (|>> {jvm.#Embedded} sequence.sequence)
- ... (phase archive pass_through))
- ]
- (phase archive pass_through)))
+ (phase archive pass_through))
(analysis: (..dummy_generation self phase archive [])
(# phase.monad in {analysis.#Extension self (list)}))
@@ -128,16 +125,13 @@
(generation: (..dummy_generation self phase archive [])
(# phase.monad in
- (for [@.jvm
- (jvm.string self)
- ... (sequence.sequence {jvm.#Constant {jvm.#LDC {jvm.#String self}}})
-
- @.js (js.string self)
- @.python (python.unicode self)
- @.lua (lua.string self)
- @.ruby (ruby.string self)
- @.php (php.string self)
- @.scheme (scheme.string self)])))
+ (for @.jvm (jvm.string self)
+ @.js (js.string self)
+ @.python (python.unicode self)
+ @.lua (lua.string self)
+ @.ruby (ruby.string self)
+ @.php (php.string self)
+ @.scheme (scheme.string self))))
... Directive
(directive: (..directive self phase archive [expression <code>.any])
@@ -161,26 +155,26 @@
[[module_id artifact_id] (generation.context archive)
.let [commentary (format "Successfully installed directive " (%.text self) "!")]
_ (generation.save! artifact_id {.#None}
- (for [@.jvm (let [$class (jvm/runtime.class_name [module_id artifact_id])]
- (<| [$class]
- (try.else (binary.empty 0))
- (try#each (binaryF.result class.writer))
- (class.class version.v6_0 class.public
- (name.internal $class)
- {.#None}
- (name.internal "java.lang.Object")
- (list)
- (list)
- (list)
- sequence.empty)))
- @.js (js.comment commentary
- (js.statement (js.string commentary)))
- @.python (python.comment commentary
- (python.statement (python.string commentary)))
- @.lua (lua.comment commentary
- (lua.statement expressionG))
- @.ruby (ruby.comment commentary
- (ruby.statement (ruby.string commentary)))]))]
+ (for @.jvm (let [$class (jvm/runtime.class_name [module_id artifact_id])]
+ (<| [$class]
+ (try.else (binary.empty 0))
+ (try#each (binaryF.result class.writer))
+ (class.class version.v6_0 class.public
+ (name.internal $class)
+ {.#None}
+ (name.internal "java.lang.Object")
+ (list)
+ (list)
+ (list)
+ sequence.empty)))
+ @.js (js.comment commentary
+ (js.statement (js.string commentary)))
+ @.python (python.comment commentary
+ (python.statement (python.string commentary)))
+ @.lua (lua.comment commentary
+ (lua.statement expressionG))
+ @.ruby (ruby.comment commentary
+ (ruby.statement (ruby.string commentary)))))]
(generation.log! commentary))))]
(in directive.no_requirements)))
@@ -195,16 +189,14 @@
(`` ($_ _.and
(~~ (template [<macro> <extension>]
[(_.cover [<macro>]
- (for [@.old
- false]
+ (for @.old false
(n.= expected
(`` ((~~ (static <extension>)) expected)))))]
[/.analysis: ..analysis]
[/.synthesis: ..synthesis]))
(_.cover [/.generation:]
- (for [@.old
- false]
+ (for @.old false
(and (n.= expected
(`` ((~~ (static ..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 b74a80786..c8b786701 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>)
- @.jvm (as_is <jvm>)]
+ (for @.old (as_is <jvm>)
+ @.jvm (as_is <jvm>)
(as_is)))
(def: .public test
@@ -210,8 +210,8 @@
(and (/.not_a_number? expected)
(/.not_a_number? actual))))))
)]
- (for [@.old <jvm>
- @.jvm <jvm>]
+ (for @.old <jvm>
+ @.jvm <jvm>
(let [test (: (-> Frac Bit)
(function (_ expected)
(let [actual (|> expected /.bits /.of_bits)]
diff --git a/stdlib/source/test/lux/meta/configuration.lux b/stdlib/source/test/lux/meta/configuration.lux
index c96a5593d..fc300a01d 100644
--- a/stdlib/source/test/lux/meta/configuration.lux
+++ b/stdlib/source/test/lux/meta/configuration.lux
@@ -66,25 +66,32 @@
(try#each (# /.equivalence = expected))
(try.else false)))
(_.cover [/.for]
- (and (and (/.for [["left" "<<<"
- "right" ">>>"]
- true]
+ (and (and (/.for ["left" "<<<"
+ "right" ">>>"]
+ true
+ ... else
false)
- (/.for [["left" "<<<"]
- true]
+ (/.for ["left" "<<<"]
+ true
+ ... else
false)
- (/.for [["right" ">>>"]
- true]
+ (/.for ["right" ">>>"]
+ true
+ ... else
false))
- (and (/.for [["yolo" ""]
- false]
+ (and (/.for ["yolo" ""]
+ false
+ ... else
true)
- (/.for [["left" "yolo"]
- false]
+ (/.for ["left" "yolo"]
+ false
+ ... else
true))))
(_.cover [/.invalid]
(and (text.contains? (the exception.#label /.invalid)
- (..failure (/.for [])))
+ (..failure (/.for)))
(text.contains? (the exception.#label /.invalid)
- (..failure (/.for [["left" "yolo"] false])))))
+ (..failure (/.for ["left" "yolo"]
+ ... else
+ false)))))
))))
diff --git a/stdlib/source/test/lux/meta/version.lux b/stdlib/source/test/lux/meta/version.lux
index ca219323a..b5c2c0c97 100644
--- a/stdlib/source/test/lux/meta/version.lux
+++ b/stdlib/source/test/lux/meta/version.lux
@@ -43,13 +43,13 @@
(_.cover [/.current]
(not (text.empty? (/.current))))
(_.cover [/.for]
- (and (/.for [<current> true]
+ (and (/.for <current> true
false)
- (/.for [<fake> false]
+ (/.for <fake> false
true)))
(_.cover [/.invalid]
(and (text.contains? (the exception.#label /.invalid)
- (..failure (/.for [])))
+ (..failure (/.for)))
(text.contains? (the exception.#label /.invalid)
- (..failure (/.for [<fake> false])))))
+ (..failure (/.for <fake> false)))))
)))
diff --git a/stdlib/source/test/lux/static.lux b/stdlib/source/test/lux/static.lux
index 691749810..44413d5e0 100644
--- a/stdlib/source/test/lux/static.lux
+++ b/stdlib/source/test/lux/static.lux
@@ -24,7 +24,7 @@
(def: .public test
Test
(<| (_.covering /._)
- (for [@.old (_.test "PLACEHOLDER" true)])
+ (for @.old (_.test "PLACEHOLDER" true))
(_.for [meta.eval])
(`` ($_ _.and
(~~ (template [<static> <random> <=> <+> <tag>]
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index cdeefb573..562473fb0 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -309,10 +309,11 @@
(do [! random.monad]
[expected (# ! each (i64.and (i64.mask <bits>)) random.nat)]
(<| (_.lifted <message>)
- (..bytecode (for [@.old
- (|>> (:as <type>) <to_long> ("jvm leq" expected))
- @.jvm
- (|>> (:as <type>) <to_long> "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))]))
+ (..bytecode (for @.old
+ (|>> (:as <type>) <to_long> ("jvm leq" expected))
+
+ @.jvm
+ (|>> (:as <type>) <to_long> "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))))
(do /.monad
[_ (<push> (|> expected .int <signed> try.trusted))]
<wrap>))))]
@@ -325,13 +326,13 @@
[(template: (<name> <old_extension> <new_extension>)
[(: (-> <type> <type> <type>)
(function (_ parameter subject)
- (for [@.old
- (<old_extension> subject parameter)
-
- @.jvm
- ("jvm object cast"
- (<new_extension> ("jvm object cast" parameter)
- ("jvm object cast" subject)))])))])]
+ (for @.old
+ (<old_extension> subject parameter)
+
+ @.jvm
+ ("jvm object cast"
+ (<new_extension> ("jvm object cast" parameter)
+ ("jvm object cast" subject))))))])]
[int/2 java/lang/Integer]
[long/2 java/lang/Long]
@@ -342,23 +343,23 @@
(template: (int+long/2 <old_extension> <new_extension>)
[(: (-> java/lang/Integer java/lang/Long java/lang/Long)
(function (_ parameter subject)
- (for [@.old
- (<old_extension> subject parameter)
-
- @.jvm
- ("jvm object cast"
- (<new_extension> ("jvm object cast" parameter)
- ("jvm object cast" subject)))])))])
+ (for @.old
+ (<old_extension> subject parameter)
+
+ @.jvm
+ ("jvm object cast"
+ (<new_extension> ("jvm object cast" parameter)
+ ("jvm object cast" subject))))))])
(def: int
Test
(let [int (: (-> java/lang/Integer (Bytecode Any) (Random Bit))
(function (_ expected bytecode)
- (<| (..bytecode (for [@.old
- (|>> (:as java/lang/Integer) ("jvm ieq" expected))
-
- @.jvm
- (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))]))
+ (<| (..bytecode (for @.old
+ (|>> (:as java/lang/Integer) ("jvm ieq" expected))
+
+ @.jvm
+ (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))))
(do /.monad
[_ bytecode]
..$Integer::wrap))))
@@ -435,11 +436,11 @@
Test
(let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit))
(function (_ expected bytecode)
- (<| (..bytecode (for [@.old
- (|>> (:as Int) (i.= expected))
-
- @.jvm
- (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))]))
+ (<| (..bytecode (for @.old
+ (|>> (:as Int) (i.= expected))
+
+ @.jvm
+ (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))))
(do /.monad
[_ bytecode]
..$Long::wrap))))
@@ -508,11 +509,11 @@
... (i.< (:as Int reference) (:as Int subject))
(:as java/lang/Long -1))]]
- (<| (..bytecode (for [@.old
- (|>> (:as Int) (i.= expected))
-
- @.jvm
- (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))]))
+ (<| (..bytecode (for @.old
+ (|>> (:as Int) (i.= expected))
+
+ @.jvm
+ (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))))
(do /.monad
[_ (..$Long::literal subject)
_ (..$Long::literal reference)
@@ -534,17 +535,17 @@
Test
(let [float (: (-> java/lang/Float (Bytecode Any) (Random Bit))
(function (_ expected bytecode)
- (<| (..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)))
- (f.not_a_number? (:as Frac (ffi.float_to_double (:as java/lang/Float actual)))))))
-
- @.jvm
- (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)))))))]))
+ (<| (..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)))
+ (f.not_a_number? (:as Frac (ffi.float_to_double (:as java/lang/Float actual)))))))
+
+ @.jvm
+ (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)))))))))
(do /.monad
[_ bytecode]
..$Float::wrap))))
@@ -596,11 +597,11 @@
..$Float::random)]
reference valid_float
subject valid_float
- .let [expected (if (for [@.old
- ("jvm feq" reference subject)
-
- @.jvm
- ("jvm float =" ("jvm object cast" reference) ("jvm object cast" subject))])
+ .let [expected (if (for @.old
+ ("jvm feq" reference subject)
+
+ @.jvm
+ ("jvm float =" ("jvm object cast" reference) ("jvm object cast" subject)))
+0
(if (standard reference subject)
+1
@@ -614,11 +615,11 @@
..$Long::wrap)))))
comparison_standard (: (-> java/lang/Float java/lang/Float Bit)
(function (_ reference subject)
- (for [@.old
- ("jvm fgt" subject reference)
-
- @.jvm
- ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))])))
+ (for @.old
+ ("jvm fgt" subject reference)
+
+ @.jvm
+ ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference)))))
comparison ($_ _.and
(_.lifted "FCMPL" (comparison /.fcmpl comparison_standard))
(_.lifted "FCMPG" (comparison /.fcmpg comparison_standard)))]
@@ -635,17 +636,17 @@
Test
(let [double (: (-> java/lang/Double (Bytecode Any) (Random Bit))
(function (_ expected bytecode)
- (<| (..bytecode (for [@.old
- (function (_ actual)
- (or (|> actual (:as java/lang/Double) ("jvm deq" expected))
- (and (f.not_a_number? (:as Frac expected))
- (f.not_a_number? (:as Frac actual)))))
-
- @.jvm
- (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)))))]))
+ (<| (..bytecode (for @.old
+ (function (_ actual)
+ (or (|> actual (:as java/lang/Double) ("jvm deq" expected))
+ (and (f.not_a_number? (:as Frac expected))
+ (f.not_a_number? (:as Frac actual)))))
+
+ @.jvm
+ (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)))))))
(do /.monad
[_ bytecode]
..$Double::wrap))))
@@ -690,11 +691,11 @@
(do random.monad
[reference ..valid_double
subject ..valid_double
- .let [expected (if (for [@.old
- ("jvm deq" reference subject)
-
- @.jvm
- ("jvm double =" ("jvm object cast" reference) ("jvm object cast" subject))])
+ .let [expected (if (for @.old
+ ("jvm deq" reference subject)
+
+ @.jvm
+ ("jvm double =" ("jvm object cast" reference) ("jvm object cast" subject)))
+0
(if (standard reference subject)
+1
@@ -709,11 +710,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
- ("jvm dgt" subject reference)
-
- @.jvm
- ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))])))
+ (for @.old
+ ("jvm dgt" subject reference)
+
+ @.jvm
+ ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference)))))
comparison ($_ _.and
(_.lifted "DCMPL" (comparison /.dcmpl comparison_standard))
(_.lifted "DCMPG" (comparison /.dcmpg comparison_standard)))]
@@ -791,11 +792,11 @@
(do random.monad
[expected (random.only (|>> (:as Frac) f.not_a_number? not)
..$Double::random)])
- (..bytecode (for [@.old
- (|>> (:as java/lang/Double) ("jvm deq" expected))
-
- @.jvm
- (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))]))
+ (..bytecode (for @.old
+ (|>> (:as java/lang/Double) ("jvm deq" expected))
+
+ @.jvm
+ (|>> (: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)]))))
@@ -812,11 +813,11 @@
(do random.monad
[expected (random.only (|>> (:as Frac) f.not_a_number? not)
..$Double::random)])
- (..bytecode (for [@.old
- (|>> (:as java/lang/Double) ("jvm deq" expected))
-
- @.jvm
- (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))]))
+ (..bytecode (for @.old
+ (|>> (:as java/lang/Double) ("jvm deq" expected))
+
+ @.jvm
+ (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))))
(do /.monad
[_ (/.new ..$Double)
_ /.dup
@@ -840,12 +841,12 @@
part0 ..$Long::random
part1 ..$Long::random
.let [expected (: java/lang/Long
- (for [@.old
- ("jvm ladd" part0 part1)
-
- @.jvm
- ("jvm object cast"
- ("jvm long +" ("jvm object cast" part0) ("jvm object cast" part1)))]))
+ (for @.old
+ ("jvm ladd" part0 part1)
+
+ @.jvm
+ ("jvm object cast"
+ ("jvm long +" ("jvm object cast" part0) ("jvm object cast" part1)))))
$Self (/type.class class_name (list))
class_field "class_field"
object_field "object_field"
@@ -960,59 +961,59 @@
(_.context "byte"
(array (/.newarray /instruction.t_byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap]
(function (_ expected)
- (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)))))]))))
+ (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)))))))))
(_.context "short"
(array (/.newarray /instruction.t_short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap]
(function (_ expected)
- (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)))))]))))
+ (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)))))))))
(_.context "int"
(array (/.newarray /instruction.t_int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap]
(function (_ expected)
- (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))))]))))
+ (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))))))))
(_.context "long"
(array (/.newarray /instruction.t_long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap]
(function (_ expected)
- (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))))]))))
+ (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))))))))
(_.context "float"
(array (/.newarray /instruction.t_float) ..valid_float $Float::literal [/.fastore /.faload $Float::wrap]
(function (_ expected)
- (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))))]))))
+ (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))))))))
(_.context "double"
(array (/.newarray /instruction.t_double) ..valid_double $Double::literal [/.dastore /.daload $Double::wrap]
(function (_ expected)
- (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))))]))))
+ (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))))))))
(_.context "char"
(array (/.newarray /instruction.t_char) $Character::random $Character::literal [/.castore /.caload $Character::wrap]
(function (_ expected)
- (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))))]))))
+ (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))))))))
(_.context "object"
(array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop]
(function (_ expected) (|>> (:as Text) (text#= (:as Text expected))))))
@@ -1042,11 +1043,11 @@
(template: (!::= <type> <old> <new>)
[(: (-> <type> Any Bit)
(function (_ expected)
- (for [@.old
- (|>> (:as <type>) (<old> expected))
-
- @.jvm
- (|>> (:as <type>) "jvm object cast" (<new> ("jvm object cast" (:as <type> expected))))])))])
+ (for @.old
+ (|>> (:as <type>) (<old> expected))
+
+ @.jvm
+ (|>> (:as <type>) "jvm object cast" (<new> ("jvm object cast" (:as <type> expected)))))))])
(def: conversion
Test
@@ -1073,20 +1074,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
- (|>> (: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)))))]))))
+ (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)))))))))
(_.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
- (|>> (: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)))))]))))))
+ (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)))))))))))
(<| (_.context "long")
($_ _.and
(_.lifted "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> ffi.long_to_int) int::=))
@@ -1158,16 +1159,16 @@
increment (# ! each (|>> (n.% 100) /unsigned.u1 try.trusted)
random.nat)
.let [expected (: java/lang/Long
- (for [@.old
- ("jvm ladd"
- (ffi.byte_to_long base)
- (.int (/unsigned.value increment)))
-
- @.jvm
- ("jvm object cast"
- ("jvm long +"
- ("jvm object cast" (ffi.byte_to_long base))
- ("jvm object cast" (:as java/lang/Long (/unsigned.value increment)))))]))]]
+ (for @.old
+ ("jvm ladd"
+ (ffi.byte_to_long base)
+ (.int (/unsigned.value increment)))
+
+ @.jvm
+ ("jvm object cast"
+ ("jvm long +"
+ ("jvm object cast" (ffi.byte_to_long base))
+ ("jvm object cast" (:as java/lang/Long (/unsigned.value increment)))))))]]
(..bytecode (|>> (:as Int) (i.= (:as Int expected)))
(do /.monad
[_ (..$Byte::literal base)
@@ -1419,11 +1420,11 @@
reference ..$Integer::random
subject (|> ..$Integer::random
(random.only (|>> ((!::= java/lang/Integer "jvm ieq" "jvm int =") reference) not)))
- .let [[lesser greater] (if (for [@.old
- ("jvm ilt" reference subject)
-
- @.jvm
- ("jvm int <" ("jvm object cast" subject) ("jvm object cast" reference))])
+ .let [[lesser greater] (if (for @.old
+ ("jvm ilt" reference subject)
+
+ @.jvm
+ ("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 2b335ca6a..1b1695122 100644
--- a/stdlib/source/test/lux/type/poly/equivalence.lux
+++ b/stdlib/source/test/lux/type/poly/equivalence.lux
@@ -1,27 +1,27 @@
(.using
- [library
- [lux {"-" Variant Record}
- ["_" test {"+" Test}]
- ["@" target]
- [abstract
- [monad {"+" do}]
- [equivalence {"+" Equivalence}
- [\\poly
- ["[0]" /]]]
- [\\specification
- ["$[0]" equivalence]]]
- [control
- ["[0]" maybe]]
- [data
- ["[0]" bit]
- ["[0]" text]
- [collection
- ["[0]" list]]]
- [math
- ["[0]" random {"+" Random}]
- [number
- ["n" nat]
- ["i" int]]]]])
+ [library
+ [lux {"-" Variant Record}
+ ["_" test {"+" Test}]
+ ["@" target]
+ [abstract
+ [monad {"+" do}]
+ [equivalence {"+" Equivalence}
+ [\\poly
+ ["[0]" /]]]
+ [\\specification
+ ["$[0]" equivalence]]]
+ [control
+ ["[0]" maybe]]
+ [data
+ ["[0]" bit]
+ ["[0]" text]
+ [collection
+ ["[0]" list]]]
+ [math
+ ["[0]" random {"+" Random}]
+ [number
+ ["n" nat]
+ ["i" int]]]]])
(type: Variant
(.Variant
@@ -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 466656cf0..727f658af 100644
--- a/stdlib/source/test/lux/type/poly/functor.lux
+++ b/stdlib/source/test/lux/type/poly/functor.lux
@@ -1,20 +1,20 @@
(.using
- [library
- [lux "*"
- ["@" target]
- [abstract
- [monad {"+" do}]
- [functor {"+" Functor}
- [\\poly
- ["[0]" /]]]]
- ["r" math/random {"+" Random}]
- ["_" test {"+" Test}]
- [control
- ["[0]" state]]
- [data
- ["[0]" identity]]]])
+ [library
+ [lux "*"
+ ["@" target]
+ [abstract
+ [monad {"+" do}]
+ [functor {"+" Functor}
+ [\\poly
+ ["[0]" /]]]]
+ ["r" math/random {"+" Random}]
+ ["_" test {"+" Test}]
+ [control
+ ["[0]" state]]
+ [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 56b6f13d9..668b8ea21 100644
--- a/stdlib/source/test/lux/type/poly/json.lux
+++ b/stdlib/source/test/lux/type/poly/json.lux
@@ -1,52 +1,52 @@
(.using
- [library
- [lux {"-" Variant Record}
- ["_" test {"+" Test}]
- ["@" target]
- ["[0]" debug]
- [abstract
- codec
- [monad {"+" do}]
- ["[0]" equivalence {"+" Equivalence}
- ["poly/[1]" \\poly]]
- [\\specification
- ["$[0]" equivalence]
- ["$[0]" codec]]]
- [control
- pipe
- ["[0]" try]
- ["p" parser
- ... TODO: Get rid of this import ASAP
- [json {"+"}]]]
- [data
- ["[0]" bit]
- ["[0]" text]
- [format
- [json {"+" JSON}
- [\\poly
- ["[0]" /]]]]
- [collection
- [sequence {"+" sequence}]
- ["d" dictionary]
- ["[0]" list]]]
- [type
- ["[0]" unit]]
- [math
- ["[0]" random {"+" Random}]
- [number
- ["n" nat]
- ["[0]" frac]]]
- [time
- ["ti" instant]
- ["tda" date]
- ... ["tdu" duration]
- ]]]
- [test
- [lux
- [time
- ["_[0]" instant]
- ... ["_[0]" duration]
- ]]])
+ [library
+ [lux {"-" Variant Record}
+ ["_" test {"+" Test}]
+ ["@" target]
+ ["[0]" debug]
+ [abstract
+ codec
+ [monad {"+" do}]
+ ["[0]" equivalence {"+" Equivalence}
+ ["poly/[1]" \\poly]]
+ [\\specification
+ ["$[0]" equivalence]
+ ["$[0]" codec]]]
+ [control
+ pipe
+ ["[0]" try]
+ ["p" parser
+ ... TODO: Get rid of this import ASAP
+ [json {"+"}]]]
+ [data
+ ["[0]" bit]
+ ["[0]" text]
+ [format
+ [json {"+" JSON}
+ [\\poly
+ ["[0]" /]]]]
+ [collection
+ [sequence {"+" sequence}]
+ ["d" dictionary]
+ ["[0]" list]]]
+ [type
+ ["[0]" unit]]
+ [math
+ ["[0]" random {"+" Random}]
+ [number
+ ["n" nat]
+ ["[0]" frac]]]
+ [time
+ ["ti" instant]
+ ["tda" date]
+ ... ["tdu" duration]
+ ]]]
+ [test
+ [lux
+ [time
+ ["_[0]" instant]
+ ... ["_[0]" duration]
+ ]]])
(type: Variant
(.Variant
@@ -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)))))