diff options
author | Eduardo Julian | 2018-05-10 21:42:17 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-05-10 21:42:17 -0400 |
commit | a268b8e66fbb5ad51e053bbb9a334a6460602aed (patch) | |
tree | c5673273f149bf41174f297c74f142f5ab507dcb | |
parent | 0594525aea5a62355838116a1408f7ce7a7ba0b4 (diff) |
- Some improvements and fixes for stdlib.
-rw-r--r-- | stdlib/source/lux/data/format/json.lux | 5 | ||||
-rw-r--r-- | stdlib/source/lux/io.lux | 4 | ||||
-rw-r--r-- | stdlib/source/lux/macro/poly.lux | 62 | ||||
-rw-r--r-- | stdlib/source/lux/macro/poly/eq.lux | 12 | ||||
-rw-r--r-- | stdlib/source/lux/macro/poly/json.lux | 33 | ||||
-rw-r--r-- | stdlib/source/lux/test.lux | 5 | ||||
-rw-r--r-- | 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)) |