diff options
Diffstat (limited to 'stdlib')
35 files changed, 1884 insertions, 422 deletions
diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux index 3b690ea7d..b82a24cca 100644 --- a/stdlib/source/lux/control/concurrency/atom.lux +++ b/stdlib/source/lux/control/concurrency/atom.lux @@ -20,63 +20,52 @@ (compareAndSet [a a] boolean)]))] (for {@.old <jvm> @.jvm <jvm>} - (as_is))) -(abstract: #export (Atom a) - (for {@.old - (java/util/concurrent/atomic/AtomicReference a) - - @.jvm - (java/util/concurrent/atomic/AtomicReference a) - - @.js - (array.Array a) - }) - - {#.doc "Atomic references that are safe to mutate concurrently."} - - (def: #export (atom value) - (All [a] (-> a (Atom a))) - (:abstraction (for {@.old - (java/util/concurrent/atomic/AtomicReference::new value) - - @.jvm - (java/util/concurrent/atomic/AtomicReference::new value) - - @.js - ("js array write" 0 value ("js array new" 1)) - }))) - - (def: #export (read atom) - (All [a] (-> (Atom a) (IO a))) - (io (for {@.old - (java/util/concurrent/atomic/AtomicReference::get (:representation atom)) - - @.jvm - (java/util/concurrent/atomic/AtomicReference::get (:representation atom)) - - @.js - ("js array read" 0 (:representation atom)) - }))) - - (def: #export (compare_and_swap current new atom) - {#.doc (doc "Only mutates an atom if you can present its current value." - "That guarantees that atom was not updated since you last read from it.")} - (All [a] (-> a a (Atom a) (IO Bit))) - (io (for {@.old - (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom)) - - @.jvm - (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom)) - - @.js - (let [old ("js array read" 0 (:representation atom))] - (if (is? old current) - (exec ("js array write" 0 new (:representation atom)) - true) - false))}))) - ) +(with_expansions [<new> (for {@.js "js array new" + @.python "python array new"} + (as_is)) + <write> (for {@.js "js array write" + @.python "python array write"} + (as_is)) + <read> (for {@.js "js array read" + @.python "python array read"} + (as_is))] + (abstract: #export (Atom a) + (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)] + (for {@.old <jvm> + @.jvm <jvm>} + (array.Array a))) + + {#.doc "Atomic references that are safe to mutate concurrently."} + + (def: #export (atom value) + (All [a] (-> a (Atom a))) + (:abstraction (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::new value)] + (for {@.old <jvm> + @.jvm <jvm>} + (<write> 0 value (<new> 1)))))) + + (def: #export (read atom) + (All [a] (-> (Atom a) (IO a))) + (io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::get (:representation atom))] + (for {@.old <jvm> + @.jvm <jvm>} + (<read> 0 (:representation atom)))))) + + (def: #export (compare_and_swap current new atom) + {#.doc (doc "Only mutates an atom if you can present its current value." + "That guarantees that atom was not updated since you last read from it.")} + (All [a] (-> a a (Atom a) (IO Bit))) + (io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom))] + (for {@.old <jvm> + @.jvm <jvm>} + (let [old (<read> 0 (:representation atom))] + (if (is? old current) + (exec (<write> 0 new (:representation atom)) + true) + false)))))) + )) (def: #export (update f atom) {#.doc (doc "Updates an atom by applying a function to its current value." diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux index d1ab65886..9c77fc85f 100644 --- a/stdlib/source/lux/control/concurrency/thread.lux +++ b/stdlib/source/lux/control/concurrency/thread.lux @@ -12,7 +12,8 @@ ["." list]]] [math [number - ["n" nat]]]] + ["n" nat] + ["f" frac]]]] [// ["." atom (#+ Atom)]]) @@ -43,7 +44,12 @@ @.jvm (as_is <jvm>) @.js - (as_is (host.import: (setTimeout [host.Function host.Number] #io Any)))} + (as_is (host.import: (setTimeout [host.Function host.Number] #io Any))) + + @.python + (host.import: threading/Timer + (new [host.Float host.Function]) + (start [] #io Any))} ## Default (type: Thread @@ -59,7 +65,6 @@ .nat)] (for {@.old <jvm> @.jvm <jvm>} - ## Default 1))) @@ -68,9 +73,8 @@ (java/util/concurrent/ScheduledThreadPoolExecutor::new (.int ..parallelism))))] (for {@.old <jvm> @.jvm <jvm> - - @.js - (as_is)} + @.js (as_is) + @.python (as_is)} ## Default (def: runner @@ -101,7 +105,13 @@ @.js (..setTimeout [(host.closure [] (io.run action)) - (n.frac milli_seconds)])} + (n.frac milli_seconds)]) + + @.python + (|> (host.lambda [] (io.run action)) + [(|> milli_seconds n.frac (f./ +1,000.0))] + threading/Timer::new + (threading/Timer::start []))} ## Default (do io.monad @@ -111,14 +121,10 @@ ..runner)] (wrap [])))) -(for {@.old - (as_is) - - @.jvm - (as_is) - - @.js - (as_is)} +(for {@.old (as_is) + @.jvm (as_is) + @.js (as_is) + @.python (as_is)} ## Default (as_is (exception: #export cannot_continue_running_threads) diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index cc4273079..eb8405fc5 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -37,39 +37,39 @@ [inverted_slice] ) -(with_expansions [<for_jvm> (as_is (type: #export Binary (host.type [byte])) - - (host.import: java/lang/Object) - - (host.import: java/lang/System - ["#::." - (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)]) - - (host.import: java/util/Arrays - ["#::." - (#static copyOfRange [[byte] int int] [byte]) - (#static equals [[byte] [byte]] boolean)]) - - (def: byte_mask - I64 - (|> i64.bits_per_byte i64.mask .i64)) - - (def: i64 - (-> (primitive "java.lang.Byte") I64) - (|>> host.byte_to_long (:coerce I64) (i64.and ..byte_mask))) - - (def: byte - (-> (I64 Any) (primitive "java.lang.Byte")) - (for {@.old - (|>> .int host.long_to_byte) - - @.jvm - (|>> .int (:coerce (primitive "java.lang.Long")) host.long_to_byte)})))] +(with_expansions [<jvm> (as_is (type: #export Binary (host.type [byte])) + + (host.import: java/lang/Object) + + (host.import: java/lang/System + ["#::." + (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)]) + + (host.import: java/util/Arrays + ["#::." + (#static copyOfRange [[byte] int int] [byte]) + (#static equals [[byte] [byte]] boolean)]) + + (def: byte_mask + I64 + (|> i64.bits_per_byte i64.mask .i64)) + + (def: i64 + (-> (primitive "java.lang.Byte") I64) + (|>> host.byte_to_long (:coerce I64) (i64.and ..byte_mask))) + + (def: byte + (-> (I64 Any) (primitive "java.lang.Byte")) + (for {@.old + (|>> .int host.long_to_byte) + + @.jvm + (|>> .int (:coerce (primitive "java.lang.Long")) host.long_to_byte)})))] (for {@.old - (as_is <for_jvm>) + (as_is <jvm>) @.jvm - (as_is <for_jvm>) + (as_is <jvm>) @.js (as_is (host.import: ArrayBuffer @@ -80,7 +80,11 @@ (length host.Number)) (type: #export Binary - Uint8Array))})) + Uint8Array)) + + @.python + (type: #export Binary + (primitive "bytearray"))})) (template: (!size binary) (for {@.old @@ -90,7 +94,12 @@ (host.array_length binary) @.js - (f.nat (Uint8Array::length binary))})) + (f.nat (Uint8Array::length binary)) + + @.python + (|> binary + (:coerce (array.Array (I64 Any))) + "python array length")})) (template: (!read idx binary) (for {@.old @@ -105,7 +114,12 @@ (:coerce (array.Array .Frac)) ("js array read" idx) f.nat - .i64)})) + .i64) + + @.python + (|> binary + (:coerce (array.Array .I64)) + ("python array read" idx))})) (template: (!write idx value binary) (for {@.old @@ -119,6 +133,12 @@ (: ..Binary) (:coerce (array.Array .Frac)) ("js array write" idx (n.frac (.nat value))) + (:coerce ..Binary)) + + @.python + (|> binary + (:coerce (array.Array (I64 Any))) + ("python array write" idx (:coerce (I64 Any) value)) (:coerce ..Binary))})) (def: #export size @@ -134,7 +154,11 @@ (|>> (host.array byte)) @.js - (|>> n.frac [] ArrayBuffer::new Uint8Array::new)})) + (|>> n.frac [] ArrayBuffer::new Uint8Array::new) + + @.python + (|>> ("python apply" ("python constant" "bytearray")) + (:coerce Binary))})) (def: #export (fold f init binary) (All [a] (-> (-> I64 a a) a Binary a)) @@ -245,11 +269,8 @@ (recur (inc idx))) true))))))) -(for {@.old - (as_is) - - @.jvm - (as_is)} +(for {@.old (as_is) + @.jvm (as_is)} ## Default (exception: #export (cannot_copy_bytes {bytes Nat} @@ -262,14 +283,14 @@ (def: #export (copy bytes source_offset source target_offset target) (-> Nat Nat Binary Nat Binary (Try Binary)) - (with_expansions [<for_jvm> (as_is (do try.monad - [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] - (wrap target)))] + (with_expansions [<jvm> (as_is (do try.monad + [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] + (wrap target)))] (for {@.old - <for_jvm> + <jvm> @.jvm - <for_jvm>} + <jvm>} ## Default (let [source_input (n.- source_offset (!size source)) @@ -290,12 +311,12 @@ (if (n.<= to from) (if (and (n.< size from) (n.< size to)) - (with_expansions [<for_jvm> (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))] + (with_expansions [<jvm> (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))] (for {@.old - <for_jvm> + <jvm> @.jvm - <for_jvm>} + <jvm>} ## Default (let [how_many (n.- from to)] diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux index 470640bcf..e407f4877 100644 --- a/stdlib/source/lux/data/collection/array.lux +++ b/stdlib/source/lux/data/collection/array.lux @@ -46,7 +46,10 @@ :assume) @.js - ("js array new" size)})) + ("js array new" size) + + @.python + ("python array new" size)})) (def: #export (size array) (All [a] (-> (Array a) Nat)) @@ -63,7 +66,10 @@ (:coerce Nat)) @.js - ("js array length" array)})) + ("js array length" array) + + @.python + ("python array length" array)})) (def: #export (read index array) (All [a] @@ -87,6 +93,12 @@ (let [output ("js array read" index array)] (if ("js object undefined?" output) #.None + (#.Some output))) + + @.python + (let [output ("python array read" index array)] + (if ("python object none?" output) + #.None (#.Some output)))}) #.None)) @@ -103,7 +115,10 @@ :assume) @.js - ("js array write" index value array)})) + ("js array write" index value array) + + @.python + ("python array write" index value array)})) (def: #export (delete! index array) (All [a] @@ -116,7 +131,10 @@ (write! index (:assume (: <elem_type> ("jvm object null"))) array) @.js - ("js array delete" index array)}) + ("js array delete" index array) + + @.python + ("python array delete" index array)}) array)) ) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index cc30732d2..031d76a07 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -14,8 +14,8 @@ ["." list ("#\." fold)]]] [math [number - ["." i64] - ["n" nat]]]]) + ["n" nat] + ["." i64]]]]) (type: #export Char Nat) diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index df1714484..2050cbc8c 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -173,11 +173,8 @@ ["#::." (new [[byte] java/lang/String]) (getBytes [java/lang/String] [byte])]))] - (for {@.old - (as_is <jvm>) - - @.jvm - (as_is <jvm>) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>) @.js (as_is (host.import: Uint8Array) @@ -195,12 +192,14 @@ (host.import: TextDecoder (new [host.String]) - (decode [Uint8Array] host.String)))})) + (decode [Uint8Array] host.String)))} + (as_is))) (def: (to_utf8 value) (-> Text Binary) (for {@.old (java/lang/String::getBytes (..name ..utf_8) + ## TODO: Remove coercion below. ## The coercion below may seem ## gratuitous, but removing it ## causes a grave compilation problem. @@ -222,31 +221,35 @@ ## On the browser (|> (TextEncoder::new [(..name ..utf_8)]) (TextEncoder::encode [value])) - )})) + ) + + @.python + (:coerce Binary ("python apply" (:assume ("python constant" "bytearray")) value "utf-8"))})) (def: (from_utf8 value) (-> Binary (Try Text)) - (for {@.old - (#try.Success (java/lang/String::new value (..name ..utf_8))) + (with_expansions [<jvm> (#try.Success (java/lang/String::new value (..name ..utf_8)))] + (for {@.old <jvm> + @.jvm <jvm> - @.jvm - (#try.Success (java/lang/String::new value (..name ..utf_8))) + @.js + (cond host.on_nashorn? + (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"]) + (:coerce Text) + #try.Success) - @.js - (cond host.on_nashorn? - (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"]) - (:coerce Text) - #try.Success) + host.on_node_js? + (|> (Buffer::from|decode [value]) + (Buffer::toString ["utf8"]) + #try.Success) + + ## On the browser + (|> (TextDecoder::new [(..name ..utf_8)]) + (TextDecoder::decode [value]) + #try.Success)) - host.on_node_js? - (|> (Buffer::from|decode [value]) - (Buffer::toString ["utf8"]) - #try.Success) - - ## On the browser - (|> (TextDecoder::new [(..name ..utf_8)]) - (TextDecoder::decode [value]) - #try.Success))})) + @.python + (host.try (:coerce Text ("python object do" "decode" (:assume value) "utf-8")))}))) (structure: #export utf8 (Codec Binary Text) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index b60d62c11..cd354ec84 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- type) ["@" target] ["." type] ["." host (#+ import:)] @@ -58,17 +58,21 @@ (intValue [] int) (longValue [] long) (doubleValue [] double)]))] - (for {@.old - (as_is <jvm>) - - @.jvm - (as_is <jvm>) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>) @.js (as_is (import: JSON (#static stringify [.Any] host.String)) (import: Array - (#static isArray [.Any] host.Boolean)))})) + (#static isArray [.Any] host.Boolean))) + + @.python + (as_is (type: PyType + (primitive "python_type")) + + (import: (type [.Any] PyType)) + (import: (str [.Any] host.String)))})) (def: Inspector (-> Any Text)) @@ -117,11 +121,8 @@ (inspect_tuple inspect value))) #.None) (java/lang/Object::toString object))))] - (for {@.old - <jvm> - - @.jvm - <jvm> + (for {@.old <jvm> + @.jvm <jvm> @.js (case (host.type_of value) @@ -156,7 +157,39 @@ (JSON::stringify value))) _ - (undefined)) + (JSON::stringify value)) + + @.python + (case (..str (..type value)) + (^template [<type_of> <then>] + [<type_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 'list'>" + (inspect_tuple inspect value) + + "<type 'tuple'>" + (let [variant (:coerce (array.Array Any) value)] + (case (array.size variant) + 3 (let [variant_tag ("python array read" 0 variant) + variant_flag ("python array read" 1 variant) + variant_value ("python array read" 2 variant)] + (if (or ("python object none?" variant_tag) + ("python object none?" variant_value)) + (..str value) + (|> (format (|> variant_tag (:coerce .Int) %.int) + " " (|> variant_flag "python object none?" not %.bit) + " " (inspect variant_value)) + (text.enclose ["(" ")"])))) + _ (..str value))) + + _ + (..str value)) }))) (exception: #export (cannot_represent_value {type Type}) diff --git a/stdlib/source/lux/host.py.lux b/stdlib/source/lux/host.py.lux new file mode 100644 index 000000000..ed3497df8 --- /dev/null +++ b/stdlib/source/lux/host.py.lux @@ -0,0 +1,315 @@ +(.module: + [lux #* + ["." meta] + ["@" target] + [abstract + [monad (#+ do)]] + [control + ["." io] + ["<>" parser + ["<c>" code (#+ Parser)]]] + [data + ["." product] + ["." maybe] + ["." text + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor fold)]]] + [type + abstract] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code] + ["." template]]]) + +(abstract: #export (Object brand) Any) + +(template [<name>] + [(with_expansions [<brand> (template.identifier [<name> "'"])] + (abstract: #export <brand> Any) + (type: #export <name> + (..Object <brand>)))] + + [None] + [Function] + ) + +(template [<name> <type>] + [(type: #export <name> + <type>)] + + [Boolean Bit] + [Integer Int] + [Float Frac] + [String Text] + ) + +(type: Noneable + [Bit Code]) + +(def: noneable + (Parser Noneable) + (let [token (' #?)] + (<| (<>.and (<>.parses? (<c>.this! token))) + (<>.after (<>.not (<c>.this! token))) + <c>.any))) + +(type: Constructor + (List Noneable)) + +(def: constructor + (Parser Constructor) + (<c>.form (<>.after (<c>.this! (' new)) + (<c>.tuple (<>.some ..noneable))))) + +(type: Field + [Bit Text Noneable]) + +(def: static! + (Parser Any) + (<c>.this! (' #static))) + +(def: field + (Parser Field) + (<c>.form ($_ <>.and + (<>.parses? ..static!) + <c>.local_identifier + ..noneable))) + +(type: Common_Method + {#name Text + #alias (Maybe Text) + #inputs (List Noneable) + #io? Bit + #try? Bit + #output Noneable}) + +(type: Static_Method Common_Method) +(type: Virtual_Method Common_Method) + +(type: Method + (#Static Static_Method) + (#Virtual Virtual_Method)) + +(def: common_method + (Parser Common_Method) + ($_ <>.and + <c>.local_identifier + (<>.maybe (<>.after (<c>.this! (' #as)) <c>.local_identifier)) + (<c>.tuple (<>.some ..noneable)) + (<>.parses? (<c>.this! (' #io))) + (<>.parses? (<c>.this! (' #try))) + ..noneable)) + +(def: static_method + (<>.after ..static! ..common_method)) + +(def: method + (Parser Method) + (<c>.form (<>.or ..static_method + ..common_method))) + +(type: Member + (#Constructor Constructor) + (#Field Field) + (#Method Method)) + +(def: member + (Parser Member) + ($_ <>.or + ..constructor + ..field + ..method + )) + +(def: input_variables + (-> (List Noneable) (List [Bit Code])) + (|>> list.enumeration + (list\map (function (_ [idx [noneable? type]]) + [noneable? (|> idx %.nat code.local_identifier)])))) + +(def: (noneable_type [noneable? type]) + (-> Noneable Code) + (if noneable? + (` (.Maybe (~ type))) + type)) + +(def: (with_none g!temp [noneable? input]) + (-> Code [Bit Code] Code) + (if noneable? + (` (case (~ input) + (#.Some (~ g!temp)) + (~ g!temp) + + #.None + ("python object none"))) + input)) + +(def: (without_none g!temp [noneable? outputT] output) + (-> Code Noneable Code Code) + (if noneable? + (` (let [(~ g!temp) (~ output)] + (if ("python object none?" (~ g!temp)) + #.None + (#.Some (~ g!temp))))) + output)) + +(type: Import + (#Class [Text (List Member)]) + (#Function Static_Method)) + +(def: import + ($_ <>.or + ($_ <>.and + <c>.local_identifier + (<>.some member)) + (<c>.form ..common_method) + )) + +(syntax: #export (try expression) + {#.doc (doc (case (try (risky_computation input)) + (#.Right success) + (do_something success) + + (#.Left error) + (recover_from_failure error)))} + (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) + +(def: (with_io with? without) + (-> Bit Code Code) + (if with? + (` (io.io (~ without))) + without)) + +(def: (io_type io? rawT) + (-> Bit Code Code) + (if io? + (` (io.IO (~ rawT))) + rawT)) + +(def: (with_try with? without_try) + (-> Bit Code Code) + (if with? + (` (..try (~ without_try))) + without_try)) + +(def: (try_type try? rawT) + (-> Bit Code Code) + (if try? + (` (.Either .Text (~ rawT))) + rawT)) + +(def: (make_function g!method g!temp source inputsT io? try? outputT) + (-> Code Code Code (List Noneable) Bit Bit Noneable Code) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ g!method) + [(~+ (list\map product.right g!inputs))]) + (-> [(~+ (list\map noneable_type inputsT))] + (~ (|> (noneable_type outputT) + (try_type try?) + (io_type io?)))) + (:assume + (~ (<| (with_io io?) + (with_try try?) + (without_none g!temp outputT) + (` ("python apply" + (~ source) + (~+ (list\map (with_none g!temp) g!inputs))))))))))) + +(syntax: #export (import: {import ..import}) + (with_gensyms [g!temp] + (case import + (#Class [class members]) + (with_gensyms [g!object] + (let [qualify (: (-> Text Code) + (|>> (format class "::") code.local_identifier)) + g!type (code.local_identifier class) + real_class (text.replace_all "/" "." class) + imported (case (text.split_all_with "/" class) + (#.Cons head tail) + (list\fold (function (_ sub super) + (` ("python object get" (~ (code.text sub)) (~ super)))) + (` ("python import" (~ (code.text head)))) + tail) + + #.Nil + (` ("python import" (~ (code.text class)))))] + (wrap (list& (` (type: (~ g!type) + (..Object (primitive (~ (code.text real_class)))))) + (list\map (function (_ member) + (case member + (#Constructor inputsT) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify "new")) + [(~+ (list\map product.right g!inputs))]) + (-> [(~+ (list\map noneable_type inputsT))] + (~ g!type)) + (:assume + ("python apply" + (:coerce ..Function (~ imported)) + [(~+ (list\map (with_none g!temp) g!inputs))]))))) + + (#Field [static? field fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify field))) + (\ (~! meta.monad) (~' wrap) + (list (` (.:coerce (~ (noneable_type fieldT)) + ("python object get" (~ (code.text field)) (~ imported)))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (-> (~ g!type) + (~ (noneable_type fieldT))) + (:assume + (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field)) (~ g!object))))))))) + + (#Method method) + (case method + (#Static [method alias inputsT io? try? outputT]) + (..make_function (qualify (maybe.default method alias)) + g!temp + (` ("python object get" (~ (code.text method)) (~ imported))) + inputsT + io? + try? + outputT) + + (#Virtual [method alias inputsT io? try? outputT]) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify (maybe.default method alias))) + [(~+ (list\map product.right g!inputs))] + (~ g!object)) + (-> [(~+ (list\map noneable_type inputsT))] + (~ g!type) + (~ (|> (noneable_type outputT) + (try_type try?) + (io_type io?)))) + (:assume + (~ (<| (with_io io?) + (with_try try?) + (without_none g!temp outputT) + (` ("python object do" + (~ (code.text method)) + (~ g!object) + [(~+ (list\map (with_none g!temp) g!inputs))]))))))))))) + members))))) + + (#Function [name alias inputsT io? try? outputT]) + (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) + g!temp + (` ("python constant" (~ (code.text name)))) + inputsT + io? + try? + outputT))) + ))) + +(def: #export none + (<| (:coerce None) + ("python object none"))) + +(template: #export (lambda <inputs> <output>) + (.:coerce ..Function + (`` ("python function" + (~~ (template.count <inputs>)) + (.function (_ [<inputs>]) + <output>))))) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 6c52b62fd..44650ed57 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -41,8 +41,17 @@ ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) @.jvm - (as_is (template: (!double value) (|> value (:coerce (primitive "java.lang.Double")) "jvm object cast")) - (template: (!frac value) (|> value "jvm object cast" (: (primitive "java.lang.Double")) (:coerce Frac))) + (as_is (template: (!double value) + (|> value + (:coerce (primitive "java.lang.Double")) + "jvm object cast")) + + (template: (!frac value) + (|> value + "jvm object cast" + (: (primitive "java.lang.Double")) + (:coerce Frac))) + (template [<name> <method>] [(def: #export <name> (-> Frac Frac) @@ -68,6 +77,7 @@ [root/2 "sqrt"] [root/3 "cbrt"] ) + (def: #export (pow param subject) (-> Frac Frac Frac) (|> ("jvm member invoke static" [] "java.lang.Math" "pow" [] @@ -78,7 +88,8 @@ (as_is (template [<name> <method>] [(def: #export <name> (-> Frac Frac) - (|>> ("js apply" ("js constant" <method>)) (:coerce Frac)))] + (|>> ("js apply" ("js constant" <method>)) + (:coerce Frac)))] [cos "Math.cos"] [sin "Math.sin"] @@ -97,9 +108,42 @@ [root/2 "Math.sqrt"] [root/3 "Math.cbrt"] ) + (def: #export (pow param subject) (-> Frac Frac Frac) - (:coerce Frac ("js apply" ("js constant" "Math.pow") subject param))))}) + (:coerce Frac ("js apply" ("js constant" "Math.pow") subject param)))) + + @.python + (as_is (template [<name> <method>] + [(def: #export <name> + (-> Frac Frac) + (|>> ("python object do" <method> ("python import" "math")) + (:coerce Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: #export (pow param subject) + (-> Frac Frac Frac) + (:coerce Frac ("python object do" "pow" ("python import" "math") subject param))) + + (def: #export root/3 + (-> Frac Frac) + (..pow ("lux f64 /" +3.0 +1.0))))}) (def: #export (round input) (-> Frac Frac) @@ -117,7 +161,7 @@ (def: #export (atan2 param subject) (-> Frac Frac Frac) (cond ("lux f64 <" param +0.0) - (atan ("lux f64 /" param subject)) + (..atan ("lux f64 /" param subject)) ("lux f64 <" +0.0 param) (if (or ("lux f64 <" subject +0.0) diff --git a/stdlib/source/lux/math/number/frac.lux b/stdlib/source/lux/math/number/frac.lux index 09c80cd05..599c5cbbb 100644 --- a/stdlib/source/lux/math/number/frac.lux +++ b/stdlib/source/lux/math/number/frac.lux @@ -1,5 +1,6 @@ (.module: [lux (#- nat int rev) + ["@" target] [abstract [hash (#+ Hash)] [monoid (#+ Monoid)] @@ -12,13 +13,13 @@ ["." try (#+ Try)]] [data ["." maybe] - ["." text]] - ["." math]] + ["." text]]] ["." // #_ ["#." i64] ["#." nat] ["#." int] - ["#." rev]]) + ["#." rev] + ["/#" //]]) (def: #export (= reference sample) {#.doc "Frac(tion) equivalence."} @@ -144,13 +145,13 @@ (def: #export smallest Frac - (math.pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent)) - +2.0)) + (///.pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent)) + +2.0)) (def: #export biggest Frac - (let [f2^-52 (math.pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0) - f2^+1023 (math.pow ..max_exponent +2.0)] + (let [f2^-52 (///.pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0) + f2^+1023 (///.pow ..max_exponent +2.0)] (|> +2.0 (..- f2^-52) (..* f2^+1023)))) @@ -168,16 +169,32 @@ [maximum ..max (..* -1.0 ..biggest)] ) -(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."] - [negative_infinity -1.0 "Negative infinity."] - ) +(for {@.python + (template [<name> <constant> <doc>] + [(def: #export <name> + {#.doc <doc>} + (|> <constant> + ("python apply" (:assume ("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."] + )) + +(def: #export negative_infinity + {#.doc "Negative infinity."} + Frac + (..* -1.0 ..positive_infinity)) (def: #export (not_a_number? number) {#.doc "Tests whether a frac is actually not-a-number."} @@ -213,8 +230,8 @@ (def: log/2 (-> Frac Frac) - (|>> math.log - (../ (math.log +2.0)))) + (|>> ///.log + (../ (///.log +2.0)))) (def: double_bias Nat 1023) @@ -263,7 +280,7 @@ input (..abs input) exponent (|> input ..log/2 - math.floor + ///.floor (..min ..max_exponent)) min_gap (..- (//int.frac ..min_exponent) exponent) power (|> (//nat.frac ..mantissa_size) @@ -271,9 +288,9 @@ (..- exponent)) max_gap (..- ..max_exponent power) mantissa (|> input - (..* (math.pow (..min ..max_exponent power) +2.0)) + (..* (///.pow (..min ..max_exponent power) +2.0)) (..* (if (..> +0.0 max_gap) - (math.pow max_gap +2.0) + (///.pow max_gap +2.0) +1.0))) exponent_bits (|> (if (..< +0.0 min_gap) (|> (..int exponent) @@ -334,7 +351,7 @@ (//int.- (.int ..mantissa_size)))] [(//i64.set ..mantissa_size M) (|> E (//nat.- ..double_bias) (//nat.- ..mantissa_size) .int)]) - exponent (math.pow (//int.frac power) +2.0)] + exponent (///.pow (//int.frac power) +2.0)] (|> (//nat.frac mantissa) (..* exponent) (..* sign))))) diff --git a/stdlib/source/lux/math/number/i64.lux b/stdlib/source/lux/math/number/i64.lux index b25015bf9..d04a9c13a 100644 --- a/stdlib/source/lux/math/number/i64.lux +++ b/stdlib/source/lux/math/number/i64.lux @@ -107,16 +107,14 @@ (-> Nat (I64 Any) Bit) (.not (..set? idx input))) -(template [<name> <main> <comp>] +(template [<name> <forward> <backward>] [(def: #export (<name> distance input) (All [s] (-> Nat (I64 s) (I64 s))) - (let [backwards_distance (n.- (n.% width distance) width)] - (|> input - (<comp> backwards_distance) - (..or (<main> distance input)))))] + (..or (<forward> distance input) + (<backward> (n.- (n.% ..width distance) ..width) input)))] - [rotate_left left_shift logic_right_shift] - [rotate_right logic_right_shift left_shift] + [rotate_left ..left_shift ..logic_right_shift] + [rotate_right ..logic_right_shift ..left_shift] ) (def: #export (region size offset) @@ -147,31 +145,42 @@ [conjunction ..true ..and] ) -(template [<swap> <size> <pattern>] - [(def: <swap> - (All [a] (-> (I64 a) (I64 a))) - (let [high (try.assume (\ n.binary decode <pattern>)) - low (..rotate_right <size> high)] - (function (_ value) - (..or (..logic_right_shift <size> (..and high value)) - (..left_shift <size> (..and low value))))))] - - [swap/32 32 "1111111111111111111111111111111100000000000000000000000000000000"] - [swap/16 16 "1111111111111111000000000000000011111111111111110000000000000000"] - [swap/08 08 "1111111100000000111111110000000011111111000000001111111100000000"] - [swap/04 04 "1111000011110000111100001111000011110000111100001111000011110000"] - [swap/02 02 "1100110011001100110011001100110011001100110011001100110011001100"] - [swap/01 01 "1010101010101010101010101010101010101010101010101010101010101010"] - ) - (def: #export reverse (All [a] (-> (I64 a) (I64 a))) - (|>> ..swap/32 - ..swap/16 - ..swap/08 - ..swap/04 - ..swap/02 - ..swap/01)) + (let [swapper (: (-> Nat (All [a] (-> (I64 a) (I64 a)))) + (function (_ power) + (let [size (..left_shift power 1) + repetitions (: (-> Nat Text Text) + (function (_ times char) + (loop [iterations 1 + output char] + (if (n.< times iterations) + (recur (inc iterations) + ("lux text concat" char output)) + output)))) + pattern (repetitions (n./ (n.+ size size) ..width) + ("lux text concat" + (repetitions size "1") + (repetitions size "0"))) + + high (try.assume (\ n.binary decode pattern)) + low (..rotate_right size high)] + (function (_ value) + (..or (..logic_right_shift size (..and high value)) + (..left_shift size (..and low value))))))) + + swap/01 (swapper 0) + swap/02 (swapper 1) + swap/04 (swapper 2) + swap/08 (swapper 3) + swap/16 (swapper 4) + swap/32 (swapper 5)] + (|>> swap/32 + swap/16 + swap/08 + swap/04 + swap/02 + swap/01))) (signature: #export (Sub size) (: (Equivalence (I64 size)) diff --git a/stdlib/source/lux/math/number/nat.lux b/stdlib/source/lux/math/number/nat.lux index 267846c89..5d1f7a101 100644 --- a/stdlib/source/lux/math/number/nat.lux +++ b/stdlib/source/lux/math/number/nat.lux @@ -108,11 +108,11 @@ (def: #export (/% parameter subject) {#.doc "Nat(ural) [division remainder]."} (-> Nat Nat [Nat Nat]) - (let [div (../ parameter subject) + (let [quotient (../ parameter subject) flat ("lux i64 *" ("lux coerce" Int parameter) - ("lux coerce" Int div))] - [div ("lux i64 -" flat subject)])) + ("lux coerce" Int quotient))] + [quotient ("lux i64 -" flat subject)])) (def: #export (% parameter subject) {#.doc "Nat(ural) remainder."} @@ -177,7 +177,7 @@ (Interval Nat) (def: &enum ..enum) - (def: top (.nat -1)) + (def: top (dec 0)) (def: bottom 0)) (template [<name> <compose> <identity>] diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 36a2294a2..454d33498 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -303,8 +303,9 @@ (get@ #.definitions) (list.all (function (_ [def_name global]) (case global - (#.Definition _) - (if (text\= normal_short def_name) + (#.Definition [exported? _ _ _]) + (if (and exported? + (text\= normal_short def_name)) (#.Some (name\encode [module_name def_name])) #.None) diff --git a/stdlib/source/lux/program.lux b/stdlib/source/lux/program.lux index 55e9ec9b0..36f513e84 100644 --- a/stdlib/source/lux/program.lux +++ b/stdlib/source/lux/program.lux @@ -53,14 +53,10 @@ (let [initialization+event_loop (` ((~! do) (~! io.monad) [(~ g!output) (~ body) - (~+ (for {@.old - (list) - - @.jvm - (list) - - @.js - (list)} + (~+ (for {@.old (list) + @.jvm (list) + @.js (list) + @.python (list)} (list g!_ (` ((~! thread.run!) [])))))] ((~' wrap) (~ g!output))))] diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index 6edba8f89..7510eac7d 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Location Code not or and list if cond int comment) + [lux (#- Location Code not or and list if cond int comment exec) [abstract [equivalence (#+ Equivalence)] [hash (#+ Hash)] @@ -159,6 +159,13 @@ (text.enclose [text.double_quote text.double_quote]) :abstraction)) + (def: #export unicode + (-> Text Literal) + (|>> ..string + :representation + (format "u") + :abstraction)) + (def: (composite_literal left_delimiter right_delimiter entry_serializer) (All [a] (-> Text Text (-> a Text) @@ -272,6 +279,7 @@ [- "-"] [* "*"] [/ "/"] + [// "//"] [% "%"] [** "**"] [bit_or "|"] @@ -354,6 +362,12 @@ (-> (Expression Any) (Statement Any)) (|>> :transmutation)) + (def: #export (exec code then) + (-> (Expression Any) (Statement Any) (Statement Any)) + (:abstraction + (format "exec" (..expression (:representation code)) text.new_line + (:representation then)))) + (def: #export pass (Statement Any) (:abstraction "pass")) diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index fb63247be..dbc56bc0d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -29,8 +29,11 @@ ["." descriptor (#+ Module)] ["." artifact]]]]]) -(type: #export Context [archive.ID artifact.ID]) -(type: #export (Buffer directive) (Row [Text directive])) +(type: #export Context + [archive.ID artifact.ID]) + +(type: #export (Buffer directive) + (Row [Text directive])) (exception: #export (cannot_interpret {error Text}) (exception.report @@ -224,6 +227,7 @@ [?buffer (extension.read (get@ #buffer))] (case ?buffer (#.Some buffer) + ## TODO: Optimize by no longer checking for overwrites... (if (row.any? (|>> product.left (text\= name)) buffer) (phase.throw ..cannot_overwrite_output [name]) (extension.update (set@ #buffer (#.Some (row.add [name code] buffer))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux new file mode 100644 index 000000000..5c10bbc0f --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux @@ -0,0 +1,224 @@ +(.module: + [lux #* + ["." host] + [abstract + ["." monad (#+ do)]] + [control + ["<>" parser + ["<c>" code (#+ Parser)]]] + [data + [collection + ["." array (#+ Array)] + ["." dictionary] + ["." list]]] + ["." type + ["." check]] + ["@" target + ["_" python]]] + [// + ["/" lux (#+ custom)] + [// + ["." bundle] + [// + ["." analysis #_ + ["#/." type]] + [// + ["." analysis (#+ Analysis Operation Phase Handler Bundle)] + [/// + ["." phase]]]]]]) + +(def: array::new + Handler + (custom + [<c>.any + (function (_ extension phase archive lengthC) + (do phase.monad + [lengthA (analysis/type.with_type Nat + (phase archive lengthC)) + [var_id varT] (analysis/type.with_env check.var) + _ (analysis/type.infer (type (Array varT)))] + (wrap (#analysis.Extension extension (list lengthA)))))])) + +(def: array::length + Handler + (custom + [<c>.any + (function (_ extension phase archive arrayC) + (do phase.monad + [[var_id varT] (analysis/type.with_env check.var) + arrayA (analysis/type.with_type (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.infer Nat)] + (wrap (#analysis.Extension extension (list arrayA)))))])) + +(def: array::read + Handler + (custom + [(<>.and <c>.any <c>.any) + (function (_ extension phase archive [indexC arrayC]) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + [var_id varT] (analysis/type.with_env check.var) + arrayA (analysis/type.with_type (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.infer varT)] + (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + +(def: array::write + Handler + (custom + [($_ <>.and <c>.any <c>.any <c>.any) + (function (_ extension phase archive [indexC valueC arrayC]) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + [var_id varT] (analysis/type.with_env check.var) + valueA (analysis/type.with_type varT + (phase archive valueC)) + arrayA (analysis/type.with_type (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.infer (type (Array varT)))] + (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) + +(def: array::delete + Handler + (custom + [($_ <>.and <c>.any <c>.any) + (function (_ extension phase archive [indexC arrayC]) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + [var_id varT] (analysis/type.with_env check.var) + arrayA (analysis/type.with_type (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.infer (type (Array varT)))] + (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + +(def: bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" array::new) + (bundle.install "length" array::length) + (bundle.install "read" array::read) + (bundle.install "write" array::write) + (bundle.install "delete" array::delete) + ))) + +(def: None + (for {@.python + host.None} + Any)) + +(def: Object + (for {@.python (type (host.Object Any))} + Any)) + +(def: Function + (for {@.python host.Function} + Any)) + +(def: object::get + Handler + (custom + [($_ <>.and <c>.text <c>.any) + (function (_ extension phase archive [fieldC objectC]) + (do phase.monad + [objectA (analysis/type.with_type ..Object + (phase archive objectC)) + _ (analysis/type.infer .Any)] + (wrap (#analysis.Extension extension (list (analysis.text fieldC) + objectA)))))])) + +(def: object::do + Handler + (custom + [($_ <>.and <c>.text <c>.any (<>.some <c>.any)) + (function (_ extension phase archive [methodC objectC inputsC]) + (do {! phase.monad} + [objectA (analysis/type.with_type ..Object + (phase archive objectC)) + inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer .Any)] + (wrap (#analysis.Extension extension (list& (analysis.text methodC) + objectA + inputsA)))))])) + +(def: bundle::object + Bundle + (<| (bundle.prefix "object") + (|> bundle.empty + (bundle.install "get" object::get) + (bundle.install "do" object::do) + (bundle.install "none" (/.nullary ..None)) + (bundle.install "none?" (/.unary Any Bit)) + ))) + +(def: python::constant + Handler + (custom + [<c>.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.infer Any)] + (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + +(def: python::import + Handler + (custom + [<c>.text + (function (_ extension phase archive name) + (do phase.monad + [_ (analysis/type.infer ..Object)] + (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + +(def: python::apply + Handler + (custom + [($_ <>.and <c>.any (<>.some <c>.any)) + (function (_ extension phase archive [abstractionC inputsC]) + (do {! phase.monad} + [abstractionA (analysis/type.with_type ..Function + (phase archive abstractionC)) + inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer Any)] + (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) + +(def: python::function + Handler + (custom + [($_ <>.and <c>.nat <c>.any) + (function (_ extension phase archive [arity abstractionC]) + (do phase.monad + [#let [inputT (type.tuple (list.repeat arity Any))] + abstractionA (analysis/type.with_type (-> inputT Any) + (phase archive abstractionC)) + _ (analysis/type.infer ..Function)] + (wrap (#analysis.Extension extension (list (analysis.nat arity) + abstractionA)))))])) + +(def: python::exec + Handler + (custom + [<c>.any + (function (_ extension phase archive codeC) + (do phase.monad + [codeA (analysis/type.with_type Text + (phase archive codeC)) + _ (analysis/type.infer .Any)] + (wrap (#analysis.Extension extension (list codeA)))))])) + +(def: #export bundle + Bundle + (<| (bundle.prefix "python") + (|> bundle.empty + (dictionary.merge bundle::array) + (dictionary.merge bundle::object) + + (bundle.install "constant" python::constant) + (bundle.install "import" python::import) + (bundle.install "apply" python::apply) + (bundle.install "function" python::function) + (bundle.install "exec" python::exec) + ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux index 6c09e4123..5639551c6 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux @@ -1,7 +1,11 @@ (.module: - [lux #*] + [lux #* + [data + [collection + ["." dictionary]]]] ["." / #_ ["#." common] + ["#." host] [//// [generation [python @@ -9,4 +13,5 @@ (def: #export bundle Bundle - /common.bundle) + (dictionary.merge /common.bundle + /host.bundle)) 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 b1da3c425..9657fcb66 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 @@ -3,48 +3,114 @@ [abstract ["." monad (#+ do)]] [control - ["." function]] + ["." function] + ["." try] + ["<>" parser + ["<s>" synthesis (#+ Parser)]]] [data ["." product] + [text + ["%" format (#+ format)]] [collection - ["." dictionary]]] + ["." dictionary] + ["." list ("#\." functor fold)]]] [math [number ["f" frac]]] [target ["_" python (#+ Expression)]]] - [//// + ["." //// #_ ["/" bundle] - [// + ["/#" // #_ + ["." extension] [generation [extension (#+ Nullary Unary Binary Trinary nullary unary binary trinary)] ["//" python #_ - ["#." runtime (#+ Operation Phase Handler Bundle)]]]]]) + ["#." runtime (#+ Operation Phase Handler Bundle Generator)]]] + [// + [synthesis (#+ %synthesis)] + ["." generation] + [/// + ["#" phase]]]]]) + +(def: #export (custom [parser handler]) + (All [s] + (-> [(Parser s) + (-> Text (Generator s))] + Handler)) + (function (_ extension_name phase archive input) + (case (<s>.run parser input) + (#try.Success input') + (handler extension_name phase archive input') + + (#try.Failure error) + (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + +## TODO: Get rid of this ASAP +(def: lux::syntax_char_case! + (..custom [($_ <>.and + <s>.any + <s>.any + (<>.some (<s>.tuple ($_ <>.and + (<s>.tuple (<>.many <s>.i64)) + <s>.any)))) + (function (_ extension_name phase archive [input else conditionals]) + (do {! /////.monad} + [inputG (phase archive input) + elseG (phase archive else) + @input (\ ! map _.var (generation.gensym "input")) + conditionalsG (: (Operation (List [(Expression Any) + (Expression Any)])) + (monad.map ! (function (_ [chars branch]) + (do ! + [branchG (phase archive branch)] + (wrap [(|> chars + (list\map (|>> .int _.int (_.= @input))) + (list\fold (function (_ clause total) + (if (is? _.none total) + clause + (_.or clause total))) + _.none)) + branchG]))) + conditionals)) + #let [closure (_.lambda (list @input) + (list\fold (function (_ [test then] else) + (_.? test then else)) + elseG + conditionalsG))]] + (wrap (_.apply/* closure (list inputG)))))])) (def: lux_procs Bundle (|> /.empty + (/.install "syntax char case!" lux::syntax_char_case!) (/.install "is" (binary (product.uncurry _.is))) (/.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))) + (def: i64_procs Bundle (<| (/.prefix "i64") (|> /.empty - (/.install "and" (binary (product.uncurry _.bit_and))) - (/.install "or" (binary (product.uncurry _.bit_or))) - (/.install "xor" (binary (product.uncurry _.bit_xor))) - (/.install "left-shift" (binary (function.compose //runtime.i64//64 (product.uncurry _.bit_shl)))) + (/.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 "logical-right-shift" (binary (product.uncurry //runtime.i64//logic_right_shift))) (/.install "arithmetic-right-shift" (binary (product.uncurry _.bit_shr))) + (/.install "<" (binary (product.uncurry _.<))) (/.install "=" (binary (product.uncurry _.=))) - (/.install "+" (binary (product.uncurry _.+))) - (/.install "-" (binary (product.uncurry _.-))) - (/.install "*" (binary (product.uncurry _.*))) - (/.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 _.//))) + (/.install "%" (binary (product.uncurry //runtime.i64//remainder))) (/.install "f64" (unary _.float/1)) (/.install "char" (unary _.chr/1)) ))) @@ -66,11 +132,11 @@ (def: (text//clip [paramO extraO subjectO]) (Trinary (Expression Any)) - (//runtime.text//clip subjectO paramO extraO)) + (//runtime.text//clip paramO extraO subjectO)) (def: (text//index [startO partO textO]) (Trinary (Expression Any)) - (//runtime.text//index textO partO startO)) + (//runtime.text//index startO partO textO)) (def: text_procs Bundle @@ -78,7 +144,7 @@ (|> /.empty (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) - (/.install "concat" (binary (product.uncurry _.+))) + (/.install "concat" (binary (product.uncurry (function.flip _.+)))) (/.install "index" (trinary text//index)) (/.install "size" (unary _.len/1)) (/.install "char" (binary (product.uncurry //runtime.text//char))) 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 new file mode 100644 index 000000000..fcf35aa99 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux @@ -0,0 +1,163 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." function] + ["<>" parser + ["<s>" synthesis (#+ Parser)]]] + [data + [collection + ["." dictionary] + ["." list]]] + [target + ["_" python (#+ Expression SVar)]]] + ["." // #_ + ["#." common (#+ custom)] + ["//#" /// #_ + ["/" bundle] + ["/#" // #_ + ["." extension] + [generation + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["//" python #_ + ["#." runtime (#+ Operation Phase Handler Bundle + with_vars)]]] + ["/#" // #_ + ["." generation] + ["//#" /// #_ + ["#." phase]]]]]]) + +(def: (array::new size) + (Unary (Expression Any)) + (|> (list _.none) + _.list + (_.* size))) + +(def: array::length + (Unary (Expression Any)) + (|>> _.len/1 //runtime.i64//64)) + +(def: (array::read [indexG arrayG]) + (Binary (Expression Any)) + (_.nth indexG arrayG)) + +(def: (array::write [indexG valueG arrayG]) + (Trinary (Expression Any)) + (//runtime.array//write indexG valueG arrayG)) + +(def: (array::delete [indexG arrayG]) + (Binary (Expression Any)) + (//runtime.array//write indexG _.none arrayG)) + +(def: array + Bundle + (<| (/.prefix "array") + (|> /.empty + (/.install "new" (unary array::new)) + (/.install "length" (unary array::length)) + (/.install "read" (binary array::read)) + (/.install "write" (trinary array::write)) + (/.install "delete" (binary array::delete)) + ))) + +(def: object::get + Handler + (custom + [($_ <>.and <s>.text <s>.any) + (function (_ extension phase archive [fieldS objectS]) + (do ////////phase.monad + [objectG (phase archive objectS)] + (wrap (_.the fieldS objectG))))])) + +(def: object::do + Handler + (custom + [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) + (function (_ extension phase archive [methodS objectS inputsS]) + (do {! ////////phase.monad} + [objectG (phase archive objectS) + inputsG (monad.map ! (phase archive) inputsS)] + (wrap (_.do methodS inputsG objectG))))])) + +(template [<!> <?> <unit>] + [(def: <!> (Nullary (Expression Any)) (function.constant <unit>)) + (def: <?> (Unary (Expression Any)) (_.= <unit>))] + + [object::none object::none? _.none] + ) + +(def: object + Bundle + (<| (/.prefix "object") + (|> /.empty + (/.install "get" object::get) + (/.install "do" object::do) + (/.install "none" (nullary object::none)) + (/.install "none?" (unary object::none?)) + ))) + +(def: python::constant + (custom + [<s>.text + (function (_ extension phase archive name) + (do ////////phase.monad + [] + (wrap (_.var name))))])) + +(def: python::import + (custom + [<s>.text + (function (_ extension phase archive module) + (do ////////phase.monad + [] + (wrap (_.apply/* (_.var "__import__") (list (_.string module))))))])) + +(def: python::apply + (custom + [($_ <>.and <s>.any (<>.some <s>.any)) + (function (_ extension phase archive [abstractionS inputsS]) + (do {! ////////phase.monad} + [abstractionG (phase archive abstractionS) + inputsG (monad.map ! (phase archive) inputsS)] + (wrap (_.apply/* abstractionG inputsG))))])) + +(def: python::function + (custom + [($_ <>.and <s>.i64 <s>.any) + (function (_ extension phase archive [arity abstractionS]) + (do {! ////////phase.monad} + [abstractionG (phase archive abstractionS) + #let [variable (: (-> Text (Operation SVar)) + (|>> generation.gensym + (\ ! map _.var)))] + g!inputs (monad.map ! (function (_ _) (variable "input")) + (list.repeat (.nat arity) []))] + (wrap (_.lambda g!inputs + (case (.nat arity) + 0 (_.apply/1 abstractionG //runtime.unit) + 1 (_.apply/* abstractionG g!inputs) + _ (_.apply/1 abstractionG (_.list g!inputs)))))))])) + +(def: python::exec + (custom + [<s>.any + (function (_ extension phase archive codeS) + (do {! ////////phase.monad} + [codeG (phase archive codeS)] + (wrap (//runtime.lux//exec codeG))))])) + +(def: #export bundle + Bundle + (<| (/.prefix "python") + (|> /.empty + (dictionary.merge ..array) + (dictionary.merge ..object) + + (/.install "constant" python::constant) + (/.install "import" python::import) + (/.install "apply" python::apply) + (/.install "function" python::function) + (/.install "exec" python::exec) + ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux index 9ab6f4056..4d6000fbc 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux @@ -19,6 +19,7 @@ ["/#" // #_ ["#." extension] ["/#" // #_ + [analysis (#+)] ["#." synthesis] ["//#" /// #_ ["#." phase ("#\." monad)] 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 e3be48bc6..ddaf1fe5b 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 @@ -267,10 +267,6 @@ pattern_matching!) (_.raise (_.Exception/1 (_.string case.pattern_matching_error))))))) -(def: #export (gensym prefix) - (-> Text (Operation SVar)) - (///////phase\map (|>> %.nat (format prefix) _.var) /////generation.next)) - (def: #export dependencies (-> Path (List SVar)) (|>> case.storage @@ -284,6 +280,10 @@ (#///////variable.Foreign register) (..capture register)))))) +(def: #export (gensym prefix) + (-> Text (Operation SVar)) + (///////phase\map (|>> %.nat (format prefix) _.var) /////generation.next)) + (def: #export (case! statement expression archive [valueS pathP]) (Generator! [Synthesis Path]) (do ///////phase.monad @@ -298,12 +298,13 @@ (def: #export (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) (do ///////phase.monad - [pattern_matching! (case! statement expression archive [valueS pathP]) - @case (..gensym "case") - #let [@dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS) + [[[case_module case_artifact] pattern_matching!] (/////generation.with_new_context archive + (case! statement expression archive [valueS pathP])) + #let [@case (_.var (///reference.artifact [case_module case_artifact])) + @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS) pathP)) directive (_.def @case @dependencies+ pattern_matching!)] _ (/////generation.execute! directive) - _ (/////generation.save! (_.code @case) directive)] + _ (/////generation.save! (%.nat case_artifact) directive)] (wrap (_.apply/* @case @dependencies+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux index 23619eafc..8ef3446f5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -25,7 +25,10 @@ [arity (#+ Arity)] ["#." phase] [reference - [variable (#+ Register Variable)]]]]]]) + [variable (#+ Register Variable)]] + [meta + [archive (#+ Archive) + ["." artifact]]]]]]]) (def: #export (apply expression archive [functionS argsS+]) (Generator (Application Synthesis)) @@ -38,27 +41,26 @@ (-> Register SVar) (|>> (///reference.foreign //reference.system) :assume)) -(def: (with_closure function_name inits function_definition) - (-> Text (List (Expression Any)) (Statement Any) (Operation (Expression Any))) +(def: (with_closure function_id @function inits function_definition) + (-> artifact.ID SVar (List (Expression Any)) (Statement Any) (Operation (Expression Any))) (case inits #.Nil (do ///////phase.monad [_ (/////generation.execute! function_definition) - _ (/////generation.save! function_name function_definition)] - (wrap (_.apply/* (_.var function_name) inits))) + _ (/////generation.save! (%.nat function_id) function_definition)] + (wrap @function)) _ (do {! ///////phase.monad} - [@closure (\ ! map _.var (/////generation.gensym "closure")) - #let [directive (_.def @closure + [#let [directive (_.def @function (|> (list.enumeration inits) (list\map (|>> product.left ..capture))) ($_ _.then function_definition - (_.return (_.var function_name))))] + (_.return @function)))] _ (/////generation.execute! directive) - _ (/////generation.save! (_.code @closure) directive)] - (wrap (_.apply/* @closure inits))))) + _ (/////generation.save! (%.nat function_id) directive)] + (wrap (_.apply/* @function inits))))) (def: input (|>> inc //case.register)) @@ -68,18 +70,14 @@ (do {! ///////phase.monad} [@expected_exception (//case.gensym "expected_exception") @actual_exception (//case.gensym "actual_exception") - [function_name body!] (/////generation.with_new_context archive - (do ! - [function_name (\ ! map ///reference.artifact - (/////generation.context archive))] - (/////generation.with_anchor [1 @expected_exception] - (statement expression archive bodyS)))) + [[function_module function_artifact] body!] (/////generation.with_new_context archive + (/////generation.with_anchor [1 @expected_exception] + (statement expression archive bodyS))) environment (monad.map ! (expression archive) environment) - #let [function_name (///reference.artifact function_name) - @curried (_.var "curried") + #let [@curried (_.var "curried") arityO (|> arity .int _.int) @num_args (_.var "num_args") - @self (_.var function_name) + @self (_.var (///reference.artifact [function_module function_artifact])) apply_poly (.function (_ args func) (_.apply_poly (list) args func)) initialize_self! (_.set (list (//case.register 0)) @self) @@ -89,7 +87,7 @@ (_.set (list (..input post)) (_.nth (|> post .int _.int) @curried)))) initialize_self! (list.indices arity))]] - (with_closure function_name environment + (with_closure function_artifact @self environment (_.def @self (list (_.poly @curried)) ($_ _.then (_.set (list @num_args) (_.len/1 @curried)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 563e8ee61..c330d1f45 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -17,20 +17,18 @@ ["." // #_ [runtime (#+ Operation Phase Generator Phase! Generator!)] ["#." case] - ["//#" /// #_ - [synthesis - ["." case]] + ["/#" // #_ + ["#." reference] ["/#" // #_ - ["." synthesis (#+ Scope Synthesis)] - ["#." generation] - ["//#" /// #_ - ["#." phase] - [reference - ["#." variable (#+ Register)]]]]]]) - -(def: loop_name - (-> Nat SVar) - (|>> %.nat (format "loop") _.var)) + [synthesis + ["." case]] + ["/#" // #_ + ["." synthesis (#+ Scope Synthesis)] + ["#." generation] + ["//#" /// #_ + ["#." phase] + [reference + ["#." variable (#+ Register)]]]]]]]) (def: (setup offset bindings body) (-> Register (List (Expression Any)) (Statement Any) (Statement Any)) @@ -84,39 +82,39 @@ ## true loop _ (do {! ///////phase.monad} - [@loop (\ ! map ..loop_name /////generation.next) - @expected_exception (//case.gensym "expected_exception") + [@expected_exception (//case.gensym "expected_exception") @actual_exception (//case.gensym "actual_exception") initsO+ (monad.map ! (expression archive) initsS+) - body! (/////generation.with_anchor [start @expected_exception] - (statement expression archive bodyS)) - #let [locals (|> initsS+ + [[loop_module loop_artifact] body!] (/////generation.with_new_context archive + (/////generation.with_anchor [start @expected_exception] + (statement expression archive bodyS))) + #let [@loop (_.var (///reference.artifact [loop_module loop_artifact])) + locals (|> initsS+ list.enumeration (list\map (|>> product.left (n.+ start) //case.register))) actual_loop (<| (_.def @loop locals) (set_scope @expected_exception @actual_exception) body!) - [directive instantiation] (case (|> (synthesis.path/then bodyS) - //case.dependencies - (set.from_list _.hash) - (set.difference (set.from_list _.hash locals)) - set.to_list) - #.Nil - [actual_loop - (_.apply/* @loop initsO+)] + [directive instantiation] (: [(Statement Any) (Expression Any)] + (case (|> (synthesis.path/then bodyS) + //case.dependencies + (set.from_list _.hash) + (set.difference (set.from_list _.hash locals)) + set.to_list) + #.Nil + [actual_loop + @loop] - foreigns - [(_.def @loop foreigns - ($_ _.then - actual_loop - (_.return @loop) - )) - (_.apply/* (_.apply/* @loop - foreigns) - initsO+)])] + foreigns + [(_.def @loop foreigns + ($_ _.then + actual_loop + (_.return @loop) + )) + (_.apply/* @loop foreigns)]))] _ (/////generation.execute! directive) - _ (/////generation.save! (_.code @loop) directive)] - (wrap instantiation)))) + _ (/////generation.save! (%.nat loop_artifact) directive)] + (wrap (_.apply/* instantiation initsO+))))) (def: #export (recur! statement expression archive argsS+) (Generator! (List Synthesis)) 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 5ecb466b3..270560266 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 @@ -1,7 +1,9 @@ (.module: [lux (#- i64) [target - ["_" python (#+ Expression)]]]) + ["_" python (#+ Expression)]]] + ["." // #_ + ["#." runtime]]) (template [<type> <name> <implementation>] [(def: #export <name> @@ -9,7 +11,7 @@ <implementation>)] [Bit bit _.bool] - [(I64 Any) i64 (|>> .int _.long)] + [(I64 Any) i64 (|>> .int _.int //runtime.i64//64)] [Frac f64 _.float] - [Text text _.string] + [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 fc2e95789..ef213fb2c 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,7 +21,7 @@ [math [number (#+ hex) ["." i64]]] - [target + ["@" target ["_" python (#+ Expression SVar Computation Literal Statement)]]] ["." /// #_ ["#." reference] @@ -61,12 +61,12 @@ (def: #export unit - (_.string /////synthesis.unit)) + (_.unicode /////synthesis.unit)) (def: (flag value) (-> Bit Literal) (if value - (_.string "") + (_.unicode "") _.none)) (def: (variant' tag last? value) @@ -132,8 +132,8 @@ (` (def: (~ code_nameC) (Statement Any) (..feature (~ runtime_nameC) - (function ((~ g!_) (~ nameC)) - (~ code))))))))) + (function ((~ g!_) (~ g!_)) + (_.set (list (~ g!_)) (~ code)))))))))) (#.Right [name inputs]) (macro.with_gensyms [g!_] @@ -165,17 +165,22 @@ (runtime: (lux//program_args program_args) (with_vars [inputs value] ($_ _.then - (_.set (list inputs) none) + (_.set (list inputs) ..none) (<| (_.for_in value program_args) (_.set (list inputs) - (some (_.tuple (list value inputs))))) + (..some (_.tuple (list value inputs))))) (_.return inputs)))) +(runtime: (lux//exec code) + (<| (_.exec code) + (_.return ..unit))) + (def: runtime//lux (Statement Any) ($_ _.then @lux//try @lux//program_args + @lux//exec )) (runtime: (io//log! message) @@ -184,9 +189,7 @@ (_.return ..unit))) (runtime: (io//throw! message) - ($_ _.then - (_.raise (_.Exception/1 message)) - (_.return ..unit))) + (_.raise (_.Exception/1 message))) (runtime: (io//current_time! _) ($_ _.then @@ -240,7 +243,7 @@ sum_tag (_.nth (_.int +0) sum) sum_flag (_.nth (_.int +1) sum) sum_value (_.nth (_.int +2) sum) - is_last? (_.= (_.string "") sum_flag) + is_last? (_.= (_.unicode "") sum_flag) test_recursion! (_.if is_last? ## Must recurse. (_.return (sum//get sum_value wantsLast (_.- sum_tag wantedTag))) @@ -254,7 +257,7 @@ test_recursion!] [(_.and (_.< sum_tag wantedTag) - (_.= (_.string "") wantsLast)) + (_.= (_.unicode "") wantsLast)) (_.return (variant' (_.- wantedTag sum_tag) sum_flag sum_value))]) no_match!))) @@ -267,37 +270,71 @@ @sum//get )) -(def: full_64_bits - Literal - (_.manual "0xFFFFFFFFFFFFFFFF")) +(runtime: i64//top + (|> (_.int +1) + (_.bit_shl (_.int +63)) + (_.- (_.int +1)))) + +(runtime: i64//bottom + (_.- (|> (_.int +1) + (_.bit_shl (_.int +63))) + (_.int +0))) (runtime: (i64//64 input) - (with_vars [capped] - (_.cond (list [(|> input (_.> full_64_bits)) - (_.return (|> input (_.bit_and full_64_bits) i64//64))] - [(|> input (_.> (: Literal (_.manual "0x7FFFFFFFFFFFFFFF")))) - ($_ _.then - (_.set (list capped) - (_.int/1 (|> (: Literal (_.manual "0x10000000000000000")) - (_.- input)))) - (_.if (|> capped (_.<= (: Literal (_.manual "9223372036854775807L")))) - (_.return (|> capped (_.* (_.int -1)))) - (_.return (: Literal (_.manual "-9223372036854775808L")))))]) - (_.return input)))) + (_.return (<| (_.? (|> input (_.< ..i64//bottom)) + (|> input (_.- ..i64//bottom) (_.+ (_.int +1)) (_.+ i64//top) i64//64)) + (_.? (|> input (_.> ..i64//top)) + (|> input (_.- ..i64//top) (_.- (_.int +1)) (_.+ ..i64//bottom) i64//64)) + (for {@.python input} + ## This +- is only necessary to guaranteed that values within the limits are always longs in Python 2 + (|> input (_.+ i64//top) (_.- ..i64//top)))))) + +(runtime: i64//nat_top + (|> (_.int +1) + (_.bit_shl (_.int +64)) + (_.- (_.int +1)))) + +(def: as_nat + (_.% (_.manual "0x10000000000000000"))) + +(runtime: (i64//left_shift param subject) + (_.return (|> subject + ..as_nat + (_.bit_shl param) + ..as_nat + ..i64//64))) (runtime: (i64//logic_right_shift param subject) - (let [mask (|> (_.int +1) - (_.bit_shl (_.- param (_.int +64))) - (_.- (_.int +1)))] - (_.return (|> subject - (_.bit_shr param) - (_.bit_and mask))))) + (_.return (|> subject + ..as_nat + (_.bit_shr param)))) + +(runtime: (i64//remainder param subject) + (_.return (_.- (|> subject (_.// param) (_.* param)) + subject))) + +(template [<runtime> <python>] + [(runtime: (<runtime> left right) + (_.return (..i64//64 (<python> (..as_nat left) (..as_nat right)))))] + + [i64//and _.bit_and] + [i64//or _.bit_or] + [i64//xor _.bit_xor] + ) (def: runtime//i64 (Statement Any) ($_ _.then + @i64//top + @i64//bottom @i64//64 + @i64//left_shift @i64//logic_right_shift + @i64//nat_top + @i64//and + @i64//or + @i64//xor + @i64//remainder )) (runtime: (f64//decode input) @@ -313,28 +350,29 @@ @f64//decode )) -(runtime: (text//index subject param start) +(runtime: (text//index start param subject) (with_vars [idx] ($_ _.then (_.set (list idx) (|> subject (_.do "find" (list param start)))) - (_.if (_.= (_.int -1) idx) - (_.return ..none) - (_.return (..some idx)))))) + (_.return (_.? (_.= (_.int -1) idx) + ..none + (..some (..i64//64 idx))))))) -(def: inc (|>> (_.+ (_.int +1)))) +(def: inc + (|>> (_.+ (_.int +1)))) (def: (within? top value) (-> (Expression Any) (Expression Any) (Computation Any)) (_.and (|> value (_.>= (_.int +0))) (|> value (_.< top)))) -(runtime: (text//clip @text @from @to) - (_.return (|> @text (_.slice @from (inc @to))))) +(runtime: (text//clip @from @to @text) + (_.return (|> @text (_.slice @from @to)))) (runtime: (text//char idx text) (_.if (|> idx (within? (_.len/1 text))) - (_.return (..some (_.ord/1 (|> text (_.slice idx (inc idx)))))) - (_.return ..none))) + (_.return (|> text (_.slice idx (..inc idx)) _.ord/1 ..i64//64)) + (_.raise (_.Exception/1 (_.unicode "[Lux Error] Cannot get char from text."))))) (def: runtime//text (Statement Any) @@ -344,6 +382,17 @@ @text//char )) +(runtime: (array//write idx value array) + ($_ _.then + (_.set (list (_.nth idx array)) value) + (_.return array))) + +(def: runtime//array + (Statement Any) + ($_ _.then + @array//write + )) + (def: runtime (Statement Any) ($_ _.then @@ -353,6 +402,7 @@ runtime//f64 runtime//text runtime//io + runtime//array )) (def: #export artifact diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index e87b1802a..8f79817c0 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -49,9 +49,11 @@ ["Expected" (//.format expected)] ["Actual" (//.format actual)])) -(type: #export Var Nat) +(type: #export Var + Nat) -(type: #export Assumption [Type Type]) +(type: #export Assumption + [Type Type]) (type: #export (Check a) (-> Type_Context (Try [Type_Context a]))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 8882270f8..e8ebb7aac 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -1,6 +1,6 @@ (.module: [lux #* - ["." host (#+ import:)] + ["." host] ["@" target] [abstract ["." monad (#+ Monad do)]] @@ -226,9 +226,9 @@ ["Instant" (%.instant instant)] ["Path" file])) - (import: java/lang/String) + (host.import: java/lang/String) - (`` (import: java/io/File + (`` (host.import: java/io/File ["#::." (new [java/lang/String]) (~~ (template [<name>] @@ -258,24 +258,24 @@ _ (wrap (exception.throw exception [path]))))) - (import: java/lang/AutoCloseable + (host.import: java/lang/AutoCloseable ["#::." (close [] #io #try void)]) - (import: java/io/OutputStream + (host.import: java/io/OutputStream ["#::." (write [[byte]] #io #try void) (flush [] #io #try void)]) - (import: java/io/FileOutputStream + (host.import: java/io/FileOutputStream ["#::." (new [java/io/File boolean] #io #try)]) - (import: java/io/InputStream + (host.import: java/io/InputStream ["#::." (read [[byte]] #io #try int)]) - (import: java/io/FileInputStream + (host.import: java/io/FileInputStream ["#::." (new [java/io/File] #io #try)]) @@ -435,31 +435,28 @@ (def: separator (java/io/File::separator)) )))] - (for {@.old - (as_is <for_jvm>) - - @.jvm - (as_is <for_jvm>) + (for {@.old (as_is <for_jvm>) + @.jvm (as_is <for_jvm>) @.js - (as_is (import: Buffer + (as_is (host.import: Buffer (#static from [Binary] ..Buffer)) - (import: FileDescriptor) + (host.import: FileDescriptor) - (import: Stats + (host.import: Stats (size host.Number) (mtimeMs host.Number) (isFile [] #io #try host.Boolean) (isDirectory [] #io #try host.Boolean)) - (import: FsConstants + (host.import: FsConstants (F_OK host.Number) (R_OK host.Number) (W_OK host.Number) (X_OK host.Number)) - (import: Fs + (host.import: Fs (constants FsConstants) (readFileSync [host.String] #io #try Binary) (appendFileSync [host.String Buffer] #io #try Any) @@ -473,7 +470,7 @@ (mkdirSync [host.String] #io #try Any) (rmdirSync [host.String] #io #try Any)) - (import: JsPath + (host.import: JsPath (sep host.String) (basename [host.String] host.String)) @@ -678,6 +675,202 @@ "/")) )) ) + + @.python + (as_is (type: (Tuple/2 left right) + (primitive "python_tuple[2]" [left right])) + + (host.import: (open [host.String host.String] #io #try Any)) + (host.import: (tuple [[host.Integer host.Integer]] (Tuple/2 host.Integer host.Integer))) + + (host.import: os + (#static F_OK host.Integer) + (#static R_OK host.Integer) + (#static W_OK host.Integer) + (#static X_OK host.Integer) + + (#static mkdir [host.String] #io #try Any) + (#static access [host.String host.Integer] #io #try host.Boolean) + (#static remove [host.String] #io #try Any) + (#static rmdir [host.String] #io #try Any) + (#static rename [host.String host.String] #io #try Any) + (#static utime [host.String (Tuple/2 host.Integer host.Integer)] #io #try Any) + (#static listdir [host.String] #io #try (Array host.String))) + + (host.import: os/path + (#static isfile [] #io #try host.Boolean) + (#static isdir [] #io #try host.Boolean) + (#static sep host.String) + (#static basename [host.String] host.String) + (#static getsize [host.String] #io #try host.Integer) + (#static getmtime [host.String] #io #try host.Float)) + + (`` (structure: (file path) + (-> Path (File IO)) + + (~~ (template [<name> <mode>] + [(def: <name> + (..can_modify + (function (<name> data) + (do (try.with io.monad) + [file (..open [path <mode>])] + (io.io (do try.monad + [_ (host.try ("python object do" "write" (:assume file) data))] + (host.try ("python object do" "close" (:assume file)))))))))] + + [over_write "wb"] + [append "ab"] + )) + + (def: content + (..can_query + (function (_ _) + (do (try.with io.monad) + [file (..open [path "rb"])] + (io.io (do try.monad + [data (:coerce (Try Binary) + (host.try ("python object do" "read" (:assume file)))) + _ (host.try ("python object do" "close" (:assume file)))] + (wrap data))))))) + + (def: name + (..can_see + (function (_ _) + (os/path::basename [path])))) + + (def: path + (..can_see + (function (_ _) + path))) + + (def: size + (..can_query + (function (_ _) + (do (try.with io.monad) + [size (os/path::getsize [path])] + (wrap (.nat size)))))) + + (def: last_modified + (..can_query + (function (_ _) + (do (try.with io.monad) + [seconds_since_epoch (os/path::getmtime [path])] + (wrap (|> seconds_since_epoch + f.int + (i.* +1,000) + duration.from_millis + instant.absolute)))))) + + (def: can_execute? + (..can_query + (function (can_execute? _) + (os::access [path (os::X_OK)])))) + + (def: move + (..can_open + (function (move destination) + (do (try.with io.monad) + [_ (os::rename [path destination])] + (wrap (file destination)))))) + + (def: modify + (..can_modify + (function (modify time_stamp) + (let [when (|> time_stamp instant.relative duration.to_millis (i./ +1,000))] + (os::utime [path (..tuple [when when])]))))) + + (def: delete + (..can_delete + (function (delete _) + (os::remove [path])))) + )) + + (`` (structure: (directory path) + (-> Path (Directory IO)) + + (def: scope + (..can_see + (function (_ _) + path))) + + (~~ (template [<name> <method> <capability>] + [(def: <name> + (..can_query + (function (<name> _) + (do {! (try.with io.monad)} + [subs (os::listdir [path]) + subs (monad.map ! (function (_ sub) + (do ! + [verdict (<method> [sub])] + (wrap [verdict sub]))) + (array.to_list subs))] + (wrap (|> subs + (list.filter product.left) + (list\map (|>> product.right <capability>))))))))] + + [files os/path::isfile ..file] + [directories os/path::isdir directory] + )) + + (def: discard + (..can_delete + (function (discard _) + (os::rmdir [path])))) + )) + + (`` (structure: #export default + (System IO) + + (~~ (template [<name> <method> <capability> <exception>] + [(with_expansions [<failure> (exception.throw <exception> [path])] + (def: <name> + (..can_open + (function (<name> path) + (do io.monad + [?verdict (<method> [path])] + (wrap (case ?verdict + (#try.Success verdict) + (if verdict + (#try.Success (<capability> path)) + <failure>) + + (#try.Failure _) + <failure>)))))))] + + [file os/path::isfile ..file ..cannot_find_file] + [directory os/path::isdir ..directory ..cannot_find_directory] + )) + + (def: create_file + (..can_open + (function (create_file path) + (do io.monad + [outcome (..open [path "x"])] + (wrap (case outcome + (#try.Success _) + (do try.monad + [_ (host.try ("python object do" "close" (:assume outcome)))] + (wrap (..file path))) + + (#try.Failure error) + (exception.throw ..cannot_create_file [path]))))))) + + (def: create_directory + (..can_open + (function (create_directory path) + (do io.monad + [outcome (os::mkdir [path])] + (wrap (case outcome + (#try.Success _) + (#try.Success (..directory path)) + + (#try.Failure error) + (exception.throw ..cannot_create_directory [path]))))))) + + (def: separator + (os/path::sep)) + )) + ) })) (template [<get> <signature> <create> <find> <exception>] diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index 92a5793bd..ca301e2ce 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -3,7 +3,7 @@ ["@" target] ["." host (#+ import:)] [abstract - [monad (#+ do)]] + ["." monad (#+ do)]] [control ["." function] ["." io (#+ IO)] @@ -166,7 +166,19 @@ (import: NodeJs_OS (homedir [] #io Path)) - (import: (require [host.String] Any)))} + (import: (require [host.String] Any))) + @.python (as_is (import: os + (#static getcwd [] #io host.String)) + + (import: os/path + (#static expanduser [host.String] #io host.String)) + + (import: os/environ + (#static keys [] #io (Array host.String)) + (#static get [host.String] #io host.String)) + + (import: sys + (#static exit [host.Integer] #io Nothing)))} (as_is))) (structure: #export default @@ -190,7 +202,15 @@ #.None (undefined)) - environment.empty))} + environment.empty)) + @.python (do {! io.monad} + [keys (os/environ::keys [])] + (monad.fold ! (function (_ variable environment) + (do ! + [value (os/environ::get [variable])] + (wrap (dictionary.put variable value environment)))) + environment.empty + (array.to_list keys)))} ## TODO: Replace dummy implementation. (io.io environment.empty)))) @@ -203,7 +223,8 @@ (|> (..require "os") (:coerce NodeJs_OS) (NodeJs_OS::homedir [])) - <default>)} + <default>) + @.python (os/path::expanduser ["~"])} ## TODO: Replace dummy implementation. <default>))) @@ -219,7 +240,8 @@ #.None <default>) - <default>)} + <default>) + @.python (os::getcwd [])} ## TODO: Replace dummy implementation. <default>))) @@ -236,4 +258,5 @@ (..exit_browser! code) ## else - (..default_exit! code))})))) + (..default_exit! code)) + @.python (sys::exit code)})))) diff --git a/stdlib/source/program/aedifex/artifact/snapshot.lux b/stdlib/source/program/aedifex/artifact/snapshot.lux new file mode 100644 index 000000000..0488d76dd --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/snapshot.lux @@ -0,0 +1,72 @@ +(.module: + [lux (#- Name Type) + [abstract + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + [control + ["<>" parser + ["<.>" xml (#+ Parser)] + ["<.>" text]]] + [data + ["." sum] + [format + ["." xml (#+ XML)]]]] + ["." / #_ + ["#." stamp (#+ Stamp)]]) + +(type: #export Snapshot + #Local + (#Remote Stamp)) + +(structure: any_equivalence + (Equivalence Any) + + (def: (= _ _) + true)) + +(def: #export equivalence + (Equivalence Snapshot) + ($_ sum.equivalence + ..any_equivalence + /stamp.equivalence + )) + +(template [<definition> <tag>] + [(def: <definition> xml.Tag ["" <tag>])] + + [<local_copy> "localCopy"] + [<snapshot> "snapshot"] + ) + +(def: local_copy_value + "true") + +(def: local_copy_format + XML + (#xml.Node <local_copy> + xml.attributes + (list (#xml.Text ..local_copy_value)))) + +(def: local_copy_parser + (Parser Any) + (do <>.monad + [_ (<xml>.node ..<local_copy>)] + (<xml>.children (<text>.embed (<text>.this ..local_copy_value) + <xml>.text)))) + +(def: #export (format snapshot) + (-> Snapshot XML) + (<| (#xml.Node ..<snapshot> xml.attributes) + (case snapshot + #Local + (list ..local_copy_format) + + (#Remote stamp) + (/stamp.format stamp)))) + +(def: #export parser + (Parser Snapshot) + (do <>.monad + [_ (<xml>.node <snapshot>)] + (<xml>.children (<>.or ..local_copy_parser + /stamp.parser)))) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux index c1efcc8ee..ca59b11a6 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux @@ -1,11 +1,16 @@ (.module: [lux #* [abstract - [equivalence (#+ Equivalence)]] + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + [control + ["<>" parser + ["<.>" xml (#+ Parser)] + ["<.>" text]]] [data ["." product] [format - [xml (#+ XML)]]]] + ["." xml (#+ XML)]]]] ["." // #_ ["#." time (#+ Time)] ["#." build (#+ Build)]]) @@ -21,22 +26,22 @@ //build.equivalence )) +(def: <timestamp> + xml.Tag + ["" "timestamp"]) + (def: time_format (-> Time XML) (|>> //time.format #xml.Text list - (#xml.Node ..tag xml.attributes))) + (#xml.Node ..<timestamp> xml.attributes))) (def: #export (format (^slots [#time #build])) (-> Stamp (List XML)) (list (..time_format time) (//build.format build))) -(def: <timestamp> - xml.Tag - ["" "timestamp"]) - ## (exception: #export (mismatch {expected Instant} {actual Instant}) ## (exception.report ## ["Expected" (%.instant expected)] diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux new file mode 100644 index 000000000..1bdb9ca2d --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -0,0 +1,48 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" xml]]] + [math + ["." random (#+ Random) ("#\." monad)]]] + ["$." / #_ + ["#." build] + ["#." time] + ["#." stamp]] + {#program + ["." /]}) + +(def: #export random + (Random /.Snapshot) + (random.or (random\wrap []) + $/stamp.random)) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Snapshot] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + list + (<xml>.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + + $/build.test + $/time.test + $/stamp.test + )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux index aab722cad..a36e5af9d 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux @@ -41,8 +41,8 @@ (_.cover [/.format /.parser] (|> expected /.format - (<xml>.run' /.parser) - (try\map (\ instant.equivalence = expected)) + (<xml>.run /.parser) + (try\map (\ /.equivalence = expected)) (try.default false))) )) ))) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index ec76184cd..c3d984854 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -3,6 +3,7 @@ ["_" test (#+ Test)] ["." type ("#\." equivalence)] [abstract + [equivalence (#+ Equivalence)] [monad (#+ do)] {[0 #spec] [/ @@ -742,6 +743,133 @@ correct_type!))))))))) ))) +(def: locals_related + Test + (do {! random.monad} + [current_module (random.ascii/upper 1) + [name_0 name_1 name_2 name_3 name_4] (|> (random.ascii/upper 1) + (random.set text.hash 5) + (\ ! map set.to_list) + (random.one (function (_ values) + (case values + (^ (list name_0 name_1 name_2 name_3 name_4)) + (#.Some [name_0 name_1 name_2 name_3 name_4]) + + _ + #.None)))) + #let [type_0 (#.Primitive name_0 (list)) + type_1 (#.Primitive name_1 (list)) + type_2 (#.Primitive name_2 (list)) + type_3 (#.Primitive name_3 (list)) + type_4 (#.Primitive name_4 (list)) + + globals (: (List [Text .Global]) + (list [name_4 + (#.Definition [false type_4 (' {}) []])])) + + scopes (list {#.name (list) + #.inner 0 + #.locals {#.counter 1 + #.mappings (list [name_3 [type_3 3]])} + #.captured {#.counter 0 + #.mappings (list)}} + {#.name (list) + #.inner 0 + #.locals {#.counter 2 + #.mappings (list [name_1 [type_1 1]] + [name_2 [type_2 2]])} + #.captured {#.counter 0 + #.mappings (list)}} + {#.name (list) + #.inner 0 + #.locals {#.counter 1 + #.mappings (list [name_0 [type_0 0]])} + #.captured {#.counter 0 + #.mappings (list)}})] + #let [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 globals + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes scopes + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed 0 + #.scope_type_vars (list) + #.extensions [] + #.host []})]] + ($_ _.and + (_.cover [/.locals] + (let [equivalence (: (Equivalence (List (List [Text Type]))) + (list.equivalence + (list.equivalence + (product.equivalence + text.equivalence + type.equivalence))))] + (|> /.locals + (/.run expected_lux) + (try\map (\ equivalence = (list (list [name_3 type_3]) + (list [name_1 type_1] + [name_2 type_2])))) + (try.default false)))) + (_.cover [/.find_var_type] + (and (|> (/.find_var_type name_0) + (/.run expected_lux) + (try\map (\ type.equivalence = type_0)) + (try.default false)) + (|> (/.find_var_type name_1) + (/.run expected_lux) + (try\map (\ type.equivalence = type_1)) + (try.default false)) + (|> (/.find_var_type name_2) + (/.run expected_lux) + (try\map (\ type.equivalence = type_2)) + (try.default false)) + (|> (/.find_var_type name_3) + (/.run expected_lux) + (try\map (\ type.equivalence = type_3)) + (try.default false)))) + (_.cover [/.find_type] + (and (|> (/.find_type ["" name_0]) + (/.run expected_lux) + (try\map (\ type.equivalence = type_0)) + (try.default false)) + (|> (/.find_type ["" name_1]) + (/.run expected_lux) + (try\map (\ type.equivalence = type_1)) + (try.default false)) + (|> (/.find_type ["" name_2]) + (/.run expected_lux) + (try\map (\ type.equivalence = type_2)) + (try.default false)) + (|> (/.find_type ["" name_3]) + (/.run expected_lux) + (try\map (\ type.equivalence = type_3)) + (try.default false)) + (|> (/.find_type [current_module name_4]) + (/.run expected_lux) + (try\map (\ type.equivalence = type_4)) + (try.default false)) + (|> (/.find_type ["" name_4]) + (/.run expected_lux) + (try\map (\ type.equivalence = type_4)) + (try.default false)))) + ))) + (def: injection (Injection Meta) (\ /.monad wrap)) @@ -824,6 +952,7 @@ ..definition_related ..search_related ..tags_related + ..locals_related )) /annotation.test diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux index fadc98ca7..533b7fad0 100644 --- a/stdlib/source/test/lux/type/dynamic.lux +++ b/stdlib/source/test/lux/type/dynamic.lux @@ -1,35 +1,47 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] - [abstract/monad (#+ do)] ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] [control - ["." try]] + ["." try] + ["." exception]] + [data + ["." text ("#\." equivalence) + ["%" format (#+ format)]]] [math ["." random (#+ Random)] [number ["n" nat]]]] {1 - ["." / (#+ Dynamic :dynamic :check)]}) + ["." /]}) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) + (_.for [/.Dynamic]) (do random.monad - [expected random.nat - #let [value (:dynamic expected)]] + [expected random.nat] ($_ _.and - (_.test "Can check dynamic values." - (case (:check Nat value) - (#try.Success actual) - (n.= expected actual) - - (#try.Failure _) - false)) - (_.test "Cannot confuse types." - (case (:check Text value) - (#try.Success actual) - false - - (#try.Failure _) - true)))))) + (_.cover [/.:dynamic /.:check] + (case (/.:check Nat (/.:dynamic expected)) + (#try.Success actual) + (n.= expected actual) + + (#try.Failure _) + false)) + (_.cover [/.wrong_type] + (case (/.:check Text (/.:dynamic expected)) + (#try.Success actual) + false + + (#try.Failure error) + (exception.match? /.wrong_type error))) + (_.cover [/.print] + (case (/.print (/.:dynamic expected)) + (#try.Success actual) + (text\= (%.nat expected) actual) + + (#try.Failure _) + false)) + )))) |