diff options
Diffstat (limited to 'stdlib/source')
29 files changed, 568 insertions, 349 deletions
diff --git a/stdlib/source/lux/abstract/enum.lux b/stdlib/source/lux/abstract/enum.lux index 9470cd142..ce9b66d92 100644 --- a/stdlib/source/lux/abstract/enum.lux +++ b/stdlib/source/lux/abstract/enum.lux @@ -18,8 +18,8 @@ (cond (/@< end from) (recur (/@pred end) (#.Cons end output)) - (/@= end from) - (#.Cons end output) + (/@< from end) + (recur (/@succ end) (#.Cons end output)) - ## else - output)))) + ## (/@= end from) + (#.Cons end output))))) diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux index 8da6b0935..9bd1e1472 100644 --- a/stdlib/source/lux/control/concurrency/atom.lux +++ b/stdlib/source/lux/control/concurrency/atom.lux @@ -24,6 +24,7 @@ (new [a]) (get [] a) (compareAndSet [a a] boolean))} + (as-is)) (abstract: #export (Atom a) diff --git a/stdlib/source/lux/control/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux index 04bfbbbae..afd24bb5c 100644 --- a/stdlib/source/lux/control/concurrency/process.lux +++ b/stdlib/source/lux/control/concurrency/process.lux @@ -58,7 +58,7 @@ (schedule [java/lang/Runnable long java/util/concurrent/TimeUnit] #io (java/util/concurrent/ScheduledFuture java/lang/Object)))) @.js - (as-is (host.import: (setTimeout [host.Function host.Number] Any)))} + (as-is (host.import: (setTimeout [host.Function host.Number] #io Any)))} ## Default (type: Process @@ -121,8 +121,8 @@ runner))) @.js - (io.io (..setTimeout [(host.closure [] (io.run action)) - (n.frac milli-seconds)]))} + (..setTimeout [(host.closure [] (io.run action)) + (n.frac milli-seconds)])} ## Default (do io.monad diff --git a/stdlib/source/lux/control/parser/xml.lux b/stdlib/source/lux/control/parser/xml.lux index da21c1dfb..f734a2684 100644 --- a/stdlib/source/lux/control/parser/xml.lux +++ b/stdlib/source/lux/control/parser/xml.lux @@ -7,7 +7,8 @@ ["." exception (#+ exception:)]] [data ["." name ("#@." equivalence codec)] - ["." text ("#@." monoid)] + ["." text + ["%" format (#+ format)]] [collection ["." list ("#@." functor)] ["." dictionary]] @@ -20,13 +21,22 @@ (exception: #export empty-input) (exception: #export unexpected-input) -(exception: #export unknown-attribute) -(exception: #export (wrong-tag {tag Name}) - (exception.report - ["Tag" (name@encode tag)])) +(def: (label [namespace name]) + (-> Name Text) + (format namespace ":" name)) -(def: blank-line ($_ text@compose text.new-line text.new-line)) +(template [<exception> <header>] + [(exception: #export (<exception> {label Name}) + (exception.report + [<header> (%.text (..label label))]))] + + [wrong-tag "Tag"] + [unknown-attribute "Attribute"] + ) + +(def: blank-line + (format text.new-line text.new-line)) (exception: #export (unconsumed-inputs {inputs (List XML)}) (|> inputs @@ -48,6 +58,23 @@ (#/.Node _) (exception.throw ..unexpected-input []))))) +(def: #export (node tag) + (-> Name (Parser Any)) + (function (_ docs) + (case docs + #.Nil + (exception.throw ..empty-input []) + + (#.Cons head _) + (case head + (#/.Text _) + (exception.throw ..unexpected-input []) + + (#/.Node _tag _attrs _children) + (if (name@= tag _tag) + (#try.Success [docs []]) + (exception.throw ..wrong-tag tag)))))) + (def: #export (attr name) (-> Name (Parser Text)) (function (_ docs) @@ -63,7 +90,7 @@ (#/.Node tag attrs children) (case (dictionary.get name attrs) #.None - (exception.throw ..unknown-attribute []) + (exception.throw ..unknown-attribute [name]) (#.Some value) (#try.Success [docs value])))))) @@ -79,23 +106,6 @@ (#try.Failure error) (#try.Failure error))) -(def: #export (node tag) - (-> Name (Parser Any)) - (function (_ docs) - (case docs - #.Nil - (exception.throw ..empty-input []) - - (#.Cons head _) - (case head - (#/.Text _) - (exception.throw ..unexpected-input []) - - (#/.Node _tag _attrs _children) - (if (name@= tag _tag) - (#try.Success [docs []]) - (exception.throw ..wrong-tag tag)))))) - (def: #export (children reader) (All [a] (-> (Parser a) (Parser a))) (function (_ docs) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index e694a6161..5c117a857 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -8,7 +8,8 @@ [fold (#+ Fold)] [predicate (#+ Predicate)] ["." functor (#+ Functor)] - ["." monad (#+ do Monad)]] + ["." monad (#+ do Monad)] + ["." enum]] [data ["." bit] ["." product] @@ -369,25 +370,6 @@ xs')] ($_ compose (sort < pre) (list x) (sort < post))))) -(template [<name> <type> <lt>] - [(def: #export (<name> from to) - {#.doc "Generates an inclusive interval of values [from, to]."} - (-> <type> <type> (List <type>)) - (loop [end to - output #.Nil] - (cond (<lt> end from) - (recur (dec end) (#.Cons end output)) - - ("lux i64 =" end from) - (#.Cons end output) - - ## else - output)))] - - [i/range Int "lux i64 <"] - [n/range Nat n.<] - ) - (def: #export (empty? xs) (All [a] (Predicate (List a))) (case xs @@ -421,7 +403,7 @@ (All [a] (-> Nat (List Nat))) (if (n.= 0 size) (list) - (|> size dec (n/range 0)))) + (|> size dec (enum.range n.enum 0)))) (def: (identifier$ name) (-> Text Code) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 9a3c0b6b4..0e7cfb7bf 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -28,6 +28,8 @@ (#Text Text) (#Node Tag Attrs (List XML))) +(def: namespace-separator ":") + (def: xml-standard-escape-char^ (Parser Text) ($_ p.either @@ -74,7 +76,7 @@ (Parser Name) (do p.monad [first-part xml-identifier - ?second-part (<| p.maybe (p.after (l.this ":")) xml-identifier)] + ?second-part (<| p.maybe (p.after (l.this ..namespace-separator)) xml-identifier)] (case ?second-part #.None (wrap ["" first-part]) @@ -185,18 +187,18 @@ (text.replace-all "'" "'") (text.replace-all text.double-quote """))) -(def: (write-tag [namespace name]) +(def: (write-label [namespace name]) (-> Tag Text) (case namespace "" name - _ ($_ text@compose namespace ":" name))) + _ ($_ text@compose namespace ..namespace-separator name))) (def: (write-attrs attrs) (-> Attrs Text) (|> attrs dictionary.entries (list@map (function (_ [key value]) - ($_ text@compose (write-tag key) "=" text.double-quote (sanitize-value value) text.double-quote))) + ($_ text@compose (..write-label key) "=" text.double-quote (sanitize-value value) text.double-quote))) (text.join-with " "))) (def: xml-header @@ -212,7 +214,7 @@ (sanitize-value value) (#Node xml-tag xml-attrs xml-children) - (let [tag (write-tag xml-tag) + (let [tag (..write-label xml-tag) attrs (if (dictionary.empty? xml-attrs) "" ($_ text@compose " " (write-attrs xml-attrs)))] @@ -224,11 +226,15 @@ (text.join-with "")) "</" tag ">"))))))) -(structure: #export codec (Codec Text XML) +(structure: #export codec + (Codec Text XML) + (def: encode write) (def: decode read)) -(structure: #export equivalence (Equivalence XML) +(structure: #export equivalence + (Equivalence XML) + (def: (= reference sample) (case [reference sample] [(#Text reference/value) (#Text sample/value)] diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index c3f35f7f5..bbd1f0290 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -1,5 +1,6 @@ (.module: [lux #* + [host (#+ import:)] [data ["." product] [number @@ -11,8 +12,7 @@ [compiler ["_" host]] [type - abstract] - [host (#+ import:)]] + abstract]] ["." //]) (`` (for {(~~ (static _.old)) diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index 88b04c00c..bf9e71508 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -169,14 +169,14 @@ (|>> :representation)) ) -(with-expansions [<for-jvm> (as-is (host.import: #long java/lang/String - (new [[byte] java/lang/String]) - (getBytes [java/lang/String] [byte])))] +(with-expansions [<jvm> (as-is (host.import: #long java/lang/String + (new [[byte] java/lang/String]) + (getBytes [java/lang/String] [byte])))] (for {@.old - (as-is <for-jvm>) + (as-is <jvm>) @.jvm - (as-is <for-jvm>) + (as-is <jvm>) @.js (as-is (host.import: Uint8Array) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index 47e104842..135e33251 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -28,31 +28,31 @@ [macro ["." template]]]) -(with-expansions [<for-jvm> (as-is (import: #long java/lang/String) +(with-expansions [<jvm> (as-is (import: #long java/lang/String) - (import: #long (java/lang/Class a) - (getCanonicalName [] java/lang/String)) + (import: #long (java/lang/Class a) + (getCanonicalName [] java/lang/String)) - (import: #long java/lang/Object - (new []) - (toString [] java/lang/String) - (getClass [] (java/lang/Class java/lang/Object))) + (import: #long java/lang/Object + (new []) + (toString [] java/lang/String) + (getClass [] (java/lang/Class java/lang/Object))) - (import: #long java/lang/Integer - (longValue [] long)) + (import: #long java/lang/Integer + (longValue [] long)) - (import: #long java/lang/Long - (intValue [] int)) + (import: #long java/lang/Long + (intValue [] int)) - (import: #long java/lang/Number - (intValue [] int) - (longValue [] long) - (doubleValue [] double)))] + (import: #long java/lang/Number + (intValue [] int) + (longValue [] long) + (doubleValue [] double)))] (for {@.old - (as-is <for-jvm>) + (as-is <jvm>) @.jvm - (as-is <for-jvm>) + (as-is <jvm>) @.js (as-is (import: JSON @@ -72,46 +72,46 @@ (def: #export (inspect value) Inspector - (with-expansions [<for-jvm> (let [object (:coerce java/lang/Object value)] - (`` (<| (~~ (template [<class> <processing>] - [(case (host.check <class> object) - (#.Some value) - (`` (|> value (~~ (template.splice <processing>)))) - #.None)] - - [java/lang/Boolean [(:coerce .Bit) %.bit]] - [java/lang/String [(:coerce .Text) %.text]] - [java/lang/Long [(:coerce .Int) %.int]] - [java/lang/Number [java/lang/Number::doubleValue %.frac]] - )) - (case (host.check [java/lang/Object] object) - (#.Some value) - (let [value (:coerce (array.Array java/lang/Object) value)] - (case (array.read 0 value) - (^multi (#.Some tag) - [(host.check java/lang/Integer tag) - (#.Some tag)] - [[(array.read 1 value) - (array.read 2 value)] - [last? - (#.Some choice)]]) - (let [last? (case last? - (#.Some _) #1 - #.None #0)] - (|> (format (%.nat (.nat (java/lang/Integer::longValue tag))) - " " (%.bit last?) - " " (inspect choice)) - (text.enclose ["(" ")"]))) - - _ - (inspect-tuple inspect value))) - #.None) - (java/lang/Object::toString object))))] + (with-expansions [<jvm> (let [object (:coerce java/lang/Object value)] + (`` (<| (~~ (template [<class> <processing>] + [(case (host.check <class> object) + (#.Some value) + (`` (|> value (~~ (template.splice <processing>)))) + #.None)] + + [java/lang/Boolean [(:coerce .Bit) %.bit]] + [java/lang/String [(:coerce .Text) %.text]] + [java/lang/Long [(:coerce .Int) %.int]] + [java/lang/Number [java/lang/Number::doubleValue %.frac]] + )) + (case (host.check [java/lang/Object] object) + (#.Some value) + (let [value (:coerce (array.Array java/lang/Object) value)] + (case (array.read 0 value) + (^multi (#.Some tag) + [(host.check java/lang/Integer tag) + (#.Some tag)] + [[(array.read 1 value) + (array.read 2 value)] + [last? + (#.Some choice)]]) + (let [last? (case last? + (#.Some _) #1 + #.None #0)] + (|> (format (%.nat (.nat (java/lang/Integer::longValue tag))) + " " (%.bit last?) + " " (inspect choice)) + (text.enclose ["(" ")"]))) + + _ + (inspect-tuple inspect value))) + #.None) + (java/lang/Object::toString object))))] (for {@.old - <for-jvm> + <jvm> @.jvm - <for-jvm> + <jvm> @.js (case (host.type-of value) diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 6be66f0a6..2770108cc 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -70,7 +70,14 @@ <c>.local-identifier ..nullable))) -(type: Common-Method [Text (Maybe Text) (List Nullable) Bit Nullable]) +(type: Common-Method + {#name Text + #alias (Maybe Text) + #inputs (List Nullable) + #io? Bit + #try? Bit + #output Nullable}) + (type: Static-Method Common-Method) (type: Virtual-Method Common-Method) @@ -84,6 +91,7 @@ <c>.local-identifier (<>.maybe (<>.after (<c>.this! (' #as)) <c>.local-identifier)) (<c>.tuple (<>.some ..nullable)) + (<>.parses? (<c>.this! (' #io))) (<>.parses? (<c>.this! (' #try))) ..nullable)) @@ -161,11 +169,22 @@ (recover-from-failure error)))} (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) -(def: (with-try try? without-try) +(def: (with-io with? without) (-> Bit Code Code) - (if try? - (` ("lux try" - ((~! io.io) (~ without-try)))) + (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) @@ -174,15 +193,18 @@ (` (.Either .Text (~ rawT))) rawT)) -(def: (make-function g!method g!temp source inputsT try? outputT) - (-> Code Code Text (List Nullable) Bit Nullable Code) +(def: (make-function g!method g!temp source inputsT io? try? outputT) + (-> Code Code Text (List Nullable) Bit Bit Nullable Code) (let [g!inputs (input-variables inputsT)] (` (def: ((~ g!method) [(~+ (list@map product.right g!inputs))]) (-> [(~+ (list@map nullable-type inputsT))] - (~ (try-type try? (nullable-type outputT)))) + (~ (|> (nullable-type outputT) + (try-type try?) + (io-type io?)))) (:assume - (~ (<| (with-try try?) + (~ (<| (with-io io?) + (with-try try?) (without-null g!temp outputT) (` ("js apply" ("js constant" (~ (code.text source))) @@ -227,24 +249,28 @@ (#Method method) (case method - (#Static [method alias inputsT try? outputT]) + (#Static [method alias inputsT io? try? outputT]) (..make-function (qualify (maybe.default method alias)) g!temp (format real-class "." method) inputsT + io? try? outputT) - (#Virtual [method alias inputsT 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 nullable-type inputsT))] (~ g!type) - (~ (try-type try? (nullable-type outputT)))) + (~ (|> (nullable-type outputT) + (try-type try?) + (io-type io?)))) (:assume - (~ (<| (with-try try?) + (~ (<| (with-io io?) + (with-try try?) (without-null g!temp outputT) (` ("js object do" (~ (code.text method)) @@ -252,12 +278,14 @@ [(~+ (list@map (with-null g!temp) g!inputs))]))))))))))) members))))) - (#Function [name alias inputsT try? outputT]) + (#Function [name alias inputsT io? try? outputT]) (wrap (list (..make-function (code.local-identifier (maybe.default name alias)) g!temp name inputsT - try? outputT))) + io? + try? + outputT))) ))) (template: #export (type-of object) diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index 2f0438f8f..2d7ff89a2 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -1,11 +1,14 @@ (.module: [lux (#- Code not or and list if cond int comment) + [abstract + ["." enum]] [control [pipe (#+ new> case> cond>)] [parser ["s" code]]] [data [number + ["n" nat] ["f" frac]] ["." text ["%" format (#+ format)]] @@ -394,7 +397,7 @@ (wrap (case arity 0 (.list) _ (|> (dec arity) - (list.n/range 0) + (enum.range n.enum 0) (list@map (|>> %.nat code.local-identifier)))))) (syntax: (arity-types {arity s.nat}) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 945a8d03c..0df1a5812 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -1,7 +1,8 @@ (.module: [lux (#- Type Definition case log! false true) [abstract - ["." monad (#+ do)]] + ["." monad (#+ do)] + ["." enum]] [control ["." try]] [data @@ -534,8 +535,9 @@ (def: generate-function (Operation Any) - (let [apply::method+ (|> (list.n/range (inc //function/arity.minimum) - //function/arity.maximum) + (let [apply::method+ (|> (enum.range n.enum + (inc //function/arity.minimum) + //function/arity.maximum) (list@map (function (_ arity) (method.method method.public ..apply::name (..apply::type arity) (list) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux index ea15e4b24..4f510e1b6 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -1,7 +1,8 @@ (.module: [lux #* [abstract - ["." monad (#+ do)]] + ["." monad (#+ do)] + ["." enum]] [control [pipe (#+ case>)] ["." exception (#+ exception:)]] @@ -32,7 +33,7 @@ (def: arity-arguments (-> Arity (List Synthesis)) (|>> dec - (list.n/range 1) + (enum.range n.enum 1) (list@map (|>> /.variable/local)))) (template: #export (self-reference) diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index a308c50b4..018cb3c41 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -55,62 +55,62 @@ [can-write ..can-write] [can-close ..can-close]))))) -(with-expansions [<form-jvm> (as-is (import: java/lang/String) - - (import: #long java/io/Console - (readLine [] #io #try String)) - - (import: java/io/InputStream - (read [] #io #try int)) - - (import: java/io/PrintStream - (print [String] #io #try void)) - - (import: java/lang/System - (#static console [] #io #? java/io/Console) - (#static in java/io/InputStream) - (#static out java/io/PrintStream)) - - (def: #export system - (IO (Try (Console IO))) - (do io.monad - [?jvm-console (System::console)] - (case ?jvm-console - #.None - (wrap (ex.throw cannot-open [])) - - (#.Some jvm-console) - (let [jvm-input (System::in) - jvm-output (System::out)] - (<| wrap - ex.return - (: (Console IO)) ## TODO: Remove ASAP - (structure - (def: can-read - (..can-read - (function (_ _) - (|> jvm-input - InputStream::read - (:: (try.with io.monad) map .nat))))) - - (def: can-read-line - (..can-read - (function (_ _) - (java/io/Console::readLine jvm-console)))) - - (def: can-write - (..can-write - (function (_ message) - (PrintStream::print message jvm-output)))) - - (def: can-close - (..can-close - (|>> (ex.throw cannot-close) wrap))))))))))] +(with-expansions [<jvm> (as-is (import: java/lang/String) + + (import: #long java/io/Console + (readLine [] #io #try String)) + + (import: java/io/InputStream + (read [] #io #try int)) + + (import: java/io/PrintStream + (print [String] #io #try void)) + + (import: java/lang/System + (#static console [] #io #? java/io/Console) + (#static in java/io/InputStream) + (#static out java/io/PrintStream)) + + (def: #export system + (IO (Try (Console IO))) + (do io.monad + [?jvm-console (System::console)] + (case ?jvm-console + #.None + (wrap (ex.throw cannot-open [])) + + (#.Some jvm-console) + (let [jvm-input (System::in) + jvm-output (System::out)] + (<| wrap + ex.return + (: (Console IO)) ## TODO: Remove ASAP + (structure + (def: can-read + (..can-read + (function (_ _) + (|> jvm-input + InputStream::read + (:: (try.with io.monad) map .nat))))) + + (def: can-read-line + (..can-read + (function (_ _) + (java/io/Console::readLine jvm-console)))) + + (def: can-write + (..can-write + (function (_ message) + (PrintStream::print message jvm-output)))) + + (def: can-close + (..can-close + (|>> (ex.throw cannot-close) wrap))))))))))] (for {@.old - (as-is <form-jvm>) + (as-is <jvm>) @.jvm - (as-is <form-jvm>) + (as-is <jvm>) })) (def: #export (write-line message console) diff --git a/stdlib/source/lux/world/environment.lux b/stdlib/source/lux/world/environment.lux index 8ad10f1f9..09475a548 100644 --- a/stdlib/source/lux/world/environment.lux +++ b/stdlib/source/lux/world/environment.lux @@ -1,13 +1,13 @@ (.module: [lux #* + [host (#+ import:)] [data ["." text] [format [context (#+ Context)]] [collection ["." dictionary]]] - [io (#- run)] - [host (#+ import:)]]) + [io (#- run)]]) ## Do not trust the values of environment variables ## https://wiki.sei.cmu.edu/confluence/display/java/ENV02-J.+Do+not+trust+the+values+of+environment+variables diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 88ddeb237..8720c9ce9 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -242,7 +242,7 @@ (wrap (#try.Success [])) _ - (io.io (exception.throw exception [path]))))) + (wrap (exception.throw exception [path]))))) (import: #long java/lang/AutoCloseable (close [] #io #try void)) @@ -289,7 +289,7 @@ _ (java/lang/AutoCloseable::close stream)] (if (i.= size bytes-read) (wrap data) - (io.io (exception.throw cannot-read-all-data path))))))) + (:: io.monad wrap (exception.throw ..cannot-read-all-data path))))))) (def: name (..can-see @@ -337,7 +337,7 @@ (wrap (#try.Success (file destination))) _ - (io.io (exception.throw cannot-move [destination path]))))))) + (wrap (exception.throw ..cannot-move [destination path]))))))) (def: modify (..can-modify @@ -350,7 +350,7 @@ (wrap (#try.Success [])) _ - (io.io (exception.throw cannot-modify [time-stamp path]))))))) + (wrap (exception.throw ..cannot-modify [time-stamp path]))))))) (def: delete (..can-delete @@ -375,7 +375,7 @@ (:: @ join)) #.None - (io.io (exception.throw not-a-directory [path])))))))] + (:: io.monad wrap (exception.throw ..not-a-directory [path])))))))] [files java/io/File::isFile file] [directories java/io/File::isDirectory directory] @@ -426,8 +426,8 @@ (import: Stats (size host.Number) (mtimeMs host.Number) - (isFile [] #try host.Boolean) - (isDirectory [] #try host.Boolean)) + (isFile [] #io #try host.Boolean) + (isDirectory [] #io #try host.Boolean)) (import: FsConstants (F_OK host.Number) @@ -437,17 +437,17 @@ (import: Fs (constants FsConstants) - (readFileSync [host.String] #try Binary) - (appendFileSync [host.String Buffer] #try Any) - (writeFileSync [host.String Buffer] #try Any) - (statSync [host.String] #try Stats) - (accessSync [host.String host.Number] #try Any) - (renameSync [host.String host.String] #try Any) - (utimesSync [host.String host.Number host.Number] #try Any) - (unlink [host.String] #try Any) - (readdirSync [host.String] #try (Array host.String)) - (mkdirSync [host.String] #try Any) - (rmdirSync [host.String] #try Any)) + (readFileSync [host.String] #io #try Binary) + (appendFileSync [host.String Buffer] #io #try Any) + (writeFileSync [host.String Buffer] #io #try Any) + (statSync [host.String] #io #try Stats) + (accessSync [host.String host.Number] #io #try Any) + (renameSync [host.String host.String] #io #try Any) + (utimesSync [host.String host.Number host.Number] #io #try Any) + (unlink [host.String] #io #try Any) + (readdirSync [host.String] #io #try (Array host.String)) + (mkdirSync [host.String] #io #try Any) + (rmdirSync [host.String] #io #try Any)) (import: JsPath (sep host.String) @@ -490,7 +490,7 @@ [(def: <name> (..can-modify (function (<name> data) - (io.io (<method> [path (Buffer::from data)] (..node-fs []))))))] + (<method> [path (Buffer::from data)] (..node-fs [])))))] [over-write Fs::writeFileSync] [append Fs::appendFileSync] @@ -499,7 +499,7 @@ (def: content (..can-query (function (_ _) - (io.io (Fs::readFileSync [path] (..node-fs [])))))) + (Fs::readFileSync [path] (..node-fs []))))) (def: name (..can-see @@ -513,71 +513,76 @@ (def: size (..can-query - (function (size _) - (|> (Fs::statSync [path] (..node-fs [])) - (:: try.monad map (|>> Stats::size f.nat)) - io.io)))) + (function (_ _) + (do (try.with io.monad) + [stat (Fs::statSync [path] (..node-fs []))] + (wrap (|> stat + Stats::size + f.nat)))))) (def: last-modified (..can-query - (function (last-modified _) - (|> (Fs::statSync [path] (..node-fs [])) - (:: try.monad map (|>> Stats::mtimeMs - f.int - duration.from-millis - instant.absolute)) - io.io)))) + (function (_ _) + (do (try.with io.monad) + [stat (Fs::statSync [path] (..node-fs []))] + (wrap (|> stat + Stats::mtimeMs + f.int + duration.from-millis + instant.absolute)))))) (def: can-execute? (..can-query (function (can-execute? _) - (io.io (do try.monad - [#let [node-fs (..node-fs [])] - _ (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::F_OK)] node-fs)] - (wrap (case (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::X_OK)] node-fs) - (#try.Success _) - true - - (#try.Failure _) - false))))))) + (do (try.with io.monad) + [#let [node-fs (..node-fs [])] + _ (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::F_OK)] node-fs)] + (do io.monad + [outcome (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::X_OK)] node-fs)] + (wrap (#try.Success (case outcome + (#try.Success _) + true + + (#try.Failure _) + false)))))))) (def: move (..can-open (function (move destination) - (io.io (do try.monad - [_ (Fs::renameSync [path destination] (..node-fs []))] - (wrap (file destination))))))) + (do (try.with io.monad) + [_ (Fs::renameSync [path destination] (..node-fs []))] + (wrap (file destination)))))) (def: modify (..can-modify (function (modify time-stamp) - (io.io (let [when (|> time-stamp instant.relative duration.to-millis i.frac)] - (Fs::utimesSync [path when when] (..node-fs []))))))) + (let [when (|> time-stamp instant.relative duration.to-millis i.frac)] + (Fs::utimesSync [path when when] (..node-fs [])))))) (def: delete (..can-delete (function (delete _) - (io.io (Fs::unlink [path] (..node-fs [])))))))) + (Fs::unlink [path] (..node-fs []))))))) (`` (structure: (directory path) (-> Path (Directory IO)) - + (~~ (template [<name> <method> <capability>] [(def: <name> (..can-query (function (<name> _) - (io.io (do {@ try.monad} - [#let [node-fs (..node-fs [])] - subs (Fs::readdirSync [path] node-fs) - subs (monad.map @ (function (_ sub) - (do @ - [stats (Fs::statSync [sub] node-fs) - verdict (<method> [] stats)] - (wrap [verdict sub]))) - (array.to-list subs))] - (wrap (|> subs - (list.filter product.left) - (list@map (|>> product.right <capability>)))))))))] + (do {@ (try.with io.monad)} + [#let [node-fs (..node-fs [])] + subs (Fs::readdirSync [path] node-fs) + subs (monad.map @ (function (_ sub) + (do @ + [stats (Fs::statSync [sub] node-fs) + verdict (<method> [] stats)] + (wrap [verdict sub]))) + (array.to-list subs))] + (wrap (|> subs + (list.filter product.left) + (list@map (|>> product.right <capability>))))))))] [files Stats::isFile ..file] [directories Stats::isDirectory directory] @@ -586,7 +591,7 @@ (def: discard (..can-delete (function (discard _) - (io.io (Fs::rmdirSync [path] (..node-fs [])))))))) + (Fs::rmdirSync [path] (..node-fs []))))))) (`` (structure: #export system (System IO) @@ -595,12 +600,12 @@ [(def: <name> (..can-open (function (<name> path) - (io.io (do try.monad - [stats (Fs::statSync [path] (..node-fs [])) - verdict (<method> [] stats)] - (if verdict - (wrap (<capability> path)) - (exception.throw <exception> [path])))))))] + (do (try.with io.monad) + [stats (Fs::statSync [path] (..node-fs [])) + verdict (<method> [] stats)] + (if verdict + (wrap (<capability> path)) + (:: io.monad wrap (exception.throw <exception> [path])))))))] [file Stats::isFile ..file ..cannot-find-file] [directory Stats::isDirectory ..directory ..cannot-find-directory] @@ -610,15 +615,17 @@ [(def: <name> (..can-open (function (<name> path) - (io.io (let [node-fs (..node-fs [])] - (case (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::F_OK)] node-fs) - (#try.Success _) - (exception.throw <exception> [path]) - - (#try.Failure _) - (do try.monad - [_ (|> node-fs <prep>)] - (wrap (<capability> path)))))))))] + (let [node-fs (..node-fs [])] + (do io.monad + [outcome (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::F_OK)] node-fs)] + (case outcome + (#try.Success _) + (wrap (exception.throw <exception> [path])) + + (#try.Failure _) + (do (try.with io.monad) + [_ (|> node-fs <prep>)] + (wrap (<capability> path)))))))))] [create-file ..file ..cannot-create-file (Fs::appendFileSync [path (Buffer::from (binary.create 0))])] [create-directory ..directory ..cannot-create-directory (Fs::mkdirSync [path])] diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index 804d24324..50121d653 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -2,13 +2,16 @@ [lux #* ["." io (#+ IO)] ["jvm" host (#+ import:)] + [abstract + ["." enum]] [control [monad (#+ do)] ["." try (#+ Try)]] [data - [number (#+ hex)] ["." product] ["." maybe] + [number (#+ hex) + ["n" nat]] ["." text ["%" format (#+ format)] ["." encoding]] @@ -37,7 +40,7 @@ dangerous (if windows? (format dangerous "%!") dangerous) - indices (list.n/range 0 (dec (text.size dangerous)))] + indices (enum.range n.enum 0 (dec (text.size dangerous)))] (function (_ unsafe) (list;fold (function (_ index safer) (let [bad (|> dangerous (text.nth index) maybe.assume text.from-code) diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index 419e8a4c9..86a45e606 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -1,7 +1,8 @@ (.module: [lux #* [abstract - ["." monad (#+ do)]] + ["." monad (#+ do)] + ["." enum]] [control [pipe (#+ when>)] ["." try (#+ Try)] @@ -16,12 +17,12 @@ ["n" nat]] [format ["md" markdown (#+ Markdown Span Block)]] - ["." text ("#;." equivalence) + ["." text ("#@." equivalence) ["%" format (#+ format)] ["." encoding]] [collection - ["." sequence (#+ Sequence) ("#;." functor)] - ["." list ("#;." functor fold)]]] + ["." sequence (#+ Sequence) ("#@." functor)] + ["." list ("#@." functor fold)]]] ["." function] ["." type ("#@." equivalence)] ["." macro] @@ -47,7 +48,7 @@ (def: type-var-names (Sequence Text) - (|> 0 (sequence.iterate inc) (sequence;map parameter-type-name))) + (|> 0 (sequence.iterate inc) (sequence@map parameter-type-name))) (template [<name> <partition>] [(def: (<name> id) @@ -83,14 +84,14 @@ (list) (|> level dec - (list.n/range 0) - (list;map (|>> (n.+ (inc offset)) parameter-type-name))))) + (enum.range n.enum 0) + (list@map (|>> (n.+ (inc offset)) parameter-type-name))))) (def: (prefix-lines prefix lines) (-> Text Text Text) (|> lines (text.split-all-with text.new-line) - (list;map (|>> (format prefix))) + (list@map (|>> (format prefix))) (text.join-with text.new-line))) (def: (pprint-type-definition level type-func-info tags module signature? recursive-type? type) @@ -109,7 +110,7 @@ (format "(primitive " (%.text name) ")") _ - (format "(primitive " (%.text name) " " (|> params (list;map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) + (format "(primitive " (%.text name) " " (|> params (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) [_ (#.Sum _)] (let [members (type.flatten-variant type)] @@ -117,20 +118,20 @@ #.Nil (format "(| " (|> members - (list;map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) + (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")") _ (|> members (list.zip2 tags) - (list;map (function (_ [[_ t-name] type]) + (list@map (function (_ [[_ t-name] type]) (case type (#.Product _) (let [types (type.flatten-tuple type)] (format "(#" t-name " " (|> types - (list;map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) + (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) @@ -142,12 +143,12 @@ (let [members (type.flatten-tuple type)] (case tags #.Nil - (format "[" (|> members (list;map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) "]") + (format "[" (|> members (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) "]") _ (let [member-docs (|> members (list.zip2 tags) - (list;map (function (_ [[_ t-name] type]) + (list@map (function (_ [[_ t-name] type]) (if signature? (format "(: " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) text.new-line " " t-name ")") (format "#" t-name " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type))))) @@ -158,7 +159,7 @@ [_ (#.Function input output)] (let [[ins out] (type.flatten-function type)] - (format "(-> " (|> ins (list;map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) + (format "(-> " (|> ins (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? out) ")")) @@ -193,10 +194,10 @@ [_ (#.Apply param fun)] (let [[type-func type-arguments] (type.flatten-application type)] - (format "(" (pprint-type-definition level type-func-info tags module signature? recursive-type? type-func) " " (|> type-arguments (list;map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) + (format "(" (pprint-type-definition level type-func-info tags module signature? recursive-type? type-func) " " (|> type-arguments (list@map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) [_ (#.Named [_module _name] type)] - (if (text;= module _module) + (if (text@= module _module) _name (%.name [_module _name])) ))) @@ -210,20 +211,20 @@ (format "(primitive " (%.text name) ")") _ - (format "(primitive " (%.text name) " " (|> params (list;map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) + (format "(primitive " (%.text name) " " (|> params (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) (#.Sum _) (let [members (type.flatten-variant type)] - (format "(| " (|> members (list;map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) + (format "(| " (|> members (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) (#.Product _) (let [members (type.flatten-tuple type)] - (format "[" (|> members (list;map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) "]")) + (format "[" (|> members (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) "]")) (#.Function input output) (let [[ins out] (type.flatten-function type)] (format "(-> " - (|> ins (list;map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) + (|> ins (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) " " (pprint-type level type-func-name module out) ")")) @@ -250,10 +251,10 @@ (#.Apply param fun) (let [[type-func type-arguments] (type.flatten-application type)] - (format "(" (pprint-type level type-func-name module type-func) " " (|> type-arguments (list;map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) + (format "(" (pprint-type level type-func-name module type-func) " " (|> type-arguments (list@map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) (#.Named [_module _name] type) - (if (text;= module _module) + (if (text@= module _module) _name (%.name [_module _name])) )) @@ -271,7 +272,7 @@ (def: (lux-module? module-name) (-> Text Bit) - (or (text;= "lux" module-name) + (or (text@= "lux" module-name) (text.starts-with? "lux/" module-name))) (def: (add-definition [name [def-type def-annotations def-value]] organization) @@ -302,9 +303,9 @@ (def: name-sort (All [r] (-> [Text r] [Text r] Bit)) - (let [text;< (:: text.order <)] + (let [text@< (:: text.order <)] (function (_ [n1 _] [n2 _]) - (text;< n1 n2)))) + (text@< n1 n2)))) (def: (organize-definitions defs) (-> (List [Text Definition]) Organization) @@ -312,7 +313,7 @@ #macros (list) #structures (list) #values (list)}] - (|> (list;fold add-definition init defs) + (|> (list@fold add-definition init defs) (update@ #types (list.sort name-sort)) (update@ #macros (list.sort name-sort)) (update@ #structures (list.sort name-sort)) @@ -366,7 +367,7 @@ (when> recursive-type? [unrecurse-type]) (pprint-type-definition (dec nesting) [_name type-arguments] (maybe.default (list) tags) module signature? recursive-type?) (text.split-all-with text.new-line) - (list;map (|>> (format " "))) + (list@map (|>> (format " "))) (text.join-with text.new-line)) ")")))) @@ -392,14 +393,14 @@ md.empty) type-code))))) types)] - (wrap (list;fold (function.flip md.then) + (wrap (list@fold (function.flip md.then) (md.heading/2 "Types") type-docs)))) (def: (document-macros module-name names) (-> Text (List [Text Code]) (Markdown Block)) (|> names - (list;map (: (-> [Text Code] (Markdown Block)) + (list@map (: (-> [Text Code] (Markdown Block)) (function (_ [name def-annotations]) ($_ md.then (md.heading/3 name) @@ -408,7 +409,7 @@ (do maybe.monad [documentation (macro.get-documentation def-annotations)] (wrap (md.code documentation)))))))) - (list;fold (function.flip md.then) + (list@fold (function.flip md.then) (md.heading/2 "Macros")))) (template [<singular> <plural> <header>] @@ -419,7 +420,7 @@ (def: (<plural> module values) (-> Text (List Value) (Markdown Block)) (|> values - (list;map (function (_ [name def-annotations value-type]) + (list@map (function (_ [name def-annotations value-type]) (let [?doc (macro.get-documentation def-annotations) usage (case (macro.function-arguments def-annotations) #.Nil @@ -436,7 +437,7 @@ _ md.empty) (<singular> module value-type))))) - (list;fold (function.flip md.then) + (list@fold (function.flip md.then) (md.heading/2 <header>))))] [document-structure document-structures "Structures"] @@ -447,7 +448,7 @@ (-> [Text Text] Text Text) (|> block (text.split-all-with text.new-line) - (list;map (text.enclose pre+post)) + (list@map (text.enclose pre+post)) (text.join-with text.new-line))) (def: (document-module [[module-name module] organization]) @@ -505,7 +506,7 @@ (list.sort name-sort))] lux-exports (monad.map @ (function.compose macro.exports product.left) lux-modules) - module-documentation (|> (list;map organize-definitions lux-exports) + module-documentation (|> (list@map organize-definitions lux-exports) (list.zip2 lux-modules) (monad.map @ document-module)) #let [_ (io.run (monad.map io.monad save-documentation! module-documentation))]] diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux index 3de0301b8..e3112d799 100644 --- a/stdlib/source/spec/compositor/generation/function.lux +++ b/stdlib/source/spec/compositor/generation/function.lux @@ -2,7 +2,8 @@ [lux (#- function) ["_" test (#+ Test)] [abstract - [monad (#+ do)]] + [monad (#+ do)] + ["." enum]] [control [pipe (#+ case>)]] [data @@ -71,7 +72,7 @@ (_.test "Can read environment." (or (n.= 1 arity) (let [environment (|> partial-arity - (list.n/range 1) + (enum.range n.enum 1) (list@map (|>> #reference.Local))) variableS (if (n.<= partial-arity local) (synthesis.variable/foreign (dec local)) diff --git a/stdlib/source/test/lux/abstract/enum.lux b/stdlib/source/test/lux/abstract/enum.lux index c020ec211..17e1d0cce 100644 --- a/stdlib/source/test/lux/abstract/enum.lux +++ b/stdlib/source/test/lux/abstract/enum.lux @@ -32,6 +32,9 @@ (let [expected-size (|> end (n.- start) inc) expected-start? (|> range list.head (maybe@map (n.= start)) (maybe.default false)) expected-end? (|> range list.last (maybe@map (n.= end)) (maybe.default false)) + can-be-backwards? (:: (list.equivalence n.equivalence) = + (/.range n.enum start end) + (list.reverse (/.range n.enum end start))) every-element-is-a-successor? (case range (#.Cons head tail) (|> (list@fold (function (_ next [verdict prev]) @@ -47,5 +50,6 @@ (and (n.= expected-size (list.size range)) expected-start? expected-end? + can-be-backwards? every-element-is-a-successor?))) ))))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index fe35c0500..b3e55e901 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -27,7 +27,8 @@ ["#/." synthesis] ["#/." text] ["#/." tree] - ["#/." type]] + ["#/." type] + ["#/." xml]] ["#." pipe] ["#." reader] ["#." region] @@ -73,6 +74,7 @@ /parser/text.test /parser/tree.test /parser/type.test + /parser/xml.test )) (def: security diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 469ff4308..dcdb78f78 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -2,7 +2,8 @@ [lux #* ["_" test (#+ Test)] [abstract - ["." monad (#+ do)]] + ["." monad (#+ do)] + ["." enum]] [control ["." io] ["." try] @@ -153,7 +154,7 @@ [#let [ending (|> "_" (list.repeat limit) (text.join-with "")) - ids (list.n/range 0 (dec limit)) + ids (enum.range n.enum 0 (dec limit)) waiters (list@map (function (_ id) (exec (io.run (atom.update (|>> (format "_")) resource)) (waiter resource barrier id))) diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux new file mode 100644 index 000000000..15e0e993b --- /dev/null +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -0,0 +1,171 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try] + ["." exception]] + [data + ["." text ("#@." equivalence)] + ["." name] + [format + ["." xml]] + [number + ["n" nat]] + [collection + ["." dictionary]]] + [math + ["." random (#+ Random)]] + [macro + ["." template]] + ["." type ("#@." equivalence)]] + {1 + ["." / + ["/#" // ("#@." monad)]]}) + +(template: (!expect <pattern> <value>) + (case <value> + <pattern> + true + + _ + false)) + +(template: (!failure <exception> <cases>) + (with-expansions [<<cases>> (template.splice <cases>)] + (do {@ random.monad} + [expected (random.ascii/alpha 1)] + (_.cover [<exception>] + (`` (and (~~ (template [<parser> <input>] + [(|> (/.run <parser> <input>) + (!expect (^multi (#try.Failure error) + (exception.match? <exception> error))))] + + <<cases>>)))))))) + +(def: random-label + (Random Name) + (random.and (random.ascii/alpha 1) + (random.ascii/alpha 1))) + +(def: random-tag ..random-label) +(def: random-attribute ..random-label) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Parser]) + ($_ _.and + (do {@ random.monad} + [expected (random.ascii/alpha 1)] + (_.cover [/.run /.text] + (|> (/.run /.text (#xml.Text expected)) + (!expect (^multi (#try.Success actual) + (text@= expected actual)))))) + (!failure /.unconsumed-inputs + [[(//@wrap expected) + (#xml.Text expected)]]) + (do {@ random.monad} + [expected (random.ascii/alpha 1)] + (_.cover [/.ignore] + (|> (/.run /.ignore (#xml.Text expected)) + (!expect (#try.Success []))))) + (do {@ random.monad} + [expected ..random-tag] + (_.cover [/.node] + (|> (/.run (do //.monad + [_ (/.node expected)] + /.ignore) + (#xml.Node expected (dictionary.new name.hash) (list))) + (!expect (#try.Success []))))) + (!failure /.wrong-tag + [[(/.node ["" expected]) + (#xml.Node [expected ""] (dictionary.new name.hash) (list))]]) + (do {@ random.monad} + [expected-tag ..random-tag + expected-attribute ..random-attribute + expected-value (random.ascii/alpha 1)] + (_.cover [/.attr] + (|> (/.run (do //.monad + [_ (/.node expected-tag) + _ (/.attr expected-attribute)] + /.ignore) + (#xml.Node expected-tag + (|> (dictionary.new name.hash) + (dictionary.put expected-attribute expected-value)) + (list))) + (!expect (#try.Success []))))) + (!failure /.unknown-attribute + [[(do //.monad + [_ (/.attr ["" expected])] + /.ignore) + (#xml.Node [expected expected] + (|> (dictionary.new name.hash) + (dictionary.put [expected ""] expected)) + (list))]]) + (do {@ random.monad} + [expected ..random-tag] + (_.cover [/.children] + (|> (/.run (do {@ //.monad} + [_ (/.node expected)] + (/.children + (do @ + [_ (/.node expected)] + /.ignore))) + (#xml.Node expected + (dictionary.new name.hash) + (list (#xml.Node expected + (dictionary.new name.hash) + (list))))) + (!expect (#try.Success []))))) + (!failure /.empty-input + [[(do //.monad + [_ /.ignore] + /.ignore) + (#xml.Text expected)] + [(do //.monad + [_ /.ignore] + /.text) + (#xml.Text expected)] + [(do //.monad + [_ /.ignore] + (/.node [expected expected])) + (#xml.Node [expected expected] + (dictionary.new name.hash) + (list))] + [(do //.monad + [_ /.ignore] + (/.node [expected expected])) + (#xml.Node [expected expected] + (|> (dictionary.new name.hash) + (dictionary.put [expected expected] expected)) + (list))] + [(do //.monad + [_ /.ignore] + (/.children + (/.node [expected expected]))) + (#xml.Node [expected expected] + (dictionary.new name.hash) + (list (#xml.Node [expected expected] + (dictionary.new name.hash) + (list))))]]) + (!failure /.unexpected-input + [[/.text + (#xml.Node [expected expected] (dictionary.new name.hash) (list))] + [(do //.monad + [_ (/.node [expected expected])] + /.ignore) + (#xml.Text expected)] + [(do //.monad + [_ (/.attr [expected expected])] + /.ignore) + (#xml.Text expected)] + [(do {@ //.monad} + [_ (/.node [expected expected])] + (/.children + (do @ + [_ (/.node [expected expected])] + /.ignore))) + (#xml.Text expected)]]) + ))) diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index d0c9eef40..550b3b872 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -6,6 +6,7 @@ [functor (#+ Functor)] [apply (#+ Apply)] ["." monad (#+ Monad do)] + ["." enum] {[0 #spec] [/ ["$." functor (#+ Injection Comparison)] @@ -100,7 +101,7 @@ outcome (/.run @ (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) - (list.n/range 1 expected-clean-ups))] + (enum.range n.enum 1 expected-clean-ups))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] (wrap (and (success? outcome) @@ -118,7 +119,7 @@ outcome (/.run @ (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) - (list.n/range 1 expected-clean-ups)) + (enum.range n.enum 1 expected-clean-ups)) _ (/.fail //@ (exception.construct ..oops []))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] @@ -137,7 +138,7 @@ outcome (/.run @ (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) - (list.n/range 1 expected-clean-ups)) + (enum.range n.enum 1 expected-clean-ups)) _ (/.throw //@ ..oops [])] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] @@ -157,7 +158,7 @@ outcome (/.run @ (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) - (list.n/range 1 expected-clean-ups))] + (enum.range n.enum 1 expected-clean-ups))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] (wrap (and (or (n.= 0 expected-clean-ups) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 508a2c1af..492fdac24 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -5,6 +5,7 @@ ["_" test (#+ Test)] [abstract ["." monad (#+ do)] + ["." enum] {[0 #spec] [/ ["$." equivalence]]}] @@ -78,7 +79,7 @@ (_.test "Can slice binaries." (let [slice-size (|> to (n.- from) inc) random-slice (try.assume (/.slice from to random-binary)) - idxs (list.n/range 0 (dec slice-size)) + idxs (enum.range n.enum 0 (dec slice-size)) reader (function (_ binary idx) (/.read/8 idx binary))] (and (n.= slice-size (/.size random-slice)) (case [(monad.map try.monad (reader random-slice) idxs) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index a49a71e38..e1f469fae 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -4,6 +4,7 @@ ["_" test (#+ Test)] [abstract [monad (#+ do)] + ["." enum] {[0 #spec] [/ ["$." equivalence] @@ -171,7 +172,7 @@ (and (not (/.any? n.even? sample)) (/.every? (bit.complement n.even?) sample)))) (_.test "You can iteratively construct a list, generating values until you're done." - (/@= (/.n/range 0 (dec size)) + (/@= (enum.range n.enum 0 (dec size)) (/.iterate (function (_ n) (if (n.< size n) (#.Some (inc n)) #.None)) 0))) (_.test "Can enumerate all elements in a list." @@ -180,15 +181,4 @@ (/@map product.left enum-sample)) (/@= sample (/@map product.right enum-sample))))) - (do @ - [from (|> r.nat (:: @ map (n.% 10))) - to (|> r.nat (:: @ map (n.% 10)))] - (_.test "Ranges can be constructed forward and backwards." - (and (/@= (/.n/range from to) - (/.reverse (/.n/range to from))) - (let [from (.int from) - to (.int to) - (^open "/@.") (/.equivalence int.equivalence)] - (/@= (/.i/range from to) - (/.reverse (/.i/range to from))))))) )))) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 4b204d37a..f47629d70 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -5,7 +5,8 @@ [abstract comonad [functor (#+)] - [monad (#+ do)]] + [monad (#+ do)] + ["." enum]] [data ["." maybe] [number @@ -33,31 +34,31 @@ sample1 (/.iterate inc offset)]] ($_ _.and (_.test "Can move along a sequence and take slices off it." - (and (and (list@= (list.n/range 0 (dec size)) + (and (and (list@= (enum.range n.enum 0 (dec size)) (/.take size sample0)) - (list@= (list.n/range offset (dec (n.+ offset size))) + (list@= (enum.range n.enum offset (dec (n.+ offset size))) (/.take size (/.drop offset sample0))) (let [[drops takes] (/.split size sample0)] - (and (list@= (list.n/range 0 (dec size)) + (and (list@= (enum.range n.enum 0 (dec size)) drops) - (list@= (list.n/range size (dec (n.* 2 size))) + (list@= (enum.range n.enum size (dec (n.* 2 size))) (/.take size takes))))) - (and (list@= (list.n/range 0 (dec size)) + (and (list@= (enum.range n.enum 0 (dec size)) (/.take-while (n.< size) sample0)) - (list@= (list.n/range offset (dec (n.+ offset size))) + (list@= (enum.range n.enum offset (dec (n.+ offset size))) (/.take-while (n.< (n.+ offset size)) (/.drop-while (n.< offset) sample0))) (let [[drops takes] (/.split-while (n.< size) sample0)] - (and (list@= (list.n/range 0 (dec size)) + (and (list@= (enum.range n.enum 0 (dec size)) drops) - (list@= (list.n/range size (dec (n.* 2 size))) + (list@= (enum.range n.enum size (dec (n.* 2 size))) (/.take-while (n.< (n.* 2 size)) takes))))) )) (_.test "Can repeat any element and infinite number of times." (n.= elem (/.nth offset (/.repeat elem)))) (_.test "Can obtain the head & tail of a sequence." (and (n.= offset (/.head sample1)) - (list@= (list.n/range (inc offset) (n.+ offset size)) + (list@= (enum.range n.enum (inc offset) (n.+ offset size)) (/.take size (/.tail sample1))))) (_.test "Can filter sequences." (and (n.= (n.* 2 offset) diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index eeace02be..d692cb3f4 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -1,7 +1,9 @@ (.module: [lux #* ["%" data/text/format (#+ format)] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)] + ["." enum]] [math ["." random (#+ Random)]] ["_" test (#+ Test)] @@ -142,7 +144,7 @@ (def: predicates-and-sets Test (do {@ random.monad} - [#let [set-10 (set.from-list n.hash (list.n/range 0 10))] + [#let [set-10 (set.from-list n.hash (enum.range n.enum 0 10))] sample (|> random.nat (:: @ map (n.% 20)))] ($_ _.and (_.test (%.name (name-of /.from-predicate)) diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 520776996..7c55a0d6f 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -5,7 +5,8 @@ [abstract [equivalence (#+)] [functor (#+)] - [monad (#+ do)]] + [monad (#+ do)] + ["." enum]] [data ["." bit ("#@." equivalence)] [number @@ -31,14 +32,14 @@ (let [(^open "list@.") (list.equivalence n.equivalence)] (and (bit@= (:: n.equivalence = left right) (/.::: = left right)) - (list@= (:: list.functor map inc (list.n/range start end)) - (/.::: map inc (list.n/range start end)))))) + (list@= (:: list.functor map inc (enum.range n.enum start end)) + (/.::: map inc (enum.range n.enum start end)))))) (_.test "Can automatically select second-order structures." (/.::: = - (list.n/range start end) - (list.n/range start end))) + (enum.range n.enum start end) + (enum.range n.enum start end))) (_.test "Can automatically select third-order structures." - (let [lln (/.::: map (list.n/range start) - (list.n/range start end))] + (let [lln (/.::: map (enum.range n.enum start) + (enum.range n.enum start end))] (/.::: = lln lln))) )))) |