1. Haskell / Говнокод #11976

    −82

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    {-# LANGUAGE ExistentialQuantification,
                 DeriveDataTypeable,
                 PatternSignatures #-}
    
    import Data.Typeable
    import Control.Concurrent
    import Control.Concurrent.MVar
    import Control.Concurrent.Chan
    
    -- Core data types
    
    data Message = forall t . Typeable t => Message t | StopMessage
        deriving Typeable
    
    data Handler = forall t . Typeable t => Handler (t -> IO ())
    
    
    -- Worker thread
    
    data Worker = Worker (Chan Message) (MVar ())
    
    workerThread :: [Handler] -> Chan Message -> MVar () -> IO ()
    workerThread handlers chan finish = loop where
        loop = do
            message <- readChan chan
            case message of
                StopMessage -> putMVar finish ()
                Message val -> do
                    foldr (tryHandler val) (putStrLn "Unhandled message") handlers
                    loop
        tryHandler val (Handler h) rest = maybe rest h (cast val)
    
    startWorker :: [Handler] -> IO Worker
    startWorker handlers = do
        chan <- newChan
        finish <- newEmptyMVar
        forkIO (workerThread handlers chan finish)
        return $ Worker chan finish
    
    send :: Typeable m => Worker -> m -> IO ()
    send (Worker chan _) message = do
        writeChan chan $ Message message
    
    stopWorker :: Worker -> IO ()
    stopWorker (Worker chan finish) = do
        writeChan chan $ StopMessage
        takeMVar finish
    
    
    -- Some tests
    
    data Test = Test Bool String deriving Typeable
    
    intHandler :: Int -> IO ()
    intHandler val = putStrLn $ "Int: " ++ show (val * 2)
    
    strHandler :: String -> IO ()
    strHandler val = putStrLn $ "String: " ++ reverse val
    
    testHandler :: Test -> IO ()
    testHandler (Test b s) = putStrLn $ "Test: " ++ show b ++ " " ++ show s
    
    main = do
        w <- startWorker [
            Handler intHandler,
            Handler (\(val::Char) -> putStrLn $ "Char: " ++ show val),
            Handler strHandler,
            Handler testHandler]
        send w (5::Int)
        send w False
        send w 'a'
        send w "foo"
        send w (Test True "bar")
        stopWorker w
        putStrLn "Finished!"

    Вот такая вот портянка была написана под влиянием дискуссии с HaskellGovno http://govnokod.ru/11968, и недавней его просьбой рассказать об общении потоков в хаскеле.

    Код запускает тред, в который можно передавать различные сообщения (ограничение только одно - тип сообщения должен быть инстансом тайпкласса Typeable). В треде исполняются указанные хендлеры, каждый из которых ловит свой тип сообщений.

    P.S. Для неимеющих хаскеля, но желающих посмотреть на работу кода: http://ideone.com/OMVamc.

    bormand, 22 Октября 2012

    Комментарии (43)
  2. Haskell / Говнокод #11510

    −79

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    t = 40000 -- количество итераций, чтобы выполнялось примерно 1 миллисекунду
                    -- экспериментальным путем определено, что для ideone'вских машин это значение ~40000
     
    sleep x = (apply (t*x) id x) `seq`
        ("I've waited ~" ++ show x ++ " milliseconds to tell this: 'pipisiunchik'.")
    
    -- apply применяет ф-цию f к x n раз
    apply 0 _ !x = x
    apply !n !f !x = apply (n - 1) f (f x)
     
    main = putStrLn $ sleep 1000

    Спешу представить вам плод моего безделья: чистая ф-ция sleep на Haskell!

    Тесты:
    1sec - http://ideone.com/sLxRx
    3.5sec - http://ideone.com/vn4Fd
    10sec - http://ideone.com/U8s36

    zim, 31 Июля 2012

    Комментарии (16)
  3. Haskell / Говнокод #10205

    −84

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    data (,) a b = (,) a b
        deriving Generic
    data (,,) a b c = (,,) a b c
        deriving Generic
    data (,,,) a b c d = (,,,) a b c d
        deriving Generic
    .......
    data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
     = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
        -- deriving Generic
    {- Manuel says: Including one more declaration gives a segmentation fault.

    Вот такая вот реализация туплов:
    http://www.haskell.org/ghc/docs/7.4.1/html/libraries/ghc-prim-0.2.0.0/src/GHC-Tuple.html

    bormand, 05 Мая 2012

    Комментарии (15)
  4. Haskell / Говнокод #9598

    −92

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    -- | The unit datatype @()@ has one non-undefined member, the nullary
    -- constructor @()@.
    data () = () deriving Generic
    
    data (,) a b = (,) a b
    . . .
    data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
     = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
        -- deriving Generic
    {- Manuel says: Including one more declaration gives a segmentation fault.
    . . .

    *тяжелый вздох*

    http://www.haskell.org/ghc/docs/latest/html/libraries/ghc-prim-0.2.0.0/src/GHC-Tuple.html#%28%29

    wvxvw, 03 Марта 2012

    Комментарии (64)
  5. Haskell / Говнокод #6765

    −357

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    chislo :: String -> Bool
    chislo []=True
    chislo (x:xs) =if (x=='1') then chislo xs
                   else if (x=='2') then chislo xs
                     else if (x=='3') then chislo xs
                       else if (x=='4') then chislo xs
                         else if (x=='5') then chislo xs
                           else if (x=='6') then chislo xs
                             else if (x=='7') then chislo xs
                               else if (x=='8') then chislo xs
                                 else if (x=='9') then chislo xs
                                   else if (x=='0') then chislo xs
                                     else if (x=='.') then chislo xs
    							 else False

    haskell

    resettik, 26 Мая 2011

    Комментарии (45)
  6. Haskell / Говнокод #3942

    −91

    1. 1
    2. 2
    fac 1 = 1
    fac n = fac (n-1) * n

    Вычисления факторила advanced-нубами с луркмора(с) на Haskell

    sergylens, 11 Августа 2010

    Комментарии (17)