September Morn Update

Task/CRC-32/Haskell/crc-32-1.hs

@@ -1,21 +1,26 @@
-import Data.Bits
-import Data.Word
-import Numeric
+import Data.Bits ((.&.), complement, shiftR, xor)
+import Data.Word (Word32)
+import Numeric (showHex)
 
 crcTable :: Word32 -> Word32
-crcTable i = table !! (fromIntegral i)
-        where
-                table = map (\a -> iterate xf a !! 8) [0..255]
-                xf r = let d = shiftR r 1 in
-                        if r .&. 1 == 1 then xor d 0xedb88320 else d
+crcTable = (table !!) . fromIntegral
+  where
+    table = ((!! 8) . iterate xf) <$> [0 .. 255]
+    shifted x = shiftR x 1
+    xf r
+      | r .&. 1 == 1 = xor (shifted r) 0xedb88320
+      | otherwise = shifted r
 
 charToWord :: Char -> Word32
-charToWord c = (fromIntegral . fromEnum) c
+charToWord = fromIntegral . fromEnum
 
 calcCrc :: String -> Word32
-calcCrc text = complement ( foldl cf (complement 0) text )
-        where cf crc x = xor (shiftR crc 8) (crcTable $ xor (crc .&. 0xff) (charToWord x) )
+calcCrc = complement . foldl cf (complement 0)
+  where
+    cf crc x = xor (shiftR crc 8) (crcTable $ xor (crc .&. 0xff) (charToWord x))
 
-crc32 text = showHex ( calcCrc text ) ""
+crc32 :: String -> String
+crc32 = flip showHex [] . calcCrc
 
+main :: IO ()
 main = putStrLn $ crc32 "The quick brown fox jumps over the lazy dog"

Task/CRC-32/Haskell/crc-32-2.hs

@@ -2,12 +2,12 @@ import Data.List (genericLength)
 import Numeric (showHex)
 import Foreign.C
 
-foreign import ccall "zlib.h crc32" zlib_crc32 :: CULong -> CString -> CUInt -> CULong
+foreign import ccall "zlib.h crc32" zlib_crc32 ::
+               CULong -> CString -> CUInt -> CULong
 
+main :: IO ()
 main = do
-        let s = "The quick brown fox jumps over the lazy dog"
-        ptr <- newCString s
-
-        let r = zlib_crc32 0 ptr (genericLength s)
-
-        putStrLn $ showHex r ""
+  let s = "The quick brown fox jumps over the lazy dog"
+  ptr <- newCString s
+  let r = zlib_crc32 0 ptr (genericLength s)
+  putStrLn $ showHex r ""

Task/CRC-32/JavaScript/crc-32.js

@@ -0,0 +1,87 @@
+(() => {
+    'use strict';
+
+    const main = () =>
+        showHex(
+            crc32('The quick brown fox jumps over the lazy dog')
+        );
+
+    // crc32 :: String -> Int
+    const crc32 = str => {
+
+        // table :: [Int]
+        const table = map(
+            n => take(9,
+                iterate(
+                    x => (
+                        x & 1 ? z => 0xEDB88320 ^ z : id
+                    )(x >>> 1),
+                    n
+                )
+            )[8],
+            enumFromTo(0, 255)
+        );
+        return (
+            foldl(
+                (a, c) => (a >>> 8) ^ table[
+                    (a ^ c.charCodeAt(0)) & 255
+                ],
+                -1,
+                chars(str)
+            ) ^ -1
+        );
+    };
+
+    // GENERIC ABSTRACTIONS -------------------------------
+
+    // chars :: String -> [Char]
+    const chars = s => s.split('');
+
+    // enumFromTo :: Int -> Int -> [Int]
+    const enumFromTo = (m, n) =>
+        Array.from({
+            length: 1 + n - m
+        }, (_, i) => m + i);
+
+    // foldl :: (a -> b -> a) -> a -> [b] -> a
+    const foldl = (f, a, xs) => xs.reduce(f, a);
+
+    // id :: a -> a
+    const id = x => x;
+
+    // iterate :: (a -> a) -> a -> Gen [a]
+    function* iterate(f, x) {
+        let v = x;
+        while (true) {
+            yield(v);
+            v = f(v);
+        }
+    }
+
+    // map :: (a -> b) -> [a] -> [b]
+    const map = (f, xs) => xs.map(f);
+
+    // showHex :: Int -> String
+    const showHex = n =>
+        n.toString(16);
+
+    // take :: Int -> [a] -> [a]
+    // take :: Int -> String -> String
+    const take = (n, xs) =>
+        xs.constructor.constructor.name !== 'GeneratorFunction' ? (
+            xs.slice(0, n)
+        ) : [].concat.apply([], Array.from({
+            length: n
+        }, () => {
+            const x = xs.next();
+            return x.done ? [] : [x.value];
+        }));
+
+
+    // MAIN -------------
+    const result = main();
+    return (
+        console.log(result),
+        result
+    );
+})();

Task/CRC-32/Julia/crc-32-1.julia

@@ -0,0 +1,2 @@
+using Libz
+println(string(Libz.crc32(UInt8.(b"The quick brown fox jumps over the lazy dog")), base=16))

Task/CRC-32/Lua/crc-32.lua

@@ -0,0 +1,3 @@
+local compute=require"zlib".crc32()
+local sum=compute("The quick brown fox jumps over the lazy dog")
+print(string.format("0x%x", sum))

Task/CRC-32/Neko/crc-32.neko

