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