From bdf674249b993b1135d59420033a92ba39278fea Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 1 May 2018 22:02:27 -0400 Subject: - Re-organized priority-queue modules. --- stdlib/source/lux/data/coll/priority-queue.lux | 102 ------------------------- stdlib/source/lux/data/coll/queue/priority.lux | 102 +++++++++++++++++++++++++ 2 files changed, 102 insertions(+), 102 deletions(-) delete mode 100644 stdlib/source/lux/data/coll/priority-queue.lux create mode 100644 stdlib/source/lux/data/coll/queue/priority.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux/data/coll/priority-queue.lux b/stdlib/source/lux/data/coll/priority-queue.lux deleted file mode 100644 index 833d3b3e1..000000000 --- a/stdlib/source/lux/data/coll/priority-queue.lux +++ /dev/null @@ -1,102 +0,0 @@ -(.module: - lux - (lux (control [eq #+ Eq] - [monad #+ do Monad]) - (data (coll (tree ["F" finger])) - [number] - [maybe]))) - -(type: #export Priority Nat) - -(type: #export (Queue a) - (Maybe (F.Fingers Priority a))) - -(def: max-priority Priority ("lux nat max")) -(def: min-priority Priority ("lux nat min")) - -(def: #export empty - Queue - #.None) - -(def: #export (peek queue) - (All [a] (-> (Queue a) (Maybe a))) - (do maybe.Monad - [fingers queue] - (wrap (maybe.assume (F.search (n/= (F.tag fingers)) fingers))))) - -(def: #export (size queue) - (All [a] (-> (Queue a) Nat)) - (case queue - #.None - +0 - - (#.Some fingers) - (loop [node (get@ #F.tree fingers)] - (case node - (#F.Leaf _ _) - +1 - - (#F.Branch _ left right) - (n/+ (recur left) (recur right)))))) - -(def: #export (member? Eq queue member) - (All [a] (-> (Eq a) (Queue a) a Bool)) - (case queue - #.None - false - - (#.Some fingers) - (loop [node (get@ #F.tree fingers)] - (case node - (#F.Leaf _ reference) - (:: Eq = reference member) - - (#F.Branch _ left right) - (or (recur left) - (recur right)))))) - -(def: #export (pop queue) - (All [a] (-> (Queue a) (Queue a))) - (do maybe.Monad - [fingers queue - #let [highest-priority (F.tag fingers)] - node' (loop [node (get@ #F.tree fingers)] - (case node - (#F.Leaf priority reference) - (if (n/= highest-priority priority) - #.None - (#.Some node)) - - (#F.Branch priority left right) - (if (n/= highest-priority (F.tag (set@ #F.tree left fingers))) - (case (recur left) - #.None - (#.Some right) - - (#.Some =left) - (|> (F.branch (set@ #F.tree =left fingers) - (set@ #F.tree right fingers)) - (get@ #F.tree) - #.Some)) - (case (recur right) - #.None - (#.Some left) - - (#.Some =right) - (|> (F.branch (set@ #F.tree left fingers) - (set@ #F.tree =right fingers)) - (get@ #F.tree) - #.Some)) - )))] - (wrap (set@ #F.tree node' fingers)))) - -(def: #export (push priority value queue) - (All [a] (-> Priority a (Queue a) (Queue a))) - (let [addition {#F.monoid number.Max@Monoid - #F.tree (#F.Leaf priority value)}] - (case queue - #.None - (#.Some addition) - - (#.Some fingers) - (#.Some (F.branch fingers addition))))) diff --git a/stdlib/source/lux/data/coll/queue/priority.lux b/stdlib/source/lux/data/coll/queue/priority.lux new file mode 100644 index 000000000..833d3b3e1 --- /dev/null +++ b/stdlib/source/lux/data/coll/queue/priority.lux @@ -0,0 +1,102 @@ +(.module: + lux + (lux (control [eq #+ Eq] + [monad #+ do Monad]) + (data (coll (tree ["F" finger])) + [number] + [maybe]))) + +(type: #export Priority Nat) + +(type: #export (Queue a) + (Maybe (F.Fingers Priority a))) + +(def: max-priority Priority ("lux nat max")) +(def: min-priority Priority ("lux nat min")) + +(def: #export empty + Queue + #.None) + +(def: #export (peek queue) + (All [a] (-> (Queue a) (Maybe a))) + (do maybe.Monad + [fingers queue] + (wrap (maybe.assume (F.search (n/= (F.tag fingers)) fingers))))) + +(def: #export (size queue) + (All [a] (-> (Queue a) Nat)) + (case queue + #.None + +0 + + (#.Some fingers) + (loop [node (get@ #F.tree fingers)] + (case node + (#F.Leaf _ _) + +1 + + (#F.Branch _ left right) + (n/+ (recur left) (recur right)))))) + +(def: #export (member? Eq queue member) + (All [a] (-> (Eq a) (Queue a) a Bool)) + (case queue + #.None + false + + (#.Some fingers) + (loop [node (get@ #F.tree fingers)] + (case node + (#F.Leaf _ reference) + (:: Eq = reference member) + + (#F.Branch _ left right) + (or (recur left) + (recur right)))))) + +(def: #export (pop queue) + (All [a] (-> (Queue a) (Queue a))) + (do maybe.Monad + [fingers queue + #let [highest-priority (F.tag fingers)] + node' (loop [node (get@ #F.tree fingers)] + (case node + (#F.Leaf priority reference) + (if (n/= highest-priority priority) + #.None + (#.Some node)) + + (#F.Branch priority left right) + (if (n/= highest-priority (F.tag (set@ #F.tree left fingers))) + (case (recur left) + #.None + (#.Some right) + + (#.Some =left) + (|> (F.branch (set@ #F.tree =left fingers) + (set@ #F.tree right fingers)) + (get@ #F.tree) + #.Some)) + (case (recur right) + #.None + (#.Some left) + + (#.Some =right) + (|> (F.branch (set@ #F.tree left fingers) + (set@ #F.tree =right fingers)) + (get@ #F.tree) + #.Some)) + )))] + (wrap (set@ #F.tree node' fingers)))) + +(def: #export (push priority value queue) + (All [a] (-> Priority a (Queue a) (Queue a))) + (let [addition {#F.monoid number.Max@Monoid + #F.tree (#F.Leaf priority value)}] + (case queue + #.None + (#.Some addition) + + (#.Some fingers) + (#.Some (F.branch fingers addition))))) -- cgit v1.2.3