update readme

1 files changed, 91 insertions, 11 deletions

diff --git a/base64/base64.hs b/base64/base64.hs
index 2443d07..cd84c48 100644
--- a/base64/base64.hs
+++ b/base64/base64.hs
@@ -1,12 +1,67 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ViewPatterns #-}
 import Data.Maybe (fromJust,isJust)
 import Data.List.Split (chunksOf)
 import Data.Tuple (swap)
 import Data.Tuple.Extra (first,second,dupe)
 import System.Environment (getArgs)
-import qualified Data.ByteString.Lazy as B
-import qualified Data.ByteString.Lazy.Char8 as C
-import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString as B
+import qualified Data.Map.Strict as M
+import Data.Char
+import Data.Maybe
+import Data.Word
+import Data.Array
+import Data.Bits
+--import Data.ByteString.Base64.Lazy as B64
+import Data.ByteString.Base64 as B64
+import GHC.Int
+import Control.Parallel
+import Control.Parallel.Strategies
 
+main :: IO()
+main = BL.getContents >>= mapM_ BL.putStr . parMap rdeepseq (chunkBL 3 (fromNum 6 4.toNum 8)) . chunkB 100000
+
+table64 :: Array Int Word8
+table64 = array (0,63) $ zip [0..] $ map (fromIntegral.ord) $ 
+          ['A'..'Z']++['a'..'z']++['0'..'9']++['+','/']
+
+toNum :: Int->BL.ByteString->Int
+toNum s  = BL.foldl' f 0 where f a v = a `shiftL` s + fromIntegral v
+
+fromNum :: Int->Int->Int->BL.ByteString
+fromNum s l x = BL.pack $ map f (reverse [0..l-1]) 
+                where f v = table64 ! (x `shiftR` (v*s) .&. (2^s-1))
+
+chunkBL :: Int64->(BL.ByteString->BL.ByteString)->BL.ByteString->BL.ByteString
+chunkBL n f b | BL.null b  = b
+              | otherwise = let l = f . BL.take n $ b
+                                r = chunkBL n f . BL.drop n $ b
+                            in  BL.append l r    
+
+chunkB :: Int64->BL.ByteString->[BL.ByteString]
+chunkB n b | BL.null b  = []
+              | otherwise = let l = BL.take n $ b
+                                r = chunkB n . BL.drop n $ b
+                            in  l:r
+{-
+    let arr=reverse $ BL.foldr f (0,0:[]) b
+             in arr --BL.unfoldr uf (0,snd arr)
+             where uf (_,[])    = Nothing
+                   uf (3,x:xs)  = Just (table64 ! x,(0,xs))
+                   uf (c,x:xs)  = Just (table64 ! (x.&.63),(c+1,x `shiftR` 6:xs))
+                   f :: (Int,[Int]) -> Word8 -> (Int,[Int])
+                   f (_,[]) v = (0,[])
+                   f (2,x:xs) v = (0,0:(x `shiftL` 8) + fromIntegral v:xs)
+                   f (c,x:xs) v = (c+1,(x `shiftL` 8) + fromIntegral v:xs)
+
+    -- BL.unfoldr uf . (,)3 . snd . BL.foldl' f (0,0:[])
+    -- -}
+{-
+-}
+    
+
+--main = B.getContents >>= B.putStr . B64.encode
 -- Example Usage: echo "hello world" | ./base64  | ./base64 -d
 
 -- TODO
@@ -16,32 +71,57 @@ import qualified Data.Map as M
 -- (see man base64)
 -- compare performance . named map? array?
 
-main = do arg<-getArgs
-          dat<-B.getContents
-          B.putStr.B.pack.encode.B.unpack $  dat
+-- arg<-getArgs
 {-
+enc64 x = B.reverse $ B.unfoldr unf $ (4, (B.foldl' (\a b->a `shiftL` 8 + fromIntegral b) (0::Int) x))
+unf (c,v) = if c==0 then Nothing else let r = v .&. 63  in Just (table64 ! r,(c-1,v`shiftR` 6))
           if length arg == 0 
              then putStr . (++"\n") . encode64 . map fromIntegral . B.unpack $ dat
              else B.putStr. B.pack . map fromIntegral . decode64 .  C.unpack $ dat
 -}
 
-encode = map ((+65).(`mod` 24))
+--t1 = BL.getContents >>= BL.putStr . BL.fromChunks . map (B.map f) . BL.toChunks
+
+
+
+--enc=B.map (\x->table64 ! (x `shiftR` 4))
+
 
-table64    = zip [0..] (['A'..'Z']++['a'..'z']++['0'..'9']++['+','/'])
 
-enc64 k = M.lookup k mp where mp = M.fromList table64
-dec64 k = M.lookup k mp where mp = M.fromList $ map swap table64
+-- -- reChunkIn :: Int -> [B.ByteString] -> [B.ByteString]
+-- -- reChunkIn !n = go
+-- --   where
+-- --     go [] = []
+-- --     go (y : ys) = case B.length y `divMod` n of
+-- --                     (_, 0) -> y : go ys
+-- --                     (d, _) -> case B.splitAt (d * n) y of
+-- --                                 (prefix, suffix) -> prefix : fixup suffix ys
+-- --     fixup acc [] = [acc]
+-- --     fixup acc (z : zs) = case B.splitAt (n - B.length acc) z of
+-- --                            (prefix, suffix) ->
+-- --                              let acc' = acc `B.append` prefix
+-- --                              in if B.length acc' == n
+-- --                                 then let zs' = if B.null suffix
+-- --                                                then          zs
+-- --                                                else suffix : zs
+-- --                                      in acc' : go zs'
+-- --                                 else -- suffix must be null
+-- --                                     fixup acc' zs
+--
+--dec64 k = M.lookup k mp where mp = M.fromList $ map swap table64
 
+{-
 encode64 :: [Int] -> [Char]
 encode64 = map (fromJust.enc64.flip mod 64)  -- concat . map (pad . first enc . second length . dupe) . chunksOf 3
            where enc = map (fromJust . enc64) . sumC
-                 pad (v,l) =take 4 $ take (1+l) v ++ "==="
                  sumC = map fst . reverse . take 4 . drop 1 .iterate to64 . (,) 0 . sum  . map (uncurry (*)) . zip mult
                  mult = map (256^) [2,1,0]
                  to64 (r,v) = let r' = v `mod` 64 in (r',(v-r')`div`64)
+                 pad (v,l) =take 4 $ take (1+l) v ++ "==="
 
 decode64 :: [Char]->[Int]
 decode64 = map fst .  concat . map (rem . first (reverse . take 3 . drop 1 . iterate to256 . (,) 0 . dec. map (fromJust) . filter (isJust) . map dec64).second (length.filter(=='=')). dupe) . chunksOf 4 . filter (/='\n')
            where dec = sum . map (uncurry (*)) . zip (map (64^) [3,2..]) 
                  to256 (r,v) = let r' = v `mod` 256 in (r',(v-r')`div`256)
                  rem (v,l) = take (3-l) v
+-}