Commit 951cacaf authored by Steffen Michels's avatar Steffen Michels

improve & refactor fold related function in Data.List

parent 108b7e9d
Pipeline #17348 failed with stage
in 1 minute and 38 seconds
......@@ -76,14 +76,14 @@ class Foldable t where
* applied to non-empty structures.
* `foldr1 f = 'Data.List'.{{foldr1}} f o {{toList}}`
*/
foldr1 :: (a a -> a) !(t a) -> a
foldr1 :: !(a a -> a) !(t a) -> a
/**
* A variant of {{foldl}} that has no base case, and thus may only be
* applied to non-empty structures.
* `foldl1 f = 'Data.List'.{{foldl1}} f o {{toList}}`
*/
foldl1 :: (a a -> a) !(t a) -> a
foldl1 :: !(a a -> a) !(t a) -> a
// TODO Cleanify
//instance Ix i => Foldable (Array i)
......
......@@ -4,7 +4,7 @@ import StdBool
import StdFunc
import StdInt
from StdList import ++, filter, hd, isEmpty, isMember, map, reverse, tl,
instance length []
instance length [], foldr
import StdOrdList
import StdTuple
......
......@@ -82,14 +82,12 @@ intercalate :: !.[a] ![.[a]] -> .[a]
transpose :: ![[a]] -> [.[a]]
subsequences :: .[a] -> .[[a]]
permutations :: [a] -> .[[a]]
foldl1 :: (.a -> .(.a -> .a)) ![.a] -> .a
concatMap :: (.a -> [.b]) ![.a] -> [.b]
maximum :: !.[a] -> a | < a
minimum :: !.[a] -> a | Ord a
getItems :: ![a] ![Int] -> [a]
scanl :: (a -> .(.b -> a)) a [.b] -> .[a]
scanl1 :: (a -> .(a -> a)) !.[a] -> .[a]
foldr1 :: (.a -> .(.a -> .a)) ![.a] -> .a
replicate :: !.Int a -> .[a]
cycle :: !.[a] -> [a]
unfoldr :: !(.a -> Maybe (.b,.a)) .a -> [.b]
......@@ -144,15 +142,11 @@ hasDup :: ![a] -> Bool | Eq a
isMemberGen :: !a !.[a] -> Bool | gEq{|*|} a
strictFoldr :: !(.a -> .(.b -> .b)) !.b ![.a] -> .b
strictFoldl :: !(.a -> .(.b -> .a)) !.a ![.b] -> .a
strictTRMapRev :: !(.a -> .b) ![.a] -> [.b]
strictTRMapAcc :: !(u:a -> v:b) !w:[u:a] !x:[v:b] -> y:[v:b], [w <= u,y <= v,x <= y]
strictTRMap :: !(.a -> .b) ![.a] -> [.b]
reverseTR :: ![.a] -> [.a]
flattenTR :: ![[a]] -> [a]
strictFoldrSt :: !(.a -> .(.b -> .(.st -> .(.b, .st)))) !.b ![.a] .st -> .(.b, .st)
strictFoldlSt :: !(.a -> .(.b -> .(.st -> .(.a, .st)))) !.a ![.b] .st -> .(.a, .st)
strictTRMapSt :: !(a .st -> (!b, !.st)) ![a] !.st -> (![b], !.st)
strictTRMapStAcc :: !(a .st -> (!b, !.st)) ![a] ![b] !.st -> (![b], !.st)
strictTRZipWith :: !(a b -> c) ![a] ![b] -> [c]
......
......@@ -12,7 +12,7 @@ import Data.Functor
import Data.GenEq
import Data.Maybe
import Data.Monoid
from Data.Foldable import class Foldable(foldMap)
from Data.Foldable import class Foldable(foldMap, foldl1, foldr1)
from Data.Traversable import class Traversable(traverse)
import Control.Applicative
import Control.Monad
......@@ -55,12 +55,27 @@ where
fold x = foldMap id x
foldMap f x = foldr (mappend o f) mempty x
foldr f x y = foldr f x y
foldr` f z0 xs = foldl f` id xs z0
where f` k x z = k (f x z)
foldr` f x y = strictFoldr f x y
where
strictFoldr :: !(.a -> .(.b -> .b)) !.b ![.a] -> .b
strictFoldr _ b [] = b
strictFoldr f b [x:xs] = f x (strictFoldr f b xs)
foldl f x y = foldl f x y
foldl` f x y = foldl f x y
foldr1 f x = foldr1 f x
foldl1 f x = foldl1 f x
foldl` f x y = strictFoldl f x y
where
strictFoldl :: !(.a -> .(.b -> .a)) !.a ![.b] -> .a
strictFoldl _ b [] = b
strictFoldl f b [x:xs] = strictFoldl f (f b x) xs
foldr1 _ [x] = x
foldr1 f [x:xs] = f x (foldr1 f xs)
foldr1 _ _ = abort "foldr1 called with empty list\n"
foldl1 f [x:xs] = foldl f x xs
foldl1 _ _ = abort "foldl1 called with empty list\n"
instance Traversable []
where
......@@ -151,10 +166,6 @@ permutations xs0 = [xs0 : perms xs0 []]
interleave` f [y:ys] r = let (us,zs) = interleave` (f o (\xs -> [y:xs])) ys r
in ([y:us], [f [t:y:us] : zs])
foldl1 :: (.a -> .(.a -> .a)) ![.a] -> .a
foldl1 f [x:xs] = foldl f x xs
foldl1 _ _ = abort "foldl1 called with empty list\n"
concatMap :: (.a -> [.b]) ![.a] -> [.b]
concatMap f ls = flatten (map f ls)
......@@ -178,11 +189,6 @@ scanl1 :: (a -> .(a -> a)) !.[a] -> .[a]
scanl1 f [x:xs] = scanl f x xs
scanl1 _ [] = []
foldr1 :: (.a -> .(.a -> .a)) ![.a] -> .a
foldr1 _ [x] = x
foldr1 f [x:xs] = f x (foldr1 f xs)
foldr1 _ _ = abort "foldr1 called with empty list\n"
replicate :: !.Int a -> .[a]
replicate n x = take n (repeat x)
......@@ -264,19 +270,13 @@ find :: (a -> .Bool) -> .(.[a] -> .(Maybe a))
find p = listToMaybe o filter p
partition :: !(a -> .Bool) !.[a] -> (!.[a], !.[a])
partition p xs = foldr` (select p) ([],[]) xs
partition p xs = foldr (select p) ([],[]) xs
select :: !.(a -> .Bool) !a !(!u:[a], !v:[a]) -> (!w:[a], !x:[a]), [u <= w,v <= x]
select p x (ts, fs)
| p x = ([x:ts], fs)
| otherwise = (ts, [x:fs])
foldr` :: !(a .b -> .b) !.b !.[a] -> .b
foldr` _ acc [] = acc
foldr` f acc [x : xs]
#! tmp = foldr` f acc xs
= f x tmp
elemIndex :: a -> .(.[a] -> .(Maybe Int)) | == a
elemIndex x = findIndex (\y -> x==y)
......@@ -400,29 +400,6 @@ isMemberGen :: !a !.[a] -> Bool | gEq{|*|} a
isMemberGen x [hd:tl] = hd === x || isMemberGen x tl
isMemberGen x [] = False
strictFoldr :: !(.a -> .(.b -> .b)) !.b ![.a] -> .b
strictFoldr _ b [] = b
strictFoldr f b [x:xs] = f x (strictFoldr f b xs)
strictFoldrSt :: !(.a -> .(.b -> .(.st -> .(.b, .st)))) !.b ![.a] .st -> .(.b, .st)
strictFoldrSt _ b [] st = (b, st)
strictFoldrSt f b [x:xs] st
#! (acc, st) = strictFoldrSt f b xs st
#! (r, st) = f x acc st
= (r, st)
strictFoldlSt :: !(.a -> .(.b -> .(.st -> .(.a, .st)))) !.a ![.b] .st -> .(.a, .st)
strictFoldlSt _ b [] st = (b, st)
strictFoldlSt f b [x:xs] st
#! (r, st) = f b x st
= strictFoldlSt f r xs st
strictFoldl :: !(.a -> .(.b -> .a)) !.a ![.b] -> .a
strictFoldl _ b [] = b
strictFoldl f b [x:xs]
#! r = f b x
= strictFoldl f r xs
strictTRMapRev :: !(.a -> .b) ![.a] -> [.b]
strictTRMapRev f xs = strictTRMapAcc f xs []
......
......@@ -6,7 +6,7 @@ from StdFunc import flip, o
import StdInt
from StdList import filter, flatten, isMember, map, removeDup, span, take, ++,
instance length [], instance == [a], instance < [a],
instance fromString [Char], instance toString [Char]
instance fromString [Char], instance toString [Char], foldr
import StdOrdList
import StdString
......
......@@ -6,6 +6,7 @@ import StdFile
import StdInt
import StdString
import StdTuple
from StdList import foldr
from Data.Func import $, hyperstrict
import Data.Functor
......
......@@ -14,6 +14,7 @@ from Data.Map import :: Map, findKeyWith
from Data.Maybe import :: Maybe (..), fromJust, maybeToList, instance Functor Maybe, instance == (Maybe a)
import Data.Error
from Data.Functor import class Functor (..)
from Data.Foldable import class Foldable (foldl1)
from Control.Applicative import class Applicative
import Control.Monad
import Data.MapCollection
......
......@@ -15,6 +15,7 @@ import Data.Functor
import Data.List
import Data.Maybe
import Data.Tuple
from Data.Foldable import class Foldable(foldr1)
from Text import class Text(join,rpad), instance Text String
instance Alternative (MaybeError [String])
......
......@@ -3,6 +3,7 @@ implementation module Text.PPrint
import StdEnv
import Data.List
import Data.Maybe
from Data.Foldable import class Foldable(foldr1)
/*
* PPrint
......
......@@ -3,6 +3,7 @@ implementation module Text.Show
import StdArray, StdBool, StdFunc, StdOverloaded, StdClass, StdList
import StdString
import Data.Maybe, Data.List
from Data.Foldable import class Foldable(foldr1)
import Text
// | The @shows@ functions return a function that prepends the
......
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