diff options
author | Eduardo Julian | 2017-04-03 18:18:34 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-04-03 18:18:34 -0400 |
commit | 82c955d5777ecb87b53bafcc658683d5a76e9a3c (patch) | |
tree | 5e9c638d7c9e3e04c0db94012184f606f7f71573 /stdlib/source/lux.lux | |
parent | 65b39c7d66244d275ad75c734bc42b0588379bfb (diff) |
- 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.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux.lux | 163 |
1 files changed, 85 insertions, 78 deletions
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)) |