Haskell — Говнокод.ру

Haskell / Говнокод #14343

−83

01
02
03
04
05
06
07
08
09
10
11
12

setRegState :: RegisterStates -> M_Register -> Word8 -> RegisterStates
setRegState rs r n =
  let (a, b, c, d, e, f, h, l, pc, sp) = rs in
  case r of
    M_A -> (n, b, c, d, e, f, h, l, pc, sp)
    M_B -> (a, n, c, d, e, f, h, l, pc, sp)
    M_C -> (a, b, n, d, e, f, h, l, pc, sp)
    M_D -> (a, b, c, n, e, f, h, l, pc, sp)
    M_E -> (a, b, c, d, n, f, h, l, pc, sp)
    M_F -> (a, b, c, d, e, n.&.0xF0, h, l, pc, sp)
    M_H -> (a, b, c, d, e, f, n, l, pc, sp)
    M_L -> (a, b, c, d, e, f, h, n, pc, sp)

Haskell has no boilerplate.
Из исходников заброшенного эмулятора GameBoy (https://github.com/bitc/omegagb/)

Yuuri, 10 Января 2014

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

Haskell / Говнокод #12738

−95

1
2

instance Show (a -> b)
main = print (*)

http://liveworkspace.org/code/17QAgf$23
stderr:
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.
Возможно это из-за того, что нет реализации show и я написать вменяемую не смогу. Как заставить Haskell сгенерировать для меня show?

Хочется типа такого:

{-# LANGUAGE OverlappingInstances, FlexibleInstances, UndecidableInstances, StandaloneDeriving, DeriveFunctor #-}

deriving instance Show (a -> b)

main = print (*)

http://liveworkspace.org/code/17QAgf$21
http://www.haskell.org/ghc/docs/6.12.1/html/users_guide/deriving.html
http://www.haskell.org/haskellwiki/GHC/Stand-alone_deriving_declarations

HaskellGovno, 13 Марта 2013

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

Haskell / Говнокод #12262

−85

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

by :: Int -> [a] -> [[a]]
by _ [] = []
by n xs = take n xs: by n (drop n xs)
 
words2 :: String -> (String, String)
words2 str = conc $ words str where
    conc (x:xs) = (x, concat xs)
 
groupTemplates :: String -> [(String, String)]
groupTemplates xs = map (words2) (lines xs)
 
decodeOne :: String -> [(String, String)] -> String
decodeOne _ [] = ""
decodeOne str (x:xs) | str == fst x = fst x ++ " " ++ snd x ++ "\n"
decodeOne str (_:xs) = decodeOne str xs
 
decode :: [String] -> [(String, String)] -> String
decode bs ts = concat $ map (\b -> decodeOne b ts) bs
 
main = do
    bits      <- readFile "bits.txt"
    templates <- readFile "templates.txt"
 
    writeFile "out.txt" $ decode (by 4 bits) (groupTemplates templates)

http://www.cyberforum.ru/haskell/thread723767.html

Fai, 09 Декабря 2012

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

Haskell / Говнокод #12056

−82

1
2
3
4
5
6
7

only :: (Integral nt) => nt -> [Bool]
only n = [ x `mod` n == 0 | x <- [0..] ]

each :: (Integral nt) => nt -> [a] -> [a]
each n xs = [ snd x | x <- filter fst $ zip (only n) xs ]

main = do print $ each 2 [1,2,3,4,5,6,7,8,9]

Haskell. Получение каждого n-го элемента списка.

Fai, 05 Ноября 2012

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

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

−82

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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)

Haskell / Говнокод #11510

−79

01
02
03
04
05
06
07
08
09
10
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

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

Haskell / Говнокод #10205

−84

01
02
03
04
05
06
07
08
09
10
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)

Haskell / Говнокод #9598

−92

01
02
03
04
05
06
07
08
09
10
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

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

Haskell / Говнокод #6765

−357

01
02
03
04
05
06
07
08
09
10
11
12
13
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

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

Haskell / Говнокод #3942

−91

1
2

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

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

sergylens, 11 Августа 2010

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

Говнокод: по колено в коде.