aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux.lux
diff options
context:
space:
mode:
authorEduardo Julian2017-04-03 18:18:34 -0400
committerEduardo Julian2017-04-03 18:18:34 -0400
commit82c955d5777ecb87b53bafcc658683d5a76e9a3c (patch)
tree5e9c638d7c9e3e04c0db94012184f606f7f71573 /stdlib/source/lux.lux
parent65b39c7d66244d275ad75c734bc42b0588379bfb (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.lux163
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))