Commit 28796b2f authored by Mart Lubbers's avatar Mart Lubbers

Merge branch 'remove-qualified-as' of...

Merge branch 'remove-qualified-as' of gitlab.science.ru.nl:clean-and-itasks/clean-platform into remove-qualified-as
parents 3d7a828b 8e509ffc
Pipeline #15382 failed with stage
in 1 minute and 16 seconds
implementation module Codec.Compression.Snappy
import StdClass
import StdInt
import StdMisc
import StdString
import StdEnv
import Data._Array
import System._Pointer
import Text
......@@ -28,7 +24,7 @@ where
snappy_compress :: !.String -> .String
snappy_compress s
#! n = snappy_max_compressed_length (size s)
#! c = createArrayUnsafe (n+1)
#! c = createArray (n+1) '\0'
#! (r,len) = compress s (size s) c
| r <> 0 = abort ("Invalid return status of snappy_compress: " <+ r <+ "\n")
= {c \\ c <-: c & i <- [0..len-1]}
......@@ -41,7 +37,7 @@ where
snappy_uncompress :: !.String -> .String
snappy_uncompress s
#! n = snappy_uncompressed_length s
#! u = createArrayUnsafe (n+1)
#! u = createArray (n+1) '\0'
#! (r,len) = uncompress s (size s) u
| r <> 0 = abort ("Invalid return status of snappy_uncompress: " <+ r <+ "\n")
= {c \\ c <-: u & i <- [0..len-1]}
......
implementation module Control.GenFMap
import StdGeneric, StdEnv, Data._Array, Control.GenMonad
import StdGeneric, StdEnv, Control.GenMonad
from Data.Maybe import :: Maybe(..)
derive bimap (,), []
......@@ -32,7 +32,6 @@ updateAssocList key value default_val [(k,v):xs]
= (old_val, [(k, v) : xs])
derive bimap FMap, Maybe
bimap{|{}|} bma = {map_to = mapArray bma.map_to, map_from = mapArray bma.map_from}
generic gLookupFMap key :: key (FMap value) -> FMap value
gLookupFMap{|Char|} key (FMChar xs) = lookupAssocList key FMEmpty xs
......
implementation module Control.GenMap
import StdClass, StdArray, StdInt, StdFunc
import StdGeneric, Data._Array
import StdGeneric
generic gMap a b :: .a -> .b
gMap{|c|} x = x
......@@ -12,7 +12,7 @@ gMap{|EITHER|} fl fr (RIGHT x) = RIGHT (fr x)
gMap{|CONS|} f (CONS x) = CONS (f x)
gMap{|FIELD|} f (FIELD x) = FIELD (f x)
gMap{|OBJECT|} f (OBJECT x) = OBJECT (f x)
gMap{|{}|} f xs = mapArray f xs
gMap{|{!}|} f xs = mapArray f xs
gMap{|{}|} f xs = {f x\\x<-:xs}
gMap{|{!}|} f xs = {f x\\x<-:xs}
derive gMap [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
implementation module Control.GenMapSt
import StdGeneric, Data._Array
import StdGeneric, StdEnv, Data.Array
derive bimap (,)
......@@ -31,12 +31,11 @@ gMapRSt{|EITHER|} fx fy x st = mapStEITHER fx fy x st
gMapRSt{|CONS|} f x st = mapStCONS f x st
gMapRSt{|FIELD|} f x st = mapStFIELD f x st
gMapRSt{|OBJECT|} f x st = mapStOBJECT f x st
gMapRSt{|{}|} f x st = mapArrayRSt f x st
gMapRSt{|{!}|} f x st = mapArrayRSt f x st
gMapRSt{|{}|} f x st = mapArrSt f x st
gMapRSt{|{!}|} f x st = mapArrSt f x st
derive gMapRSt [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
mapStEITHER fl fr (LEFT x) st
# (x, st) = fl x st
= (LEFT x, st)
......
implementation module Control.GenReduce
import StdGeneric, Data._Array
import StdGeneric
// or crush
generic gReduce t :: (a a -> a) a t -> a
......
implementation module Data.GenCompress
import StdGeneric, StdEnv, Data._Array
import StdGeneric, StdEnv
from Data.Maybe import :: Maybe(..)
//--------------------------------------------------
......@@ -8,10 +8,10 @@ from Data.Maybe import :: Maybe(..)
ret :: !.a !u:CompressSt -> (!Maybe .a,!u:CompressSt)
ret a st = (Just a, st)
(>>=) infixl 5
(>>=) infixl 5
(>>=) pa pb = bind pa pb
where
bind pa pb st
bind pa pb st
#! (ma, st) = pa st
= case ma of
Nothing -> (Nothing, st)
......@@ -35,7 +35,7 @@ compressBool bit {cs_pos = pos, cs_bits = bits}
#! int_pos = pos >> (IF_INT_64_OR_32 6 5)
#! bit_pos = pos bitand (IF_INT_64_OR_32 63 31)
| s == int_pos
= abort "reallocate"
= abort "reallocate"
#! int = bits.[int_pos]
#! bit_mask = 1 << bit_pos
#! new_int = if bit (int bitor bit_mask) (int bitand (bitnot bit_mask))
......@@ -47,7 +47,7 @@ uncompressBool cs=:{cs_pos = pos, cs_bits = bits}
#! int_pos = pos >> (IF_INT_64_OR_32 6 5)
#! bit_pos = pos bitand (IF_INT_64_OR_32 63 31)
| s == int_pos
= (Nothing, cs)
= (Nothing, cs)
#! int = bits.[int_pos]
#! bit_mask = 1 << bit_pos
#! bit = (bit_mask bitand int) <> 0
......@@ -61,7 +61,7 @@ where
| i == n
= id
| otherwise
= compress (inc i) n (int >> 1)
= compress (inc i) n (int >> 1)
o compressBool ((int bitand 1) == 1)
......@@ -77,14 +77,14 @@ where
= ret int
| otherwise
= uncompressBool
>>= \bit -> uncompress (inc i) n int
>>= \bit -> uncompress (inc i) n int
>>= \x -> ret ((if bit 1 0) + (x << 1))
uncompressInt :: (u:CompressSt -> (.(Maybe Int),v:CompressSt)), [u <= v]
uncompressInt = uncompressIntB (IF_INT_64_OR_32 64 32)
uncompressChar :: (u:CompressSt -> (.(Maybe Char),v:CompressSt)), [u <= v]
uncompressChar = uncompressIntB 8 >>= ret o toChar
uncompressChar = uncompressIntB 8 >>= ret o toChar
realToBinary32 :: !Real -> (!Int,!Int);
realToBinary32 _ = code {
......@@ -116,25 +116,25 @@ uncompressReal
= IF_INT_64_OR_32
(uncompressInt
>>= \i -> ret (binaryToReal64 i))
(uncompressInt
>>= \i1 -> uncompressInt
(uncompressInt
>>= \i1 -> uncompressInt
>>= \i2 -> ret (binaryToReal32 (i1,i2)))
compressArray :: (a -> u:(v:CompressSt -> w:CompressSt)) !.(b a) -> x:(*CompressSt -> y:CompressSt) | Array b a, [x <= u,w <= v,w <= y]
compressArray f xs
compressArray f xs
= foldSt f [x \\ x <-: xs] o compressInt (size xs)
foldSt f [] = id
foldSt f [x:xs] = foldSt f xs o f x
uncompressArray :: (u:CompressSt -> ((Maybe v:a),w:CompressSt)) -> .(x:CompressSt -> ((Maybe y:(b v:a)),z:CompressSt)) | Array b a, [x w <= u,y <= v,x w <= z]
uncompressArray f
= uncompressInt >>= \s -> uncompress_array 0 s (createArrayUnsafe s)
where
uncompressArray f
= uncompressInt >>= \s -> uncompress_array 0 s {undef\\_<-[0..s]}
where
uncompress_array i s arr
| i == s
= ret arr
= f >>= \x -> uncompress_array (inc i) s {arr & [i] = x}
= f >>= \x -> uncompress_array (inc i) s {arr & [i] = x}
compressList :: (a *CompressSt -> *CompressSt) ![a] -> *CompressSt -> *CompressSt
compressList c xs = compressArray c (list_to_arr xs)
......@@ -146,13 +146,13 @@ where
uncompressList xs = uncompressArray xs >>= ret o arr_to_list
where
arr_to_list :: {b} -> [b] | Array {} b
arr_to_list xs = [x \\ x <-: xs]
arr_to_list xs = [x \\ x <-: xs]
//--------------------------------------------------------------------------------------
generic gCompress a :: !a -> *CompressSt -> *CompressSt
gCompress{|Int|} x = compressInt x
gCompress{|Real|} x = compressReal x
gCompress{|Int|} x = compressInt x
gCompress{|Real|} x = compressReal x
gCompress{|Char|} x = compressChar x
gCompress{|Bool|} x = compressBool x
gCompress{|UNIT|} x = id
......@@ -180,9 +180,9 @@ gCompressedSize{|EITHER|} cl cr (RIGHT x) = 1 + cr x
gCompressedSize{|CONS|} c (CONS x) = c x
gCompressedSize{|FIELD|} c (FIELD x) = c x
gCompressedSize{|OBJECT|} c (OBJECT x) = c x
gCompressedSize{|[]|} c xs = foldSt (\x st -> c x + st) xs (IF_INT_64_OR_32 64 32)
gCompressedSize{|{}|} c xs = foldSt (\x st -> c x + st) [x\\x<-:xs] (IF_INT_64_OR_32 64 32)
gCompressedSize{|{!}|} c xs = foldSt (\x st -> c x + st) [x\\x<-:xs] (IF_INT_64_OR_32 64 32)
gCompressedSize{|[]|} c xs = foldSt (\x st -> c x + st) xs (IF_INT_64_OR_32 64 32)
gCompressedSize{|{}|} c xs = foldSt (\x st -> c x + st) [x\\x<-:xs] (IF_INT_64_OR_32 64 32)
gCompressedSize{|{!}|} c xs = foldSt (\x st -> c x + st) [x\\x<-:xs] (IF_INT_64_OR_32 64 32)
gCompressedSize{|String|} xs = (IF_INT_64_OR_32 64 32) + size xs * 8
generic gUncompress a :: (u:CompressSt -> ((Maybe a),u:CompressSt))
......@@ -194,17 +194,17 @@ gUncompress{|UNIT|} = ret UNIT
gUncompress{|PAIR|} fx fy = fx >>= \x -> fy >>= \y -> ret (PAIR x y)
gUncompress{|EITHER|} fl fr = uncompressBool >>= either
where
either is_right
either is_right
| is_right
= fr >>= ret o RIGHT
= fl >>= ret o LEFT
gUncompress{|CONS|} f = f >>= ret o CONS
gUncompress{|FIELD|} f = f >>= ret o FIELD
gUncompress{|OBJECT|} f = f >>= ret o OBJECT
gUncompress{|[]|} f = uncompressList f
gUncompress{|{}|} f = uncompressArray f
gUncompress{|{!}|} f = uncompressArray f
gUncompress{|String|} = uncompressArray uncompressChar
gUncompress{|[]|} f = uncompressList f
gUncompress{|{}|} f = uncompressArray f
gUncompress{|{!}|} f = uncompressArray f
gUncompress{|String|} = uncompressArray uncompressChar
//-------------------------------------------------------------------------------------
......@@ -213,12 +213,13 @@ uncompress :: (BitVector -> Maybe a) | gUncompress{|*|} a
uncompress = fst o gUncompress{|*|} o mkCompressSt
compress :: !a -> BitVector | gCompressedSize{|*|} a & gCompress{|*|} a
compress x
compress x
#! compressed_size = gCompressedSize{|*|} x
#! arr_size = (compressed_size + (IF_INT_64_OR_32 63 31)) >> (IF_INT_64_OR_32 6 5)
#! bits = createArray arr_size 0
= (gCompress{|*|} x (mkCompressSt bits)).cs_bits
//-------------------------------------------------------------------------------------
/*
......@@ -229,11 +230,11 @@ derive bimap (,), (,,), Maybe
derive gCompress Tree, Color
derive gUncompress Tree, Color
derive gCompressedSize Tree, Color
//Start :: Maybe (Tree Color Color)
//Start = uncompress (compress (Bin Red (Bin Green (Tip Blue) (Tip Red)) (Tip Green)))
//Start = gCompressedSize{|*|} (Bin Red (Bin Green (Tip Blue) (Tip Red)) (Tip Green))
Start
Start
= gCompressedSize{|*|} xs
*/
definition module Data._Array
import StdArray
createArrayUnsafe :: .Int -> u:(a v:b) | Array a b, [u <= v]
/*
class UnsafeArray a e | Array a e where
unsafeCreate :: !Int -> *(a .e)
unsafeUselect :: !u:(a .e) !Int -> *(.e, !u:(a .e))
instance UnsafeArray {} e, {!} e
mapArray :: (u:a -> v:b) w:(c u:a) -> x:(d v:b) | UnsafeArray c a & UnsafeArray d b, [w <= u,x <= v]
mapArrayLSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | UnsafeArray d a & UnsafeArray e c, [w <= u,x <= v]
mapArrayRSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | UnsafeArray d a & UnsafeArray e c, [w <= u,x <= v]
*/
class UnsafeArray a where
unsafeCreate :: !Int -> *(a .e)
unsafeUselect :: !u:(a .e) !Int -> *(.e, !u:(a .e))
instance UnsafeArray {}, {!}
mapArray :: (u:a -> v:b) w:(c u:a) -> x:(d v:b) | Array d b & UnsafeArray c & UnsafeArray d & Array c a, [w <= u,x <= v]
mapArrayLSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | Array e c & UnsafeArray d & UnsafeArray e & Array d a, [w <= u,x <= v]
mapArrayRSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | Array e c & UnsafeArray d & UnsafeArray e & Array d a, [w <= u,x <= v]
reduceArray :: ((.a -> u:(b -> b)) -> .(b -> .(c -> .a))) (.a -> u:(b -> b)) b .(d c) -> b | Array d c
reduceArrayLSt :: (u:a -> .(.b -> .b)) v:(c u:a) .b -> .b | UnsafeArray c & Array c a, [v <= u]
reduceArrayRSt :: (u:a -> .(.b -> .b)) v:(c u:a) .b -> .b | UnsafeArray c & Array c a, [v <= u]
implementation module Data._Array
import _SystemArray, StdInt, StdClass
import qualified _SystemArray as A
createArrayUnsafe :: .Int -> u:(a v:b) | Array a b, [u <= v]
createArrayUnsafe size = 'A'._createArray size
instance UnsafeArray {} where
unsafeCreate size =
code
{
create_array_ _ 1 0
}
unsafeUselect arr index =
code
{
push_a 0
select _ 1 0
}
instance UnsafeArray {!} where
unsafeCreate size =
code
{
create_array_ _ 1 0
}
unsafeUselect arr index =
code
{
push_a 0
select _ 1 0
}
//mapArray :: (u:a -> v:b) w:(c u:a) -> x:(d v:b) | UnsafeArray c a & UnsafeArray d b, [w <= u,x <= v]
mapArray :: (u:a -> v:b) w:(c u:a) -> x:(d v:b) | Array d b & UnsafeArray c & UnsafeArray d & Array c a, [w <= u,x <= v]
mapArray f xs
#! (size_xs, xs) = usize xs
#! (xs, ys) = map f 0 size_xs xs (unsafeCreate size_xs)
= ys
where
map f i n xs ys
| i == n
= (xs, ys)
| otherwise
#! (x, xs) = unsafeUselect xs i
#! ys = update ys i (f x)
= map f (inc i) n xs ys
//mapArrayLSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | UnsafeArray d a & UnsafeArray e c, [w <= u,x <= v]
mapArrayLSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | Array e c & UnsafeArray d & UnsafeArray e & Array d a, [w <= u,x <= v]
mapArrayLSt f xs st
#! (size_xs, xs) = usize xs
#! (xs, ys, st) = map f 0 size_xs xs (unsafeCreate size_xs) st
= (ys, st)
where
map f i n xs ys st
| i == n
= (xs, ys, st)
| otherwise
#! (x, xs) = unsafeUselect xs i
#! (y, st) = f x st
#! ys = update ys i y
= map f (inc i) n xs ys st
//mapArrayRSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | UnsafeArray d a & UnsafeArray e c, [w <= u,x <= v]
mapArrayRSt :: (u:a -> .(.b -> (v:c,.b))) w:(d u:a) .b -> (x:(e v:c),.b) | Array e c & UnsafeArray d & UnsafeArray e & Array d a, [w <= u,x <= v]
mapArrayRSt f xs st
#! (size_xs, xs) = usize xs
#! (xs, ys, st) = map f (size_xs - 1) xs (unsafeCreate size_xs) st
= (ys, st)
where
map f i xs ys st
| i < 0
= (xs, ys, st)
| otherwise
#! (x, xs) = unsafeUselect xs i
#! (y, st) = f x st
#! ys = update ys i y
= map f (dec i) xs ys st
reduceArray :: ((.a -> u:(b -> b)) -> .(b -> .(c -> .a))) (.a -> u:(b -> b)) b .(d c) -> b | Array d c
reduceArray f op e xs
= reduce f 0 (size xs) op e xs
where
reduce f i n op e xs
| i == n
= e
| otherwise
= op (f op e xs.[i]) (reduce f (inc i) n op e xs)
reduceArrayLSt :: (u:a -> .(.b -> .b)) v:(c u:a) .b -> .b | UnsafeArray c & Array c a, [v <= u]
reduceArrayLSt f xs st
#! (size_xs, xs) = usize xs
#! (xs, st) = reduce f 0 size_xs xs st
= st
where
reduce f i n xs st
| i == n
= (xs, st)
| otherwise
#! (x, xs) = unsafeUselect xs i
= reduce f (inc i) n xs (f x st)
reduceArrayRSt :: (u:a -> .(.b -> .b)) v:(c u:a) .b -> .b | UnsafeArray c & Array c a, [v <= u]
reduceArrayRSt f xs st
#! (size_xs, xs) = usize xs
#! (xs, st) = reduce f (dec size_xs) xs st
= st
where
reduce f i xs st
| i < 0
= (xs, st)
| otherwise
#! (x, xs) = unsafeUselect xs i
= reduce f (dec i) xs (f x st)
......@@ -133,7 +133,6 @@ import qualified Data.Traversable
import qualified Data.Tree
import qualified Data.Tuple
import qualified Data.Word8
import qualified Data._Array
import qualified Data.Generics
import qualified Database.Native
import qualified Database.Native.JSON
......
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