From 9d89d791a8c65e6d2fa5ee9ff7ecae29ca9b7fdc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 10 Jul 2018 19:28:45 -0400 Subject: - Re-implemented sets using abstract types to make it impossible to use dictionary functions on them. --- stdlib/source/lux/data/coll/set/ordered.lux | 150 +++++++++++++------------- stdlib/source/lux/data/coll/set/unordered.lux | 127 +++++++++++----------- 2 files changed, 141 insertions(+), 136 deletions(-) diff --git a/stdlib/source/lux/data/coll/set/ordered.lux b/stdlib/source/lux/data/coll/set/ordered.lux index 45a6b0cb0..4761b7409 100644 --- a/stdlib/source/lux/data/coll/set/ordered.lux +++ b/stdlib/source/lux/data/coll/set/ordered.lux @@ -1,86 +1,86 @@ (.module: lux - (lux (control [monad #+ do Monad] - equivalence + (lux (control [equivalence #+ Equivalence] [order #+ Order]) - (data (coll [list "L/" Monad Monoid Fold] - (dictionary ["d" ordered])) - ["p" product] - ["M" maybe #+ Functor]) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]))) - -(type: #export (Set a) - (d.Dict a a)) - -(def: #export new - (All [a] (-> (Order a) (Set a))) - d.new) - -(def: #export (member? set elem) - (All [a] (-> (Set a) a Bool)) - (d.contains? elem set)) - -(do-template [ ] - [(def: #export ( set) - (All [a] (-> (Set a) (Maybe a))) - ( set))] - - [min d.min] - [max d.max] + (data (coll [list "list/" Fold] + (dictionary ["//" ordered]))) + (type abstract))) + +(abstract: #export (Set a) + {} + + (//.Dict a a) + + (def: #export new + (All [a] (-> (Order a) (Set a))) + (|>> //.new :abstraction)) + + (def: #export (member? set elem) + (All [a] (-> (Set a) a Bool)) + (|> set :representation (//.contains? elem))) + + (do-template [ ] + [(def: #export + (All [a] (-> (Set a) (Maybe a))) + (|>> :representation ))] + + [min //.min] + [max //.max] + ) + + (do-template [ ] + [(def: #export + (-> (Set Any) Nat) + (|>> :representation ))] + + [size //.size] + [depth //.depth] + ) + + (def: #export (add elem set) + (All [a] (-> a (Set a) (Set a))) + (|> set :representation (//.put elem elem) :abstraction)) + + (def: #export (remove elem set) + (All [a] (-> a (Set a) (Set a))) + (|> set :representation (//.remove elem) :abstraction)) + + (def: #export to-list + (All [a] (-> (Set a) (List a))) + (|>> :representation //.keys)) + + (def: #export (from-list Order list) + (All [a] (-> (Order a) (List a) (Set a))) + (list/fold add (new Order) list)) + + (def: #export (union left right) + (All [a] (-> (Set a) (Set a) (Set a))) + (list/fold ..add right (..to-list left))) + + (def: #export (intersection left right) + (All [a] (-> (Set a) (Set a) (Set a))) + (|> (..to-list right) + (list.filter (..member? left)) + (..from-list (get@ #//.order (:representation right))))) + + (def: #export (difference param subject) + (All [a] (-> (Set a) (Set a) (Set a))) + (|> (..to-list subject) + (list.filter (|>> (..member? param) not)) + (..from-list (get@ #//.order (:representation subject))))) + + (structure: #export Equivalence (All [a] (Equivalence (Set a))) + (def: (= reference sample) + (:: (list.Equivalence (:: (:representation sample) eq)) + = (..to-list reference) (..to-list sample)))) ) -(do-template [ ] - [(def: #export ( set) - (All [a] (-> (Set a) Nat)) - ( set))] - - [size d.size] - [depth d.depth] - ) - -(def: #export (add elem set) - (All [a] (-> a (Set a) (Set a))) - (d.put elem elem set)) - -(def: #export (remove elem set) - (All [a] (-> a (Set a) (Set a))) - (d.remove elem set)) - -(def: #export (from-list Order list) - (All [a] (-> (Order a) (List a) (Set a))) - (L/fold add (new Order) list)) - -(def: #export (to-list set) - (All [a] (-> (Set a) (List a))) - (d.keys set)) - -(def: #export (union left right) - (All [a] (-> (Set a) (Set a) (Set a))) - (L/fold add right (to-list left))) - -(def: #export (intersection left right) - (All [a] (-> (Set a) (Set a) (Set a))) - (|> (to-list right) - (list.filter (member? left)) - (from-list (get@ #d.order right)))) - -(def: #export (difference param subject) - (All [a] (-> (Set a) (Set a) (Set a))) - (|> (to-list subject) - (list.filter (|>> (member? param) not)) - (from-list (get@ #d.order subject)))) - (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bool)) - (list.every? (member? super) (to-list sub))) + (|> sub + ..to-list + (list.every? (..member? super)))) (def: #export (super? sub super) (All [a] (-> (Set a) (Set a) Bool)) (sub? super sub)) - -(structure: #export Equivalence (All [a] (Equivalence (Set a))) - (def: (= reference sample) - (:: (list.Equivalence (:: sample eq)) - = (to-list reference) (to-list sample)))) diff --git a/stdlib/source/lux/data/coll/set/unordered.lux b/stdlib/source/lux/data/coll/set/unordered.lux index 6f0007412..1d9942206 100644 --- a/stdlib/source/lux/data/coll/set/unordered.lux +++ b/stdlib/source/lux/data/coll/set/unordered.lux @@ -1,76 +1,81 @@ (.module: lux (lux (control [equivalence #+ Equivalence] - [hash #*]) + [hash #+ Hash]) (data (coll (dictionary ["dict" unordered #+ Dict]) - [list "list/" Fold Functor])))) + [list "list/" Fold])) + (type abstract))) -## [Types] -(type: #export (Set a) - (Dict a a)) - -## [Values] -(def: #export (new Hash) - (All [a] (-> (Hash a) (Set a))) - (dict.new Hash)) - -(def: #export (add elem set) - (All [a] (-> a (Set a) (Set a))) - (dict.put elem elem set)) - -(def: #export (remove elem set) - (All [a] (-> a (Set a) (Set a))) - (dict.remove elem set)) - -(def: #export (member? set elem) - (All [a] (-> (Set a) a Bool)) - (dict.contains? elem set)) - -(def: #export to-list - (All [a] (-> (Set a) (List a))) - dict.keys) +(abstract: #export (Set a) + {} + + (Dict a a) + + (def: #export new + (All [a] (-> (Hash a) (Set a))) + (|>> dict.new :abstraction)) + + (def: #export size + (All [a] (-> (Set a) Nat)) + (|>> :representation dict.size)) + + (def: #export (add elem set) + (All [a] (-> a (Set a) (Set a))) + (|> set :representation (dict.put elem elem) :abstraction)) + + (def: #export (remove elem set) + (All [a] (-> a (Set a) (Set a))) + (|> set :representation (dict.remove elem) :abstraction)) + + (def: #export (member? set elem) + (All [a] (-> (Set a) a Bool)) + (|> set :representation (dict.contains? elem))) + + (def: #export to-list + (All [a] (-> (Set a) (List a))) + (|>> :representation dict.keys)) + + (def: #export (union xs yx) + (All [a] (-> (Set a) (Set a) (Set a))) + (:abstraction (dict.merge (:representation xs) (:representation yx)))) + + (def: #export (difference sub base) + (All [a] (-> (Set a) (Set a) (Set a))) + (list/fold ..remove base (..to-list sub))) + + (def: #export (intersection filter base) + (All [a] (-> (Set a) (Set a) (Set a))) + (:abstraction (dict.select (dict.keys (:representation filter)) + (:representation base)))) + + (structure: #export Equivalence (All [a] (Equivalence (Set a))) + (def: (= reference sample) + (let [[Hash _] (:representation reference)] + (:: (list.Equivalence (get@ #hash.eq Hash)) = + (..to-list reference) (..to-list sample))))) + + (structure: #export Hash (All [a] (Hash (Set a))) + (def: eq ..Equivalence) + + (def: (hash set) + (let [[Hash _] (:representation set)] + (list/fold (function (_ elem acc) (n/+ (:: Hash hash elem) acc)) + +0 + (..to-list set))))) + ) + +(def: #export empty? + (All [a] (-> (Set a) Bool)) + (|>> ..size (n/= +0))) (def: #export (from-list Hash xs) (All [a] (-> (Hash a) (List a) (Set a))) - (list/fold add (new Hash) xs)) - -(def: #export (union xs yx) - (All [a] (-> (Set a) (Set a) (Set a))) - (dict.merge xs yx)) - -(def: #export (difference sub base) - (All [a] (-> (Set a) (Set a) (Set a))) - (list/fold remove base (to-list sub))) - -(def: #export (intersection filter base) - (All [a] (-> (Set a) (Set a) (Set a))) - (dict.select (dict.keys filter) base)) - -(def: #export (size set) - (All [a] (-> (Set a) Nat)) - (dict.size set)) - -(def: #export (empty? set) - (All [a] (-> (Set a) Bool)) - (n/= +0 (dict.size set))) + (list/fold ..add (..new Hash) xs)) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bool)) - (list.every? (member? super) (to-list sub))) + (list.every? (..member? super) (..to-list sub))) (def: #export (super? sub super) (All [a] (-> (Set a) (Set a) Bool)) (sub? super sub)) - -## [Structures] -(structure: #export Equivalence (All [a] (Equivalence (Set a))) - (def: (= (^@ test [Hash _]) subject) - (:: (list.Equivalence (get@ #hash.eq Hash)) = (to-list test) (to-list subject)))) - -(structure: #export Hash (All [a] (Hash (Set a))) - (def: eq Equivalence) - - (def: (hash (^@ set [Hash _])) - (list/fold (function (_ elem acc) (n/+ (:: Hash hash elem) acc)) - +0 - (to-list set)))) -- cgit v1.2.3