Commit 0ce751c4 authored by Mart Lubbers's avatar Mart Lubbers

Merge branch '31-add-instances-for-data-map-set' into 'master'

Resolve "add instances for Data.Map/Set"

Closes #31

See merge request !91
parents 0e9fb2e2 15a0118e
Pipeline #8803 passed with stage
in 1 minute and 31 seconds
......@@ -56,7 +56,7 @@ class Foldable t where
* Right-associative fold of a structure, but with strict application of
* the operator.
*/
foldr` :: (a b -> b) b !(t a) -> b
foldr` :: (a b -> b) !b !(t a) -> b
/**
* Left-associative fold of a structure.
......@@ -68,7 +68,7 @@ class Foldable t where
* Left-associative fold of a structure, but with strict application of the
* operator.
*/
foldl` :: (b a -> b) b !(t a) -> b
foldl` :: (b a -> b) !b !(t a) -> b
/**
* A variant of {{foldr}} that has no base case, and thus may only be
......
......@@ -10,7 +10,7 @@ import Data.Graph.Inductive.Graph
, key :: Int
}
instance == (NodeMap a) | == a
instance == (NodeMap a) | Eq a
// | Create a new, empty mapping.
new :: NodeMap a
......
......@@ -19,7 +19,7 @@ import qualified Data.List as DL
, key :: Int
}
instance == (NodeMap a) | == a where
instance == (NodeMap a) | Eq a where
(==) {map, key} {map = map`, key = key`} = key == key` && map == map`
// | Create a new, empty mapping.
......
......@@ -11,6 +11,7 @@ from StdBool import not
from StdFunc import id
from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Data.Generics.GenEq import generic gEq
from Data.Generics.GenLexOrd import generic gLexOrd, :: LexOrd
from Data.Monoid import class Monoid, class Semigroup
import qualified StdList as SL
from Data.List import foldr
......@@ -31,7 +32,8 @@ import StdClass
instance Monoid (Map k v) | < k
instance == (Map k v) | == k & == v
instance == (Map k v) | Eq k & Eq v
instance < (Map k v) | Ord k & Ord v
//Basic functions
......@@ -170,6 +172,7 @@ fromList :: !u:[v:(!a, !b)] -> Map a b | == a & < a, [u <= v]
derive JSONEncode Map
derive JSONDecode Map
derive gEq Map
derive gLexOrd Map
/**
* Check if a key exists in a Map.
......
......@@ -6,10 +6,10 @@ from StdBool import &&, ||
from StdFunc import id, flip, o, const
from StdTuple import snd
from StdMisc import abort, undef
import StdString
import StdString, StdTuple
from Data.Generics.GenEq import generic gEq
import qualified StdList as SL
import Data.Maybe, Text.JSON
import Data.Maybe, Text.JSON, Data.Generics.GenLexOrd
from Data.Set import :: Set
import qualified Data.Set as DS
import Data.Monoid, Data.Functor, Control.Applicative
......@@ -56,8 +56,6 @@ mapSize :: !(Map k a) -> Int
mapSize Tip = 0
mapSize (Bin sz _ _ _ _) = sz
:: LexOrd = LT | GT | EQ
//lexOrd :: !a !a -> LexOrd | < a
lexOrd x y :== if (x < y) LT (if (x > y) GT EQ)
......@@ -1891,11 +1889,11 @@ bin k x l r = Bin (mapSize l + mapSize r + 1) k x l r
// actually seems one of the faster methods to gLexOrd{|*|} two trees
// and it is certainly the simplest :-)
////////////////////////////////////////////////////////////////////
instance == (Map k a) | == k & == a where
instance == (Map k a) | Eq k & Eq a where
(==) t1 t2 = (mapSize t1 == mapSize t2) && (toAscList t1 == toAscList t2)
instance == (a, b) | == a & == b where
(==) (x1, y1) (x2, y2) = x1 == x2 && y1 == y2
instance < (Map k v) | Ord k & Ord v where
(<) t1 t2 = toAscList t1 < toAscList t2
////////////////////////////////////////////////////////////////////
// Functor
......@@ -2526,4 +2524,5 @@ gEq{|Map|} fk fv mx my = length mxl == length myl && and [fk kx ky && fv vx vy \
where
mxl = toList mx
myl = toList my
gLexOrd{|Map|} kLexOrd vLexOrd x y = gLexOrd{|* -> *|} (gLexOrd{|* -> * -> *|} kLexOrd vLexOrd) (toAscList x) (toAscList y)
......@@ -5,6 +5,9 @@ from StdClass import class Ord (..), <=, >
from Data.Maybe import :: Maybe
from Data.List import foldl, map
from StdBool import not, &&
from Data.Generics.GenEq import generic gEq
from Data.Generics.GenLexOrd import generic gLexOrd, :: LexOrd
from Data.Foldable import class Foldable
// This module is ported from Haskell Data.Set by László Domoszlai. 2013.sep.6
......@@ -47,8 +50,10 @@ from StdBool import not, &&
| Bin !Int !a !(Set a) !(Set a)
instance == (Set a) | == a
instance < (Set a) | < a
derive gEq Set
derive gLexOrd Set
instance Foldable Set
/**
* True iff this is the empty set.
......
implementation module Data.Set
import StdClass, StdMisc, StdBool, StdList, StdFunc, StdInt, StdTuple
import Data.Maybe
import StdClass, StdMisc, StdBool, StdFunc, StdInt, StdTuple
import Data.Maybe, Data.Generics.GenEq, Data.Generics.GenLexOrd, Data.Monoid
from Data.Foldable import class Foldable (..)
import qualified StdList
from StdList import instance == [a]
//mapSet :: !(a -> b) !(Set a) -> Set b | < a & == a & < b & == b
//mapSet f s = fromList (map f (toList s))
......@@ -34,6 +37,35 @@ instance < (Set a) | < a where
| a > b = False
| otherwise = compare as bs
gEq{|Set|} eEq x y = (size x == size y) && gEq{|* -> *|} eEq (toAscList x) (toAscList y)
gLexOrd{|Set|} eLexOrd x y = gLexOrd{|* -> *|} eLexOrd (toAscList x) (toAscList y)
instance Foldable Set where
fold x = foldMap id x
foldMap f x = foldr (mappend o f) mempty x
foldr _ z Tip = z
foldr f z (Bin _ x l r) = foldr f (f x (foldr f z r)) l
foldr` _ z Tip = z
foldr` f z (Bin _ x l r) = foldr` f (f x (foldr` f z r)) l
foldl _ z Tip = z
foldl f z (Bin _ x l r) = foldl f (f (foldl f z l) x) r
foldl` _ z Tip = z
foldl` f z (Bin _ x l r) = foldl` f (f (foldl` f z l) x) r
foldr1 f (Bin _ x Tip Tip) = x
foldr1 f (Bin _ x Tip r) = foldr f x r
foldr1 f (Bin _ x l Tip) = foldr f x l
foldr1 f (Bin _ x l r) = foldr f (f x (foldr1 f r)) l
foldl1 f (Bin _ x Tip Tip) = x
foldl1 f (Bin _ x Tip r) = foldl f x r
foldl1 f (Bin _ x l Tip) = foldl f x l
foldl1 f (Bin _ x l r) = foldl f (f (foldr1 f l) x) r
/*--------------------------------------------------------------------
* Query
*--------------------------------------------------------------------*/
......@@ -206,7 +238,7 @@ hedgeDiff blo bhi t (Bin _ x l r) = merge (hedgeDiff blo bmi (trim blo bmi t) l)
intersections :: ![Set a] -> Set a | < a & == a
intersections [t] = t
intersections [t:ts] = foldl intersection t ts
intersections [t:ts] = 'StdList'.foldl intersection t ts
// | /O(n+m)/. The intersection of two sets.
// Elements of the result come from the first set, so for example
......@@ -281,7 +313,7 @@ fold f z (Bin _ x l r) = fold f (f x (fold f z r)) l
// | /O(n*log n)/. Create a set from a list of elements.
fromList :: ![a] -> Set a | < a
fromList xs = foldl ins newSet xs
fromList xs = 'StdList'.foldl ins newSet xs
where
ins :: !(Set a) !a -> Set a | < a
ins t x = insert x t
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment