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 ++++++++++++++++++++++++++------------------------
 1 file changed, 85 insertions(+), 78 deletions(-)

(limited to 'stdlib/source/lux.lux')

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))
-- 
cgit v1.2.3