@@ -0,0 +1,12 @@
+/**
+ <doc>CRC32 in Neko</doc>
+**/
+
+var int32_new = $loader.loadprim("std@int32_new", 1)
+var update_crc32 = $loader.loadprim("zlib@update_crc32", 4)
+
+var crc = int32_new(0)
+var txt = "The quick brown fox jumps over the lazy dog"
+
+crc = update_crc32(crc, txt, 0, $ssize(txt))
+$print(crc, "\n")

Task/CRC-32/Objeck/crc-32.objeck

@@ -0,0 +1,5 @@
+class CRC32 {
+  function : Main(args : String[]) ~ Nil {
+    "The quick brown fox jumps over the lazy dog"->ToByteArray()->CRC32()->PrintLine();
+  }
+}

Task/CRC-32/PowerBASIC/crc-32.powerbasic

@@ -0,0 +1,48 @@
+#COMPILE EXE
+#DIM ALL
+#COMPILER PBCC 6
+
+' ***********
+
+FUNCTION CRC32(BYVAL p AS BYTE PTR, BYVAL NumBytes AS DWORD) AS DWORD
+  STATIC LUT() AS DWORD
+  LOCAL i, j, k, crc AS DWORD
+
+  IF ARRAYATTR(LUT(), 0) = 0 THEN
+    REDIM LUT(0 TO 255)
+    FOR i = 0 TO 255
+      k = i
+      FOR j = 0 TO 7
+        IF (k AND 1) THEN
+          SHIFT RIGHT k, 1
+          k XOR= &HEDB88320
+        ELSE
+          SHIFT RIGHT k, 1
+        END IF
+      NEXT j
+      LUT(i) = k
+    NEXT i
+  END IF
+
+  crc = &HFFFFFFFF
+
+  FOR i = 0 TO NumBytes - 1
+    k = (crc AND &HFF& XOR @p[i])
+    SHIFT RIGHT crc, 8
+    crc XOR= LUT(k)
+  NEXT i
+
+  FUNCTION = NOT crc
+END FUNCTION
+
+' ***********
+
+FUNCTION PBMAIN () AS LONG
+  LOCAL s AS STRING
+  LOCAL crc AS DWORD
+
+  s = "The quick brown fox jumps over the lazy dog"
+  CON.PRINT "Text:  " & s
+  crc = CRC32(STRPTR(s), LEN(s))
+  CON.PRINT "CRC32: " & HEX$(crc)
+END FUNCTION

Task/CRC-32/Python/crc-32-3.py

@@ -0,0 +1,62 @@
+'''CRC-32 checksums for ascii strings'''
+
+from functools import (reduce)
+from itertools import (islice)
+
+
+# crc32 :: String -> Int
+def crc32(s):
+    '''CRC-32 checksum for an ASCII encoded string'''
+    def go(x):
+        x2 = x >> 1
+        return 0xedb88320 ^ x2 if x & 1 else x2
+    table = [
+        index(iterate(go)(n))(8)
+        for n in range(0, 256)
+    ]
+    return reduce(
+        lambda a, c: (a >> 8) ^ table[
+            (a ^ ord(c)) & 0xff
+        ],
+        list(s),
+        (0xffffffff)
+    ) ^ 0xffffffff
+
+
+# TEST ----------------------------------------------------
+# main :: IO ()
+def main():
+    '''Test'''
+    print(
+        format(
+            crc32('The quick brown fox jumps over the lazy dog'),
+            '02x'
+        )
+    )
+
+
+# GENERIC ABSTRACTION -------------------------------------
+
+# index (!!) :: [a] -> Int -> a
+def index(xs):
+    '''Item at given (zero-based) index.'''
+    return lambda n: None if 0 > n else (
+        xs[n] if (
+            hasattr(xs, "__getitem__")
+        ) else next(islice(xs, n, None))
+    )
+
+
+# iterate :: (a -> a) -> a -> Gen [a]
+def iterate(f):
+    '''An infinite list of repeated applications of f to x.'''
+    def go(x):
+        v = x
+        while True:
+            yield v
+            v = f(v)
+    return lambda x: go(x)
+
+
+if __name__ == '__main__':
+    main()

Task/CRC-32/R/crc-32.r

@@ -0,0 +1 @@
+digest("The quick brown fox jumps over the lazy dog","crc32", serialize=F)

Task/CRC-32/Racket/crc-32.rkt

@@ -0,0 +1,15 @@
+#lang racket
+(define (bytes-crc32 data)
+  (bitwise-xor
+   (for/fold ([accum #xFFFFFFFF])
+     ([byte  (in-bytes data)])
+     (for/fold ([accum (bitwise-xor accum byte)])
+       ([num (in-range 0 8)])
+       (bitwise-xor (quotient accum 2)
+                    (* #xEDB88320 (bitwise-and accum 1)))))
+   #xFFFFFFFF))
+
+(define (crc32 s)
+  (bytes-crc32 (string->bytes/utf-8 s)))
+
+(format "~x" (crc32 "The quick brown fox jumps over the lazy dog"))

Task/CRC-32/Visual-Basic/crc-32.vb

@@ -0,0 +1,15 @@
+Option Explicit
+Declare Function RtlComputeCrc32 Lib "ntdll.dll" _
+  (ByVal dwInitial As Long, pData As Any, ByVal iLen As Long) As Long
+'--------------------------------------------------------------------
+Sub Main()
+Dim s As String
+Dim b() As Byte
+Dim l As Long
+
+  s = "The quick brown fox jumps over the lazy dog"
+  b() = StrConv(s, vbFromUnicode) 'convert Unicode to ASCII
+  l = RtlComputeCrc32(0&, b(0), Len(s))
+  Debug.Assert l = &H414FA339
+
+End Sub