aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2017-07-15 20:45:10 -0400
committerEduardo Julian2017-07-15 20:45:10 -0400
commit4c36eaf769bc74e708d1f63e67ff612176963731 (patch)
tree797ca6d0222bae3293646e690ad58690f89b6b2c
parentfbd8a37baf6d50d62716d69b451d4ac58b872283 (diff)
- Can now generate Eq instances for #rec-style recursive types.
- Minor refactorings.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux4
-rw-r--r--stdlib/source/lux/concurrency/frp.lux2
-rw-r--r--stdlib/source/lux/control/codec.lux2
-rw-r--r--stdlib/source/lux/control/eq.lux9
-rw-r--r--stdlib/source/lux/control/hash.lux2
-rw-r--r--stdlib/source/lux/control/interval.lux2
-rw-r--r--stdlib/source/lux/control/order.lux2
-rw-r--r--stdlib/source/lux/data/bool.lux2
-rw-r--r--stdlib/source/lux/data/coll/array.lux2
-rw-r--r--stdlib/source/lux/data/coll/dict.lux2
-rw-r--r--stdlib/source/lux/data/coll/list.lux2
-rw-r--r--stdlib/source/lux/data/coll/priority-queue.lux2
-rw-r--r--stdlib/source/lux/data/coll/queue.lux2
-rw-r--r--stdlib/source/lux/data/coll/seq.lux2
-rw-r--r--stdlib/source/lux/data/coll/set.lux2
-rw-r--r--stdlib/source/lux/data/coll/vector.lux2
-rw-r--r--stdlib/source/lux/data/format/json.lux104
-rw-r--r--stdlib/source/lux/data/format/xml.lux2
-rw-r--r--stdlib/source/lux/data/ident.lux2
-rw-r--r--stdlib/source/lux/data/maybe.lux2
-rw-r--r--stdlib/source/lux/data/number.lux2
-rw-r--r--stdlib/source/lux/data/number/complex.lux2
-rw-r--r--stdlib/source/lux/data/number/ratio.lux2
-rw-r--r--stdlib/source/lux/data/text.lux2
-rw-r--r--stdlib/source/lux/macro/code.lux2
-rw-r--r--stdlib/source/lux/macro/poly.lux81
-rw-r--r--stdlib/source/lux/macro/poly/eq.lux27
-rw-r--r--stdlib/source/lux/macro/syntax.lux2
-rw-r--r--stdlib/source/lux/type.lux2
-rw-r--r--stdlib/test/test/lux/control/parser.lux2
-rw-r--r--stdlib/test/test/lux/data/coll/ordered/dict.lux2
-rw-r--r--stdlib/test/test/lux/data/format/json.lux2
-rw-r--r--stdlib/test/test/lux/macro/poly/eq.lux19
-rw-r--r--stdlib/test/test/lux/macro/poly/functor.lux2
-rw-r--r--stdlib/test/test/lux/macro/poly/text-encoder.lux2
-rw-r--r--stdlib/test/test/lux/macro/syntax.lux2
36 files changed, 182 insertions, 122 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 76db92f2f..30f38897b 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -3721,9 +3721,9 @@
(if (empty? args)
(let [g!param (symbol$ ["" ""])
prime-name (symbol$ ["" name])
- type+ (replace-syntax (list [name (` ((~ prime-name) (~ g!param)))]) type)]
+ type+ (replace-syntax (list [name (` ((~ prime-name) #;Void))]) type)]
(#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+))
- Void))))
+ #;Void))))
#None)
(case args
#Nil
diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux
index a646f2b6e..54e7c957b 100644
--- a/stdlib/source/lux/concurrency/frp.lux
+++ b/stdlib/source/lux/concurrency/frp.lux
@@ -3,7 +3,7 @@
(lux (control functor
applicative
monad
- eq
+ [eq #+ Eq]
["p" parser])
[io #- run]
(data (coll [list "L/" Monoid<List>])
diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux
index 63ef0526b..535201954 100644
--- a/stdlib/source/lux/control/codec.lux
+++ b/stdlib/source/lux/control/codec.lux
@@ -12,7 +12,7 @@
decode))
## [Values]
-(struct: #export (compC Codec<c,b> Codec<b,a>)
+(struct: #export (compose Codec<c,b> Codec<b,a>)
{#;doc "Codec composition."}
(All [a b c] (-> (Codec c b) (Codec b a) (Codec c a)))
(def: encode (|>. (:: Codec<b,a> encode) (:: Codec<c,b> encode)))
diff --git a/stdlib/source/lux/control/eq.lux b/stdlib/source/lux/control/eq.lux
index 7a2fb3d3a..b69292daa 100644
--- a/stdlib/source/lux/control/eq.lux
+++ b/stdlib/source/lux/control/eq.lux
@@ -5,13 +5,13 @@
(: (-> a a Bool)
=))
-(def: #export (conj left right)
+(def: #export (seq left right)
(All [l r] (-> (Eq l) (Eq r) (Eq [l r])))
(struct (def: (= [a b] [x y])
(and (:: left = a x)
(:: right = b y)))))
-(def: #export (disj left right)
+(def: #export (alt left right)
(All [l r] (-> (Eq l) (Eq r) (Eq (| l r))))
(struct (def: (= a|b x|y)
(case [a|b x|y]
@@ -23,3 +23,8 @@
_
false))))
+
+(def: #export (rec sub)
+ (All [a] (-> (-> (Eq a) (Eq a)) (Eq a)))
+ (struct (def: (= left right)
+ (sub (rec sub) left right))))
diff --git a/stdlib/source/lux/control/hash.lux b/stdlib/source/lux/control/hash.lux
index da24575a4..3472098c1 100644
--- a/stdlib/source/lux/control/hash.lux
+++ b/stdlib/source/lux/control/hash.lux
@@ -1,6 +1,6 @@
(;module:
lux
- (.. eq))
+ (.. [eq #+ Eq]))
## [Signatures]
(sig: #export (Hash a)
diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux
index 673ad630f..95a23c378 100644
--- a/stdlib/source/lux/control/interval.lux
+++ b/stdlib/source/lux/control/interval.lux
@@ -1,6 +1,6 @@
(;module:
lux
- (lux (control eq
+ (lux (control [eq #+ Eq]
[order]
[enum #+ Enum])))
diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux
index eb2a6f81b..89708d986 100644
--- a/stdlib/source/lux/control/order.lux
+++ b/stdlib/source/lux/control/order.lux
@@ -1,7 +1,7 @@
(;module:
lux
(lux function)
- (.. eq))
+ (.. [eq #+ Eq]))
## [Signatures]
(sig: #export (Order a)
diff --git a/stdlib/source/lux/data/bool.lux b/stdlib/source/lux/data/bool.lux
index 35c00477f..e292c0ede 100644
--- a/stdlib/source/lux/data/bool.lux
+++ b/stdlib/source/lux/data/bool.lux
@@ -1,7 +1,7 @@
(;module:
lux
(lux (control monoid
- eq
+ [eq #+ Eq]
hash
codec)))
diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux
index a8f8d9f00..4ab94fae8 100644
--- a/stdlib/source/lux/data/coll/array.lux
+++ b/stdlib/source/lux/data/coll/array.lux
@@ -4,7 +4,7 @@
functor
applicative
monad
- eq
+ [eq #+ Eq]
fold)
(data (coll [list "List/" Fold<List>])
[product])
diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux
index 4ebb9a746..e54aaf5cc 100644
--- a/stdlib/source/lux/data/coll/dict.lux
+++ b/stdlib/source/lux/data/coll/dict.lux
@@ -1,7 +1,7 @@
(;module:
lux
(lux (control hash
- eq)
+ [eq #+ Eq])
(data maybe
(coll [list "List/" Fold<List> Functor<List> Monoid<List>]
[array #+ Array "Array/" Functor<Array> Fold<Array>])
diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux
index 5d21585a4..41f1cddaf 100644
--- a/stdlib/source/lux/data/coll/list.lux
+++ b/stdlib/source/lux/data/coll/list.lux
@@ -4,7 +4,7 @@
functor
applicative
["M" monad #*]
- eq
+ [eq #+ Eq]
[fold])
(data [number "Nat/" Codec<Text,Nat>]
bool
diff --git a/stdlib/source/lux/data/coll/priority-queue.lux b/stdlib/source/lux/data/coll/priority-queue.lux
index f02b4de57..00c655d8e 100644
--- a/stdlib/source/lux/data/coll/priority-queue.lux
+++ b/stdlib/source/lux/data/coll/priority-queue.lux
@@ -1,6 +1,6 @@
(;module:
lux
- (lux (control eq
+ (lux (control [eq #+ Eq]
monad)
(data (coll (tree ["F" finger]))
[number]
diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux
index 520211dca..c1e7ae6a9 100644
--- a/stdlib/source/lux/data/coll/queue.lux
+++ b/stdlib/source/lux/data/coll/queue.lux
@@ -1,6 +1,6 @@
(;module:
lux
- (lux (control eq)
+ (lux (control [eq #+ Eq])
(data (coll [list "List/" Monoid<List>]))))
## [Types]
diff --git a/stdlib/source/lux/data/coll/seq.lux b/stdlib/source/lux/data/coll/seq.lux
index 84795f91f..9c981b6aa 100644
--- a/stdlib/source/lux/data/coll/seq.lux
+++ b/stdlib/source/lux/data/coll/seq.lux
@@ -3,7 +3,7 @@
(lux (control functor
applicative
monad
- eq
+ [eq #+ Eq]
fold
["p" parser])
(data (coll ["L" list "L/" Monoid<List> Fold<List>]
diff --git a/stdlib/source/lux/data/coll/set.lux b/stdlib/source/lux/data/coll/set.lux
index 8d075a961..06953ef23 100644
--- a/stdlib/source/lux/data/coll/set.lux
+++ b/stdlib/source/lux/data/coll/set.lux
@@ -3,7 +3,7 @@
(lux (control functor
applicative
monad
- eq
+ [eq #+ Eq]
[hash #*])
(data (coll [dict]
[list "List/" Fold<List> Functor<List>]))))
diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux
index 69a7a9822..5f7a91640 100644
--- a/stdlib/source/lux/data/coll/vector.lux
+++ b/stdlib/source/lux/data/coll/vector.lux
@@ -3,7 +3,7 @@
(lux (control functor
applicative
monad
- eq
+ [eq #+ Eq]
monoid
fold
["p" parser])
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 2e31a3924..865e92b8c 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -5,7 +5,7 @@
(lux (control functor
applicative
monad
- eq
+ [eq #+ Eq]
codec
["p" parser "p/" Monad<Parser>])
(data [bool]
@@ -387,11 +387,11 @@
_
(#R;Error (format "JSON value is not " <desc> ": " (show-json json)))))]
- [unit Unit #Null "unit" id]
+ [unit Unit #Null "unit" id]
[bool Bool #Boolean "bool" id]
[int Int #Number "int" real-to-int]
- [real Real #Number "real" id]
- [text Text #String "text" id]
+ [real Real #Number "real" id]
+ [text Text #String "text" id]
)
(do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>]
@@ -524,79 +524,85 @@
=b pb]
(wrap [=a =b])))
-(def: #export (alt pa pb json)
+(def: #export (alt pa pb)
{#;doc "Heterogeneous alternative combinator."}
(All [a b] (-> (Parser a) (Parser b) (Parser (| a b))))
- (case (pa json)
- (#R;Success a)
- (sum;right (sum;left a))
+ (function [json]
+ (case (pa json)
+ (#R;Success a)
+ (sum;right (sum;left a))
- (#R;Error message0)
- (case (pb json)
- (#R;Success b)
- (sum;right (sum;right b))
+ (#R;Error message0)
+ (case (pb json)
+ (#R;Success b)
+ (sum;right (sum;right b))
- (#R;Error message1)
- (#R;Error message0))))
+ (#R;Error message1)
+ (#R;Error message0)))))
-(def: #export (either pl pr json)
+(def: #export (either pl pr)
{#;doc "Homogeneous alternative combinator."}
(All [a] (-> (Parser a) (Parser a) (Parser a)))
- (case (pl json)
- (#R;Success x)
- (#R;Success x)
+ (function [json]
+ (case (pl json)
+ (#R;Success x)
+ (#R;Success x)
- _
- (pr json)))
+ _
+ (pr json))))
-(def: #export (opt p json)
+(def: #export (opt p)
{#;doc "Optionality combinator."}
(All [a]
(-> (Parser a) (Parser (Maybe a))))
- (case (p json)
- (#R;Error _) (#R;Success #;None)
- (#R;Success x) (#R;Success (#;Some x))))
+ (function [json]
+ (case (p json)
+ (#R;Error _) (#R;Success #;None)
+ (#R;Success x) (#R;Success (#;Some x)))))
(def: #export (run json parser)
(All [a] (-> JSON (Parser a) (R;Result a)))
(parser json))
-(def: #export (ensure test parser json)
+(def: #export (ensure test parser)
{#;doc "Only parses a JSON if it passes a test (which is also a parser)."}
(All [a] (-> (Parser Unit) (Parser a) (Parser a)))
- (case (test json)
- (#R;Success _)
- (parser json)
+ (function [json]
+ (case (test json)
+ (#R;Success _)
+ (parser json)
- (#R;Error error)
- (#R;Error error)))
+ (#R;Error error)
+ (#R;Error error))))
-(def: #export (array-size! size json)
+(def: #export (array-size! size)
{#;doc "Ensures a JSON array has the specified size."}
(-> Nat (Parser Unit))
- (case json
- (#Array parts)
- (if (n.= size (vector;size parts))
- (#R;Success [])
- (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json))))
+ (function [json]
+ (case json
+ (#Array parts)
+ (if (n.= size (vector;size parts))
+ (#R;Success [])
+ (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json))))
- _
- (#R;Error (format "JSON value is not an array: " (show-json json)))))
+ _
+ (#R;Error (format "JSON value is not an array: " (show-json json))))))
-(def: #export (object-fields! wanted-fields json)
+(def: #export (object-fields! wanted-fields)
{#;doc "Ensures that every field in the list of wanted-fields is present in a JSON object."}
(-> (List String) (Parser Unit))
- (case json
- (#Object kvs)
- (let [actual-fields (d;keys kvs)]
- (if (and (n.= (list;size wanted-fields) (list;size actual-fields))
- (list;every? (list;member? text;Eq<Text> wanted-fields)
- actual-fields))
- (#R;Success [])
- (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
+ (function [json]
+ (case json
+ (#Object kvs)
+ (let [actual-fields (d;keys kvs)]
+ (if (and (n.= (list;size wanted-fields) (list;size actual-fields))
+ (list;every? (list;member? text;Eq<Text> wanted-fields)
+ actual-fields))
+ (#R;Success [])
+ (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
- _
- (#R;Error (format "JSON value is not an object: " (show-json json)))))
+ _
+ (#R;Error (format "JSON value is not an object: " (show-json json))))))
## [Structures]
(struct: #export _ (Eq JSON)
diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux
index b95c60ed4..94bb19089 100644
--- a/stdlib/source/lux/data/format/xml.lux
+++ b/stdlib/source/lux/data/format/xml.lux
@@ -1,7 +1,7 @@
(;module: {#;doc "Functionality for reading, generating and processing values in the XML format."}
lux
(lux (control monad
- eq
+ [eq #+ Eq]
codec
["p" parser "p/" Monad<Parser>])
(data [text "t/" Eq<Text>]
diff --git a/stdlib/source/lux/data/ident.lux b/stdlib/source/lux/data/ident.lux
index 62b678ee4..174712b33 100644
--- a/stdlib/source/lux/data/ident.lux
+++ b/stdlib/source/lux/data/ident.lux
@@ -1,6 +1,6 @@
(;module:
lux
- (lux (control eq
+ (lux (control [eq #+ Eq]
codec
hash)
(data [text "Text/" Monoid<Text> Eq<Text>])))
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index d0c2c8441..e8404544f 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -4,7 +4,7 @@
(functor #as F #refer #all)
(applicative #as A #refer #all)
(monad #as M #refer #all)
- eq)))
+ [eq #+ Eq])))
## [Types]
## (type: (Maybe a)
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 238cc139a..783e9bc55 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -2,7 +2,7 @@
lux
(lux (control number
monoid
- eq
+ [eq #+ Eq]
hash
[order]
enum
diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux
index 852498e28..09d596bc3 100644
--- a/stdlib/source/lux/data/number/complex.lux
+++ b/stdlib/source/lux/data/number/complex.lux
@@ -1,7 +1,7 @@
(;module: {#;doc "Complex arithmetic."}
lux
(lux [math]
- (control eq
+ (control [eq #+ Eq]
number
codec
monad
diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux
index d9b20cb97..3352fd02d 100644
--- a/stdlib/source/lux/data/number/ratio.lux
+++ b/stdlib/source/lux/data/number/ratio.lux
@@ -1,7 +1,7 @@
(;module: {#;doc "Rational arithmetic."}
lux
(lux [math]
- (control eq
+ (control [eq #+ Eq]
[order]
number
codec
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index ac1994130..13e57aa21 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -1,7 +1,7 @@
(;module:
lux
(lux (control monoid
- eq
+ [eq #+ Eq]
[order]
monad
codec
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index efd28d052..2755ae6f5 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -1,6 +1,6 @@
(;module:
lux
- (lux (control eq)
+ (lux (control [eq #+ Eq])
(data bool
number
[text #+ Eq<Text> "Text/" Monoid<Text>]
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index fe49553a5..4ff1b3012 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -12,7 +12,7 @@
[bool]
[maybe]
[ident "Ident/" Eq<Ident>])
- [macro #+ Monad<Lux> with-gensyms]
+ [macro #+ with-gensyms "Lux/" Monad<Lux>]
(macro [code]
["s" syntax #+ syntax: Syntax]
(syntax ["cs" common]
@@ -34,7 +34,7 @@
(;function [:type:]
(case (type;un-name :type:)
<type>
- (:: macro;Monad<Lux> wrap [])
+ (Lux/wrap [])
_
(macro;fail (format "Not " <name> " type: " (%type :type:))))))]
@@ -49,7 +49,7 @@
(;function [:type:]
(case (type;un-alias :type:)
(#;Named ["lux" <name>] _)
- (:: macro;Monad<Lux> wrap [])
+ (Lux/wrap [])
_
(macro;fail (format "Not " <name> " type: " (%type :type:))))))]
@@ -67,7 +67,7 @@
(;function [:type:]
(with-expansions
[<primitives> (do-template [<parser> <type>]
- [(do Monad<Lux>
+ [(do macro;Monad<Lux>
[_ (<parser> :type:)]
(wrap <type>))]
@@ -91,7 +91,7 @@
(;function [:type:]
(case (type;un-name :type:)
(<tag> :left: :right:)
- (:: macro;Monad<Lux> wrap [:left: :right:])
+ (Lux/wrap [:left: :right:])
_
(macro;fail (format "Not a " ($Code$ <tag>) " type: " (%type :type:))))))
@@ -101,31 +101,13 @@
(;function [:type:]
(let [members (<flattener> (type;un-name :type:))]
(if (n.> +1 (list;size members))
- (:: macro;Monad<Lux> wrap members)
+ (Lux/wrap members)
(macro;fail (format "Not a " ($Code$ <tag>) " type: " (%type :type:)))))))]
[sum sum+ type;flatten-variant #;Sum]
[prod prod+ type;flatten-tuple #;Product]
)
-(def: #export func
- (Matcher [Type Type])
- (;function [:type:]
- (case (type;un-name :type:)
- (#;Function :left: :right:)
- (:: macro;Monad<Lux> wrap [:left: :right:])
-
- _
- (macro;fail (format "Not a Function type: " (%type :type:))))))
-
-(def: #export func+
- (Matcher [(List Type) Type])
- (;function [:type:]
- (let [[ins out] (type;flatten-function (type;un-name :type:))]
- (if (n.> +0 (list;size ins))
- (:: macro;Monad<Lux> wrap [ins out])
- (macro;fail (format "Not a Function type: " (%type :type:)))))))
-
(def: #export tagged
(Matcher [(List Ident) Type])
(;function [:type:]
@@ -151,7 +133,7 @@
:type:'']))
_
- (:: macro;Monad<Lux> wrap [(;list) :type:])))))
+ (Lux/wrap [(;list) :type:])))))
(do-template [<combinator> <sub-comb> <build>]
[(def: #export <combinator>
@@ -184,12 +166,12 @@
(wrap [vars members]))))
(def: #export function
- (Matcher [(List Code) [(List Type) Type]])
+ (Matcher [(List Code) (List Type) Type])
(;function [:type:]
(do macro;Monad<Lux>
[[vars :type:] (polymorphic :type:)
- ins+out (func+ :type:)]
- (wrap [vars ins+out]))))
+ #let [[ins out] (type;flatten-function (type;un-name :type:))]]
+ (wrap [vars ins out]))))
(def: #export apply
(Matcher [Type (List Type)])
@@ -217,7 +199,7 @@
(^multi (#;Apply :arg: :quant:)
[(type;un-alias :quant:) (#;Named actual _)]
(Ident/= name actual))
- (:: macro;Monad<Lux> wrap :arg:)
+ (Lux/wrap :arg:)
_
(macro;fail (format "Not " (%ident name) " type: " (%type :type:))))))
@@ -229,11 +211,21 @@
(^multi (#;Apply :arg1: (#;Apply :arg0: :quant:))
[(type;un-alias :quant:) (#;Named actual _)]
(Ident/= name actual))
- (:: macro;Monad<Lux> wrap [:arg0: :arg1:])
+ (Lux/wrap [:arg0: :arg1:])
_
(macro;fail (format "Not " (%ident name) " type: " (%type :type:))))))
+(def: #export recursive
+ (Matcher Type)
+ (;function [:type:]
+ (case (type;un-name :type:)
+ (#;Apply #;Void (#;UnivQ _ :type:'))
+ (Lux/wrap :type:')
+
+ _
+ (macro;fail (format "Not a recursive type: " (%type :type:))))))
+
(def: (adjusted-idx env idx)
(-> Env Nat Nat)
(let [env-level (n./ +2 (dict;size env))
@@ -248,7 +240,7 @@
(#;Bound idx)
(case (dict;get (adjusted-idx env idx) env)
(#;Some [poly-type poly-ast])
- (:: macro;Monad<Lux> wrap poly-ast)
+ (Lux/wrap poly-ast)
#;None
(macro;fail (format "Unknown bound type: " (%type :type:))))
@@ -256,10 +248,10 @@
_
(macro;fail (format "Not a bound type: " (%type :type:))))))
-(def: #export (recur env)
+(def: #export (recursion env)
(-> Env (Matcher Code))
(;function [:type:]
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[[t-func t-args] (apply :type:)]
(case t-func
(^multi (#;Bound t-func-idx)
@@ -282,13 +274,26 @@
(macro;fail (format "Type is not a recursive instance: " (%type :type:))))
)))
+(def: #export (self env)
+ (-> Env (Matcher Code))
+ (;function [:type:]
+ (case :type:
+ (^multi (#;Apply #;Void (#;Bound t-func-idx))
+ (n.= +0 (adjusted-idx env t-func-idx))
+ [(dict;get +0 env)
+ (#;Some [self-type self-call])])
+ (Lux/wrap self-call)
+
+ _
+ (macro;fail (format "Type is not a recursive self-call: " (%type :type:))))))
+
(def: #export (var env var-id)
(-> Env Nat (Matcher Unit))
(;function [:type:]
(case :type:
(^multi (#;Bound idx)
(n.= var-id (adjusted-idx env idx)))
- (:: macro;Monad<Lux> wrap [])
+ (Lux/wrap [])
_
(macro;fail (format "Not a bound type: " (%type :type:))))))
@@ -321,7 +326,7 @@
g!env (code;symbol ["" env])]
(wrap (;list (` (syntax: (~@ (csw;export _ex-lev)) ((~ g!name) (~@ (List/map (;function [g!input] (` [(~ g!input) s;symbol]))
g!inputs)))
- (do Monad<Lux>
+ (do macro;Monad<Lux>
[(~@ (List/join (List/map (;function [g!input] (;list g!input (` (macro;find-type-def (~ g!input)))))
g!inputs)))
(~' #let) [(~ g!env) (: Env (dict;new number;Hash<Nat>))]
@@ -395,6 +400,12 @@
(|> (dict;get idx env) (default (undefined)) product;left (to-ast env))
(` (;$ (~ (code;nat (n.dec idx)))))))
+ (#;Apply #;Void (#;Bound idx))
+ (let [idx (adjusted-idx env idx)]
+ (if (n.= +0 idx)
+ (|> (dict;get idx env) (default (undefined)) product;left (to-ast env))
+ (undefined)))
+
(^template [<tag>]
(<tag> left right)
(` (<tag> (~ (to-ast env left))
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux
index 31359a6c3..c9a58a6f5 100644
--- a/stdlib/source/lux/macro/poly/eq.lux
+++ b/stdlib/source/lux/macro/poly/eq.lux
@@ -82,6 +82,22 @@
## Variants
(with-gensyms [g!type-fun g!left g!right]
(do @
+ [members (poly;sum+ :x:)
+ pattern-matching (mapM @
+ (function [[tag :case:]]
+ (do @
+ [g!eq (Eq<?> env :case:)]
+ (wrap (list (` [((~ (code;nat tag)) (~ g!left))
+ ((~ (code;nat tag)) (~ g!right))])
+ (` ((~ g!eq) (~ g!left) (~ g!right)))))))
+ (list;enumerate members))
+ #let [base (` (function [(~ g!left) (~ g!right)]
+ (case [(~ g!left) (~ g!right)]
+ (~@ (List/join pattern-matching)))))]]
+ (wrap (` (: (~ (poly;gen-type env ->Eq g!type-fun (list) :x:))
+ (~ base))))))
+ (with-gensyms [g!type-fun g!left g!right]
+ (do @
[[g!vars members] (poly;variant :x:)
#let [new-env (poly;extend-env [:x: g!type-fun]
(list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars)
@@ -125,7 +141,16 @@
(wrap (` (: (~ (poly;gen-type new-env ->Eq g!type-fun g!vars :x:))
(~ base))))))
## Type recursion
- (poly;recur env :x:)
+ (with-gensyms [g!rec]
+ (do @
+ [:non-rec: (poly;recursive :x:)
+ #let [new-env (poly;extend-env [:x: g!rec] (list [:x: (` (;undefined))]) env)]
+ .non-rec. (Eq<?> new-env :non-rec:)]
+ (wrap (` (: (~ (poly;gen-type new-env ->Eq g!rec (list) :x:))
+ (eq;rec (;function [(~ g!rec)]
+ (~ .non-rec.))))))))
+ (poly;self env :x:)
+ (poly;recursion env :x:)
## Type applications
(do @
[[:func: :args:] (poly;apply :x:)
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index a1b84cdec..4838e16b1 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -4,7 +4,7 @@
(control functor
applicative
monad
- eq
+ [eq #+ Eq]
["p" parser])
(data [bool]
[number]
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index 48f6c3bd7..618416c33 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -1,6 +1,6 @@
(;module: {#;doc "Basic functionality for working with types."}
[lux #- function]
- (lux (control eq
+ (lux (control [eq #+ Eq]
monad)
(data [text "Text/" Monoid<Text> Eq<Text>]
[ident "Ident/" Eq<Ident>]
diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux
index 4580dca1e..ad5a57a1c 100644
--- a/stdlib/test/test/lux/control/parser.lux
+++ b/stdlib/test/test/lux/control/parser.lux
@@ -2,7 +2,7 @@
lux
(lux [io]
(control monad
- eq
+ [eq #+ Eq]
["&" parser]
pipe)
(data [text "Text/" Monoid<Text>]
diff --git a/stdlib/test/test/lux/data/coll/ordered/dict.lux b/stdlib/test/test/lux/data/coll/ordered/dict.lux
index 8793be9c2..76e9083eb 100644
--- a/stdlib/test/test/lux/data/coll/ordered/dict.lux
+++ b/stdlib/test/test/lux/data/coll/ordered/dict.lux
@@ -2,7 +2,7 @@
lux
(lux [io]
(control monad
- eq)
+ [eq #+ Eq])
(data [product]
[number]
(coll (ordered ["&" dict])
diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux
index c61429b87..fc533e4c1 100644
--- a/stdlib/test/test/lux/data/format/json.lux
+++ b/stdlib/test/test/lux/data/format/json.lux
@@ -3,7 +3,7 @@
(lux [io]
(control monad
codec
- eq
+ [eq #+ Eq]
pipe)
(data [text "Text/" Monoid<Text>]
text/format
diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux
index e3c059ddd..9bd6fc5e6 100644
--- a/stdlib/test/test/lux/macro/poly/eq.lux
+++ b/stdlib/test/test/lux/macro/poly/eq.lux
@@ -2,7 +2,7 @@
lux
(lux [io]
(control monad
- eq)
+ [eq #+ Eq])
(data text/format
[bool]
[number "i/" Number<Int>]
@@ -19,6 +19,10 @@
(#Case1 Int)
(#Case2 Real))
+(type: #rec Recursive
+ (#Number Real)
+ (#Addition Real Recursive))
+
(type: Record
{#unit Unit
#bool Bool
@@ -28,7 +32,16 @@
#maybe (Maybe Int)
#list (List Int)
#variant Variant
- #tuple [Int Real Text]})
+ #tuple [Int Real Text]
+ #recursive Recursive})
+
+(def: gen-recursive
+ (r;Random Recursive)
+ (r;rec (function [gen-recursive]
+ (r;alt r;real
+ (r;seq r;real gen-recursive)))))
+
+(derived: (&;Eq<?> Recursive))
(def: gen-record
(r;Random Record)
@@ -45,7 +58,7 @@
(r;list size gen-int)
($_ r;alt r;bool gen-int r;real)
($_ r;seq gen-int r;real (r;text size))
- )))
+ gen-recursive)))
(derived: (&;Eq<?> Record))
diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux
index 34d0d1a82..e97093d81 100644
--- a/stdlib/test/test/lux/macro/poly/functor.lux
+++ b/stdlib/test/test/lux/macro/poly/functor.lux
@@ -3,7 +3,7 @@
(lux [io]
(control monad
[functor]
- eq)
+ [eq #+ Eq])
(data text/format
[bool]
[number "i/" Number<Int>]
diff --git a/stdlib/test/test/lux/macro/poly/text-encoder.lux b/stdlib/test/test/lux/macro/poly/text-encoder.lux
index a98b8801d..1b38aa9b9 100644
--- a/stdlib/test/test/lux/macro/poly/text-encoder.lux
+++ b/stdlib/test/test/lux/macro/poly/text-encoder.lux
@@ -2,7 +2,7 @@
lux
(lux [io]
(control monad
- eq)
+ [eq #+ Eq])
(data text/format
[bool]
[number "i/" Number<Int>]
diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux
index ff8befbda..f99385521 100644
--- a/stdlib/test/test/lux/macro/syntax.lux
+++ b/stdlib/test/test/lux/macro/syntax.lux
@@ -2,7 +2,7 @@
lux
(lux [io]
(control monad
- eq
+ [eq #+ Eq]
["p" parser])
(data [text "Text/" Monoid<Text>]
text/format