(.with-expansions [ (.as-is [runtime (#+)] [primitive (#+)] [structure (#+)] [reference (#+)] [case (#+)] [loop (#+)] [function (#+)] [extension (#+)])] (.module: ["/" lux #* [abstract [monad (#+ do)] [predicate (#+ Predicate)]] [control ["." io (#+ io)] ["." function] [parser [cli (#+ program:)]]] [data ["." name] [number ["." i64]]] ["." math] ["_" test (#+ Test)] ## These modules do not need to be tested. [type [variance (#+)]] [locale (#+) [language (#+)] [territory (#+)]] data/text/format ["r" math/random (#+ Random) ("#@." functor)] ## TODO: Test these modules [data [format [css (#+)] [markdown (#+)]]] [target [js (#+)] [python (#+)] [lua (#+)] [ruby (#+)] [php (#+)] [common-lisp (#+)] [scheme (#+)]] [tool [compiler [phase [generation [js (#+) ] [python (#+) ] [lua (#+) ] [ruby (#+) ] [php (#+) ] [common-lisp (#+) ] [scheme (#+) ]]]]] ## [control ## ["._" contract] ## ["._" concatenative] ## ["._" predicate] ## [monad ## ["._" free]] ## [parser ## [type (#+)]]] ## [data ## ["._" env] ## ["._" trace] ## ["._" store] ## [format ## ["._" context] ## ["._" html] ## ["._" css] ## ["._" binary]] ## [collection ## [tree ## [rose ## ["._" parser]]] ## [dictionary ## ["._" plist]] ## [set ## ["._" multi]]] ## [text ## ["._" buffer]]] ## ["._" macro] ## [type ## ["._" unit] ## ["._" refinement] ## ["._" quotient]] ## [world ## ["._" environment] ## ["._" console]] ## [compiler ## ["._" cli] ## ["._" default ## ["._" evaluation] ## [phase ## ["._" generation] ## [extension ## ["._" statement]]] ## ["._default" cache]] ## [meta ## ["._meta" io ## ["._meta_io" context] ## ["._meta_io" archive]] ## ["._meta" archive] ## ["._meta" cache]]] ## ["._" interpreter ## ["._interpreter" type]] ] ## TODO: Must have 100% coverage on tests. ["." / #_ ["#." abstract] ["#." control] ["#." data] ["#." macro] ["#." math] ["#." time] ["#." tool] ["#." type] ["#." world] ["#." host] ["#." target #_ ["#/." jvm]]] )) (def: identity Test (do r.monad [self (r.unicode 1)] ($_ _.and (_.test "Every value is identical to itself." (is? self self)) (_.test "The identity function doesn't change values in any way." (is? self (function.identity self))) (do @ [other (r.unicode 1)] (_.test "Values created separately can't be identical." (not (is? self other)))) ))) (def: increment-and-decrement Test (do r.monad [value r.i64] ($_ _.and (_.test "'inc' and 'dec' are opposites." (and (|> value inc dec (n/= value)) (|> value dec inc (n/= value)))) (_.test "'inc' and 'dec' shift the number by 1." (and (|> (inc value) (n/- value) (n/= 1)) (|> value (n/- (dec value)) (n/= 1))))))) (def: (check-neighbors has-property? value) (All [a] (-> (Predicate (I64 a)) (I64 a) Bit)) (and (|> value inc has-property?) (|> value dec has-property?))) (def: (even-or-odd rand-gen even? odd?) (All [a] (-> (Random (I64 a)) (Predicate (I64 a)) (Predicate (I64 a)) Test)) (do r.monad [value rand-gen] ($_ _.and (_.test "Every number is either even or odd." (if (even? value) (not (odd? value)) (odd? value))) (_.test "Every odd/even number is surrounded by two of the other kind." (if (even? value) (check-neighbors odd? value) (check-neighbors even? value)))))) (type: (Choice a) (-> a a a)) (type: (Order a) (-> a a Bit)) (type: (Equivalence a) (-> a a Bit)) (def: (choice rand-gen = [< choose]) (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test)) (do r.monad [left rand-gen right rand-gen #let [choice (choose left right)]] ($_ _.and (_.test "The choice between 2 values is one of them." (or (= left choice) (= right choice))) (_.test "The choice between 2 values implies an order relationship between them." (if (= left choice) (< right choice) (< left choice)))))) (def: (minimum-and-maximum rand-gen = min' max') (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] [(Order a) (Choice a)] Test)) ($_ _.and (<| (_.context "Minimum.") (choice rand-gen = min')) (<| (_.context "Maximum.") (choice rand-gen = max')))) (def: (conversion rand-gen forward backward =) (All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test)) (do r.monad [value rand-gen] (_.test "Can convert between types in a lossless way." (|> value forward backward (= value))))) (def: frac-rev (r.Random Rev) (let [bits-to-ignore 11] (:: r.functor map (i64.left-shift bits-to-ignore) r.rev))) (def: prelude-macros Test ($_ _.and (do r.monad [factor (r@map (|>> (n/% 10) (n/max 1)) r.nat) iterations (r@map (n/% 100) r.nat) #let [expected (n/* factor iterations)]] (_.test "Can write loops." (n/= expected (loop [counter 0 value 0] (if (n/< iterations counter) (recur (inc counter) (n/+ factor value)) value))))) (do r.monad [first r.nat second r.nat third r.nat] (_.test "Can create lists easily through macros." (and (case (list first second third) (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) (and (n/= first first') (n/= second second') (n/= third third')) _ false) (case (list& first (list second third)) (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) (and (n/= first first') (n/= second second') (n/= third third')) _ false) (case (list& first second (list third)) (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) (and (n/= first first') (n/= second second') (n/= third third')) _ false)))) )) (template: (quadrance cat0 cat1) (n/+ (n/* cat0 cat0) (n/* cat1 cat1))) (def: templates Test (do r.monad [cat0 r.nat cat1 r.nat] (_.test "Template application is a stand-in for the templated code." (n/= (n/+ (n/* cat0 cat0) (n/* cat1 cat1)) (quadrance cat0 cat1))))) (def: cross-platform-support Test (do r.monad [on-default r.nat on-fake-host r.nat on-valid-host r.nat] ($_ _.and (_.test "Can provide default in case there is no particular host/platform support." (n/= on-default (for {"" on-fake-host} on-default))) (_.test "Can pick code depending on the host/platform being targeted." (n/= on-valid-host (for {"JVM" on-valid-host "JS" on-valid-host} on-default)))))) (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 r.nat n/even? n/odd?)) (<| (_.context "Integers.") (..even-or-odd r.int i/even? i/odd?)))) (<| (_.context "Minimum and maximum.") (`` ($_ _.and (~~ (template [<=> ] [(<| (_.context ) (..minimum-and-maximum <=> [ ] [ ]))] [i/= i/< i/min i/> i/max r.int "Integers."] [n/= n/< n/min n/> n/max r.nat "Natural numbers."] [r/= r/< r/min r/> r/max r.rev "Revolutions."] [f/= f/< f/min f/> f/max r.frac "Fractions."] ))))) (<| (_.context "Conversion.") (`` ($_ _.and (~~ (template [<=> ] [(<| (_.context (format (%name (name-of )) " " (%name (name-of )))) (..conversion <=>))] [i/= .nat .int (r@map (i/% +1,000,000) r.int)] [n/= .int .nat (r@map (n/% 1,000,000) r.nat)] [i/= .int-to-frac .frac-to-int (r@map (i/% +1,000,000) r.int)] [f/= .frac-to-int .int-to-frac (r@map (|>> (i/% +1,000,000) .int-to-frac) r.int)] [r/= .rev-to-frac .frac-to-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 /host.test ($_ _.and /target/jvm.test) ))) (program: args (<| io _.run! ## (_.times 100) (_.seed 8070500311708372420) ..test))