aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux15
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation.lux16
-rw-r--r--stdlib/source/test/lux.lux104
-rw-r--r--stdlib/source/test/lux/data.lux81
4 files changed, 137 insertions, 79 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
index 63f0561c0..98cf8baf8 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
@@ -50,7 +50,10 @@
["/#" // #_
[reference (#+)]
["#." analysis (#+ Analysis Operation Phase Handler Bundle)]
- ["#." synthesis]]]]])
+ ["#." synthesis]
+ [meta
+ [archive
+ [descriptor (#+ Module)]]]]]]])
(def: reflection (|>> jvm.reflection reflection.reflection))
(def: signature (|>> jvm.signature signature.signature))
@@ -1890,6 +1893,12 @@
mapping))
jvm-alias.fresh)))))
+(def: (anonymous-class-name module id)
+ (-> Module Nat Text)
+ (let [global (text.replace-all .module-separator ..jvm-package-separator module)
+ local (format "anonymous-class" (%.nat id))]
+ (format global ..jvm-package-separator local)))
+
(def: class::anonymous
Handler
(..custom
@@ -1916,9 +1925,7 @@
name (///.lift (do macro.monad
[where macro.current-module-name
id macro.count]
- (wrap (format (text.replace-all .module-separator ..jvm-package-separator where)
- ..jvm-package-separator
- "anonymous-class" (%.nat id)))))
+ (wrap (..anonymous-class-name where id))))
super-classT (typeA.with-env
(luxT.check (luxT.class mapping) (..signature super-class)))
super-interfaceT+ (typeA.with-env
diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux
index 198ca4bb4..2f6e28ed2 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation.lux
@@ -103,6 +103,22 @@
#counter 0
#name-cache (dictionary.new name.hash)})
+(def: #export (with-specific-context specific-scope expr)
+ (All [anchor expression directive output]
+ (-> Text
+ (Operation anchor expression directive output)
+ (Operation anchor expression directive output)))
+ (function (_ [bundle state])
+ (let [old (get@ #context state)]
+ (case (expr [bundle (set@ #context [specific-scope 0] state)])
+ (#try.Success [[bundle' state']
+ output])
+ (#try.Success [[bundle' (set@ #context old state')]
+ output])
+
+ (#try.Failure error)
+ (#try.Failure error)))))
+
(def: #export (with-context expr)
(All [anchor expression directive output]
(-> (Operation anchor expression directive output)
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 22208adcc..d9fbc7b1d 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -140,6 +140,13 @@
["#/." jvm]]]
))
+## TODO: Get rid of this ASAP
+(template: (!bundle body)
+ (: Test
+ (do random.monad
+ [_ (wrap [])]
+ body)))
+
(def: identity
Test
(do random.monad
@@ -309,55 +316,58 @@
(def: test
(<| (_.context (name.module (name-of /._)))
($_ _.and
- (<| (_.context "Identity.")
- ..identity)
- (<| (_.context "Increment & decrement.")
- ..increment-and-decrement)
- (<| (_.context "Even or odd.")
- ($_ _.and
- (<| (_.context "Natural numbers.")
- (..even-or-odd random.nat n.even? n.odd?))
- (<| (_.context "Integers.")
- (..even-or-odd random.int i.even? i.odd?))))
- (<| (_.context "Minimum and maximum.")
- (`` ($_ _.and
- (~~ (template [<=> <lt> <min> <gt> <max> <gen> <context>]
- [(<| (_.context <context>)
- (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))]
+ (!bundle ($_ _.and
+ (<| (_.context "Identity.")
+ ..identity)
+ (<| (_.context "Increment & decrement.")
+ ..increment-and-decrement)
+ (<| (_.context "Even or odd.")
+ ($_ _.and
+ (<| (_.context "Natural numbers.")
+ (..even-or-odd random.nat n.even? n.odd?))
+ (<| (_.context "Integers.")
+ (..even-or-odd random.int i.even? i.odd?))))
+ (<| (_.context "Minimum and maximum.")
+ (`` ($_ _.and
+ (~~ (template [<=> <lt> <min> <gt> <max> <gen> <context>]
+ [(<| (_.context <context>)
+ (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))]
- [i.= i.< i.min i.> i.max random.int "Integers."]
- [n.= n.< n.min n.> n.max random.nat "Natural numbers."]
- [r.= r.< r.min r.> r.max random.rev "Revolutions."]
- [f.= f.< f.min f.> f.max random.safe-frac "Fractions."]
- )))))
- (<| (_.context "Conversion.")
- (`` ($_ _.and
- (~~ (template [<=> <forward> <backward> <gen>]
- [(<| (_.context (format (%.name (name-of <forward>))
- " " (%.name (name-of <backward>))))
- (..conversion <gen> <forward> <backward> <=>))]
+ [i.= i.< i.min i.> i.max random.int "Integers."]
+ [n.= n.< n.min n.> n.max random.nat "Natural numbers."]
+ [r.= r.< r.min r.> r.max random.rev "Revolutions."]
+ [f.= f.< f.min f.> f.max random.safe-frac "Fractions."]
+ )))))
+ (<| (_.context "Conversion.")
+ (`` ($_ _.and
+ (~~ (template [<=> <forward> <backward> <gen>]
+ [(<| (_.context (format (%.name (name-of <forward>))
+ " " (%.name (name-of <backward>))))
+ (..conversion <gen> <forward> <backward> <=>))]
- [i.= .nat .int (random@map (i.% +1,000,000) random.int)]
- [n.= .int .nat (random@map (n.% 1,000,000) random.nat)]
- [i.= i.frac f.int (random@map (i.% +1,000,000) random.int)]
- [f.= f.int i.frac (random@map (|>> (i.% +1,000,000) i.frac) random.int)]
- [r.= r.frac f.rev frac-rev]
- )))))
- (<| (_.context "Prelude macros.")
- ..prelude-macros)
- (<| (_.context "Templates.")
- ..templates)
- (<| (_.context "Cross-platform support.")
- ..cross-platform-support)
- /abstract.test
- /control.test
- /data.test
- /macro.test
- /math.test
- /time.test
- /tool.test
- /type.test
- /world.test
+ [i.= .nat .int (random@map (i.% +1,000,000) random.int)]
+ [n.= .int .nat (random@map (n.% 1,000,000) random.nat)]
+ [i.= i.frac f.int (random@map (i.% +1,000,000) random.int)]
+ [f.= f.int i.frac (random@map (|>> (i.% +1,000,000) i.frac) random.int)]
+ [r.= r.frac f.rev frac-rev]
+ )))))
+ (<| (_.context "Prelude macros.")
+ ..prelude-macros)
+ (<| (_.context "Templates.")
+ ..templates)
+ (<| (_.context "Cross-platform support.")
+ ..cross-platform-support)))
+ (!bundle ($_ _.and
+ /abstract.test
+ /control.test
+ /data.test
+ /macro.test
+ /math.test))
+ (!bundle ($_ _.and
+ /time.test
+ /tool.test
+ /type.test
+ /world.test))
/host.test
($_ _.and
/target/jvm.test)
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux
index 116a4c890..fa544ccd5 100644
--- a/stdlib/source/test/lux/data.lux
+++ b/stdlib/source/test/lux/data.lux
@@ -1,6 +1,10 @@
(.module:
[lux #*
- ["_" test (#+ Test)]]
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [math
+ ["." random ("#@." monad)]]]
["." / #_
["#." binary]
["#." bit]
@@ -29,20 +33,34 @@
["#." xml]]
["#." collection]])
+## TODO: Get rid of this ASAP
+(template: (!bundle body)
+ (: Test
+ (do random.monad
+ [_ (wrap [])]
+ body)))
+
(def: number
Test
- ($_ _.and
- /i8.test
- /i16.test
- /i32.test
- /i64.test
- /nat.test
- /int.test
- /rev.test
- /frac.test
- /ratio.test
- /complex.test
- ))
+ ## TODO: Inline ASAP
+ (let [part0 ($_ _.and
+ /i8.test
+ /i16.test
+ /i32.test
+ /i64.test)
+ part1 ($_ _.and
+ /nat.test
+ /int.test
+ /rev.test)
+ part2 ($_ _.and
+ /frac.test
+ /ratio.test
+ /complex.test)]
+ ($_ _.and
+ (!bundle part0)
+ (!bundle part1)
+ (!bundle part2)
+ )))
(def: text
($_ _.and
@@ -58,18 +76,25 @@
(def: #export test
Test
- ($_ _.and
- /binary.test
- /bit.test
- /color.test
- /identity.test
- /lazy.test
- /maybe.test
- /name.test
- /product.test
- /sum.test
- ..number
- ..text
- ..format
- /collection.test
- ))
+ ## TODO: Inline ASAP
+ (let [test0 ($_ _.and
+ /binary.test
+ /bit.test
+ /color.test
+ /identity.test)
+ test1 ($_ _.and
+ /lazy.test
+ /maybe.test
+ /name.test
+ /product.test)
+ test2 ($_ _.and
+ /sum.test
+ ..number
+ ..text
+ ..format
+ /collection.test)]
+ ($_ _.and
+ (!bundle test0)
+ (!bundle test1)
+ (!bundle test2)
+ )))