From f59d42c7a9ad26014c9ff893d53336a0e5d8c7d3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 13 May 2018 01:13:10 -0400 Subject: - Re-named ".../eq" modules to ".../equality". - Other minor improvements. --- stdlib/source/lux/control/eq.lux | 30 ----- stdlib/source/lux/control/equality.lux | 32 +++++ stdlib/source/lux/control/hash.lux | 2 +- stdlib/source/lux/control/interval.lux | 2 +- stdlib/source/lux/control/order.lux | 2 +- stdlib/source/lux/control/predicate.lux | 4 +- stdlib/source/lux/data/bool.lux | 2 +- stdlib/source/lux/data/coll/array.lux | 2 +- stdlib/source/lux/data/coll/bits.lux | 2 +- stdlib/source/lux/data/coll/dictionary/ordered.lux | 2 +- .../source/lux/data/coll/dictionary/unordered.lux | 2 +- stdlib/source/lux/data/coll/list.lux | 2 +- stdlib/source/lux/data/coll/queue.lux | 2 +- stdlib/source/lux/data/coll/queue/priority.lux | 2 +- stdlib/source/lux/data/coll/sequence.lux | 2 +- stdlib/source/lux/data/coll/set/ordered.lux | 2 +- stdlib/source/lux/data/coll/set/unordered.lux | 2 +- stdlib/source/lux/data/coll/tree/rose.lux | 2 +- stdlib/source/lux/data/color.lux | 2 +- stdlib/source/lux/data/format/json.lux | 2 +- stdlib/source/lux/data/format/xml.lux | 2 +- stdlib/source/lux/data/ident.lux | 2 +- stdlib/source/lux/data/maybe.lux | 2 +- stdlib/source/lux/data/number.lux | 2 +- stdlib/source/lux/data/number/complex.lux | 2 +- stdlib/source/lux/data/number/ratio.lux | 2 +- stdlib/source/lux/data/text.lux | 2 +- stdlib/source/lux/lang/type.lux | 2 +- stdlib/source/lux/macro/code.lux | 2 +- stdlib/source/lux/macro/poly.lux | 2 +- stdlib/source/lux/macro/poly/eq.lux | 150 --------------------- stdlib/source/lux/macro/poly/equality.lux | 150 +++++++++++++++++++++ stdlib/source/lux/macro/poly/json.lux | 2 +- stdlib/source/lux/macro/syntax.lux | 2 +- stdlib/source/lux/time/date.lux | 2 +- stdlib/source/lux/time/duration.lux | 2 +- stdlib/source/lux/time/instant.lux | 2 +- stdlib/source/lux/type/implicit.lux | 2 +- stdlib/source/lux/type/unit.lux | 2 +- stdlib/source/lux/world/blob.jvm.lux | 2 +- stdlib/test/test/lux/control/eq.lux | 19 --- stdlib/test/test/lux/control/equality.lux | 19 +++ stdlib/test/test/lux/control/parser.lux | 2 +- stdlib/test/test/lux/data/coll/bits.lux | 2 +- .../test/test/lux/data/coll/dictionary/ordered.lux | 2 +- .../test/lux/data/coll/dictionary/unordered.lux | 2 +- stdlib/test/test/lux/data/format/json.lux | 6 +- stdlib/test/test/lux/macro/poly/eq.lux | 70 ---------- stdlib/test/test/lux/macro/poly/equality.lux | 70 ++++++++++ stdlib/test/test/lux/macro/poly/functor.lux | 2 +- stdlib/test/test/lux/macro/syntax.lux | 2 +- stdlib/test/test/lux/type/implicit.lux | 2 +- stdlib/test/test/lux/world/blob.lux | 2 +- stdlib/test/tests.lux | 2 +- 54 files changed, 321 insertions(+), 317 deletions(-) delete mode 100644 stdlib/source/lux/control/eq.lux create mode 100644 stdlib/source/lux/control/equality.lux delete mode 100644 stdlib/source/lux/macro/poly/eq.lux create mode 100644 stdlib/source/lux/macro/poly/equality.lux delete mode 100644 stdlib/test/test/lux/control/eq.lux create mode 100644 stdlib/test/test/lux/control/equality.lux delete mode 100644 stdlib/test/test/lux/macro/poly/eq.lux create mode 100644 stdlib/test/test/lux/macro/poly/equality.lux (limited to 'stdlib') diff --git a/stdlib/source/lux/control/eq.lux b/stdlib/source/lux/control/eq.lux deleted file mode 100644 index f75a78fdd..000000000 --- a/stdlib/source/lux/control/eq.lux +++ /dev/null @@ -1,30 +0,0 @@ -(.module: lux) - -(sig: #export (Eq a) - {#.doc "Equality for a type's instances."} - (: (-> a a Bool) - =)) - -(def: #export (product 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 (sum left right) - (All [l r] (-> (Eq l) (Eq r) (Eq (| l r)))) - (struct (def: (= a|b x|y) - (case [a|b x|y] - [(+0 a) (+0 x)] - (:: left = a x) - - [(+1 b) (+1 y)] - (:: right = b y) - - _ - 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/equality.lux b/stdlib/source/lux/control/equality.lux new file mode 100644 index 000000000..3750312e0 --- /dev/null +++ b/stdlib/source/lux/control/equality.lux @@ -0,0 +1,32 @@ +(.module: lux) + +(sig: #export (Equality a) + {#.doc "Equality for a type's instances."} + (: (-> a a Bool) + =)) + +(alias: Eq Equality) + +(def: #export (product 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 (sum left right) + (All [l r] (-> (Eq l) (Eq r) (Eq (| l r)))) + (struct (def: (= a|b x|y) + (case [a|b x|y] + [(+0 a) (+0 x)] + (:: left = a x) + + [(+1 b) (+1 y)] + (:: right = b y) + + _ + 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 722b0fdca..6399307bf 100644 --- a/stdlib/source/lux/control/hash.lux +++ b/stdlib/source/lux/control/hash.lux @@ -1,6 +1,6 @@ (.module: lux - (// [eq #+ Eq])) + (// [equality #+ Eq])) ## [Signatures] (sig: #export (Hash a) diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux index 90addfe19..70540622f 100644 --- a/stdlib/source/lux/control/interval.lux +++ b/stdlib/source/lux/control/interval.lux @@ -1,6 +1,6 @@ (.module: lux - (lux (control [eq #+ Eq] + (lux (control [equality #+ Eq] [order] [enum #+ Enum]))) diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux index 0e67a9b56..fd595b1f3 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])) + (// [equality #+ Eq])) ## [Signatures] (sig: #export (Order a) diff --git a/stdlib/source/lux/control/predicate.lux b/stdlib/source/lux/control/predicate.lux index de9d0dab0..a113339b8 100644 --- a/stdlib/source/lux/control/predicate.lux +++ b/stdlib/source/lux/control/predicate.lux @@ -2,9 +2,11 @@ lux (lux (data (coll (set ["set" unordered #+ Set]))))) -(type: #export (Pred a) +(type: #export (Predicate a) (-> a Bool)) +(alias: Pred Predicate) + (do-template [ ] [(def: #export ( left right) (All [a] (-> (Pred a) (Pred a) (Pred a))) diff --git a/stdlib/source/lux/data/bool.lux b/stdlib/source/lux/data/bool.lux index 9ccbc87ab..21ae0526f 100644 --- a/stdlib/source/lux/data/bool.lux +++ b/stdlib/source/lux/data/bool.lux @@ -1,7 +1,7 @@ (.module: lux (lux (control [monoid #+ Monoid] - [eq #+ Eq] + [equality #+ Eq] hash [codec #+ Codec]) function)) diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index dd3a94553..3e649fc7d 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -2,7 +2,7 @@ lux (lux (control [monoid #+ Monoid] [functor #+ Functor] - [eq #+ Eq] + [equality #+ Eq] fold) (data (coll [list "list/" Fold]) [product]) diff --git a/stdlib/source/lux/data/coll/bits.lux b/stdlib/source/lux/data/coll/bits.lux index 304076048..84e536676 100644 --- a/stdlib/source/lux/data/coll/bits.lux +++ b/stdlib/source/lux/data/coll/bits.lux @@ -1,6 +1,6 @@ (.module: [lux #- not and or] - (lux (control [eq #+ Eq] + (lux (control [equality #+ Eq] pipe) (data [maybe] [bit] diff --git a/stdlib/source/lux/data/coll/dictionary/ordered.lux b/stdlib/source/lux/data/coll/dictionary/ordered.lux index 2feb18e0f..16412e648 100644 --- a/stdlib/source/lux/data/coll/dictionary/ordered.lux +++ b/stdlib/source/lux/data/coll/dictionary/ordered.lux @@ -1,7 +1,7 @@ (.module: lux (lux (control [monad #+ do Monad] - eq + equality [order #+ Order]) (data (coll [list "L/" Monad Monoid Fold]) ["p" product] diff --git a/stdlib/source/lux/data/coll/dictionary/unordered.lux b/stdlib/source/lux/data/coll/dictionary/unordered.lux index aad28249f..053d53d48 100644 --- a/stdlib/source/lux/data/coll/dictionary/unordered.lux +++ b/stdlib/source/lux/data/coll/dictionary/unordered.lux @@ -1,7 +1,7 @@ (.module: lux (lux (control hash - [eq #+ Eq]) + [equality #+ Eq]) (data [maybe] (coll [list "list/" Fold Functor Monoid] [array "array/" Functor Fold]) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index f970ccf9f..063e9648c 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -4,7 +4,7 @@ [functor #+ Functor] [apply #+ Apply] [monad #+ do Monad] - [eq #+ Eq] + [equality #+ Eq] [fold]) (data [number "nat/" Codec] bool diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux index 2f48d3035..3a39a3e41 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 #+ Eq] + (lux (control [equality #+ Eq] ["F" functor]) (data (coll [list "L/" Monoid Functor])))) diff --git a/stdlib/source/lux/data/coll/queue/priority.lux b/stdlib/source/lux/data/coll/queue/priority.lux index 970cb9cc9..1c9c51075 100644 --- a/stdlib/source/lux/data/coll/queue/priority.lux +++ b/stdlib/source/lux/data/coll/queue/priority.lux @@ -1,6 +1,6 @@ (.module: lux - (lux (control [eq #+ Eq] + (lux (control [equality #+ Eq] [monad #+ do Monad]) (data (coll (tree ["F" finger])) [number "nat/" Interval] diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux index 5fe3befae..f5ade6bed 100644 --- a/stdlib/source/lux/data/coll/sequence.lux +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -3,7 +3,7 @@ (lux (control [functor #+ Functor] [apply #+ Apply] [monad #+ do Monad] - [eq #+ Eq] + [equality #+ Eq] monoid fold ["p" parser]) diff --git a/stdlib/source/lux/data/coll/set/ordered.lux b/stdlib/source/lux/data/coll/set/ordered.lux index 2e2ca56fc..5b7524a8a 100644 --- a/stdlib/source/lux/data/coll/set/ordered.lux +++ b/stdlib/source/lux/data/coll/set/ordered.lux @@ -1,7 +1,7 @@ (.module: lux (lux (control [monad #+ do Monad] - eq + equality [order #+ Order]) (data (coll [list "L/" Monad Monoid Fold] (dictionary ["d" ordered])) diff --git a/stdlib/source/lux/data/coll/set/unordered.lux b/stdlib/source/lux/data/coll/set/unordered.lux index 199a076c8..e977f35e5 100644 --- a/stdlib/source/lux/data/coll/set/unordered.lux +++ b/stdlib/source/lux/data/coll/set/unordered.lux @@ -1,6 +1,6 @@ (.module: lux - (lux (control [eq #+ Eq] + (lux (control [equality #+ Eq] [hash #*]) (data (coll (dictionary ["dict" unordered #+ Dict]) [list "list/" Fold Functor])))) diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux index 6c137878f..28ca96d41 100644 --- a/stdlib/source/lux/data/coll/tree/rose.lux +++ b/stdlib/source/lux/data/coll/tree/rose.lux @@ -2,7 +2,7 @@ lux (lux (control functor [monad #+ do Monad] - eq + equality ["p" parser] fold) (data (coll [list "L/" Monad Fold])) diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 8e6254c6b..56e324cac 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -1,6 +1,6 @@ (.module: lux - (lux (control [eq]) + (lux (control ["eq" equality]) (data (coll [list "L/" Functor])) [math] (type abstract))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index d960830db..03d4de615 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -3,7 +3,7 @@ For more information, please see: http://www.json.org/"} [lux #- Array] (lux (control [monad #+ do Monad] - [eq #+ Eq] + [equality #+ Eq] codec ["p" parser "parser/" Monad]) (data [bool] diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index ceeb59b1e..d1a84d675 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] + [equality #+ Eq] codec ["p" parser "p/" Monad] ["ex" exception #+ exception:]) diff --git a/stdlib/source/lux/data/ident.lux b/stdlib/source/lux/data/ident.lux index feb456d94..867f96d8b 100644 --- a/stdlib/source/lux/data/ident.lux +++ b/stdlib/source/lux/data/ident.lux @@ -1,6 +1,6 @@ (.module: lux - (lux (control [eq #+ Eq] + (lux (control [equality #+ Eq] [codec #+ Codec] hash) (data [text "text/" Monoid Eq]))) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 89be2362c..6c5a7d02e 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -4,7 +4,7 @@ ["F" functor] ["A" apply] [monad #+ do Monad] - [eq #+ Eq]))) + [equality #+ Eq]))) ## [Types] ## (type: (Maybe a) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index bb5cb8b8a..2aba0da7a 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -2,7 +2,7 @@ lux (lux (control number [monoid #+ Monoid] - [eq #+ Eq] + [equality #+ Eq] hash [order] enum diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 879ee0c1e..52cf8066f 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 #+ Eq] + (control [equality #+ Eq] number codec ["M" monad #+ do Monad] diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 2fe759932..9d241fe89 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 #+ Eq] + (control [equality #+ Eq] [order] number codec diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 9dbf0dec5..6b259b49f 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -1,7 +1,7 @@ (.module: lux (lux (control [monoid #+ Monoid] - [eq #+ Eq] + [equality #+ Eq] [order] [monad #+ do Monad] [codec #+ Codec] diff --git a/stdlib/source/lux/lang/type.lux b/stdlib/source/lux/lang/type.lux index d7dc33ca9..1bfea13d6 100644 --- a/stdlib/source/lux/lang/type.lux +++ b/stdlib/source/lux/lang/type.lux @@ -1,6 +1,6 @@ (.module: {#.doc "Basic functionality for working with types."} [lux #- function] - (lux (control [eq #+ Eq] + (lux (control [equality #+ Eq] [monad #+ do Monad]) (data [text "text/" Monoid Eq] [ident "ident/" Eq] diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index 44cd21b6d..cde2f97fe 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -1,6 +1,6 @@ (.module: [lux #- nat int deg] - (lux (control [eq #+ Eq]) + (lux (control [equality #+ Eq]) (data bool number [text #+ Eq "Text/" Monoid] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 4d9d6cf12..63590953b 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -1,7 +1,7 @@ (.module: [lux #- function] (lux (control [monad #+ do Monad] - [eq] + [equality] ["p" parser] ["ex" exception #+ exception:]) [function] diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux deleted file mode 100644 index 7d3083660..000000000 --- a/stdlib/source/lux/macro/poly/eq.lux +++ /dev/null @@ -1,150 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do Monad] - [eq] - ["p" parser]) - (data [text "text/" Monoid] - text/format - (coll [list "list/" Monad] - [sequence] - [array] - [queue] - (set ["set" unordered]) - (dictionary ["dict" unordered #+ Dict]) - (tree [rose])) - [number "nat/" Codec] - [product] - [bool] - [maybe]) - (time ["du" duration] - ["da" date] - ["i" instant]) - [macro] - (macro [code] - [syntax #+ syntax: Syntax] - (syntax [common]) - [poly #+ poly:]) - (type [unit]) - (lang [type]) - )) - -## [Derivers] -(poly: #export Eq - (`` (do @ - [#let [g!_ (code.local-symbol "_____________")] - *env* poly.env - inputT poly.peek - #let [@Eq (: (-> Type Code) - (function (_ type) - (` (eq.Eq (~ (poly.to-code *env* type))))))]] - ($_ p.either - ## Basic types - (~~ (do-template [ ] - [(do @ - [_ ] - (wrap (` (: (~ (@Eq inputT)) - ))))] - - [(poly.this Top) (function ((~ g!_) (~ g!_) (~ g!_)) true)] - [(poly.like Bool) bool.Eq] - [(poly.like Nat) number.Eq] - [(poly.like Int) number.Eq] - [(poly.like Deg) number.Eq] - [(poly.like Frac) number.Eq] - [(poly.like Text) text.Eq])) - ## Composite types - (~~ (do-template [ ] - [(do @ - [[_ argC] (poly.apply (p.seq (poly.this ) - Eq))] - (wrap (` (: (~ (@Eq inputT)) - ( (~ argC))))))] - - [.Maybe maybe.Eq] - [.List list.Eq] - [sequence.Sequence sequence.Eq] - [.Array array.Eq] - [queue.Queue queue.Eq] - [set.Set set.Eq] - [rose.Tree rose.Eq] - )) - (do @ - [[_ _ valC] (poly.apply ($_ p.seq - (poly.this dict.Dict) - poly.any - Eq))] - (wrap (` (: (~ (@Eq inputT)) - (dict.Eq (~ valC)))))) - ## Models - (~~ (do-template [ ] - [(do @ - [_ (poly.this )] - (wrap (` (: (~ (@Eq inputT)) - ))))] - - [du.Duration du.Eq] - [i.Instant i.Eq] - [da.Date da.Eq] - [da.Day da.Eq] - [da.Month da.Eq])) - (do @ - [_ (poly.apply (p.seq (poly.this unit.Qty) - poly.any))] - (wrap (` (: (~ (@Eq inputT)) - unit.Eq)))) - ## Variants - (do @ - [members (poly.variant (p.many Eq)) - #let [g!_ (code.local-symbol "_____________") - g!left (code.local-symbol "_____________left") - g!right (code.local-symbol "_____________right")]] - (wrap (` (: (~ (@Eq inputT)) - (function ((~ g!_) (~ g!left) (~ g!right)) - (case [(~ g!left) (~ g!right)] - (~+ (list/join (list/map (function (_ [tag g!eq]) - (list (` [((~ (code.nat tag)) (~ g!left)) - ((~ (code.nat tag)) (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right))))) - (list.enumerate members)))) - (~ g!_) - false)))))) - ## Tuples - (do @ - [g!eqs (poly.tuple (p.many Eq)) - #let [g!_ (code.local-symbol "_____________") - indices (|> (list.size g!eqs) dec (list.n/range +0)) - g!lefts (list/map (|>> nat/encode (text/compose "left") code.local-symbol) indices) - g!rights (list/map (|>> nat/encode (text/compose "right") code.local-symbol) indices)]] - (wrap (` (: (~ (@Eq inputT)) - (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) - (and (~+ (|> (list.zip3 g!eqs g!lefts g!rights) - (list/map (function (_ [g!eq g!left g!right]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) - ## Type recursion - (do @ - [[g!self bodyC] (poly.recursive Eq) - #let [g!_ (code.local-symbol "_____________")]] - (wrap (` (: (~ (@Eq inputT)) - (eq.rec (.function ((~ g!_) (~ g!self)) - (~ bodyC))))))) - poly.recursive-self - ## Type applications - (do @ - [[funcC argsC] (poly.apply (p.seq Eq (p.many Eq)))] - (wrap (` ((~ funcC) (~+ argsC))))) - ## Bound type-vars - poly.bound - ## Polymorphism - (do @ - [[funcC varsC bodyC] (poly.polymorphic Eq)] - (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list/map (|>> (~) eq.Eq (`)) varsC)) - (eq.Eq ((~ (poly.to-code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) - poly.recursive-call - ## If all else fails... - (|> poly.any - (:: @ map (|>> %type (format "Cannot create Eq for: ") p.fail)) - (:: @ join)) - )))) diff --git a/stdlib/source/lux/macro/poly/equality.lux b/stdlib/source/lux/macro/poly/equality.lux new file mode 100644 index 000000000..4cf8b2de0 --- /dev/null +++ b/stdlib/source/lux/macro/poly/equality.lux @@ -0,0 +1,150 @@ +(.module: + lux + (lux (control [monad #+ do Monad] + ["eq" equality] + ["p" parser]) + (data [text "text/" Monoid] + text/format + (coll [list "list/" Monad] + [sequence] + [array] + [queue] + (set ["set" unordered]) + (dictionary ["dict" unordered #+ Dict]) + (tree [rose])) + [number "nat/" Codec] + [product] + [bool] + [maybe]) + (time ["du" duration] + ["da" date] + ["i" instant]) + [macro] + (macro [code] + [syntax #+ syntax: Syntax] + (syntax [common]) + [poly #+ poly:]) + (type [unit]) + (lang [type]) + )) + +## [Derivers] +(poly: #export Eq + (`` (do @ + [#let [g!_ (code.local-symbol "_____________")] + *env* poly.env + inputT poly.peek + #let [@Eq (: (-> Type Code) + (function (_ type) + (` (eq.Eq (~ (poly.to-code *env* type))))))]] + ($_ p.either + ## Basic types + (~~ (do-template [ ] + [(do @ + [_ ] + (wrap (` (: (~ (@Eq inputT)) + ))))] + + [(poly.this Top) (function ((~ g!_) (~ g!_) (~ g!_)) true)] + [(poly.like Bool) bool.Eq] + [(poly.like Nat) number.Eq] + [(poly.like Int) number.Eq] + [(poly.like Deg) number.Eq] + [(poly.like Frac) number.Eq] + [(poly.like Text) text.Eq])) + ## Composite types + (~~ (do-template [ ] + [(do @ + [[_ argC] (poly.apply (p.seq (poly.this ) + Eq))] + (wrap (` (: (~ (@Eq inputT)) + ( (~ argC))))))] + + [.Maybe maybe.Eq] + [.List list.Eq] + [sequence.Sequence sequence.Eq] + [.Array array.Eq] + [queue.Queue queue.Eq] + [set.Set set.Eq] + [rose.Tree rose.Eq] + )) + (do @ + [[_ _ valC] (poly.apply ($_ p.seq + (poly.this dict.Dict) + poly.any + Eq))] + (wrap (` (: (~ (@Eq inputT)) + (dict.Eq (~ valC)))))) + ## Models + (~~ (do-template [ ] + [(do @ + [_ (poly.this )] + (wrap (` (: (~ (@Eq inputT)) + ))))] + + [du.Duration du.Eq] + [i.Instant i.Eq] + [da.Date da.Eq] + [da.Day da.Eq] + [da.Month da.Eq])) + (do @ + [_ (poly.apply (p.seq (poly.this unit.Qty) + poly.any))] + (wrap (` (: (~ (@Eq inputT)) + unit.Eq)))) + ## Variants + (do @ + [members (poly.variant (p.many Eq)) + #let [g!_ (code.local-symbol "_____________") + g!left (code.local-symbol "_____________left") + g!right (code.local-symbol "_____________right")]] + (wrap (` (: (~ (@Eq inputT)) + (function ((~ g!_) (~ g!left) (~ g!right)) + (case [(~ g!left) (~ g!right)] + (~+ (list/join (list/map (function (_ [tag g!eq]) + (list (` [((~ (code.nat tag)) (~ g!left)) + ((~ (code.nat tag)) (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right))))) + (list.enumerate members)))) + (~ g!_) + false)))))) + ## Tuples + (do @ + [g!eqs (poly.tuple (p.many Eq)) + #let [g!_ (code.local-symbol "_____________") + indices (|> (list.size g!eqs) dec (list.n/range +0)) + g!lefts (list/map (|>> nat/encode (text/compose "left") code.local-symbol) indices) + g!rights (list/map (|>> nat/encode (text/compose "right") code.local-symbol) indices)]] + (wrap (` (: (~ (@Eq inputT)) + (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) + (and (~+ (|> (list.zip3 g!eqs g!lefts g!rights) + (list/map (function (_ [g!eq g!left g!right]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) + ## Type recursion + (do @ + [[g!self bodyC] (poly.recursive Eq) + #let [g!_ (code.local-symbol "_____________")]] + (wrap (` (: (~ (@Eq inputT)) + (eq.rec (.function ((~ g!_) (~ g!self)) + (~ bodyC))))))) + poly.recursive-self + ## Type applications + (do @ + [[funcC argsC] (poly.apply (p.seq Eq (p.many Eq)))] + (wrap (` ((~ funcC) (~+ argsC))))) + ## Bound type-vars + poly.bound + ## Polymorphism + (do @ + [[funcC varsC bodyC] (poly.polymorphic Eq)] + (wrap (` (: (All [(~+ varsC)] + (-> (~+ (list/map (|>> (~) eq.Eq (`)) varsC)) + (eq.Eq ((~ (poly.to-code *env* inputT)) (~+ varsC))))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) + poly.recursive-call + ## If all else fails... + (|> poly.any + (:: @ map (|>> %type (format "Cannot create Eq for: ") p.fail)) + (:: @ join)) + )))) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 51a996c4c..1bf0cba96 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -1,7 +1,7 @@ (.module: {#.doc "Codecs for values in the JSON format."} lux (lux (control [monad #+ do Monad] - [eq #+ Eq] + [equality #+ Eq] codec ["p" parser "p/" Monad]) (data [bool] diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 5f5c17e20..d7621eba4 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -2,7 +2,7 @@ [lux #- nat int deg] (lux [macro #+ with-gensyms] (control [monad #+ do Monad] - [eq #+ Eq] + [equality #+ Eq] ["p" parser]) (data [bool] [number] diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 93fa324cb..89f906040 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -1,6 +1,6 @@ (.module: lux - (lux (control eq + (lux (control equality order enum codec diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index a91553544..5efccf432 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -1,6 +1,6 @@ (.module: lux - (lux (control eq + (lux (control equality order codec [monoid #+ Monoid] diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index c4d3c6fdf..12fe66172 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -1,7 +1,7 @@ (.module: lux (lux [io #- run] - (control eq + (control equality order enum codec diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 0d6f5b4df..84bff5ec9 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -1,7 +1,7 @@ (.module: lux (lux (control [monad #+ do Monad] - [eq] + ["eq" equality] ["p" parser]) (data [text "text/" Eq] text/format diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index 2af12b5df..0f81c6a08 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -2,7 +2,7 @@ lux (lux (control [monad #+ do Monad] ["p" parser "p/" Monad] - [eq #+ Eq] + [equality #+ Eq] [order #+ Order] [enum #+ Enum]) (data text/format diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux index 2cb4ed291..88b1913e9 100644 --- a/stdlib/source/lux/world/blob.jvm.lux +++ b/stdlib/source/lux/world/blob.jvm.lux @@ -2,7 +2,7 @@ [lux #- i64] (lux (control [monad #+ do] ["ex" exception #+ exception:] - [eq]) + ["eq" equality]) (data [bit] [maybe] ["e" error] diff --git a/stdlib/test/test/lux/control/eq.lux b/stdlib/test/test/lux/control/eq.lux deleted file mode 100644 index c63973079..000000000 --- a/stdlib/test/test/lux/control/eq.lux +++ /dev/null @@ -1,19 +0,0 @@ -(.module: - lux - (lux (control ["/" eq] - [monad #+ do]) - (math ["r" random]) - test)) - -(def: #export (spec Eq generator) - (All [a] (-> (/.Eq a) (r.Random a) Test)) - (do r.Monad - [sample generator - another generator] - ($_ seq - (test "Equality is reflexive." - (:: Eq = sample sample)) - (test "Equality is symmetric." - (if (:: Eq = sample another) - (:: Eq = another sample) - true))))) diff --git a/stdlib/test/test/lux/control/equality.lux b/stdlib/test/test/lux/control/equality.lux new file mode 100644 index 000000000..5139b41ea --- /dev/null +++ b/stdlib/test/test/lux/control/equality.lux @@ -0,0 +1,19 @@ +(.module: + lux + (lux (control ["/" equality] + [monad #+ do]) + (math ["r" random]) + test)) + +(def: #export (spec Eq generator) + (All [a] (-> (/.Eq a) (r.Random a) Test)) + (do r.Monad + [sample generator + another generator] + ($_ seq + (test "Equality is reflexive." + (:: Eq = sample sample)) + (test "Equality is symmetric." + (if (:: Eq = sample another) + (:: Eq = another sample) + true))))) diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux index c295463cf..bc26444ce 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 ["M" monad #+ do Monad] - [eq #+ Eq] + [equality #+ Eq] ["&" parser] pipe) (data [text "Text/" Monoid] diff --git a/stdlib/test/test/lux/data/coll/bits.lux b/stdlib/test/test/lux/data/coll/bits.lux index f416f9866..a5141034c 100644 --- a/stdlib/test/test/lux/data/coll/bits.lux +++ b/stdlib/test/test/lux/data/coll/bits.lux @@ -5,7 +5,7 @@ (data (coll ["/" bits])) ["r" math/random]) lux/test - (test (lux (control ["_." eq])))) + (test (lux (control ["_eq" equality])))) (def: (size min max) (-> Nat Nat (r.Random Nat)) diff --git a/stdlib/test/test/lux/data/coll/dictionary/ordered.lux b/stdlib/test/test/lux/data/coll/dictionary/ordered.lux index 041e27484..a373f6107 100644 --- a/stdlib/test/test/lux/data/coll/dictionary/ordered.lux +++ b/stdlib/test/test/lux/data/coll/dictionary/ordered.lux @@ -2,7 +2,7 @@ lux (lux [io] (control [monad #+ do Monad] - [eq #+ Eq]) + [equality #+ Eq]) (data [product] [number] (coll (set ["s" unordered]) diff --git a/stdlib/test/test/lux/data/coll/dictionary/unordered.lux b/stdlib/test/test/lux/data/coll/dictionary/unordered.lux index f0224a015..93b83dc7b 100644 --- a/stdlib/test/test/lux/data/coll/dictionary/unordered.lux +++ b/stdlib/test/test/lux/data/coll/dictionary/unordered.lux @@ -2,7 +2,7 @@ lux (lux [io] (control [monad #+ do Monad] - [eq]) + ["eq" equality]) (data [text] text/format [number] diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index e2781d2a5..43b0851c0 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 #+ do Monad] codec - [eq #+ Eq] + [equality #+ Eq] pipe ["p" parser]) (data [text] @@ -20,7 +20,7 @@ (macro [code] [syntax #+ syntax:] [poly #+ derived:] - [poly/eq] + [poly/equality] [poly/json]) (type [unit]) ["r" math/random] @@ -97,7 +97,7 @@ (r.alt r.frac (r.seq r.frac gen-recursive))))) -(derived: (poly/eq.Eq Recursive)) +(derived: (poly/equality.Eq Recursive)) (def: qty (All [unit] (r.Random (unit.Qty unit))) diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux deleted file mode 100644 index d22475b11..000000000 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ /dev/null @@ -1,70 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do Monad] - [eq #+ Eq]) - (data text/format - [bool] - [number "int/" Number] - [text] - [maybe] - (coll [list])) - ["r" math/random] - [macro] - (macro [poly #+ derived:] - ["&" poly/eq])) - lux/test) - -## [Utils] -(type: Variant - (#Case0 Bool) - (#Case1 Int) - (#Case2 Frac)) - -(type: #rec Recursive - (#Number Frac) - (#Addition Frac Recursive)) - -(type: Record - {#bool Bool - #int Int - #frac Frac - #text Text - #maybe (Maybe Int) - #list (List Int) - #variant Variant - #tuple [Int Frac Text] - #recursive Recursive}) - -(def: gen-recursive - (r.Random Recursive) - (r.rec (function (_ gen-recursive) - (r.alt r.frac - (r.seq r.frac gen-recursive))))) - -(def: gen-record - (r.Random Record) - (do r.Monad - [size (:: @ map (n/% +2) r.nat) - #let [gen-int (|> r.int (:: @ map (|>> int/abs (i/% 1_000_000))))]] - ($_ r.seq - r.bool - gen-int - r.frac - (r.text size) - (r.maybe gen-int) - (r.list size gen-int) - ($_ r.alt r.bool gen-int r.frac) - ($_ r.seq gen-int r.frac (r.text size)) - gen-recursive))) - -(derived: (&.Eq Record)) - -## [Tests] -(context: "Eq polytypism" - (<| (times +100) - (do @ - [sample gen-record - #let [(^open "&/") Eq]] - (test "Every instance equals itself." - (&/= sample sample))))) diff --git a/stdlib/test/test/lux/macro/poly/equality.lux b/stdlib/test/test/lux/macro/poly/equality.lux new file mode 100644 index 000000000..beb203bcb --- /dev/null +++ b/stdlib/test/test/lux/macro/poly/equality.lux @@ -0,0 +1,70 @@ +(.module: + lux + (lux [io] + (control [monad #+ do Monad] + [equality #+ Eq]) + (data text/format + [bool] + [number "int/" Number] + [text] + [maybe] + (coll [list])) + ["r" math/random] + [macro] + (macro [poly #+ derived:] + ["&" poly/equality])) + lux/test) + +## [Utils] +(type: Variant + (#Case0 Bool) + (#Case1 Int) + (#Case2 Frac)) + +(type: #rec Recursive + (#Number Frac) + (#Addition Frac Recursive)) + +(type: Record + {#bool Bool + #int Int + #frac Frac + #text Text + #maybe (Maybe Int) + #list (List Int) + #variant Variant + #tuple [Int Frac Text] + #recursive Recursive}) + +(def: gen-recursive + (r.Random Recursive) + (r.rec (function (_ gen-recursive) + (r.alt r.frac + (r.seq r.frac gen-recursive))))) + +(def: gen-record + (r.Random Record) + (do r.Monad + [size (:: @ map (n/% +2) r.nat) + #let [gen-int (|> r.int (:: @ map (|>> int/abs (i/% 1_000_000))))]] + ($_ r.seq + r.bool + gen-int + r.frac + (r.text size) + (r.maybe gen-int) + (r.list size gen-int) + ($_ r.alt r.bool gen-int r.frac) + ($_ r.seq gen-int r.frac (r.text size)) + gen-recursive))) + +(derived: (&.Eq Record)) + +## [Tests] +(context: "Eq polytypism" + (<| (times +100) + (do @ + [sample gen-record + #let [(^open "&/") Eq]] + (test "Every instance equals itself." + (&/= sample sample))))) diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux index 3cb6653a5..86c3eca7f 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 #+ do Monad] [functor] - [eq #+ Eq] + [equality #+ Eq] [state]) (data text/format [bool] diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 5c5ea835f..ba45ff6e4 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 #+ do Monad] - [eq #+ Eq] + [equality #+ Eq] ["p" parser]) (data [text "Text/" Monoid] text/format diff --git a/stdlib/test/test/lux/type/implicit.lux b/stdlib/test/test/lux/type/implicit.lux index c07067b3e..a5af06c5d 100644 --- a/stdlib/test/test/lux/type/implicit.lux +++ b/stdlib/test/test/lux/type/implicit.lux @@ -3,7 +3,7 @@ (lux [io] (control [monad #+ do Monad] functor - [eq]) + [equality]) (data [number] [bool "bool/" Eq] (coll [list])) diff --git a/stdlib/test/test/lux/world/blob.lux b/stdlib/test/test/lux/world/blob.lux index 1093f302f..e1c77552b 100644 --- a/stdlib/test/test/lux/world/blob.lux +++ b/stdlib/test/test/lux/world/blob.lux @@ -10,7 +10,7 @@ (world ["/" blob]) ["r" math/random]) lux/test - (test (lux (control ["_." eq])))) + (test (lux (control ["_eq" equality])))) (def: (succeed result) (-> (e.Error Bool) Bool) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 6a429093b..ce4113317 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -66,7 +66,7 @@ ["_." fuzzy])) (macro ["_." code] ["_." syntax] - (poly ["poly_." eq] + (poly ["poly_." equality] ["poly_." functor])) (type ["_." implicit] ["_." resource] -- cgit v1.2.3