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. --- luxc/src/lux/analyser/proc/common.clj | 3 - luxc/src/lux/compiler/js/proc/common.clj | 5 - luxc/src/lux/compiler/js/rt.clj | 65 ----------- luxc/src/lux/compiler/jvm/proc/common.clj | 3 - 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 +- 28 files changed, 366 insertions(+), 391 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 diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 2bd6ba648..842efc9c5 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -254,7 +254,6 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ) (&/|list =x) (&/|list))))))))) - ^:private analyse-int-encode ["int" "encode"] ^:private analyse-int-decode ["int" "decode"] &type/Int ^:private analyse-deg-encode ["deg" "encode"] ^:private analyse-deg-decode ["deg" "decode"] &type/Deg ^:private analyse-real-encode ["real" "encode"] ^:private analyse-real-decode ["real" "decode"] &type/Real ) @@ -558,8 +557,6 @@ "%" (analyse-int-rem analyse exo-type ?values) "=" (analyse-int-eq analyse exo-type ?values) "<" (analyse-int-lt analyse exo-type ?values) - "encode" (analyse-int-encode analyse exo-type ?values) - "decode" (analyse-int-decode analyse exo-type ?values) "min-value" (analyse-int-min-value analyse exo-type ?values) "max-value" (analyse-int-max-value analyse exo-type ?values) "to-nat" (analyse-int-to-nat analyse exo-type ?values) diff --git a/luxc/src/lux/compiler/js/proc/common.clj b/luxc/src/lux/compiler/js/proc/common.clj index 130dbb298..4fdff5f21 100644 --- a/luxc/src/lux/compiler/js/proc/common.clj +++ b/luxc/src/lux/compiler/js/proc/common.clj @@ -148,10 +148,7 @@ (return (str "LuxRT$" "(" =x ")")) )) - ^:private compile-int-encode "encodeI64" ^:private compile-deg-encode "encodeD64" - - ^:private compile-int-decode "decodeI64" ^:private compile-deg-decode "decodeD64" ^:private compile-real-decode "decodeReal" @@ -514,8 +511,6 @@ "%" (compile-int-rem compile ?values special-args) "=" (compile-int-eq compile ?values special-args) "<" (compile-int-lt compile ?values special-args) - "encode" (compile-int-encode compile ?values special-args) - "decode" (compile-int-decode compile ?values special-args) "max-value" (compile-int-max-value compile ?values special-args) "min-value" (compile-int-min-value compile ?values special-args) "to-nat" (compile-int-to-nat compile ?values special-args) diff --git a/luxc/src/lux/compiler/js/rt.clj b/luxc/src/lux/compiler/js/rt.clj index 085cf5fe4..f17998871 100644 --- a/luxc/src/lux/compiler/js/rt.clj +++ b/luxc/src/lux/compiler/js/rt.clj @@ -283,71 +283,6 @@ "if(!ln && rn) { return false; }" "return (LuxRT$subI64(l,r).H < 0);" "})") - "encodeI64" (str "(function LuxRT$encodeI64(input) {" - ;; If input = 0 - (str "if((input.H === 0) && (input.L === 0)) {" - "return '0';" - "}") - ;; If input < 0 - (str "if(input.H < 0) {" - (str "if(LuxRT$eqI64(input,LuxRT$MIN_VALUE_I64)) {" - "var radix = LuxRT$makeI64(0,10);" - "var div = LuxRT$divI64(input,radix);" - "var rem = LuxRT$subI64(LuxRT$mulI64(div,radix),input);" - "return LuxRT$encodeI64(div).concat(rem.L+'');" - "}") - (str "else {" - "return '-'.concat(LuxRT$encodeI64(LuxRT$negateI64(input)));" - "}") - "}") - ;; If input > 0 - (str "var chunker = LuxRT$makeI64(0,1000000);" - "var rem = input;" - "var result = '';" - "while(true) {" - (str "var remDiv = LuxRT$divI64(rem,chunker);" - "var chunk = LuxRT$subI64(rem,LuxRT$mulI64(remDiv,chunker));" - "var digits = (chunk.L >>> 0)+'';" - "rem = remDiv;" - (str "if((rem.H === 0) && (rem.L === 0)) {" - "return digits.concat(result);" - "}" - "else {" - (str "while(digits.length < 6) {" - "digits = '0' + digits;" - "}") - "result = '' + digits + result;" - "}")) - "}") - "})") - "decodeI64" (str "(function LuxRT$decodeI64(input) {" - "input = LuxRT$clean_separators(input);" - (str "if(/^-?\\d+$/.exec(input)) {" - (str "var isNegative = (input.charAt(0) == '-');" - "var sign = isNegative ? -1 : 1;" - "input = isNegative ? input.substring(1) : input;" - - "var chunkPower = LuxRT$fromNumberI64(Math.pow(10, 8));" - "var result = LuxRT$ZERO;" - (str "for (var i = 0; i < input.length; i += 8) {" - "var size = Math.min(8, input.length - i);" - "var value = parseInt(input.substring(i, i + size), 10);" - (str "if (size < 8) {" - "var power = LuxRT$fromNumberI64(Math.pow(10, size));" - "result = LuxRT$addI64(LuxRT$mulI64(result,power),LuxRT$fromNumberI64(value));" - "}" - "else {" - "result = LuxRT$addI64(LuxRT$mulI64(result,chunkPower),LuxRT$fromNumberI64(value));" - "}") - "}") - "result = LuxRT$mulI64(result,LuxRT$fromNumberI64(sign));" - (str "return " (make-some "result") ";") - ) - "}" - "else {" - (str "return " const-none ";") - "}") - "})") }) (def ^:private n64-methods diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 5e1fe8a1a..311cbed87 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -421,7 +421,6 @@ (.visitMethodInsn Opcodes/INVOKESTATIC "toString" ))]] (return nil))) - ^:private compile-int-encode "java/lang/Long" "(J)Ljava/lang/String;" &&/unwrap-long ^:private compile-real-encode "java/lang/Double" "(D)Ljava/lang/String;" &&/unwrap-double ) @@ -982,8 +981,6 @@ "min-value" (compile-int-min-value compile ?values special-args) "to-nat" (compile-int-to-nat compile ?values special-args) "to-real" (compile-int-to-real compile ?values special-args) - "encode" (compile-int-encode compile ?values special-args) - "decode" (compile-int-decode compile ?values special-args) ) "real" 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 [ ] @@ -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 (All [r] (Functor (Env r))) - (def: (map f fa) - (lambda [env] - (f (fa env))))) - -(struct: #export Applicative (All [r] (Applicative (Env r))) - (def: functor Functor) - - (def: (wrap x) - (lambda [env] x)) - - (def: (apply ff fa) - (lambda [env] - ((ff env) (fa env))))) - -(struct: #export Monad (All [r] (Monad (Env r))) - (def: applicative Applicative) - - (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) - {#;doc "Monad transformer for Env."} - (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Env e (M a))))))) - (def: applicative (compA Applicative (get@ #M;applicative Monad))) - (def: (join eMeMa) - (lambda [env] - (do Monad - [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 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 (All [r] (Functor (Reader r))) + (def: (map f fa) + (lambda [env] + (f (fa env))))) + +(struct: #export Applicative (All [r] (Applicative (Reader r))) + (def: functor Functor) + + (def: (wrap x) + (lambda [env] x)) + + (def: (apply ff fa) + (lambda [env] + ((ff env) (fa env))))) + +(struct: #export Monad (All [r] (Monad (Reader r))) + (def: applicative Applicative) + + (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) + {#;doc "Monad transformer for Reader."} + (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) + (def: applicative (compA Applicative (get@ #M;applicative Monad))) + (def: (join eMeMa) + (lambda [env] + (do Monad + [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 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 Functor) {#;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 [] - [(: (-> a a Bool) )] - - [<] [<=] [>] [>=] - ) - ) - -## [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 [ ] - [(def: #export ( ord x y) - (All [a] - (-> (Ord a) a a a)) - (if (:: ord 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 [] + [(: (-> a a Bool) )] + + [<] [<=] [>] [>=] + ) + ) + +## [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 [ ] + [(def: #export ( order x y) + (All [a] + (-> (Order a) a a a)) + (if (:: order 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])) @@ -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) (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 "L/" Monoid Fold]) ["p" product] ["M" maybe #+ Functor]) @@ -33,12 +33,12 @@ ) (type: #export (Set a) - {#order (Ord a) + {#order (Order a) #root (Maybe (Node a))}) -(def: #export (new Ord) - (All [a] (-> (Ord a) (Set a))) - {#order Ord +(def: #export (new Order) + (All [a] (-> (Order a) (Set a))) + {#order Order #root #;None}) (def: #export (member? tree elem) @@ -446,9 +446,9 @@ (set@ #root (#;Some (blacken root)) tree) ))) -(def: #export (from-list Ord list) - (All [a] (-> (Ord a) (List a) (Set a))) - (L/fold add (new Ord) list)) +(def: #export (from-list Order list) + (All [a] (-> (Order a) (List a) (Set a))) + (L/fold add (new Order) list)) (def: #export (to-list tree) (All [a] (-> (Set a) (List a))) @@ -489,5 +489,5 @@ (struct: #export Eq (All [a] (Eq (Set a))) (def: (= reference sample) - (:: (list;Eq (get@ [#order #ord;eq] sample)) + (:: (list;Eq (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 Fold] (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 [ ] - [(struct: #export _ (ord;Ord ) + [(struct: #export _ (order;Order ) (def: eq ) (def: < ) (def: <= ) @@ -49,7 +49,7 @@ _ +1)) ) -(do-template [ <+> <-> <*> <%> <=> <<> <0> <1> <-1>] +(do-template [ <+> <-> <*> <%> <=> <<> <0> <1> <-1>] [(struct: #export _ (Number ) (def: + <+>) (def: - <->) @@ -68,8 +68,8 @@ <1>)) )] - [ Int Ord i.+ i.- i.* i./ i.% i.= i.< 0 1 -1] - [Real Ord r.+ r.- r.* r./ r.% r.= r.< 0.0 1.0 -1.0] + [ Int Order i.+ i.- i.* i./ i.% i.= i.< 0 1 -1] + [Real Order 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 [ ] +(do-template [ ] [(struct: #export _ (Enum ) - (def: ord ) + (def: order ) (def: succ ) (def: pred ))] - [Nat Ord n.inc n.dec] - [Int Ord i.inc i.dec] - [Real Ord (r.+ (_lux_proc [ "real" "smallest-value"] [])) (r.- (_lux_proc [ "real" "smallest-value"] []))] - [Deg Ord (d.+ (_lux_proc [ "deg" "min-value"] [])) (d.- (_lux_proc [ "deg" "min-value"] []))] + [Nat Order n.inc n.dec] + [Int Order i.inc i.dec] + [Real Order (r.+ (_lux_proc [ "real" "smallest-value"] [])) (r.- (_lux_proc [ "real" "smallest-value"] []))] + [Deg Order (d.+ (_lux_proc [ "deg" "min-value"] [])) (d.- (_lux_proc [ "deg" "min-value"] []))] ) (do-template [ ] @@ -144,7 +144,6 @@ #;None (#;Left ))))] - [ 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 abs)) + output (|> value (i.% 10) (:: Number 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) 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) (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) (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 Monoid] [number "Int/" Codec] [product] - [char "Char/" Ord] + [char "Char/" Order] maybe ["E" error #- fail] (coll [list "" Functor])))) 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/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 map i.inc (i.+ 10))))) - (assert "" (i.= 10 (&;run 123 (:: &;Applicative wrap 10)))) - (assert "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative] - (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) - (assert "" (i.= 30 (&;run 123 (do &;Monad - [f (wrap i.+) - x (wrap 10) - y (wrap 20)] - (wrap (f x y)))))))) - -(test: "Monad transformer" - (let [(^open "io/") io;Monad] - (assert "Can add env functionality to any monad." - (|> (do (&;EnvT io;Monad) - [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/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 map i.inc (i.+ 10))))) + (assert "" (i.= 10 (&;run 123 (:: &;Applicative wrap 10)))) + (assert "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative] + (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) + (assert "" (i.= 30 (&;run 123 (do &;Monad + [f (wrap i.+) + x (wrap 10) + y (wrap 20)] + (wrap (f x y)))))))) + +(test: "Monad transformer" + (let [(^open "io/") io;Monad] + (assert "Can add reader functionality to any monad." + (|> (do (&;ReaderT io;Monad) + [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 = value)))) (assert "Characters have an ordering relationship." - (if (:: Ord < other value) - (:: Ord > value other) - (:: Ord >= other value))) + (if (:: Order < other value) + (:: Order > value other) + (:: Order >= 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 sizeL gen-nat) - (:: @ map (|>. S;to-list (&;from-list number;Ord)))) + (:: @ map (|>. S;to-list (&;from-list number;Order)))) setR (|> (R;set number;Hash sizeR gen-nat) - (:: @ map (|>. S;to-list (&;from-list number;Ord)))) + (:: @ map (|>. S;to-list (&;from-list number;Order)))) #let [(^open "&/") &;Eq]] ($_ 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) + &;to-list (&;from-list number;Order) (&/= setL))) (assert "Order is preserved." @@ -51,11 +51,11 @@ (assert "Union with the empty set leaves a set unchanged." (&/= setL - (&;union (&;new number;Ord) + (&;union (&;new number;Order) setL))) (assert "Intersection with the empty set results in the empty set." - (let [empty-set (&;new number;Ord)] + (let [empty-set (&;new number;Order)] (&/= 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 ] - [(test: (format "[" category "] " "Eq & Ord") +(do-template [category rand-gen ] + [(test: (format "[" category "] " "Eq & Order") [x rand-gen y rand-gen] (assert "" (and (:: = x x) (or (:: = x y) - (:: < y x) - (:: > y x)))))] + (:: < y x) + (:: > y x)))))] - ["Nat" R;nat Eq Ord] - ["Int" R;int Eq Ord] - ["Real" R;real Eq Ord] - ["Deg" R;deg Eq Ord] + ["Nat" R;nat Eq Order] + ["Int" R;int Eq Order] + ["Real" R;real Eq Order] + ["Deg" R;deg Eq Order] ) -(do-template [category rand-gen ] +(do-template [category rand-gen ] [(test: (format "[" category "] " "Number") [x rand-gen #let [(^open) - (^open) ]] + (^open) ]] (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] - ["Int" R;int Number Ord] - ["Real" R;real Number Ord] - ["Deg" R;deg Number Ord] + ["Int" R;int Number Order] + ["Real" R;real Number Order] + ["Deg" R;deg Number Order] ) -(do-template [category rand-gen ] +(do-template [category rand-gen ] [(test: (format "[" category "] " "Enum") [x rand-gen] (assert "" (let [(^open) - (^open) ] + (^open) ] (and (> x (:: succ x)) (< x @@ -61,52 +61,52 @@ (|> x (:: succ) (:: pred))) ))))] - ["Nat" R;nat Enum Number Ord] - ["Int" R;int Enum Number Ord] + ["Nat" R;nat Enum Number Order] + ["Int" R;int Enum Number Order] ) -(do-template [category rand-gen ] +(do-template [category rand-gen ] [(test: (format "[" category "] " "Interval") [x (|> rand-gen (R;filter )) #let [(^open) - (^open) ]] + (^open) ]] (assert "" (and (<= x (:: bottom)) (>= x (:: top)))))] - ["Nat" R;nat Number Ord Interval (lambda [_] true)] - ["Int" R;int Number Ord Interval (lambda [_] true)] + ["Nat" R;nat Number Order Interval (lambda [_] true)] + ["Int" R;int Number Order Interval (lambda [_] true)] ## Both min and max values will be positive (thus, greater than zero) - ["Real" R;real Number Ord Interval (r.> 0.0)] - ["Deg" R;deg Number Ord Interval (lambda [_] true)] + ["Real" R;real Number Order Interval (r.> 0.0)] + ["Deg" R;deg Number Order Interval (lambda [_] true)] ) -(do-template [category rand-gen ] +(do-template [category rand-gen ] [(test: (format "[" category "] " "Monoid") [x (|> rand-gen (:: @ map (|>. (:: abs) )) (R;filter )) #let [(^open) - (^open) + (^open) (^open) ]] (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 Ord Add@Monoid (n.% +1000) (lambda [_] true)] - ["Nat/Mul" R;nat Number Ord Mul@Monoid (n.% +1000) (lambda [_] true)] - ["Nat/Min" R;nat Number Ord Min@Monoid (n.% +1000) (lambda [_] true)] - ["Nat/Max" R;nat Number Ord Max@Monoid (n.% +1000) (lambda [_] true)] - ["Int/Add" R;int Number Ord Add@Monoid (i.% 1000) (lambda [_] true)] - ["Int/Mul" R;int Number Ord Mul@Monoid (i.% 1000) (lambda [_] true)] - ["Int/Min" R;int Number Ord Min@Monoid (i.% 1000) (lambda [_] true)] - ["Int/Max" R;int Number Ord Max@Monoid (i.% 1000) (lambda [_] true)] - ["Real/Add" R;real Number Ord Add@Monoid (r.% 1000.0) (r.> 0.0)] - ["Real/Mul" R;real Number Ord Mul@Monoid (r.% 1000.0) (r.> 0.0)] - ["Real/Min" R;real Number Ord Min@Monoid (r.% 1000.0) (r.> 0.0)] - ["Real/Max" R;real Number Ord Max@Monoid (r.% 1000.0) (r.> 0.0)] - ["Deg/Add" R;deg Number Ord Add@Monoid (d.% .125) (lambda [_] true)] - ## ["Deg/Mul" R;deg Number Ord Mul@Monoid (d.% .125) (lambda [_] true)] - ["Deg/Min" R;deg Number Ord Min@Monoid (d.% .125) (lambda [_] true)] - ["Deg/Max" R;deg Number Ord Max@Monoid (d.% .125) (lambda [_] true)] + ["Nat/Add" R;nat Number Order Add@Monoid (n.% +1000) (lambda [_] true)] + ["Nat/Mul" R;nat Number Order Mul@Monoid (n.% +1000) (lambda [_] true)] + ["Nat/Min" R;nat Number Order Min@Monoid (n.% +1000) (lambda [_] true)] + ["Nat/Max" R;nat Number Order Max@Monoid (n.% +1000) (lambda [_] true)] + ["Int/Add" R;int Number Order Add@Monoid (i.% 1000) (lambda [_] true)] + ["Int/Mul" R;int Number Order Mul@Monoid (i.% 1000) (lambda [_] true)] + ["Int/Min" R;int Number Order Min@Monoid (i.% 1000) (lambda [_] true)] + ["Int/Max" R;int Number Order Max@Monoid (i.% 1000) (lambda [_] true)] + ["Real/Add" R;real Number Order Add@Monoid (r.% 1000.0) (r.> 0.0)] + ["Real/Mul" R;real Number Order Mul@Monoid (r.% 1000.0) (r.> 0.0)] + ["Real/Min" R;real Number Order Min@Monoid (r.% 1000.0) (r.> 0.0)] + ["Real/Max" R;real Number Order Max@Monoid (r.% 1000.0) (r.> 0.0)] + ["Deg/Add" R;deg Number Order Add@Monoid (d.% .125) (lambda [_] true)] + ## ["Deg/Mul" R;deg Number Order Mul@Monoid (d.% .125) (lambda [_] true)] + ["Deg/Min" R;deg Number Order Min@Monoid (d.% .125) (lambda [_] true)] + ["Deg/Max" R;deg Number Order Max@Monoid (d.% .125) (lambda [_] true)] ) (do-template [ ] 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] + (let [(^open "&/") &;Order] ($_ 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