diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 104 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data.lux | 81 |
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) + ))) |