Add Codec.Compression.Snappy

.gitlab-ci.yml

 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

src/libraries/OS-Independent/Codec/Compression/Snappy.dcl

+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

src/libraries/OS-Independent/Codec/Compression/Snappy.icl

+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"
+	}

src/libraries/OS-Independent/Codec/Compression/Snappy/Graph.dcl

+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

src/libraries/OS-Independent/Codec/Compression/Snappy/Graph.icl

+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

tests/linux64/Makefile

@@ -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:

tests/linux64/snappytest.icl

+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"

tests/linux64/test.icl

@@ -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