diff options
Diffstat (limited to '')
28 files changed, 510 insertions, 374 deletions
diff --git a/lux-js/commands.md b/lux-js/commands.md index ff0124850..b1d974d69 100644 --- a/lux-js/commands.md +++ b/lux-js/commands.md @@ -22,13 +22,13 @@ cd ~/lux/lux-js/ \ ## Use JVM-based compiler to produce a JS/Node-based compiler. cd ~/lux/lux-js/ \ && lein clean \ -&& time java -jar jvm_based_compiler.jar build --source ~/lux/lux-js/source --target ~/lux/lux-js/target --module program \ +&& java -jar jvm_based_compiler.jar build --source ~/lux/lux-js/source --target ~/lux/lux-js/target --module program \ && mv target/program.js node_based_compiler.js ## Use JS/Node-based compiler to produce another JS/Node-based compiler. cd ~/lux/lux-js/ \ && lein clean \ -&& time node --stack_size=8192 node_based_compiler.js build --source ~/lux/lux-js/source --target ~/lux/lux-js/target --module program \ +&& node --stack_size=8192 node_based_compiler.js build --source ~/lux/lux-js/source --target ~/lux/lux-js/target --module program \ && mv target/program.js lux.js ``` @@ -38,8 +38,7 @@ cd ~/lux/lux-js/ \ ## Compile Lux's Standard Library's tests using a JS/Node-based compiler. cd ~/lux/stdlib/ \ && lein clean \ -&& time node --stack_size=8192 ~/lux/lux-js/lux.js build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux - -node ~/lux/stdlib/target/program.js +&& node --stack_size=8192 ~/lux/lux-js/lux.js build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux \ +&& node ~/lux/stdlib/target/program.js ``` diff --git a/lux-lua/commands.md b/lux-lua/commands.md index 3693fecec..f78634aec 100644 --- a/lux-lua/commands.md +++ b/lux-lua/commands.md @@ -29,8 +29,7 @@ cd ~/lux/lux-lua/ \ ## Compile Lux's Standard Library's tests using a JVM-based compiler. cd ~/lux/stdlib/ \ && lein clean \ -&& time java -jar ~/lux/lux-lua/jvm_based_compiler.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux - -~/lua-5.4.2/install/bin/lua ~/lux/stdlib/target/program.lua +&& java -jar ~/lux/lux-lua/jvm_based_compiler.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux \ +&& ~/lua-5.4.2/install/bin/lua ~/lux/stdlib/target/program.lua ``` diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux index d41447879..b581ce7bd 100644 --- a/lux-lua/source/program.lux +++ b/lux-lua/source/program.lux @@ -333,19 +333,19 @@ (for {@.old (as_is (with_expansions [$var_args (_.var "...") $str_rel_to_abs (_.var "_utf8_str_rel_to_abs") $decode (_.var "_utf8_decode")] - (template.with [(!int <hex>) - [(_.int (.int (hex <hex>)))] - - (!&| <or> <and> <raw>) - [(|> <raw> - (_.bit_and (!int <and>)) - (_.bit_or (!int <or>)))] - - (!&|< <or> <and> <shift> <raw>) - [(|> <raw> - (_.bit_shr (_.int <shift>)) - (_.bit_and (!int <and>)) - (_.bit_or (!int <or>)))]] + (template.let [(!int <hex>) + [(_.int (.int (hex <hex>)))] + + (!&| <or> <and> <raw>) + [(|> <raw> + (_.bit_and (!int <and>)) + (_.bit_or (!int <or>)))] + + (!&|< <or> <and> <shift> <raw>) + [(|> <raw> + (_.bit_shr (_.int <shift>)) + (_.bit_and (!int <and>)) + (_.bit_or (!int <or>)))]] (as_is (def: rembulan//char (let [$buffer (_.var "buffer") $k (_.var "k") diff --git a/lux-python/commands.md b/lux-python/commands.md index e01901d6c..40203411d 100644 --- a/lux-python/commands.md +++ b/lux-python/commands.md @@ -28,8 +28,7 @@ cd ~/lux/lux-python/ \ ## Compile Lux's Standard Library's tests using a JVM-based compiler. cd ~/lux/stdlib/ \ && lein clean \ -&& time java -jar ~/lux/lux-python/jvm_based_compiler.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux - -python3 ~/lux/stdlib/target/program.py +&& java -jar ~/lux/lux-python/jvm_based_compiler.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux \ +&& python3 ~/lux/stdlib/target/program.py ``` diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 27dc2e66a..0eac5a354 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -354,7 +354,7 @@ ## The first entry in the list will be the program.py file itself ## so, it must be removed so only the program's arguments are left. (_.slice_from (_.int +1)) - runtime.lux//program_args) + runtime.lux::program_args) _.none))))) (for {@.old diff --git a/lux-ruby/commands.md b/lux-ruby/commands.md index 6c4e929dd..a610080dd 100644 --- a/lux-ruby/commands.md +++ b/lux-ruby/commands.md @@ -28,8 +28,7 @@ cd ~/lux/lux-ruby/ \ ## Compile Lux's Standard Library's tests using a JVM-based compiler. cd ~/lux/stdlib/ \ && lein clean \ -&& time java -jar ~/lux/lux-ruby/jvm_based_compiler.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux - -RUBY_THREAD_VM_STACK_SIZE=15700000 ruby ~/lux/stdlib/target/program.rb +&& time java -jar ~/lux/lux-ruby/jvm_based_compiler.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux \ +&& RUBY_THREAD_VM_STACK_SIZE=15700000 ruby ~/lux/stdlib/target/program.rb ``` diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 276a8e6e7..ff676e592 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5173,23 +5173,18 @@ "Wherever a binding appears, the bound Code nodes will be spliced in there." (test: "Code operations & structures" (with_expansions - [<tests> (template [<expr> <text> <pattern>] - [(compare <pattern> <expr>) - (compare <text> (\ Code/encode encode <expr>)) - (compare #1 (\ equivalence = <expr> <expr>))] - - [(bit #1) "#1" [_ (#.Bit #1)]] - [(bit #0) "#0" [_ (#.Bit #0)]] - [(int +123) "+123" [_ (#.Int +123)]] - [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] - [(text "123") "'123'" [_ (#.Text "123")]] - [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] - [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] - [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] - [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] - [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] - [(local_tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] - [(local_identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] + [<tests> (template [<expr> <text>] + [(compare <text> (\ Code/encode encode <expr>))] + + [(bit #1) "#1"] + [(int +123) "+123"] + [(frac +123.0) "+123.0"] + [(text "123") "'123'"] + [(tag ["yolo" "lol"]) "#yolo.lol"] + [(identifier ["yolo" "lol"]) "yolo.lol"] + [(form (list (bit #1))) "(#1)"] + [(tuple (list (bit #1))) "[#1]"] + [(record (list [(bit #1) (int +123)])) "{#1 +123}"] )] (test_all <tests>))))} (case tokens diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 15e017e6b..4ad4d532c 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -338,7 +338,7 @@ (:coerce (primitive "java.lang.String") value))) @.js (:coerce Text - ("js object do" "toLowerCase" value)) + ("js object do" "toLowerCase" value [])) @.python (:coerce Text ("python object do" "lower" value)) @@ -361,7 +361,7 @@ (:coerce (primitive "java.lang.String") value))) @.js (:coerce Text - ("js object do" "toUpperCase" value)) + ("js object do" "toUpperCase" value [])) @.python (:coerce Text ("python object do" "upper" value)) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index d0ceb4b5e..962ffeefe 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -3,6 +3,7 @@ ["@" target] ["." type] ["." ffi (#+ import:)] + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -23,7 +24,6 @@ ["." array] ["." list ("#\." functor)] ["." dictionary]]] - ["." meta] [macro ["." template] ["." syntax (#+ syntax:)] @@ -31,6 +31,7 @@ [math [number [ratio (#+ Ratio)] + ["n" nat] ["i" int]]] [time (#+ Time) [instant (#+ Instant)] @@ -95,7 +96,8 @@ (import: Object ["#::." - (type [] Class)])) + (class [] Class) + (to_s [] ffi.String)])) @.php (as_is (import: (gettype [.Any] ffi.String)) @@ -116,13 +118,26 @@ (def: Inspector (.type (Format Any))) +(for {@.lua (def: (tuple_array tuple) + (-> (array.Array Any) (array.Array Any)) + (array.from_list + (loop [idx 0] + (let [member ("lua array read" idx tuple)] + (if ("lua object nil?" member) + #.Nil + (#.Cons member (recur (inc idx))))))))} + (as_is)) + (def: (inspect_tuple inspect) (-> Inspector Inspector) - (|>> (:coerce (array.Array Any)) - array.to_list - (list\map inspect) - (text.join_with " ") - (text.enclose ["[" "]"]))) + (with_expansions [<adaption> (for {@.lua (~~ (as_is ..tuple_array))} + (~~ (as_is)))] + (`` (|>> (:coerce (array.Array Any)) + <adaption> + array.to_list + (list\map inspect) + (text.join_with " ") + (text.enclose ["[" "]"]))))) (def: #export (inspect value) Inspector @@ -201,19 +216,19 @@ @.python (case (..str (..type value)) - (^template [<type_of> <then>] - [<type_of> + (^template [<type_of> <class_of> <then>] + [(^or <type_of> <class_of>) (`` (|> value (~~ (template.splice <then>))))]) - (["<type 'bool'>" [(:coerce .Bit) %.bit]] - ["<type 'int'>" [(:coerce .Int) %.int]] - ["<type 'float'>" [(:coerce .Frac) %.frac]] - ["<type 'str'>" [(:coerce .Text) %.text]] - ["<type 'unicode'>" [(:coerce .Text) %.text]]) + (["<type 'bool'>" "<class 'bool'>" [(:coerce .Bit) %.bit]] + ["<type 'int'>" "<class 'int'>" [(:coerce .Int) %.int]] + ["<type 'float'>" "<class 'float'>" [(:coerce .Frac) %.frac]] + ["<type 'str'>" "<class 'str'>" [(:coerce .Text) %.text]] + ["<type 'unicode'>" "<class 'unicode'>" [(:coerce .Text) %.text]]) - "<type 'list'>" + (^or "<type 'list'>" "<class 'list'>") (inspect_tuple inspect value) - "<type 'tuple'>" + (^or "<type 'tuple'>" "<type 'tuple'>") (let [variant (:coerce (array.Array Any) value)] (case (array.size variant) 3 (let [variant_tag ("python array read" 0 variant) @@ -252,31 +267,37 @@ (let [variant_tag ("lua object get" "_lux_tag" value) variant_flag ("lua object get" "_lux_flag" value) variant_value ("lua object get" "_lux_value" value)] - (if (not (or ("lua object nil?" variant_tag) - ("lua object nil?" variant_flag) - ("lua object nil?" variant_value))) + (if (or ("lua object nil?" variant_tag) + ("lua object nil?" variant_value)) + (inspect_tuple inspect value) (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) " " (%.bit (not ("lua object nil?" variant_flag))) " " (inspect variant_value)) - (text.enclose ["(" ")"])) - (inspect_tuple inspect value))) + (text.enclose ["(" ")"])))) _ (..tostring value)) @.ruby - (template.with [(class_of <literal>) - [(Object::type (:coerce ..Object <literal>))]] - (let [value_class (Object::type (:coerce ..Object value))] + (template.let [(class_of <literal>) + [(|> <literal> + (:coerce ..Object) + (Object::class []))] + + (to_s <object>) + [(|> <object> + (:coerce ..Object) + (Object::to_s []))]] + (let [value_class (class_of value)] (`` (cond (~~ (template [<literal> <type> <format>] [(is? (class_of <literal>) value_class) (|> value (:coerce <type>) <format>)] [#0 Bit %.bit] [#1 Bit %.bit] - [+123 Int %.int] - [+123.456 Frac %.frac] - ["+123.456" Text %.text] + [+1 Int %.int] + [+1.0 Frac %.frac] + ["" Text %.text] [("ruby object nil") Any (new> "nil" [])] )) @@ -284,20 +305,19 @@ (let [variant_tag ("ruby object get" "_lux_tag" value) variant_flag ("ruby object get" "_lux_flag" value) variant_value ("ruby object get" "_lux_value" value)] - (if (not (or ("ruby object nil?" variant_tag) - ("ruby object nil?" variant_flag) - ("ruby object nil?" variant_value))) + (if (or ("ruby object nil?" variant_tag) + ("ruby object nil?" variant_value)) + (inspect_tuple inspect value) (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) " " (%.bit (not ("ruby object nil?" variant_flag))) " " (inspect variant_value)) - (text.enclose ["(" ")"])) - (inspect_tuple inspect value))) + (text.enclose ["(" ")"])))) (is? (class_of [[] []]) value_class) (inspect_tuple inspect value) ## else - (:coerce Text ("ruby object do" "to_s" value)))))) + (to_s value))))) @.php (case (..gettype value) @@ -315,14 +335,13 @@ (let [variant_tag ("php object get" "_lux_tag" value) variant_flag ("php object get" "_lux_flag" value) variant_value ("php object get" "_lux_value" value)] - (if (not (or ("php object null?" variant_tag) - ("php object null?" variant_flag) - ("php object null?" variant_value))) + (if (or ("php object null?" variant_tag) + ("php object null?" variant_value)) + (..strval value) (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) " " (%.bit (not ("php object null?" variant_flag))) " " (inspect variant_value)) - (text.enclose ["(" ")"])) - (..strval value))) + (text.enclose ["(" ")"])))) _ (..strval value)) diff --git a/stdlib/source/lux/math/number/frac.lux b/stdlib/source/lux/math/number/frac.lux index 5ca3dff83..78c5bdde4 100644 --- a/stdlib/source/lux/math/number/frac.lux +++ b/stdlib/source/lux/math/number/frac.lux @@ -169,27 +169,15 @@ [maximum ..max (..* -1.0 ..biggest)] ) -(for {@.python - (template [<name> <constant> <doc>] - [(def: #export <name> - {#.doc <doc>} - (|> <constant> - ("python apply" (:coerce Nothing ("python constant" "float"))) - (:coerce Frac)))] - - [not_a_number "NaN" "Not a number."] - [positive_infinity "inf" "Positive infinity."] - )} - - (template [<name> <numerator> <doc>] - [(def: #export <name> - {#.doc <doc>} - Frac - (../ +0.0 <numerator>))] - - [not_a_number +0.0 "Not a number."] - [positive_infinity +1.0 "Positive infinity."] - )) +(template [<name> <numerator> <doc>] + [(def: #export <name> + {#.doc <doc>} + Frac + (../ +0.0 <numerator>))] + + [not_a_number +0.0 "Not a number."] + [positive_infinity +1.0 "Positive infinity."] + ) (def: #export negative_infinity {#.doc "Negative infinity."} diff --git a/stdlib/source/lux/program.lux b/stdlib/source/lux/program.lux index 0723a7b4e..475bd7322 100644 --- a/stdlib/source/lux/program.lux +++ b/stdlib/source/lux/program.lux @@ -45,7 +45,7 @@ (program: [name] (io (log! (\ text.monoid compose "Hello, " name)))) - (program: [{config config^}] + (program: [{config configuration_parser}] (do io.monad [data (init_program config)] (do_something data))))} @@ -67,15 +67,15 @@ (#Parsed args) (` (.function ((~ g!program) (~ g!args)) - (case ((: (~! (<cli>.Parser (io.IO .Any))) - ((~! do) (~! <>.monad) - [(~+ (|> args - (list\map (function (_ [binding parser]) - (list binding parser))) - list\join))] - ((~' wrap) (~ initialization+event_loop)))) + (case ((~! <cli>.run) (: (~! (<cli>.Parser (io.IO .Any))) + ((~! do) (~! <>.monad) + [(~+ (|> args + (list\map (function (_ [binding parser]) + (list binding parser))) + list\join))] + ((~' wrap) (~ initialization+event_loop)))) (~ g!args)) - (#.Right [(~ g!_) (~ g!output)]) + (#.Right (~ g!output)) (~ g!output) (#.Left (~ g!message)) diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index 77cc7cf28..516cc261f 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -136,13 +136,13 @@ (def: #export float (-> Frac Literal) - (`` (|>> (cond> (~~ (template [<lux> <python>] - [[(f.= <lux>)] + (`` (|>> (cond> (~~ (template [<test> <python>] + [[<test>] [(new> (format "float(" text.double_quote <python> text.double_quote ")") [])]] - [f.positive_infinity "inf"] - [f.negative_infinity "-inf"] - [f.not_a_number "nan"] + [(f.= f.positive_infinity) "inf"] + [(f.= f.negative_infinity) "-inf"] + [f.not_a_number? "nan"] )) ## else diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index 66e09f33b..61a154efc 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -86,32 +86,32 @@ (|> /.empty (/.install "syntax char case!" lux::syntax_char_case!) (/.install "is" (binary (product.uncurry _.is))) - (/.install "try" (unary //runtime.lux//try)))) + (/.install "try" (unary //runtime.lux::try)))) (def: (capped operation parameter subject) (-> (-> (Expression Any) (Expression Any) (Expression Any)) (-> (Expression Any) (Expression Any) (Expression Any))) - (//runtime.i64//64 (operation parameter subject))) + (//runtime.i64::64 (operation parameter subject))) (def: i64_procs Bundle (<| (/.prefix "i64") (|> /.empty - (/.install "and" (binary (product.uncurry //runtime.i64//and))) - (/.install "or" (binary (product.uncurry //runtime.i64//or))) - (/.install "xor" (binary (product.uncurry //runtime.i64//xor))) - (/.install "left-shift" (binary (product.uncurry //runtime.i64//left_shift))) - (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift))) + (/.install "and" (binary (product.uncurry //runtime.i64::and))) + (/.install "or" (binary (product.uncurry //runtime.i64::or))) + (/.install "xor" (binary (product.uncurry //runtime.i64::xor))) + (/.install "left-shift" (binary (product.uncurry //runtime.i64::left_shift))) + (/.install "right-shift" (binary (product.uncurry //runtime.i64::right_shift))) (/.install "<" (binary (product.uncurry _.<))) (/.install "=" (binary (product.uncurry _.=))) (/.install "+" (binary (product.uncurry (..capped _.+)))) (/.install "-" (binary (product.uncurry (..capped _.-)))) (/.install "*" (binary (product.uncurry (..capped _.*)))) - (/.install "/" (binary (product.uncurry //runtime.i64//division))) - (/.install "%" (binary (product.uncurry //runtime.i64//remainder))) + (/.install "/" (binary (product.uncurry //runtime.i64::division))) + (/.install "%" (binary (product.uncurry //runtime.i64::remainder))) (/.install "f64" (unary _.float/1)) - (/.install "char" (unary //runtime.i64//char)) + (/.install "char" (unary //runtime.i64::char)) ))) (def: f64_procs @@ -121,7 +121,7 @@ (/.install "+" (binary (product.uncurry _.+))) (/.install "-" (binary (product.uncurry _.-))) (/.install "*" (binary (product.uncurry _.*))) - (/.install "/" (binary (product.uncurry _./))) + (/.install "/" (binary (product.uncurry //runtime.f64::/))) (/.install "%" (binary (function (_ [parameter subject]) (|> (_.__import__/1 (_.unicode "math")) (_.do "fmod" (list subject parameter)))))) @@ -129,15 +129,15 @@ (/.install "<" (binary (product.uncurry _.<))) (/.install "i64" (unary _.int/1)) (/.install "encode" (unary _.repr/1)) - (/.install "decode" (unary //runtime.f64//decode))))) + (/.install "decode" (unary //runtime.f64::decode))))) -(def: (text//clip [paramO extraO subjectO]) +(def: (text::clip [paramO extraO subjectO]) (Trinary (Expression Any)) - (//runtime.text//clip paramO extraO subjectO)) + (//runtime.text::clip paramO extraO subjectO)) -(def: (text//index [startO partO textO]) +(def: (text::index [startO partO textO]) (Trinary (Expression Any)) - (//runtime.text//index startO partO textO)) + (//runtime.text::index startO partO textO)) (def: text_procs Bundle @@ -146,18 +146,18 @@ (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) (/.install "concat" (binary (product.uncurry (function.flip _.+)))) - (/.install "index" (trinary text//index)) + (/.install "index" (trinary ..text::index)) (/.install "size" (unary _.len/1)) - (/.install "char" (binary (product.uncurry //runtime.text//char))) - (/.install "clip" (trinary text//clip)) + (/.install "char" (binary (product.uncurry //runtime.text::char))) + (/.install "clip" (trinary ..text::clip)) ))) (def: io_procs Bundle (<| (/.prefix "io") (|> /.empty - (/.install "log" (unary //runtime.io//log!)) - (/.install "error" (unary //runtime.io//throw!))))) + (/.install "log" (unary //runtime.io::log!)) + (/.install "error" (unary //runtime.io::throw!))))) (def: #export bundle Bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux index 0c1478eea..a46bbb9cc 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux @@ -37,7 +37,7 @@ (def: array::length (Unary (Expression Any)) - (|>> _.len/1 //runtime.i64//64)) + (|>> _.len/1 //runtime.i64::64)) (def: (array::read [indexG arrayG]) (Binary (Expression Any)) @@ -45,11 +45,11 @@ (def: (array::write [indexG valueG arrayG]) (Trinary (Expression Any)) - (//runtime.array//write indexG valueG arrayG)) + (//runtime.array::write indexG valueG arrayG)) (def: (array::delete [indexG arrayG]) (Binary (Expression Any)) - (//runtime.array//write indexG _.none arrayG)) + (//runtime.array::write indexG _.none arrayG)) (def: array Bundle @@ -147,7 +147,7 @@ (do {! ////////phase.monad} [codeG (phase archive codeS) globalsG (phase archive globalsS)] - (wrap (//runtime.lux//exec codeG globalsG))))])) + (wrap (//runtime.lux::exec codeG globalsG))))])) (def: #export bundle Bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux index 23368285c..28ffbb624 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -93,8 +93,8 @@ (^template [<side> <accessor>] [(<side> lefts) (<accessor> (_.int (.int lefts)))]) - ([#.Left //runtime.tuple//left] - [#.Right //runtime.tuple//right]))] + ([#.Left //runtime.tuple::left] + [#.Right //runtime.tuple::right]))] (method source))) valueO (list.reverse pathP))))) @@ -138,7 +138,7 @@ [(def: (<name> simple? idx) (-> Bit Nat (Statement Any)) ($_ _.then - (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))) + (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum::get ..peek <flag>))) (.if simple? (_.when (_.= _.none @temp) fail_pm!) @@ -237,8 +237,8 @@ (^template [<pm> <getter>] [(^ (<pm> lefts)) (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) + ([/////synthesis.member/left //runtime.tuple::left] + [/////synthesis.member/right //runtime.tuple::right]) (^ (/////synthesis.!bind_top register thenP)) (do ///////phase.monad diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux index 270560266..ec8889281 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux @@ -11,7 +11,7 @@ <implementation>)] [Bit bit _.bool] - [(I64 Any) i64 (|>> .int _.int //runtime.i64//64)] + [(I64 Any) i64 (|>> .int _.int //runtime.i64::64)] [Frac f64 _.float] [Text text _.unicode] ) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 2345ab763..b77d0c915 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -21,6 +21,7 @@ ["." code]] [math [number (#+ hex) + ["f" frac] ["." i64]]] ["@" target ["_" python (#+ Expression SVar Computation Literal Statement)]]] @@ -155,13 +156,13 @@ (_.def (~ g!_) (list (~+ inputsC)) (~ code))))))))))))) -(runtime: (lux//try op) +(runtime: (lux::try op) (with_vars [exception] (_.try (_.return (..right (_.apply/* op (list ..unit)))) (list [(list (_.var "Exception")) exception (_.return (..left (_.str/1 exception)))])))) -(runtime: (lux//program_args program_args) +(runtime: (lux::program_args program_args) (with_vars [inputs value] ($_ _.then (_.set (list inputs) ..none) @@ -170,32 +171,32 @@ (..some (_.list (list value inputs))))) (_.return inputs)))) -(runtime: (lux//exec code globals) +(runtime: (lux::exec code globals) ($_ _.then (_.exec code (#.Some globals)) (_.return ..unit))) -(def: runtime//lux +(def: runtime::lux (Statement Any) ($_ _.then - @lux//try - @lux//program_args - @lux//exec + @lux::try + @lux::program_args + @lux::exec )) -(runtime: (io//log! message) +(runtime: (io::log! message) ($_ _.then (_.print message) (_.return ..unit))) -(runtime: (io//throw! message) +(runtime: (io::throw! message) (_.raise (_.Exception/1 message))) -(def: runtime//io +(def: runtime::io (Statement Any) ($_ _.then - @io//log! - @io//throw! + @io::log! + @io::throw! )) (def: last_index @@ -204,7 +205,7 @@ (with_expansions [<recur> (as_is ($_ _.then (_.set (list lefts) (_.- last_index_right lefts)) (_.set (list tuple) (_.nth last_index_right tuple))))] - (runtime: (tuple//left lefts tuple) + (runtime: (tuple::left lefts tuple) (with_vars [last_index_right] (_.while (_.bool true) ($_ _.then @@ -216,7 +217,7 @@ <recur>)) #.None))) - (runtime: (tuple//right lefts tuple) + (runtime: (tuple::right lefts tuple) (with_vars [last_index_right right_index] (_.while (_.bool true) ($_ _.then @@ -230,7 +231,7 @@ (_.return (_.slice_from right_index tuple)))) #.None)))) -(runtime: (sum//get sum wantsLast wantedTag) +(runtime: (sum::get sum wantsLast wantedTag) (let [no_match! (_.return _.none) sum_tag (_.nth (_.int +0) sum) sum_flag (_.nth (_.int +1) sum) @@ -257,22 +258,22 @@ no_match!) #.None))) -(def: runtime//adt +(def: runtime::adt (Statement Any) ($_ _.then - @tuple//left - @tuple//right - @sum//get + @tuple::left + @tuple::right + @sum::get )) -(def: i64//+limit (_.manual "+0x7FFFFFFFFFFFFFFF")) -(def: i64//-limit (_.manual "-0x8000000000000000")) -(def: i64//+iteration (_.manual "+0x10000000000000000")) -(def: i64//-iteration (_.manual "-0x10000000000000000")) -(def: i64//+cap (_.manual "+0x8000000000000000")) -(def: i64//-cap (_.manual "-0x8000000000000001")) +(def: i64::+limit (_.manual "+0x7FFFFFFFFFFFFFFF")) +(def: i64::-limit (_.manual "-0x8000000000000000")) +(def: i64::+iteration (_.manual "+0x10000000000000000")) +(def: i64::-iteration (_.manual "-0x10000000000000000")) +(def: i64::+cap (_.manual "+0x8000000000000000")) +(def: i64::-cap (_.manual "-0x8000000000000001")) -(runtime: (i64//64 input) +(runtime: (i64::64 input) (with_vars [temp] (`` (<| (~~ (template [<scenario> <iteration> <cap> <entrance>] [(_.if (|> input <scenario>) @@ -282,22 +283,22 @@ (|> temp (_.- <cap>) (_.+ <entrance>)) temp))))] - [(_.> ..i64//+limit) ..i64//+iteration ..i64//+cap ..i64//-limit] - [(_.< ..i64//-limit) ..i64//-iteration ..i64//-cap ..i64//+limit] + [(_.> ..i64::+limit) ..i64::+iteration ..i64::+cap ..i64::-limit] + [(_.< ..i64::-limit) ..i64::-iteration ..i64::-cap ..i64::+limit] )) (_.return (for {@.python input} ## This +- is only necessary to guarantee that values within the limits are always longs in Python 2 - (|> input (_.+ ..i64//+limit) (_.- ..i64//+limit)))))))) + (|> input (_.+ ..i64::+limit) (_.- ..i64::+limit)))))))) (def: as_nat - (_.% ..i64//+iteration)) + (_.% ..i64::+iteration)) -(runtime: (i64//left_shift param subject) +(runtime: (i64::left_shift param subject) (_.return (|> subject (_.bit_shl (_.% (_.int +64) param)) - ..i64//64))) + ..i64::64))) -(runtime: (i64//right_shift param subject) +(runtime: (i64::right_shift param subject) ($_ _.then (_.set (list param) (_.% (_.int +64) param)) (_.return (_.? (_.= (_.int +0) param) @@ -306,7 +307,7 @@ ..as_nat (_.bit_shr param)))))) -(runtime: (i64//division param subject) +(runtime: (i64::division param subject) (with_vars [floored] ($_ _.then (_.set (list floored) (_.// param subject)) @@ -320,17 +321,17 @@ (_.+ (_.int +1) floored) floored)))))) -(runtime: (i64//remainder param subject) - (_.return (_.- (|> subject (..i64//division param) (_.* param)) +(runtime: (i64::remainder param subject) + (_.return (_.- (|> subject (..i64::division param) (_.* param)) subject))) (template [<runtime> <host>] [(runtime: (<runtime> left right) - (_.return (..i64//64 (<host> (..as_nat left) (..as_nat right)))))] + (_.return (..i64::64 (<host> (..as_nat left) (..as_nat right)))))] - [i64//and _.bit_and] - [i64//or _.bit_or] - [i64//xor _.bit_xor] + [i64::and _.bit_and] + [i64::or _.bit_or] + [i64::xor _.bit_xor] ) (def: python_version @@ -339,45 +340,55 @@ (_.the "version_info") (_.the "major"))) -(runtime: (i64//char value) +(runtime: (i64::char value) (_.return (_.? (_.= (_.int +3) ..python_version) (_.chr/1 value) (_.unichr/1 value)))) -(def: runtime//i64 +(def: runtime::i64 (Statement Any) ($_ _.then - @i64//64 - @i64//left_shift - @i64//right_shift - @i64//division - @i64//remainder - @i64//and - @i64//or - @i64//xor - @i64//char + @i64::64 + @i64::left_shift + @i64::right_shift + @i64::division + @i64::remainder + @i64::and + @i64::or + @i64::xor + @i64::char )) -(runtime: (f64//decode input) +(runtime: (f64::/ parameter subject) + (_.return (_.? (_.= (_.float +0.0) parameter) + (<| (_.? (_.> (_.float +0.0) subject) + (_.float f.positive_infinity)) + (_.? (_.< (_.float +0.0) subject) + (_.float f.negative_infinity)) + (_.float f.not_a_number)) + (_./ parameter subject)))) + +(runtime: (f64::decode input) (with_vars [ex] (_.try (_.return (..some (_.float/1 input))) (list [(list (_.var "Exception")) ex (_.return ..none)])))) -(def: runtime//f64 +(def: runtime::f64 (Statement Any) ($_ _.then - @f64//decode + @f64::/ + @f64::decode )) -(runtime: (text//index start param subject) +(runtime: (text::index start param subject) (with_vars [idx] ($_ _.then (_.set (list idx) (|> subject (_.do "find" (list param start)))) (_.return (_.? (_.= (_.int -1) idx) ..none - (..some (..i64//64 idx))))))) + (..some (..i64::64 idx))))))) (def: inc (|>> (_.+ (_.int +1)))) @@ -387,43 +398,43 @@ (_.and (|> value (_.>= (_.int +0))) (|> value (_.< top)))) -(runtime: (text//clip @offset @length @text) +(runtime: (text::clip @offset @length @text) (_.return (|> @text (_.slice @offset (_.+ @offset @length))))) -(runtime: (text//char idx text) +(runtime: (text::char idx text) (_.if (|> idx (within? (_.len/1 text))) - (_.return (|> text (_.slice idx (..inc idx)) _.ord/1 ..i64//64)) + (_.return (|> text (_.slice idx (..inc idx)) _.ord/1 ..i64::64)) (_.raise (_.Exception/1 (_.unicode "[Lux Error] Cannot get char from text."))))) -(def: runtime//text +(def: runtime::text (Statement Any) ($_ _.then - @text//index - @text//clip - @text//char + @text::index + @text::clip + @text::char )) -(runtime: (array//write idx value array) +(runtime: (array::write idx value array) ($_ _.then (_.set (list (_.nth idx array)) value) (_.return array))) -(def: runtime//array +(def: runtime::array (Statement Any) ($_ _.then - @array//write + @array::write )) (def: runtime (Statement Any) ($_ _.then - runtime//lux - runtime//io - runtime//adt - runtime//i64 - runtime//f64 - runtime//text - runtime//array + runtime::lux + runtime::io + runtime::adt + runtime::i64 + runtime::f64 + runtime::text + runtime::array )) (def: module_id diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index ae0c6d840..96019a132 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -300,9 +300,6 @@ @.lua (io.io (list)) @.ruby (|> (RubyEnv::keys []) array.to_list - (list\map (function (_ variable) - [variable (RubyEnv::fetch [variable])])) - (dictionary.from_list text.hash) io.io) ## @.php (do io.monad ## [environment (..getenv/0 [])] @@ -339,7 +336,8 @@ @.js (io.io (if ffi.on_node_js? (case (do maybe.monad [process/env (ffi.constant Object [process env])] - (array.read (: Nat name) process/env)) + (array.read (:coerce Nat name) + (:coerce (Array Text) process/env))) (#.Some value) (#try.Success value) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 8757242c5..477ae4d50 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -16,10 +16,10 @@ ["#." local] ["#." metadata] ["#." package] + ["#." parser] + ["#." pom] ["#." profile] ["#." project] - ## ["#." parser] - ## ["#." pom] ## ["#." repository] ## ["#." runtime] ]) @@ -44,11 +44,11 @@ /local.test /metadata.test /package.test + /parser.test + /pom.test /profile.test /project.test - ## /parser.test - ## /pom.test ## /repository.test ## /runtime.test )) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index 0a13acb32..07c426ebb 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -8,7 +8,7 @@ [pipe (#+ case>)] ["." try] [parser - ["<c>" code]]] + ["<.>" code]]] [data ["." text] [collection @@ -61,6 +61,10 @@ (set.from_list text.hash (list //.default_source)) sources))))) +(def: with_default_repository + (-> //.Profile //.Profile) + (update@ #//.repositories (set.add //.default_repository))) + (def: single_profile Test (do random.monad @@ -69,10 +73,11 @@ (|> expected //format.profile list - (<c>.run /.project) + (<code>.run /.project) (case> (#try.Success actual) (|> expected ..with_default_sources + ..with_default_repository (//project.project //.default) (\ //project.equivalence = actual)) @@ -93,13 +98,15 @@ (|> expected //format.project list - (<c>.run /.project) + (<code>.run /.project) (case> (#try.Success actual) (|> expected ..with_empty_profile dictionary.entries (list\map (function (_ [name profile]) - [name (..with_default_sources profile)])) + [name (|> profile + ..with_default_sources + ..with_default_repository)])) (dictionary.from_list text.hash) (\ //project.equivalence = actual)) diff --git a/stdlib/source/test/aedifex/pom.lux b/stdlib/source/test/aedifex/pom.lux index c87ff0590..75b8cf5dc 100644 --- a/stdlib/source/test/aedifex/pom.lux +++ b/stdlib/source/test/aedifex/pom.lux @@ -30,11 +30,12 @@ (get@ #//.identity expected)] [(#try.Success pom) (#.Some _)] - (case (<xml>.run /.parser pom) + (case (<xml>.run /.parser (list pom)) (#try.Success actual) (\ //.equivalence = (|> (\ //.monoid identity) - (set@ #//.dependencies (get@ #//.dependencies expected))) + (set@ #//.dependencies (get@ #//.dependencies expected)) + (set@ #//.repositories (get@ #//.repositories expected))) actual) (#try.Failure error) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index de14f2dea..b2929de58 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -36,6 +36,7 @@ ["#." macro] ["#." math] ["#." meta] + ["#." program] ["#." time] ## ["#." tool] ## TODO: Update & expand tests for this ["#." type] @@ -220,13 +221,15 @@ /macro.test /math.test /meta.test + /program.test /time.test ## /tool.test /type.test /world.test /ffi.test <target> - <extension>))))) + <extension> + ))))) (def: test Test @@ -255,7 +258,21 @@ ))) (program: args - (<| io - _.run! - (_.times' (#.Some 2,000) 100) - ..test)) + (let [shift (for {@.jvm 1 + @.old 1 + @.js 2 + @.python 6} + 0) + time_out (|> 1 + (i64.left_shift shift) + (n.* 1,000)) + times (: (-> Test Test) + (for {@.js (_.times 10) + @.python (_.times 1) + @.lua (_.times 1) + @.ruby (_.times 1)} + (_.times' (#.Some time_out) 100)))] + (<| io + _.run! + times + ..test))) diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 9a3fddcaf..14ec96329 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -198,16 +198,15 @@ [letter/y [/.yellow /.yellow_green]] - ) - <named> (template [<definition> <by_letter>] - [((: (-> Any (List //.Color)) - (function (_ _) - (`` (list (~~ (template.splice <by_letter>)))))) - 123)] - - <colors>)] + )] (def: all_colors - (list.concat (list <named>))) + (list.concat (`` (list (~~ (template [<definition> <by_letter>] + [((: (-> Any (List //.Color)) + (function (_ _) + (`` (list (~~ (template.splice <by_letter>)))))) + 123)] + + <colors>)))))) (def: unique_colors (set.from_list //.hash ..all_colors)) diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index a91ba6247..e7f31f9d7 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -72,7 +72,7 @@ (do meta.monad [seed meta.count #let [[_ expected] (random.run (random.pcg32 [seed seed]) - (random.unicode 10))]] + (random.ascii 10))]] (wrap (list (code.text expected))))) (syntax: (static_escape {un_escaped <code>.text}) diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index 508f9fd6d..dbed9a05f 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["@" target] [abstract [monad (#+ do)]] [control @@ -209,7 +210,8 @@ (list\map /.inspect) (text.join_with " ") (text.enclose ["[" "]"])) - (/.inspect [sample_bit sample_int sample_frac sample_text]))))))) + (/.inspect [sample_bit sample_int sample_frac sample_text])) + ))))) (syntax: (macro_error macro) (function (_ compiler) @@ -238,11 +240,13 @@ bar random.nat baz random.bit] (_.cover [/.here] - (exec - (/.here) - (/.here foo - {bar %.nat}) - true))) + (with_expansions [<no_parameters> (for {@.js (~~ (as_is))} + (~~ (as_is (/.here))))] + (`` (exec + <no_parameters> + (/.here foo + {bar %.nat}) + true))))) (_.cover [/.unknown_local_binding] (exception.match? /.unknown_local_binding (..macro_error (/.here yolo)))) diff --git a/stdlib/source/test/lux/math/number/ratio.lux b/stdlib/source/test/lux/math/number/ratio.lux index 199096dab..f031810d9 100644 --- a/stdlib/source/test/lux/math/number/ratio.lux +++ b/stdlib/source/test/lux/math/number/ratio.lux @@ -64,17 +64,29 @@ denominator (random.filter (|>> (n\= 1) not) ..part)] (_.cover [/.nat] - (and (|> (/.ratio numerator) - /.nat - (maybe\map (n\= numerator)) - (maybe.default false)) - (|> (/.ratio numerator 1) - /.nat - (maybe\map (n\= numerator)) - (maybe.default false)) - (case (/.nat (/.ratio numerator denominator)) - #.None true - (#.Some _) false)))) + (let [only_numerator! + (|> (/.ratio numerator) + /.nat + (maybe\map (n\= numerator)) + (maybe.default false)) + + denominator_1! + (|> (/.ratio numerator 1) + /.nat + (maybe\map (n\= numerator)) + (maybe.default false)) + + with_denominator! + (case (/.nat (/.ratio numerator denominator)) + (#.Some factor) + (and (n.= 0 (n.% denominator numerator)) + (n.= numerator (n.* factor denominator))) + + #.None + (not (n.= 0 (n.% denominator numerator))))] + (and only_numerator! + denominator_1! + with_denominator!)))) (do random.monad [sample ..random] ($_ _.and diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux new file mode 100644 index 000000000..fe969cd3c --- /dev/null +++ b/stdlib/source/test/lux/program.lux @@ -0,0 +1,65 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + ["." ffi] + [abstract + [monad (#+ do)]] + [control + ["." io] + ["." try] + ["<>" parser + ["<.>" code] + ["<.>" cli]]] + [data + ["." text] + [collection + ["." list]]] + [macro + [syntax (#+ syntax:)]] + [math + ["." random]]] + {1 + ["." /]}) + +(syntax: (actual_program {actual_program (<| <code>.form + (<>.after (<code>.text! "lux def program")) + <code>.any)}) + (wrap (list actual_program))) + +(def: #export test + Test + (<| (_.covering /._) + (do random.monad + [inputs (random.list 5 (random.ascii/upper 5))] + (_.cover [/.program:] + (let [(^open "list\.") (list.equivalence text.equivalence)] + (and (with_expansions [<program> (/.program: all_arguments + (io.io all_arguments))] + (let [outcome ((: (-> (List Text) (io.IO Any)) + (..actual_program <program>)) + inputs)] + (is? (: Any inputs) (io.run outcome)))) + (with_expansions [<program> (/.program: [arg/0 arg/1 arg/2 arg/3 arg/4] + (io.io (list arg/4 arg/3 arg/2 arg/1 arg/0)))] + (let [outcome ((: (-> (List Text) (io.IO Any)) + (..actual_program <program>)) + inputs)] + (list\= (list.reverse inputs) + (:coerce (List Text) (io.run outcome))))) + (with_expansions [<program> (/.program: [{all_arguments (<>.many <cli>.any)}] + (io.io all_arguments))] + (let [outcome ((: (-> (List Text) (io.IO Any)) + (..actual_program <program>)) + inputs)] + (list\= inputs + (:coerce (List Text) (io.run outcome))))) + (with_expansions [<program> (/.program: [arg/0 arg/1 arg/2 arg/3] + (io.io []))] + (case (ffi.try ((: (-> (List Text) (io.IO Any)) + (..actual_program <program>)) + inputs)) + (#try.Success _) + false + + (#try.Failure _) + true)))))))) diff --git a/stdlib/source/test/lux/world/input/keyboard.lux b/stdlib/source/test/lux/world/input/keyboard.lux index e38ce6271..1dde1aaa7 100644 --- a/stdlib/source/test/lux/world/input/keyboard.lux +++ b/stdlib/source/test/lux/world/input/keyboard.lux @@ -9,6 +9,8 @@ [collection ["." list] ["." set (#+ Set)]]] + [macro + ["." template]] [math ["." random (#+ Random)] [number @@ -16,101 +18,122 @@ {1 ["." /]}) -(with_expansions [<keys> (as_is /.back_space - /.enter - /.shift - /.control - /.alt - /.caps_lock - /.escape - /.space - /.page_up - /.page_down - /.end - /.home +(with_expansions [<groups> (as_is [keys/commands + [/.back_space + /.enter + /.shift + /.control + /.alt + /.caps_lock + /.escape + /.space + /.page_up + /.page_down + /.end + /.home + /.delete + /.num_lock + /.scroll_lock + /.print_screen + /.insert + /.windows - /.left - /.up - /.right - /.down - - /.a - /.b - /.c - /.d - /.e - /.f - /.g - /.h - /.i - /.j - /.k - /.l - /.m - /.n - /.o - /.p - /.q - /.r - /.s - /.t - /.u - /.v - /.w - /.x - /.y - /.z - - /.num_pad_0 - /.num_pad_1 - /.num_pad_2 - /.num_pad_3 - /.num_pad_4 - /.num_pad_5 - /.num_pad_6 - /.num_pad_7 - /.num_pad_8 - /.num_pad_9 + /.left + /.up + /.right + /.down]] + + [keys/letters + [/.a + /.b + /.c + /.d + /.e + /.f + /.g + /.h + /.i + /.j + /.k + /.l + /.m + /.n + /.o + /.p + /.q + /.r + /.s + /.t + /.u + /.v + /.w + /.x + /.y + /.z]] + + [keys/num_pad + [/.num_pad_0 + /.num_pad_1 + /.num_pad_2 + /.num_pad_3 + /.num_pad_4 + /.num_pad_5 + /.num_pad_6 + /.num_pad_7 + /.num_pad_8 + /.num_pad_9]] - /.delete - /.num_lock - /.scroll_lock - /.print_screen - /.insert - /.windows - - /.f1 - /.f2 - /.f3 - /.f4 - /.f5 - /.f6 - /.f7 - /.f8 - /.f9 - /.f10 - /.f11 - /.f12 - /.f13 - /.f14 - /.f15 - /.f16 - /.f17 - /.f18 - /.f19 - /.f20 - /.f21 - /.f22 - /.f23 - /.f24)] + [keys/functions + [/.f1 + /.f2 + /.f3 + /.f4 + /.f5 + /.f6 + /.f7 + /.f8 + /.f9 + /.f10 + /.f11 + /.f12 + /.f13 + /.f14 + /.f15 + /.f16 + /.f17 + /.f18 + /.f19 + /.f20 + /.f21 + /.f22 + /.f23 + /.f24]])] (def: listing (List /.Key) - (list <keys>)) + (list.concat (`` (list (~~ (template [<definition> <keys>] + [((: (-> Any (List /.Key)) + (function (_ _) + (`` (list (~~ (template.splice <keys>)))))) + [])] + + <groups>)))))) (def: catalogue (Set /.Key) (set.from_list n.hash ..listing)) + (def: verdict + (n.= (list.size ..listing) + (set.size ..catalogue))) + + (template [<definition> <keys>] + [(def: <definition> + Test + (_.cover <keys> + ..verdict))] + + <groups>) + (def: #export random (Random /.Key) (let [count (list.size ..listing)] @@ -122,23 +145,24 @@ Test (<| (_.covering /._) (_.for [/.Key]) - ($_ _.and - (_.cover [<keys>] - (n.= (list.size ..listing) - (set.size ..catalogue))) + (`` ($_ _.and + (~~ (template [<definition> <keys>] + [<definition>] + + <groups>)) - (_.for [/.Press] - (`` ($_ _.and - (~~ (template [<pressed?> <function>] - [(do random.monad - [key ..random - #let [sample (<function> key)]] - (_.cover [<function>] - (and (bit\= <pressed?> (get@ #/.pressed? sample)) - (n.= key (get@ #/.input sample)))))] + (_.for [/.Press] + (`` ($_ _.and + (~~ (template [<pressed?> <function>] + [(do random.monad + [key ..random + #let [sample (<function> key)]] + (_.cover [<function>] + (and (bit\= <pressed?> (get@ #/.pressed? sample)) + (n.= key (get@ #/.input sample)))))] - [#0 /.release] - [#1 /.press] - )) - ))) - )))) + [#0 /.release] + [#1 /.press] + )) + ))) + ))))) |