Verified Commit 36ae7c14 authored by Camil Staps's avatar Camil Staps 🚀

Add Codec.Compression.Snappy

parent 8250cbef
Pipeline #12255 passed with stage
in 1 minute and 48 seconds
test:
before_script:
- install_clean.sh bundle-complete && apt-get update -qq && apt-get install -y -qq build-essential
- install_clean.sh bundle-complete
- apt-get update -qq
- apt-get install -y -qq build-essential libsnappy-dev
image: "camilstaps/clean:nightly"
script:
- make -C tests/linux64
definition module Codec.Compression.Snappy
/**
* Clean bindings for Snappy (https://github.com/google/snappy/).
* To build a program with this library, include the `snappy` library. With
* `clm`, add `-l -lsnappy` to the command line arguments.
*/
/**
* Compress a String
*/
snappy_compress :: !.String -> .String
/**
* Uncompress a String
*/
snappy_uncompress :: !.String -> .String
implementation module Codec.Compression.Snappy
import StdClass
import StdInt
import StdMisc
import StdString
import Data._Array
import System._Pointer
import Text
snappy_max_compressed_length :: !Int -> Int
snappy_max_compressed_length len = code {
ccall snappy_max_compressed_length "I:I"
}
snappy_uncompressed_length :: !String -> Int
snappy_uncompressed_length s
#! (r,len) = snappy_uncompressed_length s (size s)
| r <> 0 = abort ("Invalid return status of snappy_uncompressed_length: " <+ r <+ "\n")
= len
where
snappy_uncompressed_length :: !String !Int -> (!Int,!Int)
snappy_uncompressed_length s len = code {
ccall snappy_uncompressed_length "sI:II"
}
snappy_compress :: !.String -> .String
snappy_compress s
#! n = snappy_max_compressed_length (size s)
#! c = createArrayUnsafe (n+1)
#! (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]}
where
compress :: !String !Int !String -> (!Int,!Int)
compress i len o = code {
ccall snappy_compress "sIs:II"
}
snappy_uncompress :: !.String -> .String
snappy_uncompress s
#! n = snappy_uncompressed_length s
#! u = createArrayUnsafe (n+1)
#! (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]}
where
uncompress :: !String !Int !String -> (!Int, !Int)
uncompress i len o = code {
ccall snappy_uncompress "sIs:II"
}
definition module Codec.Compression.Snappy.Graph
/**
* Compress an arbitrary Clean expression.
* This uses GraphCopy's copy_to_string, so the result can only be uncompressed
* by the same application.
*/
snappy_compress_a :: !.a -> .String
/**
* Uncompress an arbitrary Clean expression.
* This uses GraphCopy's copy_from_string, so this only works for expressions
* compressed by the same application.
*/
snappy_uncompress_a :: !.String -> .a
implementation module Codec.Compression.Snappy.Graph
import Codec.Compression.Snappy
import dynamic_string
snappy_compress_a :: !.a -> .String
snappy_compress_a x
#! s = copy_to_string x
= snappy_compress s
snappy_uncompress_a :: !.String -> .a
snappy_uncompress_a s
# s = snappy_uncompress s
# (x,_) = copy_from_string s
= x
......@@ -3,30 +3,37 @@ CLM:=clm
override CLMFLAGS+=-dynamics
CLMLIBS:=\
-I ../../src/libraries/OS-Independent\
-I ../../src/libraries/OS-Independent/Deprecated/Generics\
-I ../../src/libraries/OS-Independent/Deprecated/ArgEnv\
-I ../../src/libraries/OS-Independent/Deprecated/Generics\
-I ../../src/libraries/OS-Independent/Deprecated/MersenneTwister\
-I ../../src/libraries/OS-Independent/Deprecated/StdLib\
-I ../../src/libraries/OS-Posix\
-I ../../src/libraries/OS-Linux\
-I ../../src/libraries/OS-Linux-64\
-I ../../src/libraries/Platform-x86\
-I $(CLEAN_HOME)/lib/StdEnv\
-I $(CLEAN_HOME)/lib/Dynamics\
-I $(CLEAN_HOME)/lib/TCPIP\
-IL StdEnv\
-IL Dynamics\
-IL GraphCopy\
-IL TCPIP
GCCVERSIONGTEQ6:=$(shell expr `gcc -dumpversion | cut -f1 -d.` \>= 6)
ifeq "$(GCCVERSIONGTEQ6)" "1"
override CLMFLAGS+=-l -no-pie
endif
BINARIES:=test gentest
BINARIES:=test gentest snappytest
all: $(BINARIES)
%: %.icl $(wildcard *.[id]cl)
$(CLM) $(CLMLIBS) $(CLMFLAGS) $(basename $<) -o $@
%: %.icl .FORCE
$(CLM) $(CLMLIBS) $(CLMFLAGS) $@ -o $@
./$@
snappytest: %: %.icl .FORCE
$(CLM) $(CLMLIBS) -l -lsnappy $(CLMFLAGS) -nr $@ -o $@
./$@
clean:
$(RM) -r $(BINARIES) Clean\ System\ Files
.FORCE:
module snappytest
import StdEnv
import Codec.Compression.Snappy
import Codec.Compression.Snappy.Graph
import Data.Error
from Data.Func import $
import System.CommandLine
import System.File
import System.Time
Start :: *World -> *World
Start w = snd $ uncurry fclose $ seq (map uncurry tests) $ stdio w
where
tests =
[ test_string
, test_expr "small_expr" ((==) [0..10]) [0..10]
, test_expr "large_expr" ((==) [0..10000000]) [0..10000000]
, test_expr "inf_expr" ((==) [0..999] o take 1000) [0..]
, test_expr "func_expr" ((==) [0,5..50] o flip map [0..10]) ((*) 5)
]
test_string :: !*File !*World -> *(!*File, !*World)
test_string io w
#! (cmd,w) = getCommandLine w
#! file = if (length cmd >= 2) (cmd!!1) "test.icl"
#! (f,w) = readFile file w
| isError f
# io = io <<< Failure <<< "Could not open " <<< file <<< "." <<< endl
= (io, w)
#! data = fromOk f
#! (c1,w) = clock w
#! (compressed,w) = (snappy_compress data,w)
#! (c2,w) = clock w
#! (sd,sc) = (size data, size compressed)
#! io = io <<< Info <<< "string: compressed " <<< sd <<< " bytes to " <<< sc
<<< " (compression rate " <<< (toReal sd / toReal sc) <<< ")" <<< endl
#! (uncompressed,w) = (snappy_uncompress compressed,w)
#! (c3,w) = clock w
#! (time1,time2) = (c2 - c1, c3 - c2)
#! io = io <<< Info <<< "Compression: " <<< time1 <<< " / " <<<
(toReal sd / 1000000.0 / toReal time1) <<< "MB/s\r\n" <<<
"Uncompression: " <<< time2 <<< " / " <<<
(toReal sc / 1000000.0 / toReal time2) <<< "MB/s" <<< endl
| data <> uncompressed
# io = io <<< Failure <<< "string: equality not preserved" <<< endl
= (io, w)
#! io = io <<< Success <<< "string passed" <<< endl
= (io, w)
instance <<< Clock where (<<<) f c = f <<< toReal c <<< "s"
instance - Clock where (-) (Clock a) (Clock b) = Clock (a - b)
instance toReal Clock where toReal (Clock i) = toReal i / toReal CLK_PER_SEC
test_expr :: !String !(a -> Bool) a !*File !*World -> *(!*File, !*World)
test_expr name isOk expr io w
# data = snappy_compress_a expr
# io = io <<< Info <<< name <<< ": compressed to " <<< size data <<< " bytes" <<< endl
# expr` = snappy_uncompress_a data
| not (isOk expr`)
# io = io <<< Failure <<< name <<< ": equality not preserved" <<< endl
= (io,w)
# io = io <<< Success <<< name <<< " passed" <<< endl
= (io,w)
:: MessageType = Info | Failure | Success
instance <<< MessageType
where
(<<<) f Info = f <<< "\x1B[36m"
(<<<) f Failure = f <<< "\x1B[31m"
(<<<) f Success = f <<< "\x1B[32m"
endl =: "\x1B[0m\r\n"
......@@ -12,6 +12,8 @@ import qualified StdMaybe
import qualified StdLibMisc
// Main libraries
import qualified Codec.Compression.Snappy
import qualified Codec.Compression.Snappy.Graph
import qualified Control.Applicative
import qualified Control.Arrow
import qualified Control.Category
......
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