diff options
Diffstat (limited to 'stdlib/source')
21 files changed, 657 insertions, 221 deletions
diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index e58e10405..e4ebba1c9 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -33,7 +33,8 @@ (new [int]) (toString [] java/lang/String)]))] (`` (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)}))) + @.jvm (as_is <jvm>)} + (as_is)))) (`` (abstract: #export Buffer (for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] diff --git a/stdlib/source/lux/math/number.lux b/stdlib/source/lux/math/number.lux index dd7dba194..a96c450ee 100644 --- a/stdlib/source/lux/math/number.lux +++ b/stdlib/source/lux/math/number.lux @@ -19,8 +19,8 @@ "Given syntax for a " encoding " number, generates a Nat, an Int, a Rev or a Frac.") - commas "Allows for the presence of commas among the digits." - description [location (#.Text ($_ "lux text concat" encoding " " commas))]] + separators "Allows for the presence of commas among the digits." + description [location (#.Text ($_ "lux text concat" encoding " " separators))]] (#try.Success [state (list (` (doc (~ description) (~ example_1) (~ example_2))))])) @@ -28,27 +28,30 @@ _ (#try.Failure "Wrong syntax for 'encoding_doc'."))) -(def: (comma_prefixed? number) +(def: separator + ",") + +(def: (separator_prefixed? number) (-> Text Bit) - (case ("lux text index" 0 "," number) + (case ("lux text index" 0 ..separator number) (#.Some 0) #1 _ #0)) -(def: clean_commas +(def: clean_separators (-> Text Text) - (text.replace_all "," "")) + (text.replace_all ..separator "")) (template [<macro> <nat> <int> <rev> <frac> <error> <doc>] [(macro: #export (<macro> tokens state) {#.doc <doc>} (case tokens (#.Cons [meta (#.Text repr')] #.Nil) - (if (comma_prefixed? repr') + (if (..separator_prefixed? repr') (#try.Failure <error>) - (let [repr (clean_commas repr')] + (let [repr (..clean_separators repr')] (case (\ <nat> decode repr) (#try.Success value) (#try.Success [state (list [meta (#.Nat value)])]) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index aeeb71cf1..9b12c6ae9 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -147,9 +147,10 @@ (def: #export current_module (Meta Module) - (do ..monad - [this_module_name current_module_name] - (find_module this_module_name))) + (let [(^open "\.") ..monad] + (|> ..current_module_name + (\map ..find_module) + \join))) (def: (macro_type? type) (-> Type Bit) @@ -593,13 +594,12 @@ (def: #export (imported? import) (-> Text (Meta Bit)) - (let [(^open ".") ..monad] - (|> ..current_module_name - (map ..find_module) join - (map (|>> (get@ #.imports) (list.any? (text\= import))))))) + (\ ..functor map + (|>> (get@ #.imports) (list.any? (text\= import))) + ..current_module)) (def: #export (resolve_tag tag) - {#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."} + {#.doc "Given a tag, finds out what is its index, its related tag-list and its associated type."} (-> Name (Meta [Nat (List Name) Type])) (do ..monad [#let [[module name] tag] diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index fbe116ee1..3ea941935 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -3,6 +3,7 @@ [abstract [equivalence (#+ Equivalence)] [order (#+ Order)] + [enum (#+ Enum)] [codec (#+ Codec)] [monoid (#+ Monoid)] [monad (#+ do)]] @@ -54,10 +55,6 @@ (-> Duration Duration) (|>> :representation (i.* -1) :abstraction)) - (def: #export (difference from to) - (-> Duration Duration Duration) - (|> from inverse (merge to))) - (def: #export (query param subject) (-> Duration Duration Int) (i./ (:representation param) (:representation subject))) @@ -178,8 +175,7 @@ (..merge (..up hours ..hour)) (..merge (..up minutes ..minute)) (..merge (..up seconds ..second)) - (..merge (..up millis ..milli_second)) - )]] + (..merge (..up millis ..milli_second)))]] (wrap (case sign (#.Left _) (..inverse span) (#.Right _) span))))) @@ -189,3 +185,16 @@ (def: encode ..encode) (def: decode (<t>.run ..parser))) + +(def: #export (difference from to) + (-> Duration Duration Duration) + (|> from ..inverse (..merge to))) + +(structure: #export enum + (Enum Duration) + + (def: &order ..order) + (def: succ + (..merge ..milli_second)) + (def: pred + (..merge (..inverse ..milli_second)))) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 15b7165f4..21fc0b343 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -1,6 +1,7 @@ (.module: [lux (#- Module) [type (#+ :share)] + ["." debug] ["@" target (#+ Host)] [abstract ["." monad (#+ Monad do)]] @@ -524,7 +525,7 @@ (#.Right [[descriptor document] output]) (do ! - [#let [_ (log! (..module_compilation_log state)) + [#let [_ (debug.log! (..module_compilation_log state)) descriptor (set@ #descriptor.references (set.from_list text.hash all_dependencies) descriptor)] _ (..cache_module static platform module_id [[descriptor document] output])] (case (archive.add module [descriptor document] archive) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux index 09341fd59..db00d6439 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux @@ -5,13 +5,16 @@ ["." // #_ ["#." runtime]]) -(def: #export bit _.boolean) +(def: #export bit + _.boolean) (def: #export (i64 value) (-> (I64 Any) Computation) - (//runtime.i64//new (|> value //runtime.high .int _.i32) - (|> value //runtime.low .int _.i32))) + (//runtime.i64 (|> value //runtime.high .int _.i32) + (|> value //runtime.low .int _.i32))) -(def: #export f64 _.number) +(def: #export f64 + _.number) -(def: #export text _.string) +(def: #export text + _.string) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 119796a73..82d787b9a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- i64) ["." meta] [abstract ["." monad (#+ do)]] @@ -193,14 +193,19 @@ (def: #export variant_flag_field "_lux_flag") (def: #export variant_value_field "_lux_value") -(runtime: (variant//create tag last? value) - (_.return (_.object (list [..variant_tag_field tag] - [..variant_flag_field last?] - [..variant_value_field value])))) +(runtime: (variant//new tag last? value) + (let [@this (_.var "this")] + (with_vars [tag is_last value] + (_.closure (list tag is_last value) + ($_ _.then + (_.set (_.the ..variant_tag_field @this) tag) + (_.set (_.the ..variant_flag_field @this) is_last) + (_.set (_.the ..variant_value_field @this) value) + ))))) (def: #export (variant tag last? value) (-> Expression Expression Expression Computation) - (..variant//create tag last? value)) + (_.new ..variant//new (list tag last? value))) (runtime: (sum//get sum wants_last wanted_tag) (let [no_match! (_.return _.null) @@ -249,7 +254,7 @@ ($_ _.then @tuple//left @tuple//right - @variant//create + @variant//new @sum//get )) @@ -281,8 +286,17 @@ (def: #export i64_high_field Text "_lux_high") (runtime: (i64//new high low) - (_.return (_.object (list [..i64_high_field high] - [..i64_low_field low])))) + (let [@this (_.var "this")] + (with_vars [high low] + (_.closure (list high low) + ($_ _.then + (_.set (_.the ..i64_high_field @this) high) + (_.set (_.the ..i64_low_field @this) low) + ))))) + +(def: #export (i64 high low) + (-> Expression Expression Computation) + (_.new ..i64//new (list high low))) (runtime: i64//2^16 (_.left_shift (_.i32 +16) (_.i32 +1))) @@ -306,16 +320,18 @@ (_.+ (i64//unsigned_low i64))))) (runtime: i64//zero - (i64//new (_.i32 +0) (_.i32 +0))) + (..i64 (_.i32 +0) (_.i32 +0))) (runtime: i64//min - (i64//new (_.i32 (hex "+80000000")) (_.i32 +0))) + (..i64 (_.i32 (hex "+80,00,00,00")) + (_.i32 +0))) (runtime: i64//max - (i64//new (_.i32 (hex "+7FFFFFFF")) (_.i32 (hex "+FFFFFFFF")))) + (..i64 (_.i32 (hex "+7F,FF,FF,FF")) + (_.i32 (hex "+FF,FF,FF,FF")))) (runtime: i64//one - (i64//new (_.i32 +0) (_.i32 +1))) + (..i64 (_.i32 +0) (_.i32 +1))) (runtime: (i64//= reference sample) (_.return (_.and (_.= (_.the ..i64_high_field reference) @@ -355,16 +371,16 @@ (_.define x48 (|> (high_16 x32) (_.+ l48) (_.+ r48) low_16)) (_.set x32 (low_16 x32)) - (_.return (i64//new (_.bit_or (up_16 x48) x32) - (_.bit_or (up_16 x16) x00))) + (_.return (..i64 (_.bit_or (up_16 x48) x32) + (_.bit_or (up_16 x16) x00))) )))) (template [<name> <op>] [(runtime: (<name> subject parameter) - (_.return (i64//new (<op> (_.the ..i64_high_field subject) - (_.the ..i64_high_field parameter)) - (<op> (_.the ..i64_low_field subject) - (_.the ..i64_low_field parameter)))))] + (_.return (..i64 (<op> (_.the ..i64_high_field subject) + (_.the ..i64_high_field parameter)) + (<op> (_.the ..i64_low_field subject) + (_.the ..i64_low_field parameter)))))] [i64//xor _.bit_xor] [i64//or _.bit_or] @@ -372,8 +388,8 @@ ) (runtime: (i64//not value) - (_.return (i64//new (_.bit_not (_.the ..i64_high_field value)) - (_.bit_not (_.the ..i64_low_field value))))) + (_.return (..i64 (_.bit_not (_.the ..i64_high_field value)) + (_.bit_not (_.the ..i64_low_field value))))) (runtime: (i64//negate value) (_.if (i64//= i64//min value) @@ -392,8 +408,8 @@ (_.return i64//max)] [(|> value (_.< (_.i32 +0))) (_.return (|> value _.negate i64//from_number i64//negate))]) - (_.return (i64//new (|> value (_./ i64//2^32) _.to_i32) - (|> value (_.% i64//2^32) _.to_i32))))) + (_.return (..i64 (|> value (_./ i64//2^32) _.to_i32) + (|> value (_.% i64//2^32) _.to_i32))))) (def: (cap_shift! shift) (-> Var Statement) @@ -416,9 +432,9 @@ (let [high (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift shift)) (|> input (_.the ..i64_low_field) (_.logic_right_shift (_.- shift (_.i32 +32))))) low (|> input (_.the ..i64_low_field) (_.left_shift shift))] - (_.return (i64//new high low)))]) + (_.return (..i64 high low)))]) (let [high (|> input (_.the ..i64_low_field) (_.left_shift (_.- (_.i32 +32) shift)))] - (_.return (i64//new high (_.i32 +0))))))) + (_.return (..i64 high (_.i32 +0))))))) (runtime: (i64//arithmetic_right_shift input shift) ($_ _.then @@ -428,12 +444,12 @@ (let [high (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift shift)) low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift) (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] - (_.return (i64//new high low)))]) + (_.return (..i64 high low)))]) (let [high (_.? (|> input (_.the ..i64_high_field) (_.>= (_.i32 +0))) (_.i32 +0) (_.i32 -1)) low (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift (_.- (_.i32 +32) shift)))] - (_.return (i64//new high low)))))) + (_.return (..i64 high low)))))) (runtime: (i64//logic_right_shift input shift) ($_ _.then @@ -443,11 +459,11 @@ (let [high (|> input (_.the ..i64_high_field) (_.logic_right_shift shift)) low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift) (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] - (_.return (i64//new high low)))] + (_.return (..i64 high low)))] [(|> shift (_.= (_.i32 +32))) - (_.return (i64//new (_.i32 +0) (|> input (_.the ..i64_high_field))))]) - (_.return (i64//new (_.i32 +0) - (|> input (_.the ..i64_high_field) (_.logic_right_shift (_.- (_.i32 +32) shift)))))))) + (_.return (..i64 (_.i32 +0) (|> input (_.the ..i64_high_field))))]) + (_.return (..i64 (_.i32 +0) + (|> input (_.the ..i64_high_field) (_.logic_right_shift (_.- (_.i32 +32) shift)))))))) (def: runtime//bit Statement @@ -520,8 +536,8 @@ (_.+ (_.* l00 r48)) low_16)) - (_.return (i64//new (_.bit_or (up_16 x48) x32) - (_.bit_or (up_16 x16) x00))) + (_.return (..i64 (_.bit_or (up_16 x48) x32) + (_.bit_or (up_16 x16) x00))) )))))) (runtime: (i64//< parameter subject) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index cc86b7df2..011734cc8 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Type Definition case log! false true) + [lux (#- Type Definition case false true) [abstract ["." monad (#+ do)] ["." enum]] diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 8e60de863..8882270f8 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -626,15 +626,27 @@ (System IO) (~~ (template [<name> <method> <capability> <exception>] - [(def: <name> - (..can_open - (function (<name> path) - (do (try.with io.monad) - [stats (Fs::statSync [path] (..node_fs [])) - verdict (<method> [] stats)] - (if verdict - (wrap (<capability> path)) - (\ io.monad wrap (exception.throw <exception> [path])))))))] + [(with_expansions [<failure> (exception.throw <exception> [path])] + (def: <name> + (..can_open + (function (<name> path) + (do {! io.monad} + [?stats (Fs::statSync [path] (..node_fs []))] + (case ?stats + (#try.Success stats) + (do ! + [?verdict (<method> [] stats)] + (wrap (case ?verdict + (#try.Success verdict) + (if verdict + (#try.Success (<capability> path)) + <failure>) + + (#try.Failure _) + <failure>))) + + (#try.Failure _) + (wrap <failure>)))))))] [file Stats::isFile ..file ..cannot_find_file] [directory Stats::isDirectory ..directory ..cannot_find_directory] diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index 049a80dea..205fbb7f8 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -1,7 +1,7 @@ (.module: [lux #* ["@" target] - [host (#+ import:)] + ["." host (#+ import:)] [abstract [monad (#+ do)]] [control @@ -11,13 +11,17 @@ ["." atom] ["." promise (#+ Promise)]] [parser - [environment (#+ Environment)]]] + ["." environment (#+ Environment)]]] [data ["." maybe] ["." text ["%" format (#+ format)]] [collection - ["." dictionary (#+ Dictionary)]]]] + ["." array (#+ Array) ("#\." fold)] + ["." dictionary (#+ Dictionary)]]] + [math + [number + ["i" int]]]] [// [file (#+ Path)] [shell (#+ Exit)]]) @@ -109,7 +113,61 @@ @.jvm <jvm>}))) )] (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)})) + @.jvm (as_is <jvm>) + @.js (as_is (def: default_exit! + (-> Exit (IO Nothing)) + (|>> %.int error! io.io)) + + (import: NodeJs_Process + (exit [host.Number] #io Nothing) + (cwd [] #io Path)) + + (def: (exit_node_js! code) + (-> Exit (IO Nothing)) + (case (host.constant ..NodeJs_Process [process]) + (#.Some process) + (NodeJs_Process::exit (i.frac code) process) + + #.None + (..default_exit! code))) + + (import: Browser_Window + (close [] Nothing)) + + (import: Browser_Location + (reload [] Nothing)) + + (def: (exit_browser! code) + (-> Exit (IO Nothing)) + (case [(host.constant ..Browser_Window [window]) + (host.constant ..Browser_Location [location])] + [(#.Some window) (#.Some location)] + (exec + (Browser_Window::close [] window) + (Browser_Location::reload [] location) + (..default_exit! code)) + + [(#.Some window) #.None] + (exec + (Browser_Window::close [] window) + (..default_exit! code)) + + [#.None (#.Some location)] + (exec + (Browser_Location::reload [] location) + (..default_exit! code)) + + [#.None #.None] + (..default_exit! code))) + + (import: JS_Object + (entries [] (Array (Array host.String)))) + + (import: NodeJs_OS + (homedir [] #io Path)) + + (import: (require [host.String] Any)))} + (as_is))) (structure: #export default (Program IO) @@ -117,21 +175,66 @@ (def: (environment _) (with_expansions [<jvm> ..jvm\\environment] (for {@.old <jvm> - @.jvm <jvm>}))) + @.jvm <jvm> + @.js (io.io (if host.on_node_js? + (case (host.constant JS_Object [process env]) + (#.Some process/env) + (|> process/env + (JS_Object::entries []) + (array\fold (function (_ entry environment) + (<| (maybe.default environment) + (do maybe.monad + [variable (array.read 0 entry) + value (array.read 1 entry)] + (wrap (dictionary.put variable value environment))))) + environment.empty)) + + #.None + (undefined)) + environment.empty))} + ## TODO: Replace dummy implementation. + (io.io environment.empty)))) (def: (home _) - (with_expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] + (with_expansions [<default> (io.io "~") + <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] (for {@.old <jvm> - @.jvm <jvm>}))) + @.jvm <jvm> + @.js (if host.on_node_js? + (|> (..require "os") + (:coerce NodeJs_OS) + (NodeJs_OS::homedir [])) + <default>)} + ## TODO: Replace dummy implementation. + <default>))) (def: (directory _) - (with_expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] + (with_expansions [<default> (io.io ".") + <jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] (for {@.old <jvm> - @.jvm <jvm>}))) + @.jvm <jvm> + @.js (if host.on_node_js? + (case (host.constant ..NodeJs_Process [process]) + (#.Some process) + (NodeJs_Process::cwd [] process) + + #.None + <default>) + <default>)} + ## TODO: Replace dummy implementation. + <default>))) (def: (exit code) (with_expansions [<jvm> (do io.monad [_ (java/lang/System::exit code)] (wrap (undefined)))] (for {@.old <jvm> - @.jvm <jvm>})))) + @.jvm <jvm> + @.js (cond host.on_node_js? + (..exit_node_js! code) + + host.on_browser? + (..exit_browser! code) + + ## else + (..default_exit! code))})))) diff --git a/stdlib/source/program/aedifex/artifact/value.lux b/stdlib/source/program/aedifex/artifact/value.lux index eb5c33c22..3e92dbf16 100644 --- a/stdlib/source/program/aedifex/artifact/value.lux +++ b/stdlib/source/program/aedifex/artifact/value.lux @@ -1,25 +1,19 @@ (.module: - [lux (#- Name Type) + [lux #* [abstract [equivalence (#+ Equivalence)]] [data ["." product] ["." text ["%" format]] - [format - ["." xml]] [collection ["." list ("#\." functor)]]] [math [number - ["n" nat]]] - ["." time (#+ Time) - ["." instant (#+ Instant)] - ["." date (#+ Date)] - ["." year] - ["." month]]] + ["." nat]]] + [time + ["." instant]]] [// (#+ Version) - [type (#+ Type)] ["." time_stamp (#+ Time_Stamp)]]) (type: #export Build @@ -35,7 +29,7 @@ ($_ product.equivalence text.equivalence instant.equivalence - n.equivalence + nat.equivalence )) (def: separator @@ -44,7 +38,7 @@ (def: snapshot "SNAPSHOT") -(def: #export (format [version time_stamp build]) +(def: #export (format (^slots [#version #time_stamp #build])) (%.Format Value) (%.format (text.replace_all ..snapshot (time_stamp.format time_stamp) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 2788783cc..63325ff0b 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -1,6 +1,7 @@ (.module: [lux (#- Module) [type (#+ :share)] + ["." debug] ["@" target (#+ Host)] [abstract [monad (#+ Monad do)]] @@ -62,9 +63,9 @@ [?output action] (case ?output (#try.Failure error) - (exec (log! (format text.new_line - failure_description text.new_line - error text.new_line)) + (exec (debug.log! (format text.new_line + failure_description text.new_line + error text.new_line)) (io.run (\ world/program.default exit +1))) (#try.Success output) @@ -141,14 +142,14 @@ _ (ioW.freeze (get@ #platform.&file_system platform) static archive) program_context (promise\wrap ($/program.context archive)) _ (promise.future (..package! io.monad file.default packager,package static archive program_context))] - (wrap (log! "Compilation complete!")))) + (wrap (debug.log! "Compilation complete!")))) (#/cli.Export export) (<| (or_crash! "Export failed:") (do (try.with promise.monad) [_ (/export.export (get@ #platform.&file_system platform) export)] - (wrap (log! "Export complete!")))) + (wrap (debug.log! "Export complete!")))) (#/cli.Interpretation interpretation) ## TODO: Fix the interpreter... diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index dc2de91f7..7409a65e2 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -21,6 +21,7 @@ ["." / #_ ["#." type] ["#." extension] + ["#." value] ["#." time_stamp ["#/." date] ["#/." time]]] @@ -45,6 +46,7 @@ /type.test /extension.test + /value.test /time_stamp.test /time_stamp/date.test /time_stamp/time.test diff --git a/stdlib/source/test/aedifex/artifact/value.lux b/stdlib/source/test/aedifex/artifact/value.lux new file mode 100644 index 000000000..10e9016b1 --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/value.lux @@ -0,0 +1,38 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" text]]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["i" int]]] + [time + ["." instant]]] + {#program + ["." /]}) + +(def: #export random + (Random /.Value) + ($_ random.and + (random.ascii/alpha 5) + random.instant + random.nat + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Build /.Value]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + ))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 2fb01ad72..f1200381a 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1,42 +1,46 @@ -(.module: - ["/" lux #* - [program (#+ program:)] - ["_" test (#+ Test)] - ["@" target] - [abstract - [monad (#+ do)] - [predicate (#+ Predicate)]] - [control - ["." io (#+ io)]] - [data - ["." name] - [text - ["%" format (#+ format)]]] - ["." math - ["." random (#+ Random) ("#\." functor)] - [number - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac] - ["." i64]]]] - ## TODO: Must have 100% coverage on tests. - ["." / #_ - ["#." abstract] - ["#." control] - ["#." data] - ["#." locale] - ["#." macro] - ["#." math] - ["#." meta] - ["#." time] - ## ["#." tool] - ["#." type] - ["#." world] - ["#." host] - ["#." extension] - ["#." target #_ - ["#/." jvm]]]) +(.with_expansions [<target>' (.for {"{old}" (.as_is ["#/." jvm]) + "JVM" (.as_is ["#/." jvm])} + (.as_is)) + <target> <target>'] + (.module: + ["/" lux #* + [program (#+ program:)] + ["_" test (#+ Test)] + ["@" target] + [abstract + [monad (#+ do)] + [predicate (#+ Predicate)]] + [control + ["." io (#+ io)]] + [data + ["." name] + [text + ["%" format (#+ format)]]] + ["." math + ["." random (#+ Random) ("#\." functor)] + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac] + ["." i64]]]] + ## TODO: Must have 100% coverage on tests. + ["." / #_ + ["#." abstract] + ["#." control] + ["#." data] + ["#." locale] + ["#." macro] + ["#." math] + ["#." meta] + ["#." time] + ## ["#." tool] + ["#." type] + ["#." world] + ["#." host] + ["#." extension] + ["#." target #_ + <target>]])) ## TODO: Get rid of this ASAP (template: (!bundle body) @@ -211,22 +215,25 @@ (def: sub_tests Test - (_.in_parallel (list& /abstract.test - /control.test - /data.test - /locale.test - /macro.test - /math.test - /meta.test - /time.test - ## /tool.test - /type.test - /world.test - /host.test - /target/jvm.test - (for {@.old (list)} - (list /extension.test)) - ))) + (let [tail (: (List Test) + (for {@.old (list)} + (list /extension.test)))] + (_.in_parallel (list& /abstract.test + /control.test + /data.test + /locale.test + /macro.test + /math.test + /meta.test + /time.test + ## /tool.test + /type.test + /world.test + /host.test + (for {@.jvm (#.Cons /target/jvm.test tail) + @.old (#.Cons /target/jvm.test tail)} + tail) + )))) (def: test (<| (_.context (name.module (name_of /._))) diff --git a/stdlib/source/test/lux/host.js.lux b/stdlib/source/test/lux/host.js.lux index 6147ef9b9..5ffe1fbeb 100644 --- a/stdlib/source/test/lux/host.js.lux +++ b/stdlib/source/test/lux/host.js.lux @@ -50,16 +50,16 @@ object random.nat] (<| (_.covering /._) ($_ _.and - (_.cover [/.on-browser? /.on-node-js? /.on-nashorn?] - (or /.on-nashorn? - /.on-node-js? - /.on-browser?)) - (_.cover [/.type-of] - (and (text\= "boolean" (/.type-of boolean)) - (text\= "number" (/.type-of number)) - (text\= "string" (/.type-of string)) - (text\= "function" (/.type-of function)) - (text\= "object" (/.type-of object)))) + (_.cover [/.on_browser? /.on_node_js? /.on_nashorn?] + (or /.on_nashorn? + /.on_node_js? + /.on_browser?)) + (_.cover [/.type_of] + (and (text\= "boolean" (/.type_of boolean)) + (text\= "number" (/.type_of number)) + (text\= "string" (/.type_of string)) + (text\= "function" (/.type_of function)) + (text\= "object" (/.type_of object)))) (_.cover [/.try] (case (/.try (error! string)) (#try.Success _) @@ -70,12 +70,12 @@ (_.cover [/.import:] (let [encoding "utf8"] (text\= string - (cond /.on-nashorn? + (cond /.on_nashorn? (let [binary (java/lang/String::getBytes [encoding] (:coerce java/lang/String string))] (|> (java/lang/String::new [binary encoding]) (:coerce Text))) - /.on-node-js? + /.on_node_js? (|> (Buffer::from [string encoding]) (Buffer::toString [encoding])) diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index 0bbe19697..5f37be2ef 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -123,7 +123,8 @@ (#static doubleToRawLongBits [double] long) (#static longBitsToDouble [long] double)]))] (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)})) + @.jvm (as_is <jvm>)} + (as_is))) (def: #export test Test diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index c1972a991..e740c1237 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." type ("#\." equivalence)] [abstract [monad (#+ do)] {[0 #spec] @@ -9,13 +10,17 @@ ["$." apply] ["$." monad]]}] [control - ["." try]] + ["." try (#+ Try) ("#\." functor)]] [data + ["." product] + ["." maybe] ["." bit ("#\." equivalence)] + ["." name ("#\." equivalence)] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list]]] + ["." list ("#\." functor monoid)] + ["." set]]] [meta ["." location]] [math @@ -161,14 +166,18 @@ version (random.ascii/upper_alpha 1) source_code (random.ascii/upper_alpha 1) expected_current_module (random.ascii/upper_alpha 1) + imported_module_name (random.filter (|>> (text\= expected_current_module) not) + (random.ascii/upper_alpha 1)) primitive_type (random.ascii/upper_alpha 1) expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) expected_short (random.ascii/upper_alpha 1) - dummy_module (random.filter (|>> (text\= expected_current_module) not) + dummy_module (random.filter (function (_ module) + (not (or (text\= expected_current_module module) + (text\= imported_module_name module)))) (random.ascii/upper_alpha 1)) - #let [expected_module {#.module_hash 0 + #let [imported_module {#.module_hash 0 #.module_aliases (list) #.definitions (list) #.imports (list) @@ -176,8 +185,18 @@ #.types (list) #.module_annotations #.None #.module_state #.Active} + expected_module {#.module_hash 0 + #.module_aliases (list) + #.definitions (list) + #.imports (list imported_module_name) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active} expected_modules (list [expected_current_module - expected_module]) + expected_module] + [imported_module_name + imported_module]) expected_lux {#.info {#.target target #.version version #.mode #.Build} @@ -222,6 +241,25 @@ (/.run expected_lux) (!expect (^multi (#try.Success actual_modules) (is? expected_modules actual_modules))))) + (_.cover [/.imported_modules] + (and (|> (/.imported_modules expected_current_module) + (/.run expected_lux) + (try\map (\ (list.equivalence text.equivalence) = + (list imported_module_name))) + (try.default false)) + (|> (/.imported_modules imported_module_name) + (/.run expected_lux) + (try\map (\ (list.equivalence text.equivalence) = + (list))) + (try.default false)))) + (_.cover [/.imported_by?] + (|> (/.imported_by? imported_module_name expected_current_module) + (/.run expected_lux) + (try.default false))) + (_.cover [/.imported?] + (|> (/.imported? imported_module_name) + (/.run expected_lux) + (try.default false))) (_.cover [/.normalize] (and (|> (/.normalize ["" expected_short]) (/.run expected_lux) @@ -256,7 +294,10 @@ dummy (random.filter (|>> (n.= expected) not) random.nat) expected_gensym (random.ascii/upper_alpha 1) expected_location ..random_location - #let [expected_lux {#.info {#.target target + #let [type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + expected_lux {#.info {#.target target #.version version #.mode #.Build} #.source [location.dummy 0 source_code] @@ -264,9 +305,7 @@ #.current_module (#.Some expected_current_module) #.modules (list) #.scopes (list) - #.type_context {#.ex_counter 0 - #.var_counter 0 - #.var_bindings (list)} + #.type_context type_context #.expected (#.Some expected_type) #.seed expected_seed #.scope_type_vars (list) @@ -299,6 +338,11 @@ (/.run expected_lux) (!expect (^multi (#try.Success actual_type) (is? expected_type actual_type))))) + (_.cover [/.type_context] + (|> /.type_context + (/.run expected_lux) + (try\map (is? type_context)) + (try.default false))) ))) (def: definition_related @@ -487,6 +531,17 @@ #.extensions [] #.host []}])))]] ($_ _.and + (_.cover [/.find_export] + (and (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some expected_type))] + (|> (/.find_export [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (#try.Success _)))) + (let [[current_globals macro_globals expected_lux] + (expected_lux false (#.Some expected_type))] + (|> (/.find_export [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (#try.Failure _)))))) (_.cover [/.find_macro] (let [same_module! (let [[current_globals macro_globals expected_lux] @@ -521,6 +576,17 @@ not_macro! not_found! aliasing!))) + (_.cover [/.un_alias] + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (and (|> (/.un_alias [expected_macro_module expected_short]) + (/.run expected_lux) + (try\map (name\= [expected_macro_module expected_short])) + (try.default false)) + (|> (/.un_alias [expected_current_module expected_short]) + (/.run expected_lux) + (try\map (name\= [expected_macro_module expected_short])) + (try.default false))))) (_.cover [/.find_def] (let [[current_globals macro_globals expected_lux] (expected_lux expected_exported? (#.Some expected_type)) @@ -578,6 +644,113 @@ alias!))) ))) +(def: tags_related + Test + (do {! random.monad} + [current_module (random.ascii/upper_alpha 1) + tag_module (random.filter (|>> (text\= current_module) not) + (random.ascii/upper_alpha 1)) + + name_0 (random.ascii/upper_alpha 1) + name_1 (random.filter (|>> (text\= name_0) not) + (random.ascii/upper_alpha 1)) + + #let [random_tag (\ ! map (|>> [tag_module]) + (random.ascii/upper_alpha 1))] + all_tags (|> random_tag + (random.set name.hash 10) + (\ ! map set.to_list)) + #let [tags_0 (list.take 5 all_tags) + tags_1 (list.drop 5 all_tags) + + type_0 (#.Primitive name_0 (list)) + type_1 (#.Primitive name_1 (list)) + + entry_0 [name_0 [tags_0 false type_0]] + entry_1 [name_1 [tags_1 true type_1]] + + expected_lux + (: Lux + {#.info {#.target "" + #.version "" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current_module (#.Some current_module) + #.modules (list [current_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (list) + #.imports (list tag_module) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}] + [tag_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (list) + #.imports (list) + #.tags (list\compose (|> tags_0 + list.enumeration + (list\map (function (_ [index [_ short]]) + [short [index tags_0 false type_0]]))) + (|> tags_1 + list.enumeration + (list\map (function (_ [index [_ short]]) + [short [index tags_1 true type_1]])))) + #.types (list entry_0 entry_1) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed 0 + #.scope_type_vars (list) + #.extensions [] + #.host []})]] + ($_ _.and + (_.cover [/.tag_lists] + (let [equivalence (list.equivalence + (product.equivalence + (list.equivalence name.equivalence) + type.equivalence))] + (|> (/.tag_lists tag_module) + (/.run expected_lux) + (try\map (\ equivalence = (list [tags_1 type_1]))) + (try.default false)))) + (_.cover [/.tags_of] + (|> (/.tags_of [tag_module name_1]) + (/.run expected_lux) + (try\map (\ (maybe.equivalence (list.equivalence name.equivalence)) = (#.Some tags_1))) + (try.default false))) + (_.cover [/.resolve_tag] + (|> tags_1 + list.enumeration + (list.every? (function (_ [expected_index tag]) + (|> tag + /.resolve_tag + (/.run expected_lux) + (!expect (^multi (^ (#try.Success [actual_index actual_tags actual_type])) + (let [correct_index! + (n.= expected_index + actual_index) + + correct_tags! + (\ (list.equivalence name.equivalence) = + tags_1 + actual_tags) + + correct_type! + (type\= type_1 + actual_type)] + (and correct_index! + correct_tags! + correct_type!))))))))) + ))) + (def: injection (Injection Meta) (\ /.monad wrap)) @@ -613,7 +786,7 @@ #let [expected_lux {#.info {#.target target #.version version #.mode #.Build} - #.source [location.dummy 0 source_code] + #.source [expected_location 0 source_code] #.location expected_location #.current_module (#.Some expected_current_module) #.modules (list) @@ -633,6 +806,26 @@ ($apply.spec ..injection (..comparison expected_lux) /.apply)) (_.for [/.monad] ($monad.spec ..injection (..comparison expected_lux) /.monad)) + + (do random.monad + [expected_value random.nat + expected_error (random.ascii/upper_alpha 1)] + (_.cover [/.lift] + (and (|> expected_error + #try.Failure + (: (Try Nat)) + /.lift + (/.run expected_lux) + (!expect (^multi (#try.Failure actual) + (text\= (location.with expected_location expected_error) + actual)))) + (|> expected_value + #try.Success + (: (Try Nat)) + /.lift + (/.run expected_lux) + (!expect (^multi (#try.Success actual) + (is? expected_value actual))))))) ..compiler_related ..error_handling @@ -640,6 +833,7 @@ ..context_related ..definition_related ..search_related + ..tags_related )) /annotation.test diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux index a08b54659..89a1aa3d4 100644 --- a/stdlib/source/test/lux/time/day.lux +++ b/stdlib/source/test/lux/time/day.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract {[0 #spec] @@ -9,25 +8,29 @@ ["$." order] ["$." enum]]}] [math - ["r" random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] {1 - ["." / (#+ Day)]}) + ["." /]}) -(def: #export day - (Random Day) - (r.either (r.either (r.either (r\wrap #/.Sunday) - (r\wrap #/.Monday)) - (r.either (r\wrap #/.Tuesday) - (r\wrap #/.Wednesday))) - (r.either (r.either (r\wrap #/.Thursday) - (r\wrap #/.Friday)) - (r\wrap #/.Saturday)))) +(def: #export random + (Random /.Day) + (random.either (random.either (random.either (random\wrap #/.Sunday) + (random\wrap #/.Monday)) + (random.either (random\wrap #/.Tuesday) + (random\wrap #/.Wednesday))) + (random.either (random.either (random\wrap #/.Thursday) + (random\wrap #/.Friday)) + (random\wrap #/.Saturday)))) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) + (_.for [/.Day]) ($_ _.and - ($equivalence.spec /.equivalence ..day) - ($order.spec /.order ..day) - ($enum.spec /.enum ..day) + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.enum] + ($enum.spec /.enum ..random)) ))) diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index af9d46014..24d5449f3 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -8,43 +7,94 @@ [/ ["$." equivalence] ["$." order] + ["$." enum] ["$." monoid] ["$." codec]]}] + [data + ["." bit ("#\." equivalence)]] [math ["." random (#+ Random)] [number ["n" nat] ["i" int]]]] {1 - ["." / (#+ Duration)]}) - -(def: #export duration - (Random Duration) - (\ random.monad map /.from_millis random.int)) + ["." /]}) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) + (_.for [/.Duration]) ($_ _.and - ($equivalence.spec /.equivalence ..duration) - ($order.spec /.order ..duration) - ($monoid.spec /.equivalence /.monoid ..duration) - ($codec.spec /.equivalence /.codec ..duration) + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.duration)) + (_.for [/.order] + ($order.spec /.order random.duration)) + (_.for [/.enum] + ($enum.spec /.enum random.duration)) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid random.duration)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.duration)) (do random.monad - [millis random.int] - (_.test "Can convert from/to milliseconds." - (|> millis /.from_millis /.to_millis (i.= millis)))) - (do {! random.monad} - [sample (|> duration (\ ! map (/.frame /.day))) - frame duration - factor (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) - #let [(^open "/\.") /.order]] + [duration random.duration] + (_.cover [/.from_millis /.to_millis] + (|> duration /.to_millis /.from_millis (\ /.equivalence = duration)))) + (do random.monad + [#let [(^open "\.") /.equivalence] + expected random.duration + parameter random.duration] ($_ _.and - (_.test "Can scale a duration." - (|> sample (/.up factor) (/.query sample) (i.= (.int factor)))) - (_.test "Scaling a duration by one does not change it." - (|> sample (/.up 1) (/\= sample))) - (_.test "Merging a duration with it's opposite yields an empty duration." - (|> sample (/.merge (/.inverse sample)) (/\= /.empty))))) + (_.cover [/.merge /.difference] + (|> expected (/.merge parameter) (/.difference parameter) (\= expected))) + (_.cover [/.empty] + (|> expected (/.merge /.empty) (\= expected))) + (_.cover [/.inverse] + (and (|> expected /.inverse /.inverse (\= expected)) + (|> expected (/.merge (/.inverse expected)) (\= /.empty)))) + (_.cover [/.positive? /.negative? /.neutral?] + (or (bit\= (/.positive? expected) + (/.negative? (/.inverse expected))) + (bit\= (/.neutral? expected) + (/.neutral? (/.inverse expected))))) + )) + (do random.monad + [#let [(^open "\.") /.equivalence] + factor random.nat] + (_.cover [/.up /.down] + (|> /.milli_second (/.up factor) (/.down factor) (\= /.milli_second)))) + (do {! random.monad} + [#let [(^open "\.") /.order + positive (|> random.duration + (random.filter (|>> (\= /.empty) not)) + (\ ! map (function (_ duration) + (if (/.positive? duration) + duration + (/.inverse duration)))))] + sample positive + frame positive] + (`` ($_ _.and + (_.cover [/.frame] + (let [sample' (/.frame frame sample)] + (and (\< frame sample') + (bit\= (\< frame sample) + (\= sample sample'))))) + (_.cover [/.query] + (i.= +1 (/.query sample sample))) + (_.cover [/.milli_second] + (\= /.empty (\ /.enum pred /.milli_second))) + (~~ (template [<factor> <big> <small>] + [(_.cover [<big>] + (|> <big> (/.query <small>) (i.= <factor>)))] + + [+1,000 /.second /.milli_second] + [+60 /.minute /.second] + [+60 /.hour /.minute] + [+24 /.day /.hour] + + [+7 /.week /.day] + [+365 /.normal_year /.day] + [+366 /.leap_year /.day] + )) + ))) ))) diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index 65fed1248..9ed1df446 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -21,8 +21,6 @@ [time ["@d" duration] ["@." date]]] - [// - ["_." duration]] {1 ["." / (#+ Instant)]}) @@ -45,7 +43,7 @@ (|> millis /.from_millis /.to_millis (i.= millis)))) (do random.monad [sample instant - span _duration.duration + span random.duration #let [(^open "@/.") /.equivalence (^open "@d/.") @d.equivalence]] ($_ _.and |