aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/abstract/enum.lux8
-rw-r--r--stdlib/source/lux/control/concurrency/atom.lux1
-rw-r--r--stdlib/source/lux/control/concurrency/process.lux6
-rw-r--r--stdlib/source/lux/control/parser/xml.lux58
-rw-r--r--stdlib/source/lux/data/collection/list.lux24
-rw-r--r--stdlib/source/lux/data/format/xml.lux20
-rw-r--r--stdlib/source/lux/data/text/buffer.lux4
-rw-r--r--stdlib/source/lux/data/text/encoding.lux10
-rw-r--r--stdlib/source/lux/debug.lux108
-rw-r--r--stdlib/source/lux/host.js.lux58
-rw-r--r--stdlib/source/lux/target/python.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux5
-rw-r--r--stdlib/source/lux/world/console.lux106
-rw-r--r--stdlib/source/lux/world/environment.lux4
-rw-r--r--stdlib/source/lux/world/file.lux157
-rw-r--r--stdlib/source/lux/world/shell.lux7
-rw-r--r--stdlib/source/program/scriptum.lux71
-rw-r--r--stdlib/source/spec/compositor/generation/function.lux5
-rw-r--r--stdlib/source/test/lux/abstract/enum.lux4
-rw-r--r--stdlib/source/test/lux/control.lux4
-rw-r--r--stdlib/source/test/lux/control/concurrency/semaphore.lux5
-rw-r--r--stdlib/source/test/lux/control/parser/xml.lux171
-rw-r--r--stdlib/source/test/lux/control/region.lux9
-rw-r--r--stdlib/source/test/lux/data/binary.lux3
-rw-r--r--stdlib/source/test/lux/data/collection/list.lux14
-rw-r--r--stdlib/source/test/lux/data/collection/sequence.lux21
-rw-r--r--stdlib/source/test/lux/math/logic/fuzzy.lux6
-rw-r--r--stdlib/source/test/lux/type/implicit.lux15
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 "'" "&apos;")
(text.replace-all text.double-quote "&quot;")))
-(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)))
))))