Commit 4777effc authored by Camil Staps's avatar Camil Staps 🐧

Merge remote-tracking branch 'origin/master' into...

Merge remote-tracking branch 'origin/master' into defunctionalized-functionalized-SVG-functions-plus-paths-for-efficient-lookup
parents d8949389 d173f9b4
Pipeline #25349 passed with stage
in 3 minutes and 55 seconds
......@@ -492,14 +492,14 @@ alter f k t =
// > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
// > == fromList [(3, "B3"), (5, "A3"), (7, "C")]
unions :: ![IntMap a] -> IntMap a
unions xs = foldlStrict union empty xs
unions xs = foldl union empty xs
// | The union of a list of maps, with a combining operation.
//
// > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
// > == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
unionsWith :: (a a -> a) [IntMap a] -> IntMap a
unionsWith f ts = foldlStrict (unionWith f) empty ts
unionsWith f ts = foldl (unionWith f) empty ts
// | /O(n+m)/. The (left-biased) union of two maps.
// It prefers the first map when duplicate keys are encountered,
......@@ -1226,7 +1226,7 @@ foldr` f z t =
//
// > let f len a = len + (length a)
// > foldl f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
foldl :: (a b -> a) a (IntMap b) -> a
/*foldl :: (a b -> a) a (IntMap b) -> a
foldl f z t =
case t of Bin _ m l r | m < 0 -> go (go z r) l // put negative numbers before
| otherwise -> go (go z l) r
......@@ -1234,7 +1234,7 @@ foldl f z t =
where
go z` Nil = z`
go z` (Tip _ x) = f z` x
go z` (Bin _ _ l r) = go (go z` l) r
go z` (Bin _ _ l r) = go (go z` l) r*/
// | /O(n)/. A strict version of 'foldl'. Each application of the operator is
// evaluated before using the result in the next application. This
......@@ -1426,7 +1426,7 @@ toDescList m = foldlWithKey (\xs k x -> [(k,x):xs]) [] m
// > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
fromList :: [(Int,a)] -> IntMap a
fromList xs
= foldlStrict ins empty xs
= foldl ins empty xs
where
ins t (k,x) = insert k x t
......@@ -1445,7 +1445,7 @@ fromListWith f xs
//// > fromListWithKey f [] == empty
fromListWithKey :: (Int a a -> a) [(Int,a)] -> IntMap a
fromListWithKey f xs
= foldlStrict ins empty xs
= foldl ins empty xs
where
ins t (k,x) = insertWithKey f k x t
......@@ -1492,10 +1492,11 @@ fromDistinctAscList :: ![(!Int, !a)] -> IntMap a
fromDistinctAscList [] = Nil
fromDistinctAscList [z0 : zs0] = work z0 zs0 Nada
where
work :: !(!Int, !a) ![(!Int, !a)] !(Stack a) -> IntMap a
work (kx,vx) [] stk = finish kx (Tip kx vx) stk
work (kx,vx) [z=:(kz,_):zs] stk = reduce z zs (branchMask kx kz) kx (Tip kx vx) stk
reduce :: (Int,a) [(Int,a)] Mask Prefix (IntMap a) (Stack a) -> IntMap a
reduce :: !(!Int, !a) ![(!Int, !a)] !Mask !Prefix !(IntMap a) !(Stack a) -> IntMap a
reduce z zs _ px tx Nada = work z zs (Push px tx Nada)
reduce z zs m px tx stk=:(Push py ty stk`) =
let mxy = branchMask px py
......@@ -1504,6 +1505,7 @@ fromDistinctAscList [z0 : zs0] = work z0 zs0 Nada
(reduce z zs m pxy (Bin pxy mxy ty tx) stk`)
(work z zs (Push px tx stk))
finish :: !Prefix !(IntMap a) !(Stack a) -> IntMap a
finish _ t Nada = t
finish px tx (Push py ty stk) = finish p (link py ty px tx) stk
where m = branchMask px py
......@@ -1571,17 +1573,11 @@ branchMask :: !Prefix !Prefix -> Mask
branchMask p1 p2 = highestBitMask (p1 bitxor p2)
highestBitMask :: !Int -> Int
highestBitMask x0
= case (x0 bitor (x0 >> 1)) of
x1 -> case (x1 bitor (x1 >> 2)) of
x2 -> case (x2 bitor (x2 >> 4)) of
x3 -> case (x3 bitor (x3 >> 8)) of
x4 -> case (x4 bitor (x4 >> 16)) of
x5 -> case (x5 bitor (x5 >> 32)) of // for 64 bit platforms
x6 -> (x6 bitxor (x6 >> 1))
foldlStrict :: !(a b -> a) !a ![b] -> a
foldlStrict f acc [] = acc
foldlStrict f acc [x:xs]
#! z` = f acc x
= foldlStrict f z` xs
highestBitMask x0 = x6 bitxor (x6 >> 1)
where
x1 = x0 bitor (x0 >> 1)
x2 = x1 bitor (x1 >> 2)
x3 = x2 bitor (x2 >> 4)
x4 = x3 bitor (x3 >> 8)
x5 = x4 bitor (x4 >> 16)
x6 = x5 bitor (x5 >> 32)
......@@ -438,8 +438,6 @@ union :: !(Map k a) !(Map k a) -> Map k a | < k
mergeWithKey :: !(k a b -> Maybe c) !((Map k a) -> Map k c) !((Map k b) -> Map k c)
!(Map k a) !(Map k b) -> Map k c | < k
foldlStrict :: !(a b -> a) !a ![b] -> a
/**
* Removes the values at given key positions. The mapping itself can be spine unique.
*
......
......@@ -557,10 +557,10 @@ union t1 Tip = t1
union t1 t2 = hedgeUnion Nothing Nothing t1 t2
unions :: ![Map k a] -> Map k a | < k
unions ts = foldlStrict union newMap ts
unions ts = foldl union newMap ts
unionsWith :: !(a a -> a) ![Map k a] -> Map k a | < k
unionsWith f ts = foldlStrict (unionWith f) newMap ts
unionsWith f ts = foldl (unionWith f) newMap ts
unionWith :: !(a a -> a) !(Map k a) !(Map k a) -> Map k a | < k
unionWith f m1 m2 = unionWithKey (appUnion f) m1 m2
......@@ -1088,9 +1088,9 @@ foldr` f z` (Bin _ _ x l r) = foldr` f (f x (foldr` f z` r)) l
//
// > let f len a = len + (length a)
// > foldl f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
foldl :: !(a b -> a) !a !(Map k b) -> a
/*foldl :: !(a b -> a) !a !(Map k b) -> a
foldl f z` Tip = z`
foldl f z` (Bin _ _ x l r) = foldl f (f (foldl f z` l) x) r
foldl f z` (Bin _ _ x l r) = foldl f (f (foldl f z` l) x) r*/
// | /O(n)/. A strict version of 'foldl`. Each application of the operator is
// evaluated before using the result in the next application. This
......@@ -1200,7 +1200,7 @@ fromList [(kx0, x0) : xs0]
not_ordered kx [(ky,_) : _] = kx >= ky
fromList` :: !(Map a b) !u:[v:(!a, !b)] -> Map a b | == a & < a, [u <= v]
fromList` t0 xs = foldlStrict ins t0 xs
fromList` t0 xs = foldl ins t0 xs
where ins t (k,x) = put k x t
go :: !Int !(Map a b) !u:[v:(!a, !b)] -> Map a b | == a & < a, [u <= v]
......@@ -1244,7 +1244,7 @@ fromListWith f xs :== fromListWithKey (\_ x y -> f x y) xs
// > fromListWithKey f [] == newMap
fromListWithKey :: !(k a a -> a) ![(!k, !a)] -> Map k a | < k
fromListWithKey f xs = foldlStrict (ins f) newMap xs
fromListWithKey f xs = foldl (ins f) newMap xs
where
ins :: !(k a a -> a) !(Map k a) !(!k, !a) -> Map k a | < k
ins f t (k, x) = putWithKey f k x t
......@@ -1963,12 +1963,6 @@ validmapSize t
(Just n,Just m) | n+m+1 == sz -> Just sz
_ -> Nothing
foldlStrict :: !(a b -> a) !a ![b] -> a
foldlStrict f acc [] = acc
foldlStrict f acc [x:xs]
#! z` = f acc x
= foldlStrict f z` xs
// | /O(1)/. Decompose a map into pieces based on the structure of the underlying
// tree. This function is useful for consuming a map in parallel.
//
......
......@@ -40,9 +40,22 @@ gEq{|Set|} eEq x y = (size x == size y) && gEq{|* -> *|} eEq (toAscList x) (toAs
gLexOrd{|Set|} eLexOrd x y = gLexOrd{|* -> *|} eLexOrd (toAscList x) (toAscList y)
instance Foldable Set where
foldr :: (a .b -> .b) .b !(Set a) -> .b
foldr _ z Tip = z
foldr f z (Bin _ x l r) = foldr f (f x (foldr f z r)) l
foldr` :: (a .b -> .b) !.b !(Set a) -> .b
foldr` _ z Tip = z
foldr` f z (Bin _ x l r) = foldr` f (f x (foldr` f z r)) l
foldl :: (.b -> .(a -> .b)) .b !(Set a) -> .b
foldl _ z Tip = z
foldl f z (Bin _ x l r) = foldl f (f (foldl f z l) x) r
foldl` :: (.b -> .(a -> .b)) !.b !(Set a) -> .b
foldl` _ z Tip = z
foldl` f z (Bin _ x l r) = foldl` f (f (foldl` f z l) x) r
/*--------------------------------------------------------------------
* Query
*--------------------------------------------------------------------*/
......
implementation module Text
import qualified StdArray
import StdOverloaded, StdString, StdArray, StdChar, StdInt, StdBool, StdClass, StdList
import Data.List
import Data.List, Data.Func
instance Text String
where
......@@ -9,16 +10,15 @@ instance Text String
textSize s = size s
concat :: ![String] -> String
concat xs = concat` xs (createArray (foldl (\s a -> s+size a) 0 xs) '\0') 0
concat xs = concat` xs ('StdArray'._createArray (foldl (\s a -> s+size a) 0 xs)) 0
where
concat` :: ![String] !*String !Int -> *String
concat` [] dst _ = dst
concat` [x:xs] dst offset = concat` xs (copyChars offset 0 (size x) x dst) (offset + size x)
concat` [x:xs] dst offset = concat` xs (copyChars offset (size x-1) x dst) (offset + size x)
copyChars :: !Int !Int !Int !String !*String -> *String
copyChars offset i num src dst
| i == num = dst
| otherwise = copyChars offset (inc i) num src {dst & [offset + i] = src.[i]}
copyChars :: !Int !Int !String !*String -> *String
copyChars _ -1 _ dst = dst
copyChars offset i src dst = copyChars offset (i-1) src {dst & [offset+i]=src.[i]}
split :: !String !String -> [String]
split sep s = splitAfter 0 (size s-1) sep s
......@@ -104,13 +104,15 @@ instance Text String
subString start len haystack = haystack % (start, start + len - 1)
replaceSubString :: !String !String !String -> String
replaceSubString needle replacement haystack
#! index = indexOf needle haystack
| index == -1 = haystack
| otherwise
#! start = subString 0 index haystack
#! end = subString (index + size needle) (size haystack) haystack
= start +++ replacement +++ (replaceSubString needle replacement end)
replaceSubString needle replacement haystack = concat $ replaceSubString` 0 []
where
replaceSubString` :: !Int ![String] -> [String]
replaceSubString` haystackIdx acc
# index = indexOfAfter haystackIdx needle haystack
| index == -1 = reverse [subString haystackIdx (size haystack - index) haystack: acc]
| otherwise
#! start = subString haystackIdx (index - haystackIdx) haystack
= replaceSubString` (index + size needle) [replacement, start: acc]
trim :: !String -> String
trim s = ltrim (rtrim s)
......
......@@ -7,7 +7,11 @@ class PrintOutput s where
:: *StringOutput
:: PrintState s
:: PrintState s =
{ ps_output :: !s
, ps_context :: !Context
}
:: Context
mkPrintState :: !*s -> PrintState *s | PrintOutput s
mkStringPrintState :: PrintState StringOutput
......
......@@ -15,8 +15,6 @@ import System._Pointer
import System._Posix
import System.OS
CHUNK_SIZE :== 1024
instance toString FileError
where
toString CannotOpen = "Cannot open"
......@@ -26,6 +24,20 @@ where
readFile :: !String !*env -> (!MaybeError FileError String, !*env) | FileSystem env
readFile filename env = withFile filename FReadData readAll env
readAll :: !*File -> (!MaybeError FileError String, !*File)
readAll file
# (ok,file) = fseek file 0 FSeekEnd
| not ok = (Error IOError,file)
# (pos,file) = fposition file
# (err,file) = ferror file
| err = (Error IOError,file)
# (ok,file) = fseek file 0 FSeekSet
| not ok = (Error IOError,file)
# (str,file) = freads file pos
# (err,file) = ferror file
| err = (Error IOError,file)
| otherwise = (Ok str,file)
readFileLines :: !String !*env -> (!MaybeError FileError [String], !*env) | FileSystem env
readFileLines filename env = withFile filename FReadData readAllLines env
......@@ -44,22 +56,6 @@ where
| string == "" = (Ok acc, file)
| otherwise = rec file [string:acc]
readAll :: !*File -> (!MaybeError FileError String, !*File)
readAll file
# (result, file) = readAcc file []
= case result of
Error e = (Error e, file)
Ok contents = (Ok ('Text'.concat (reverse contents)), file)
where
readAcc :: *File [String] -> (MaybeError FileError [String], *File)
readAcc file acc
# (str,file) = freads file CHUNK_SIZE
# (err,file) = ferror file
| err = (Error IOError,file)
# (eof,file) = fend file
| eof = (Ok [str:acc],file)
| otherwise = readAcc file [str:acc]
writeFile :: !String !String !*env -> (!MaybeError FileError (), !*env) | FileSystem env
writeFile filename contents env =
withFile filename FWriteData (\file -> (Ok (), fwrites contents file)) env
......
......@@ -53,6 +53,20 @@ where
readFile :: !String !*env -> (!MaybeError FileError String, !*env) | FileSystem env
readFile filename env = withFile filename FReadData readAll env
readAll :: !*File -> (!MaybeError FileError String, !*File)
readAll file
# (ok,file) = fseek file 0 FSeekEnd
| not ok = (Error IOError,file)
# (pos,file) = fposition file
# (err,file) = ferror file
| err = (Error IOError,file)
# (ok,file) = fseek file 0 FSeekSet
| not ok = (Error IOError,file)
# (str,file) = freads file pos
# (err,file) = ferror file
| err = (Error IOError,file)
| otherwise = (Ok str,file)
readFileLines :: !String !*env -> (!MaybeError FileError [String], !*env) | FileSystem env
readFileLines filename env = withFile filename FReadData readAllLines env
......@@ -70,22 +84,6 @@ where
| err = (Error IOError,file)
| string == "" = (Ok acc, file)
| otherwise = rec file [string:acc]
readAll :: !*File -> (!MaybeError FileError String, !*File)
readAll file
# (result, file) = readAcc file []
= case result of
Error e = (Error e, file)
Ok contents = (Ok (concat (reverse contents)), file)
where
readAcc :: !*File ![String] -> (!MaybeError FileError [String], !*File)
readAcc file acc
# (str,file) = freads file CHUNK_SIZE
# (err,file) = ferror file
| err = (Error IOError,file)
# (eof,file) = fend file
| eof = (Ok [str:acc],file)
| otherwise = readAcc file [str:acc]
writeFile :: !String !String !*env -> (!MaybeError FileError (), !*env) | FileSystem env
writeFile filename contents env =
......
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