From 82c955d5777ecb87b53bafcc658683d5a76e9a3c Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 3 Apr 2017 18:18:34 -0400
Subject: - Implemented Int encoding/decoding in the standard library. - Moved
some type-constructors for building functor types into the
lux/control/functor module. - Renamed Ord to Order. - Renamed Env to Reader.
---
stdlib/source/lux.lux | 163 +++++++++++++++-------------
stdlib/source/lux/codata/env.lux | 63 -----------
stdlib/source/lux/codata/reader.lux | 63 +++++++++++
stdlib/source/lux/control/enum.lux | 4 +-
stdlib/source/lux/control/functor.lux | 9 ++
stdlib/source/lux/control/interval.lux | 10 +-
stdlib/source/lux/control/ord.lux | 44 --------
stdlib/source/lux/control/order.lux | 44 ++++++++
stdlib/source/lux/data/char.lux | 4 +-
stdlib/source/lux/data/coll/ordered.lux | 18 +--
stdlib/source/lux/data/coll/seq.lux | 1 -
stdlib/source/lux/data/coll/tree/finger.lux | 3 +-
stdlib/source/lux/data/number.lux | 66 ++++++++---
stdlib/source/lux/data/number/complex.lux | 1 -
stdlib/source/lux/data/number/ratio.lux | 4 +-
stdlib/source/lux/data/text.lux | 4 +-
stdlib/source/lux/lexer.lux | 2 +-
stdlib/test/test/lux/codata/env.lux | 38 -------
stdlib/test/test/lux/codata/reader.lux | 38 +++++++
stdlib/test/test/lux/data/char.lux | 6 +-
stdlib/test/test/lux/data/coll/ordered.lux | 10 +-
stdlib/test/test/lux/data/number.lux | 82 +++++++-------
stdlib/test/test/lux/data/text.lux | 2 +-
stdlib/test/tests.lux | 2 +-
24 files changed, 366 insertions(+), 315 deletions(-)
delete mode 100644 stdlib/source/lux/codata/env.lux
create mode 100644 stdlib/source/lux/codata/reader.lux
delete mode 100644 stdlib/source/lux/control/ord.lux
create mode 100644 stdlib/source/lux/control/order.lux
delete mode 100644 stdlib/test/test/lux/codata/env.lux
create mode 100644 stdlib/test/test/lux/codata/reader.lux
(limited to 'stdlib')
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 964cf5b57..bac65ef16 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2059,73 +2059,6 @@
(-> (-> a Bool) ($' List a) Bool))
(fold (lambda' [_2 _1] (if _1 (p _2) false)) true xs))
-(def:''' (i= x y)
- #Nil
- (-> Int Int Bool)
- (_lux_proc ["int" "="] [x y]))
-
-(def:''' (Bool/encode x)
- #Nil
- (-> Bool Text)
- (if x "true" "false"))
-
-(def:''' (digit-to-text digit)
- #Nil
- (-> Nat Text)
- (_lux_case digit
- +0 "0"
- +1 "1" +2 "2" +3 "3"
- +4 "4" +5 "5" +6 "6"
- +7 "7" +8 "8" +9 "9"
- _ (_lux_proc ["io" "error"] ["undefined"])))
-
-(def:''' (Nat/encode value)
- #Nil
- (-> Nat Text)
- (_lux_case value
- +0
- "+0"
-
- _
- (let' [loop (_lux_: (-> Nat Text Text)
- (lambda' recur [input output]
- (if (_lux_proc ["nat" "="] [input +0])
- (_lux_proc ["text" "append"] ["+" output])
- (recur (_lux_proc ["nat" "/"] [input +10])
- (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10]))
- output])))))]
- (loop value ""))))
-
-(def:''' (Int/encode x)
- #Nil
- (-> Int Text)
- (_lux_proc ["int" "encode"] [x]))
-
-(def:''' (Deg/encode x)
- #Nil
- (-> Deg Text)
- (_lux_proc ["deg" "encode"] [x]))
-
-(def:''' (Real/encode x)
- #Nil
- (-> Real Text)
- (_lux_proc ["real" "encode"] [x]))
-
-(def:''' (Char/encode x)
- #Nil
- (-> Char Text)
- (let' [as-text (_lux_case x
- #"\t" "\\t"
- #"\v" "\\v"
- #"\b" "\\b"
- #"\n" "\\n"
- #"\r" "\\r"
- #"\f" "\\f"
- #"\"" "\\\""
- #"\\" "\\\\"
- _ (_lux_proc ["char" "to-text"] [x]))]
- ($_ Text/append "#\"" as-text "\"")))
-
(macro:' #export (do-template tokens)
(list [["lux" "doc"] (#TextA "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary.
(do-template [<name> <diff>]
@@ -2143,11 +2076,12 @@
(let' [apply (_lux_: (-> RepEnv ($' List AST))
(lambda' [env] (map (apply-template env) templates)))
num-bindings (length bindings')]
- (if (every? (i= num-bindings) (map length data'))
+ (if (every? (lambda' [sample] (_lux_proc ["int" "="] [num-bindings sample]))
+ (map length data'))
(|> data'
(join-map (. apply (make-env bindings')))
return)
- (fail (Text/append "Irregular arguments vectors for do-template. Expected size " (Int/encode num-bindings)))))
+ (fail "Irregular arguments vectors for do-template.")))
_
(fail "Wrong syntax for do-template"))
@@ -2261,6 +2195,88 @@
[r.max Real r.> "Real minimum."]
)
+(def:''' (Bool/encode x)
+ #Nil
+ (-> Bool Text)
+ (if x "true" "false"))
+
+(def:''' (digit-to-text digit)
+ #Nil
+ (-> Nat Text)
+ (_lux_case digit
+ +0 "0"
+ +1 "1" +2 "2" +3 "3"
+ +4 "4" +5 "5" +6 "6"
+ +7 "7" +8 "8" +9 "9"
+ _ (_lux_proc ["io" "error"] ["undefined"])))
+
+(def:''' (Nat/encode value)
+ #Nil
+ (-> Nat Text)
+ (_lux_case value
+ +0
+ "+0"
+
+ _
+ (let' [loop (_lux_: (-> Nat Text Text)
+ (lambda' recur [input output]
+ (if (_lux_proc ["nat" "="] [input +0])
+ (_lux_proc ["text" "append"] ["+" output])
+ (recur (_lux_proc ["nat" "/"] [input +10])
+ (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10]))
+ output])))))]
+ (loop value ""))))
+
+(def:''' (Int/abs value)
+ #Nil
+ (-> Int Int)
+ (if (i.< 0 value)
+ (i.* -1 value)
+ value))
+
+(def:''' (Int/encode value)
+ #Nil
+ (-> Int Text)
+ (if (i.= 0 value)
+ "0"
+ (let' [sign (if (i.> 0 value)
+ ""
+ "-")]
+ ((_lux_: (-> Int Text Text)
+ (lambda' recur [input output]
+ (if (i.= 0 input)
+ (_lux_proc ["text" "append"] [sign output])
+ (recur (i./ 10 input)
+ (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text)
+ output])))))
+ (|> value (i./ 10) Int/abs)
+ (|> value (i.% 10) Int/abs (_lux_:! Nat) digit-to-text)))))
+
+(def:''' (Deg/encode x)
+ #Nil
+ (-> Deg Text)
+ (_lux_proc ["deg" "encode"] [x]))
+
+(def:''' (Real/encode x)
+ #Nil
+ (-> Real Text)
+ (_lux_proc ["real" "encode"] [x]))
+
+(def:''' (Char/encode x)
+ #Nil
+ (-> Char Text)
+ (let' [as-text (_lux_case x
+ #"\t" "\\t"
+ #"\v" "\\v"
+ #"\b" "\\b"
+ #"\n" "\\n"
+ #"\r" "\\r"
+ #"\f" "\\f"
+ #"\"" "\\\""
+ #"\\" "\\\\"
+ _ (_lux_proc ["char" "to-text"] [x]))]
+ ($_ Text/append "#\"" as-text "\"")))
+
(def:''' (multiple? div n)
#Nil
(-> Int Int Bool)
@@ -5767,15 +5783,6 @@
)))))
))
-(type: #export (<&> f g)
- (All [a] (& (f a) (g a))))
-
-(type: #export (<|> f g)
- (All [a] (| (f a) (g a))))
-
-(type: #export (<.> f g)
- (All [a] (f (g a))))
-
(def: #export (assume mx)
(All [a] (-> (Maybe a) a))
(default (undefined) mx))
diff --git a/stdlib/source/lux/codata/env.lux b/stdlib/source/lux/codata/env.lux
deleted file mode 100644
index c9cc107c4..000000000
--- a/stdlib/source/lux/codata/env.lux
+++ /dev/null
@@ -1,63 +0,0 @@
-(;module:
- lux
- (lux (control functor
- applicative
- ["M" monad #*])))
-
-## [Types]
-(type: #export (Env r a)
- {#;doc "Computations that have access to some environmental value."}
- (-> r a))
-
-## [Structures]
-(struct: #export Functor<Env> (All [r] (Functor (Env r)))
- (def: (map f fa)
- (lambda [env]
- (f (fa env)))))
-
-(struct: #export Applicative<Env> (All [r] (Applicative (Env r)))
- (def: functor Functor<Env>)
-
- (def: (wrap x)
- (lambda [env] x))
-
- (def: (apply ff fa)
- (lambda [env]
- ((ff env) (fa env)))))
-
-(struct: #export Monad<Env> (All [r] (Monad (Env r)))
- (def: applicative Applicative<Env>)
-
- (def: (join mma)
- (lambda [env]
- (mma env env))))
-
-## [Values]
-(def: #export ask
- {#;doc "Get the environment."}
- (All [r] (Env r r))
- (lambda [env] env))
-
-(def: #export (local change env-proc)
- {#;doc "Run computation with a locally-modified environment."}
- (All [r a] (-> (-> r r) (Env r a) (Env r a)))
- (|>. change env-proc))
-
-(def: #export (run env env-proc)
- (All [r a] (-> r (Env r a) a))
- (env-proc env))
-
-(struct: #export (EnvT Monad<M>)
- {#;doc "Monad transformer for Env."}
- (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Env e (M a)))))))
- (def: applicative (compA Applicative<Env> (get@ #M;applicative Monad<M>)))
- (def: (join eMeMa)
- (lambda [env]
- (do Monad<M>
- [eMa (run env eMeMa)]
- (run env eMa)))))
-
-(def: #export lift-env
- {#;doc "Lift monadic values to the Env wrapper."}
- (All [M e a] (-> (M a) (Env e (M a))))
- (:: Monad<Env> wrap))
diff --git a/stdlib/source/lux/codata/reader.lux b/stdlib/source/lux/codata/reader.lux
new file mode 100644
index 000000000..955b4bba3
--- /dev/null
+++ b/stdlib/source/lux/codata/reader.lux
@@ -0,0 +1,63 @@
+(;module:
+ lux
+ (lux (control functor
+ applicative
+ ["M" monad #*])))
+
+## [Types]
+(type: #export (Reader r a)
+ {#;doc "Computations that have access to some environmental value."}
+ (-> r a))
+
+## [Structures]
+(struct: #export Functor<Reader> (All [r] (Functor (Reader r)))
+ (def: (map f fa)
+ (lambda [env]
+ (f (fa env)))))
+
+(struct: #export Applicative<Reader> (All [r] (Applicative (Reader r)))
+ (def: functor Functor<Reader>)
+
+ (def: (wrap x)
+ (lambda [env] x))
+
+ (def: (apply ff fa)
+ (lambda [env]
+ ((ff env) (fa env)))))
+
+(struct: #export Monad<Reader> (All [r] (Monad (Reader r)))
+ (def: applicative Applicative<Reader>)
+
+ (def: (join mma)
+ (lambda [env]
+ (mma env env))))
+
+## [Values]
+(def: #export ask
+ {#;doc "Get the environment."}
+ (All [r] (Reader r r))
+ (lambda [env] env))
+
+(def: #export (local change reader-proc)
+ {#;doc "Run computation with a locally-modified environment."}
+ (All [r a] (-> (-> r r) (Reader r a) (Reader r a)))
+ (|>. change reader-proc))
+
+(def: #export (run env reader-proc)
+ (All [r a] (-> r (Reader r a) a))
+ (reader-proc env))
+
+(struct: #export (ReaderT Monad<M>)
+ {#;doc "Monad transformer for Reader."}
+ (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a)))))))
+ (def: applicative (compA Applicative<Reader> (get@ #M;applicative Monad<M>)))
+ (def: (join eMeMa)
+ (lambda [env]
+ (do Monad<M>
+ [eMa (run env eMeMa)]
+ (run env eMa)))))
+
+(def: #export lift-reader
+ {#;doc "Lift monadic values to the Reader wrapper."}
+ (All [M e a] (-> (M a) (Reader e (M a))))
+ (:: Monad<Reader> wrap))
diff --git a/stdlib/source/lux/control/enum.lux b/stdlib/source/lux/control/enum.lux
index c91b5b9ea..5cd20c1a2 100644
--- a/stdlib/source/lux/control/enum.lux
+++ b/stdlib/source/lux/control/enum.lux
@@ -1,10 +1,10 @@
(;module: lux
- (lux/control [ord]))
+ (lux/control [order]))
## [Signatures]
(sig: #export (Enum e)
{#;doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."}
- (: (ord;Ord e) ord)
+ (: (order;Order e) order)
(: (-> e e) succ)
(: (-> e e) pred))
diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux
index 3532e0633..416223cd7 100644
--- a/stdlib/source/lux/control/functor.lux
+++ b/stdlib/source/lux/control/functor.lux
@@ -8,6 +8,15 @@
(type: #export (Fix f)
(f (Fix f)))
+(type: #export (<&> f g)
+ (All [a] (& (f a) (g a))))
+
+(type: #export (<|> f g)
+ (All [a] (| (f a) (g a))))
+
+(type: #export (<.> f g)
+ (All [a] (f (g a))))
+
(struct: #export (compF Functor<F> Functor<G>)
{#;doc "Functor composition."}
(All [F G] (-> (Functor F) (Functor G) (Functor (All [a] (F (G a))))))
diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux
index 1b197840b..c007477b4 100644
--- a/stdlib/source/lux/control/interval.lux
+++ b/stdlib/source/lux/control/interval.lux
@@ -1,7 +1,7 @@
(;module:
lux
(lux (control eq
- [ord]
+ [order]
[enum #+ Enum])))
## Signatures
@@ -72,14 +72,14 @@
(def: #export (union left right)
(All [a] (-> (Interval a) (Interval a) (Interval a)))
(struct (def: enum (get@ #enum right))
- (def: bottom (ord;min (get@ [#enum #enum;ord] right) (:: left bottom) (:: right bottom)))
- (def: top (ord;max (get@ [#enum #enum;ord] right) (:: left top) (:: right top)))))
+ (def: bottom (order;min (get@ [#enum #enum;order] right) (:: left bottom) (:: right bottom)))
+ (def: top (order;max (get@ [#enum #enum;order] right) (:: left top) (:: right top)))))
(def: #export (intersection left right)
(All [a] (-> (Interval a) (Interval a) (Interval a)))
(struct (def: enum (get@ #enum right))
- (def: bottom (ord;max (get@ [#enum #enum;ord] right) (:: left bottom) (:: right bottom)))
- (def: top (ord;min (get@ [#enum #enum;ord] right) (:: left top) (:: right top)))))
+ (def: bottom (order;max (get@ [#enum #enum;order] right) (:: left bottom) (:: right bottom)))
+ (def: top (order;min (get@ [#enum #enum;order] right) (:: left top) (:: right top)))))
(def: #export (complement interval)
(All [a] (-> (Interval a) (Interval a)))
diff --git a/stdlib/source/lux/control/ord.lux b/stdlib/source/lux/control/ord.lux
deleted file mode 100644
index 8b2875e25..000000000
--- a/stdlib/source/lux/control/ord.lux
+++ /dev/null
@@ -1,44 +0,0 @@
-(;module:
- lux
- (.. eq)
- lux/codata/function)
-
-## [Signatures]
-(sig: #export (Ord a)
- {#;doc "A signature for types that possess some sense of ordering among their elements."}
-
- (: (Eq a)
- eq)
-
- (do-template [<name>]
- [(: (-> a a Bool) <name>)]
-
- [<] [<=] [>] [>=]
- )
- )
-
-## [Values]
-(def: #export (ord eq <)
- (All [a]
- (-> (Eq a) (-> a a Bool) (Ord a)))
- (let [> (flip <)]
- (struct
- (def: eq eq)
- (def: < <)
- (def: (<= test subject)
- (or (< test subject)
- (:: eq = test subject)))
- (def: > >)
- (def: (>= test subject)
- (or (> test subject)
- (:: eq = test subject))))))
-
-(do-template [<name> <op>]
- [(def: #export (<name> ord x y)
- (All [a]
- (-> (Ord a) a a a))
- (if (:: ord <op> y x) x y))]
-
- [max >]
- [min <]
- )
diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux
new file mode 100644
index 000000000..153100cff
--- /dev/null
+++ b/stdlib/source/lux/control/order.lux
@@ -0,0 +1,44 @@
+(;module:
+ lux
+ (.. eq)
+ lux/codata/function)
+
+## [Signatures]
+(sig: #export (Order a)
+ {#;doc "A signature for types that possess some sense of ordering among their elements."}
+
+ (: (Eq a)
+ eq)
+
+ (do-template [<name>]
+ [(: (-> a a Bool) <name>)]
+
+ [<] [<=] [>] [>=]
+ )
+ )
+
+## [Values]
+(def: #export (order eq <)
+ (All [a]
+ (-> (Eq a) (-> a a Bool) (Order a)))
+ (let [> (flip <)]
+ (struct
+ (def: eq eq)
+ (def: < <)
+ (def: (<= test subject)
+ (or (< test subject)
+ (:: eq = test subject)))
+ (def: > >)
+ (def: (>= test subject)
+ (or (> test subject)
+ (:: eq = test subject))))))
+
+(do-template [<name> <op>]
+ [(def: #export (<name> order x y)
+ (All [a]
+ (-> (Order a) a a a))
+ (if (:: order <op> y x) x y))]
+
+ [max >]
+ [min <]
+ )
diff --git a/stdlib/source/lux/data/char.lux b/stdlib/source/lux/data/char.lux
index 0db90898e..06efa3f64 100644
--- a/stdlib/source/lux/data/char.lux
+++ b/stdlib/source/lux/data/char.lux
@@ -1,7 +1,7 @@
(;module:
lux
(lux/control eq
- [ord]
+ [order]
codec
hash)
(.. [text "Text/" Monoid<Text>]))
@@ -16,7 +16,7 @@
(def: (hash input)
(_lux_proc ["char" "to-nat"] [input])))
-(struct: #export _ (ord;Ord Char)
+(struct: #export _ (order;Order Char)
(def: eq Eq<Char>)
(def: (< test subject)
diff --git a/stdlib/source/lux/data/coll/ordered.lux b/stdlib/source/lux/data/coll/ordered.lux
index 1db97519b..37fbb1505 100644
--- a/stdlib/source/lux/data/coll/ordered.lux
+++ b/stdlib/source/lux/data/coll/ordered.lux
@@ -2,7 +2,7 @@
lux
(lux (control monad
eq
- [ord #+ Ord])
+ [order #+ Order])
(data (coll [list "" Monad<List> "L/" Monoid<List> Fold<List>])
["p" product]
["M" maybe #+ Functor<Maybe>])
@@ -33,12 +33,12 @@
)
(type: #export (Set a)
- {#order (Ord a)
+ {#order (Order a)
#root (Maybe (Node a))})
-(def: #export (new Ord<a>)
- (All [a] (-> (Ord a) (Set a)))
- {#order Ord<a>
+(def: #export (new Order<a>)
+ (All [a] (-> (Order a) (Set a)))
+ {#order Order<a>
#root #;None})
(def: #export (member? tree elem)
@@ -446,9 +446,9 @@
(set@ #root (#;Some (blacken root)) tree)
)))
-(def: #export (from-list Ord<a> list)
- (All [a] (-> (Ord a) (List a) (Set a)))
- (L/fold add (new Ord<a>) list))
+(def: #export (from-list Order<a> list)
+ (All [a] (-> (Order a) (List a) (Set a)))
+ (L/fold add (new Order<a>) list))
(def: #export (to-list tree)
(All [a] (-> (Set a) (List a)))
@@ -489,5 +489,5 @@
(struct: #export Eq<Set> (All [a] (Eq (Set a)))
(def: (= reference sample)
- (:: (list;Eq<List> (get@ [#order #ord;eq] sample))
+ (:: (list;Eq<List> (get@ [#order #order;eq] sample))
= (to-list reference) (to-list sample))))
diff --git a/stdlib/source/lux/data/coll/seq.lux b/stdlib/source/lux/data/coll/seq.lux
index 0cf7029ea..1912a31a8 100644
--- a/stdlib/source/lux/data/coll/seq.lux
+++ b/stdlib/source/lux/data/coll/seq.lux
@@ -4,7 +4,6 @@
applicative
monad
eq
- [ord #+ Ord]
fold)
(data (coll ["L" list "L/" Monoid<List> Fold<List>]
(tree ["F" finger]))
diff --git a/stdlib/source/lux/data/coll/tree/finger.lux b/stdlib/source/lux/data/coll/tree/finger.lux
index 936b8cb89..e338b551e 100644
--- a/stdlib/source/lux/data/coll/tree/finger.lux
+++ b/stdlib/source/lux/data/coll/tree/finger.lux
@@ -1,7 +1,6 @@
(;module:
lux
- (lux (control monoid
- [ord #+ Ord])
+ (lux (control monoid)
(data text/format)))
(type: #export (Node m a)
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 9b828ec25..62c7abd6b 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -4,7 +4,7 @@
monoid
eq
hash
- [ord]
+ [order]
enum
interval
codec)
@@ -22,7 +22,7 @@
)
(do-template [<type> <eq> <lt> <lte> <gt> <gte>]
- [(struct: #export _ (ord;Ord <type>)
+ [(struct: #export _ (order;Order <type>)
(def: eq <eq>)
(def: < <lt>)
(def: <= <lte>)
@@ -49,7 +49,7 @@
_ +1))
)
-(do-template [<type> <ord> <+> <-> <*> </> <%> <=> <<> <0> <1> <-1>]
+(do-template [<type> <order> <+> <-> <*> </> <%> <=> <<> <0> <1> <-1>]
[(struct: #export _ (Number <type>)
(def: + <+>)
(def: - <->)
@@ -68,8 +68,8 @@
<1>))
)]
- [ Int Ord<Int> i.+ i.- i.* i./ i.% i.= i.< 0 1 -1]
- [Real Ord<Real> r.+ r.- r.* r./ r.% r.= r.< 0.0 1.0 -1.0]
+ [ Int Order<Int> i.+ i.- i.* i./ i.% i.= i.< 0 1 -1]
+ [Real Order<Real> r.+ r.- r.* r./ r.% r.= r.< 0.0 1.0 -1.0]
)
(struct: #export _ (Number Deg)
@@ -84,16 +84,16 @@
(_lux_proc ["deg" "max-value"] []))
)
-(do-template [<type> <ord> <succ> <pred>]
+(do-template [<type> <order> <succ> <pred>]
[(struct: #export _ (Enum <type>)
- (def: ord <ord>)
+ (def: order <order>)
(def: succ <succ>)
(def: pred <pred>))]
- [Nat Ord<Nat> n.inc n.dec]
- [Int Ord<Int> i.inc i.dec]
- [Real Ord<Real> (r.+ (_lux_proc [ "real" "smallest-value"] [])) (r.- (_lux_proc [ "real" "smallest-value"] []))]
- [Deg Ord<Deg> (d.+ (_lux_proc [ "deg" "min-value"] [])) (d.- (_lux_proc [ "deg" "min-value"] []))]
+ [Nat Order<Nat> n.inc n.dec]
+ [Int Order<Int> i.inc i.dec]
+ [Real Order<Real> (r.+ (_lux_proc [ "real" "smallest-value"] [])) (r.- (_lux_proc [ "real" "smallest-value"] []))]
+ [Deg Order<Deg> (d.+ (_lux_proc [ "deg" "min-value"] [])) (d.- (_lux_proc [ "deg" "min-value"] []))]
)
(do-template [<type> <enum> <top> <bottom>]
@@ -144,7 +144,6 @@
#;None
(#;Left <error>))))]
- [ Int [ "int" "encode"] [ "int" "decode"] "Couldn't decode Int"]
[ Deg [ "deg" "encode"] [ "deg" "decode"] "Couldn't decode Deg"]
[Real ["real" "encode"] ["real" "decode"] "Couldn't decode Real"]
)
@@ -167,6 +166,45 @@
"7" (#;Some +7) "8" (#;Some +8) "9" (#;Some +9)
_ #;None))
+(struct: #export _ (Codec Text Int)
+ (def: (encode value)
+ (if (i.= 0 value)
+ "0"
+ (let [sign (if (i.> 0 value)
+ ""
+ "-")]
+ (loop [input (|> value (i./ 10) (:: Number<Int> abs))
+ output (|> value (i.% 10) (:: Number<Int> abs) int-to-nat digit-to-text)]
+ (if (i.= 0 input)
+ (_lux_proc ["text" "append"] [sign output])
+ (recur (i./ 10 input)
+ (_lux_proc ["text" "append"] [(|> input (i.% 10) int-to-nat digit-to-text)
+ output])))))
+ ))
+
+ (def: (decode repr)
+ (let [input-size (_lux_proc ["text" "size"] [repr])]
+ (if (n.>= +1 input-size)
+ (let [sign (case (_lux_proc ["text" "char"] [repr +0])
+ (#;Some #"-")
+ -1
+
+ _
+ 1)]
+ (loop [idx (if (i.= -1 sign) +1 +0)
+ output 0]
+ (if (n.< input-size idx)
+ (case (_lux_proc ["text" "char"] [repr idx])
+ (^=> (#;Some sample)
+ [(text-to-digit (_lux_proc ["char" "to-text"] [sample])) (#;Some digit)])
+ (recur (n.inc idx)
+ (|> output (i.* 10) (i.+ (nat-to-int digit))))
+
+ _
+ (undefined))
+ (#;Right (i.* sign output)))))
+ (#;Left "Invalid syntax for Int.")))))
+
(struct: #export _ (Codec Text Nat)
(def: (encode value)
(case value
@@ -200,8 +238,8 @@
(#;Right output)))
_
- (#;Left "Invalid binary syntax."))
- (#;Left "Invalid binary syntax.")))))
+ (#;Left "Invalid syntax for Nat."))
+ (#;Left "Invalid syntax for Nat.")))))
(struct: #export _ (Hash Nat)
(def: eq Eq<Nat>)
diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux
index 87b1a7d18..f9289c682 100644
--- a/stdlib/source/lux/data/number/complex.lux
+++ b/stdlib/source/lux/data/number/complex.lux
@@ -2,7 +2,6 @@
lux
(lux [math]
(control eq
- [ord]
number
codec
monad)
diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux
index fb86b1fed..52fa2c2a9 100644
--- a/stdlib/source/lux/data/number/ratio.lux
+++ b/stdlib/source/lux/data/number/ratio.lux
@@ -2,7 +2,7 @@
lux
(lux [math]
(control eq
- [ord]
+ [order]
number
codec
monad)
@@ -101,7 +101,7 @@
(struct: #export _ (Eq Ratio)
(def: = q.=))
-(struct: #export _ (ord;Ord Ratio)
+(struct: #export _ (order;Order Ratio)
(def: eq Eq<Ratio>)
(def: < q.<)
(def: <= q.<=)
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 4869d9e82..0f9e79ba6 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -2,7 +2,7 @@
lux
(lux (control monoid
eq
- [ord]
+ [order]
monad
codec
hash)
@@ -109,7 +109,7 @@
(def: (= test subject)
(_lux_proc ["text" "="] [subject test])))
-(struct: #export _ (ord;Ord Text)
+(struct: #export _ (order;Order Text)
(def: eq Eq<Text>)
(def: (< test subject)
diff --git a/stdlib/source/lux/lexer.lux b/stdlib/source/lux/lexer.lux
index e33afa5b7..e28cb0a68 100644
--- a/stdlib/source/lux/lexer.lux
+++ b/stdlib/source/lux/lexer.lux
@@ -7,7 +7,7 @@
(data [text "Text/" Eq<Text> Monoid<Text>]
[number "Int/" Codec<Text,Int>]
[product]
- [char "Char/" Ord<Char>]
+ [char "Char/" Order<Char>]
maybe
["E" error #- fail]
(coll [list "" Functor<List>]))))
diff --git a/stdlib/test/test/lux/codata/env.lux b/stdlib/test/test/lux/codata/env.lux
deleted file mode 100644
index bac90d3b0..000000000
--- a/stdlib/test/test/lux/codata/env.lux
+++ /dev/null
@@ -1,38 +0,0 @@
-(;module:
- lux
- (lux [io]
- (control monad)
- (data [text "Text/" Monoid<Text>]
- text/format
- [number])
- (codata function
- ["&" env])
- pipe)
- lux/test)
-
-(test: "Envs"
- ($_ seq
- (assert "" (i.= 123 (&;run 123 &;ask)))
- (assert "" (i.= 246 (&;run 123 (&;local (i.* 2) &;ask))))
- (assert "" (i.= 134 (&;run 123 (:: &;Functor<Env> map i.inc (i.+ 10)))))
- (assert "" (i.= 10 (&;run 123 (:: &;Applicative<Env> wrap 10))))
- (assert "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative<Env>]
- (&/apply (&/wrap (i.+ 10)) (&/wrap 20))))))
- (assert "" (i.= 30 (&;run 123 (do &;Monad<Env>
- [f (wrap i.+)
- x (wrap 10)
- y (wrap 20)]
- (wrap (f x y))))))))
-
-(test: "Monad transformer"
- (let [(^open "io/") io;Monad<IO>]
- (assert "Can add env functionality to any monad."
- (|> (do (&;EnvT io;Monad<IO>)
- [a (&;lift-env (io/wrap 123))
- b (wrap 456)]
- (wrap (i.+ a b)))
- (&;run "")
- io;run
- (case> 579 true
- _ false)))
- ))
diff --git a/stdlib/test/test/lux/codata/reader.lux b/stdlib/test/test/lux/codata/reader.lux
new file mode 100644
index 000000000..021ee1ab9
--- /dev/null
+++ b/stdlib/test/test/lux/codata/reader.lux
@@ -0,0 +1,38 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad)
+ (data [text "Text/" Monoid<Text>]
+ text/format
+ [number])
+ (codata function
+ ["&" reader])
+ pipe)
+ lux/test)
+
+(test: "Readers"
+ ($_ seq
+ (assert "" (i.= 123 (&;run 123 &;ask)))
+ (assert "" (i.= 246 (&;run 123 (&;local (i.* 2) &;ask))))
+ (assert "" (i.= 134 (&;run 123 (:: &;Functor<Reader> map i.inc (i.+ 10)))))
+ (assert "" (i.= 10 (&;run 123 (:: &;Applicative<Reader> wrap 10))))
+ (assert "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative<Reader>]
+ (&/apply (&/wrap (i.+ 10)) (&/wrap 20))))))
+ (assert "" (i.= 30 (&;run 123 (do &;Monad<Reader>
+ [f (wrap i.+)
+ x (wrap 10)
+ y (wrap 20)]
+ (wrap (f x y))))))))
+
+(test: "Monad transformer"
+ (let [(^open "io/") io;Monad<IO>]
+ (assert "Can add reader functionality to any monad."
+ (|> (do (&;ReaderT io;Monad<IO>)
+ [a (&;lift-reader (io/wrap 123))
+ b (wrap 456)]
+ (wrap (i.+ a b)))
+ (&;run "")
+ io;run
+ (case> 579 true
+ _ false)))
+ ))
diff --git a/stdlib/test/test/lux/data/char.lux b/stdlib/test/test/lux/data/char.lux
index 6b7175de7..5025a1283 100644
--- a/stdlib/test/test/lux/data/char.lux
+++ b/stdlib/test/test/lux/data/char.lux
@@ -33,9 +33,9 @@
(:: Eq<Char> = value))))
(assert "Characters have an ordering relationship."
- (if (:: Ord<Char> < other value)
- (:: Ord<Char> > value other)
- (:: Ord<Char> >= other value)))
+ (if (:: Order<Char> < other value)
+ (:: Order<Char> > value other)
+ (:: Order<Char> >= other value)))
))
(test: "Special cases"
diff --git a/stdlib/test/test/lux/data/coll/ordered.lux b/stdlib/test/test/lux/data/coll/ordered.lux
index 213a568c1..ffc2bf309 100644
--- a/stdlib/test/test/lux/data/coll/ordered.lux
+++ b/stdlib/test/test/lux/data/coll/ordered.lux
@@ -20,9 +20,9 @@
[sizeL gen-nat
sizeR gen-nat
setL (|> (R;set number;Hash<Nat> sizeL gen-nat)
- (:: @ map (|>. S;to-list (&;from-list number;Ord<Nat>))))
+ (:: @ map (|>. S;to-list (&;from-list number;Order<Nat>))))
setR (|> (R;set number;Hash<Nat> sizeR gen-nat)
- (:: @ map (|>. S;to-list (&;from-list number;Ord<Nat>))))
+ (:: @ map (|>. S;to-list (&;from-list number;Order<Nat>))))
#let [(^open "&/") &;Eq<Set>]]
($_ seq
(assert "I can query the size of a set."
@@ -30,7 +30,7 @@
(assert "Converting sets to/from lists can't change their values."
(|> setL
- &;to-list (&;from-list number;Ord<Nat>)
+ &;to-list (&;from-list number;Order<Nat>)
(&/= setL)))
(assert "Order is preserved."
@@ -51,11 +51,11 @@
(assert "Union with the empty set leaves a set unchanged."
(&/= setL
- (&;union (&;new number;Ord<Nat>)
+ (&;union (&;new number;Order<Nat>)
setL)))
(assert "Intersection with the empty set results in the empty set."
- (let [empty-set (&;new number;Ord<Nat>)]
+ (let [empty-set (&;new number;Order<Nat>)]
(&/= empty-set
(&;intersection empty-set setL))))
diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux
index 8424c82a3..ad89649ba 100644
--- a/stdlib/test/test/lux/data/number.lux
+++ b/stdlib/test/test/lux/data/number.lux
@@ -9,26 +9,26 @@
pipe)
lux/test)
-(do-template [category rand-gen <Eq> <Ord>]
- [(test: (format "[" category "] " "Eq & Ord")
+(do-template [category rand-gen <Eq> <Order>]
+ [(test: (format "[" category "] " "Eq & Order")
[x rand-gen
y rand-gen]
(assert "" (and (:: <Eq> = x x)
(or (:: <Eq> = x y)
- (:: <Ord> < y x)
- (:: <Ord> > y x)))))]
+ (:: <Order> < y x)
+ (:: <Order> > y x)))))]
- ["Nat" R;nat Eq<Nat> Ord<Nat>]
- ["Int" R;int Eq<Int> Ord<Int>]
- ["Real" R;real Eq<Real> Ord<Real>]
- ["Deg" R;deg Eq<Deg> Ord<Deg>]
+ ["Nat" R;nat Eq<Nat> Order<Nat>]
+ ["Int" R;int Eq<Int> Order<Int>]
+ ["Real" R;real Eq<Real> Order<Real>]
+ ["Deg" R;deg Eq<Deg> Order<Deg>]
)
-(do-template [category rand-gen <Number> <Ord>]
+(do-template [category rand-gen <Number> <Order>]
[(test: (format "[" category "] " "Number")
[x rand-gen
#let [(^open) <Number>
- (^open) <Ord>]]
+ (^open) <Order>]]
(assert "" (and (>= x (abs x))
## abs(0.0) == 0.0 && negate(abs(0.0)) == -0.0
(or (Text/= "Real" category)
@@ -40,16 +40,16 @@
(abs x)))))))]
## ["Nat" R;nat Number<Nat>]
- ["Int" R;int Number<Int> Ord<Int>]
- ["Real" R;real Number<Real> Ord<Real>]
- ["Deg" R;deg Number<Deg> Ord<Deg>]
+ ["Int" R;int Number<Int> Order<Int>]
+ ["Real" R;real Number<Real> Order<Real>]
+ ["Deg" R;deg Number<Deg> Order<Deg>]
)
-(do-template [category rand-gen <Enum> <Number> <Ord>]
+(do-template [category rand-gen <Enum> <Number> <Order>]
[(test: (format "[" category "] " "Enum")
[x rand-gen]
(assert "" (let [(^open) <Number>
- (^open) <Ord>]
+ (^open) <Order>]
(and (> x
(:: <Enum> succ x))
(< x
@@ -61,52 +61,52 @@
(|> x (:: <Enum> succ) (:: <Enum> pred)))
))))]
- ["Nat" R;nat Enum<Nat> Number<Nat> Ord<Nat>]
- ["Int" R;int Enum<Int> Number<Int> Ord<Int>]
+ ["Nat" R;nat Enum<Nat> Number<Nat> Order<Nat>]
+ ["Int" R;int Enum<Int> Number<Int> Order<Int>]
)
-(do-template [category rand-gen <Number> <Ord> <Interval> <test>]
+(do-template [category rand-gen <Number> <Order> <Interval> <test>]
[(test: (format "[" category "] " "Interval")
[x (|> rand-gen (R;filter <test>))
#let [(^open) <Number>
- (^open) <Ord>]]
+ (^open) <Order>]]
(assert "" (and (<= x (:: <Interval> bottom))
(>= x (:: <Interval> top)))))]
- ["Nat" R;nat Number<Nat> Ord<Nat> Interval<Nat> (lambda [_] true)]
- ["Int" R;int Number<Int> Ord<Int> Interval<Int> (lambda [_] true)]
+ ["Nat" R;nat Number<Nat> Order<Nat> Interval<Nat> (lambda [_] true)]
+ ["Int" R;int Number<Int> Order<Int> Interval<Int> (lambda [_] true)]
## Both min and max values will be positive (thus, greater than zero)
- ["Real" R;real Number<Real> Ord<Real> Interval<Real> (r.> 0.0)]
- ["Deg" R;deg Number<Deg> Ord<Deg> Interval<Deg> (lambda [_] true)]
+ ["Real" R;real Number<Real> Order<Real> Interval<Real> (r.> 0.0)]
+ ["Deg" R;deg Number<Deg> Order<Deg> Interval<Deg> (lambda [_] true)]
)
-(do-template [category rand-gen <Number> <Ord> <Monoid> <cap> <test>]
+(do-template [category rand-gen <Number> <Order> <Monoid> <cap> <test>]
[(test: (format "[" category "] " "Monoid")
[x (|> rand-gen (:: @ map (|>. (:: <Number> abs) <cap>)) (R;filter <test>))
#let [(^open) <Number>
- (^open) <Ord>
+ (^open) <Order>
(^open) <Monoid>]]
(assert "Appending to unit doesn't change the value."
(and (= x (append unit x))
(= x (append x unit))
(= unit (append unit unit)))))]
- ["Nat/Add" R;nat Number<Nat> Ord<Nat> Add@Monoid<Nat> (n.% +1000) (lambda [_] true)]
- ["Nat/Mul" R;nat Number<Nat> Ord<Nat> Mul@Monoid<Nat> (n.% +1000) (lambda [_] true)]
- ["Nat/Min" R;nat Number<Nat> Ord<Nat> Min@Monoid<Nat> (n.% +1000) (lambda [_] true)]
- ["Nat/Max" R;nat Number<Nat> Ord<Nat> Max@Monoid<Nat> (n.% +1000) (lambda [_] true)]
- ["Int/Add" R;int Number<Int> Ord<Int> Add@Monoid<Int> (i.% 1000) (lambda [_] true)]
- ["Int/Mul" R;int Number<Int> Ord<Int> Mul@Monoid<Int> (i.% 1000) (lambda [_] true)]
- ["Int/Min" R;int Number<Int> Ord<Int> Min@Monoid<Int> (i.% 1000) (lambda [_] true)]
- ["Int/Max" R;int Number<Int> Ord<Int> Max@Monoid<Int> (i.% 1000) (lambda [_] true)]
- ["Real/Add" R;real Number<Real> Ord<Real> Add@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
- ["Real/Mul" R;real Number<Real> Ord<Real> Mul@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
- ["Real/Min" R;real Number<Real> Ord<Real> Min@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
- ["Real/Max" R;real Number<Real> Ord<Real> Max@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
- ["Deg/Add" R;deg Number<Deg> Ord<Deg> Add@Monoid<Deg> (d.% .125) (lambda [_] true)]
- ## ["Deg/Mul" R;deg Number<Deg> Ord<Deg> Mul@Monoid<Deg> (d.% .125) (lambda [_] true)]
- ["Deg/Min" R;deg Number<Deg> Ord<Deg> Min@Monoid<Deg> (d.% .125) (lambda [_] true)]
- ["Deg/Max" R;deg Number<Deg> Ord<Deg> Max@Monoid<Deg> (d.% .125) (lambda [_] true)]
+ ["Nat/Add" R;nat Number<Nat> Order<Nat> Add@Monoid<Nat> (n.% +1000) (lambda [_] true)]
+ ["Nat/Mul" R;nat Number<Nat> Order<Nat> Mul@Monoid<Nat> (n.% +1000) (lambda [_] true)]
+ ["Nat/Min" R;nat Number<Nat> Order<Nat> Min@Monoid<Nat> (n.% +1000) (lambda [_] true)]
+ ["Nat/Max" R;nat Number<Nat> Order<Nat> Max@Monoid<Nat> (n.% +1000) (lambda [_] true)]
+ ["Int/Add" R;int Number<Int> Order<Int> Add@Monoid<Int> (i.% 1000) (lambda [_] true)]
+ ["Int/Mul" R;int Number<Int> Order<Int> Mul@Monoid<Int> (i.% 1000) (lambda [_] true)]
+ ["Int/Min" R;int Number<Int> Order<Int> Min@Monoid<Int> (i.% 1000) (lambda [_] true)]
+ ["Int/Max" R;int Number<Int> Order<Int> Max@Monoid<Int> (i.% 1000) (lambda [_] true)]
+ ["Real/Add" R;real Number<Real> Order<Real> Add@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
+ ["Real/Mul" R;real Number<Real> Order<Real> Mul@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
+ ["Real/Min" R;real Number<Real> Order<Real> Min@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
+ ["Real/Max" R;real Number<Real> Order<Real> Max@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
+ ["Deg/Add" R;deg Number<Deg> Order<Deg> Add@Monoid<Deg> (d.% .125) (lambda [_] true)]
+ ## ["Deg/Mul" R;deg Number<Deg> Order<Deg> Mul@Monoid<Deg> (d.% .125) (lambda [_] true)]
+ ["Deg/Min" R;deg Number<Deg> Order<Deg> Min@Monoid<Deg> (d.% .125) (lambda [_] true)]
+ ["Deg/Max" R;deg Number<Deg> Order<Deg> Max@Monoid<Deg> (d.% .125) (lambda [_] true)]
)
(do-template [<category> <rand-gen> <Eq> <Codec>]
diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux
index 72e633847..ce72cd520 100644
--- a/stdlib/test/test/lux/data/text.lux
+++ b/stdlib/test/test/lux/data/text.lux
@@ -127,7 +127,7 @@
)))
(test: "Structures"
- (let [(^open "&/") &;Ord<Text>]
+ (let [(^open "&/") &;Order<Text>]
($_ seq
(assert "" (&/< "bcd" "abc"))
(assert "" (not (&/< "abc" "abc")))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 2a7615dac..53a003756 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -13,7 +13,7 @@
["_;" lexer]
(lexer ["_;" regex])
(codata ["_;" cont]
- ["_;" env]
+ ["_;" reader]
["_;" state]
["_;" thunk]
(coll ["_;" stream]))
--
cgit v1.2.3