From a268b8e66fbb5ad51e053bbb9a334a6460602aed Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 10 May 2018 21:42:17 -0400
Subject: - Some improvements and fixes for stdlib.

---
 stdlib/source/lux/data/format/json.lux |  5 +--
 stdlib/source/lux/io.lux               |  4 +++
 stdlib/source/lux/macro/poly.lux       | 62 ++++++++--------------------------
 stdlib/source/lux/macro/poly/eq.lux    | 12 +++----
 stdlib/source/lux/macro/poly/json.lux  | 33 +++++++++---------
 stdlib/source/lux/test.lux             |  5 +--
 stdlib/test/tests.lux                  |  6 ++--
 7 files changed, 50 insertions(+), 77 deletions(-)

diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index c4dd43a1c..d960830db 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -19,10 +19,7 @@
                    (dictionary ["dict" unordered #+ Dict])))
        [macro #+ Monad<Meta> with-gensyms]
        (macro ["s" syntax #+ syntax:]
-              [code]
-              [poly #+ poly:])
-       (lang [type])
-       ))
+              [code])))
 
 (do-template [<name> <type>]
   [(type: #export <name> <type>)]
diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux
index 72307c301..d35584fd1 100644
--- a/stdlib/source/lux/io.lux
+++ b/stdlib/source/lux/io.lux
@@ -49,6 +49,10 @@
   (All [a] (-> (IO a) a))
   (action (:! Bottom [])))
 
+(def: #export (exit code)
+  (-> Int (IO Bottom))
+  (io ("lux io exit" code)))
+
 ## Process
 (type: #export (Process a)
   (IO (Error a)))
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index f3537d6f0..54a856463 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -115,43 +115,6 @@
         (#e.Success [[_ inputs'] output])
         (#e.Success [[env inputs'] [g!var output]])))))
 
-(do-template [<combinator> <name> <type>]
-  [(def: #export <combinator>
-     (Poly Top)
-     (do p.Monad<Parser>
-       [headT any]
-       (case (type.un-name headT)
-         <type>
-         (wrap [])
-
-         _
-         (p.fail ($_ text/compose "Not " <name> " type: " (type.to-text headT))))))]
-
-  [bool "Bool" (#.Primitive "#Bool" #.Nil)]
-  [nat  "Nat"  (#.Primitive "#Nat" #.Nil)]
-  [int  "Int"  (#.Primitive "#Int" #.Nil)]
-  [deg  "Deg"  (#.Primitive "#Deg" #.Nil)]
-  [frac "Frac" (#.Primitive "#Frac" #.Nil)]
-  [text "Text" (#.Primitive "#Text" #.Nil)]
-  )
-
-(def: #export basic
-  (Poly Type)
-  (do p.Monad<Parser>
-    [headT any]
-    (case (run headT ($_ p.either
-                         bool
-                         nat
-                         int
-                         deg
-                         frac
-                         text))
-      (#e.Error error)
-      (p.fail error)
-
-      (#e.Success _)
-      (wrap headT))))
-
 (do-template [<name> <flattener> <tag>]
   [(def: #export (<name> poly)
      (All [a] (-> (Poly a) (Poly a)))
@@ -231,16 +194,21 @@
       (p.fail ($_ text/compose "Non-application type: " (type.to-text headT)))
       (local (#.Cons funcT paramsT) poly))))
 
-(def: #export (this expected)
-  (-> Type (Poly Top))
-  (do p.Monad<Parser>
-    [actual any]
-    (if (type/= expected actual)
-      (wrap [])
-      (p.fail ($_ text/compose
-                  "Types do not match." "\n"
-                  "Expected: " (type.to-text expected) "\n"
-                  "  Actual: " (type.to-text actual))))))
+(do-template [<name> <test>]
+  [(def: #export (<name> expected)
+     (-> Type (Poly Top))
+     (do p.Monad<Parser>
+       [actual any]
+       (if (<test> expected actual)
+         (wrap [])
+         (p.fail ($_ text/compose
+                     "Types do not match." "\n"
+                     "Expected: " (type.to-text expected) "\n"
+                     "  Actual: " (type.to-text actual))))))]
+
+  [this type/=]
+  [like check.checks?]
+  )
 
 (def: (adjusted-idx env idx)
   (-> Env Nat Nat)
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux
index 6206c9861..ec120e0e1 100644
--- a/stdlib/source/lux/macro/poly/eq.lux
+++ b/stdlib/source/lux/macro/poly/eq.lux
@@ -46,12 +46,12 @@
                                  <eq>))))]
 
                   [(poly.this Top) (function ((~ g!_) (~ g!_) (~ g!_)) true)]
-                  [poly.bool bool.Eq<Bool>]
-                  [poly.nat  number.Eq<Nat>]
-                  [poly.int  number.Eq<Int>]
-                  [poly.deg  number.Eq<Deg>]
-                  [poly.frac number.Eq<Frac>]
-                  [poly.text text.Eq<Text>]))
+                  [(poly.like Bool) bool.Eq<Bool>]
+                  [(poly.like Nat)  number.Eq<Nat>]
+                  [(poly.like Int)  number.Eq<Int>]
+                  [(poly.like Deg)  number.Eq<Deg>]
+                  [(poly.like Frac) number.Eq<Frac>]
+                  [(poly.like Text) text.Eq<Text>]))
             ## Composite types
             (~~ (do-template [<name> <eq>]
                   [(do @
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux
index 2e288648e..44075647d 100644
--- a/stdlib/source/lux/macro/poly/json.lux
+++ b/stdlib/source/lux/macro/poly/json.lux
@@ -6,8 +6,9 @@
                 ["p" parser "p/" Monad<Parser>])
        (data [bool]
              [bit]
-             [text "text/" Eq<Text> Monoid<Text>]
-             (text ["l" lexer])
+             [text "text/" Eq<Text>]
+             (text ["l" lexer]
+                   format)
              [number "frac/" Codec<Text,Frac> "nat/" Codec<Text,Nat>]
              maybe
              ["e" error]
@@ -87,11 +88,11 @@
                               <encoder>))))]
 
                [(poly.this Top) (function ((~ g!_) (~ (code.symbol ["" "0"]))) #//.Null)]
-               [poly.bool (|>> #//.Boolean)]
-               [poly.nat  (:: (~! ..Codec<JSON,Nat>) (~' encode))]
-               [poly.int  (:: (~! ..Codec<JSON,Int>) (~' encode))]
-               [poly.frac (|>> #//.Number)]
-               [poly.text (|>> #//.String)])
+               [(poly.like Bool) (|>> #//.Boolean)]
+               [(poly.like Nat)  (:: (~! ..Codec<JSON,Nat>) (~' encode))]
+               [(poly.like Int)  (:: (~! ..Codec<JSON,Int>) (~' encode))]
+               [(poly.like Frac) (|>> #//.Number)]
+               [(poly.like Text) (|>> #//.String)])
      <time> (do-template [<type> <codec>]
               [(do @
                  [_ (poly.this <type>)]
@@ -123,7 +124,7 @@
                    g!val (code.local-symbol "_______val")]
              [_ _ =val=] (poly.apply ($_ p.seq
                                          (poly.this d.Dict)
-                                         poly.text
+                                         (poly.this .Text)
                                          Codec<JSON,?>//encode))]
             (wrap (` (: (~ (@JSON//encode inputT))
                         (|>> d.entries
@@ -191,7 +192,7 @@
           poly.bound
           poly.recursive-call
           ## If all else fails...
-          (p.fail (text/compose "Cannot create JSON encoder for: " (type.to-text inputT)))
+          (p.fail (format "Cannot create JSON encoder for: " (type.to-text inputT)))
           ))))
 
 (poly: Codec<JSON,?>//decode
@@ -203,11 +204,11 @@
                               <decoder>))))]
 
                [(poly.this Top) //.null]
-               [poly.bool //.boolean]
-               [poly.nat  (p.codec (~! ..Codec<JSON,Nat>) //.any)]
-               [poly.int  (p.codec (~! ..Codec<JSON,Int>) //.any)]
-               [poly.frac //.number]
-               [poly.text //.string])
+               [(poly.like Bool) //.boolean]
+               [(poly.like Nat)  (p.codec (~! ..Codec<JSON,Nat>) //.any)]
+               [(poly.like Int)  (p.codec (~! ..Codec<JSON,Int>) //.any)]
+               [(poly.like Frac) //.number]
+               [(poly.like Text) //.string])
      <time> (do-template [<type> <codec>]
               [(do @
                  [_ (poly.this <type>)]
@@ -236,7 +237,7 @@
           (do @
             [[_ _ valC] (poly.apply ($_ p.seq
                                         (poly.this d.Dict)
-                                        poly.text
+                                        (poly.this .Text)
                                         Codec<JSON,?>//decode))]
             (wrap (` (: (~ (@JSON//decode inputT))
                         (//.object (~ valC))))))
@@ -286,7 +287,7 @@
           poly.bound
           poly.recursive-call
           ## If all else fails...
-          (p.fail (text/compose "Cannot create JSON decoder for: " (type.to-text inputT)))
+          (p.fail (format "Cannot create JSON decoder for: " (type.to-text inputT)))
           ))))
 
 (syntax: #export (Codec<JSON,?> inputT)
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 948923aeb..7162d8e4f 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -19,8 +19,9 @@
 
 ## [Host]
 (do-template [<name> <signal>]
-  [(def: <name> (IO Bottom)
-     (io ("lux io exit" <signal>)))]
+  [(def: <name>
+     (IO Bottom)
+     (io.exit <signal>))]
 
   [exit 0]
   [die  1]
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 694ada1c5..6a429093b 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -79,7 +79,8 @@
              (world ["_." blob]
                     ["_." file]
                     (net ["_." tcp]
-                         ["_." udp]))))
+                         ["_." udp]))
+             ))
   (lux (control [contract]
                 [concatenative]
                 [predicate]
@@ -98,7 +99,8 @@
              [refinement]
              [quotient])
        [world/env]
-       [world/console]))
+       [world/console])
+  )
 
 (program: args
   (test.run))
-- 
cgit v1.2.3