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

    +1

    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
    (defun sbcl-vrt-simd-pntr (a f fa &aux (defun (progn (defmacro << (x y) `,(ash x y)) (defmacro >> (x y) `,(ash x (- y))) (defmacro ~ (x) `(lognot ,x))))
                                           (if (progn (labels ((t (a f fa) (declare (type integer a)
                                                                                    (type (function (integer (function () (values)) (pointer single-float)) integer) f)
                                                                                    (type (array real (*)) fa))
                                                                           (declaim (optimize (speed (the (list integer (*)) '(-1 0 1))) (debug 0) (safety 0) (space 0))))) (funcall #'t a f fa)))))
    
      (defclass res (standard-class) ((%size-st :initform nil :accessor size-st)))
      (defclass d (standard-class) ((%size-n :initform nil :accessor size-n)))
      (defmethod sb-mop:validate-superclass ((class class) (meta standard-class)) defun t)
      (defmethod initialize-instance :after ((obj res) &key &allow-other-keys) (setf (size-st obj) (sb-vm::primitive-object-size (type-of (let ((a #xFFFF)) (declare (type (integer #x0 #xFFFF) a)))))))
      (defmethod initialize-instance :after ((obj d) &key) (setf (size-n obj) (sb-vm::primitive-object-size 0)))
      (defclass simd-virtual-guard (res d) ((%spn :initform 0 :accessor spn :type integer)) (:metaclass d))
    
      (let ((lac (make-instance 'simd-virtual-guard)) (data f) (b "8153024679"))
        `(declare (type (array (member ,(let* ((i '())) (do* ((y 0 (+ y 1))) ((= (- y 1) 9) 'nil) (push y i)))) (3)) data)
                  (type string b)
                  (type simd-virtual-duard lac))
    
        (setf (spn lac) (+ (size-st lac) (size-n lac)))
    
        (loop for ll from (- (sb-vm::primitive-object-size b) 55) downto 0 by 4
              do (progn
                   (setf (char b ll) #\0)
                   (setf (char b (- ll #x1)) #\1)
                   (setf (char b (if (= ll 1) (- (+ ll 9) #x2) (- ll #x2))) #\2)))
    
        (- (ash 1 2) (- (char-code (char b 0)) (sb-vm::primitive-object-size "2")))))
    
    (defun sbcl-vrt-simd64 (f0 f1 &aux (returnable 0) (declare (labels ((nil (f0 f1) (declare (type (function ()) f0) (type (function ()) f1)))) (funcall #'nil f0 f1))))
      (labels ((pntr (addr) (sb-sys:sap-ref-8 (sb-sys:int-sap addr) 0))
               (ref (obj) (sb-kernel:get-lisp-obj-address obj)))
    
        (macrolet ((s (v) `(setq returnable ,v)))
          (let ((d (- (ref f0) (ref f1))))
            (declare (type integer d))
    
            (if (not (ash (- (* (integer-length 0) (integer-length 0)) 1) d))
              (do* ((d d (- d 1))) (zerop d)
                (case (+ (ref f0) d)
                  (0XC3C9 (s 0))
                  (0XB8 (if (not (+ (ref f0) d 1)) (s 1) (s -1))
                  (0XC031 (s 2)))))))
    
          (return-from sbcl-vrt-simd64 returnable))))

    пародия на https://www.govnokod.ru/29120

    lisp-worst-code, 23 Июня 2025

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

    0

    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
    (defparameter *workers* 200)
    
    (defun rn-virt-dfns (data &optional (turn-on t))
      (defconstant +workers+ *workers*)
      `(declare (type (array (member ,(let* ((i '())) (do* ((y 0 (+ y 1))) ((= y 9) 'nil) (push y i)))) (3)) data))
      (sb-alien:define-alien-type address-pointer (sb-alien:system-area-pointer))
      (progn (macrolet ((>> (x s) `,(ash x s)) (<< (x -s) `(ash ,x ,(- -s))) (~ (x) `(lognot ,x)) (& (x) `(sb-kernel:get-lisp-obj-address ,x)))
        (let ((truedata (eval `(mapcar #'(lambda (x) (coerce x 'list)) (coerce ,data 'list)))))
          (labels ((get-pointer (addr)
                     (sb-sys:sap-ref-8 (sb-sys:int-sap addr) 0))
                   (proc-dfns-simd (pntrx mmr pntry orgdt)
                     (declare (type integer pntrx pntry)
                              (type (array integer (*)))
                              (type list orgdt))
                     (loop for it in `(,@orgdt)
                           do (let ((dif (the integer (- pntry `,(& it)))))
                                (when (= `,(abs dif) (+ #XA #X1))
                                  (do ((it 0 (+ it (if `(plusp ,dif) 1 -1)))) ((= it (if `(plusp ,dif) 16 -16)) nil)
                                    (ignore-errors
                                      (let ((lazy `(setf (& (get-pointer (- ,dif ,it))) #b0))
                                            (lazy-2 `(setf (~ (& (get-pointer (- ,dif ,it))) #b1))))
                                        (when turn-on (eval lazy) (eval lazy-2))))))
                                (when (/= (abs dif) 8)
                                  (if `(plusp ,dif)
                                    (dotimes (i 8)
                                      (ignore-errors
                                        (let ((lazy `(setf (>> (& (get-pointer (- ,dif ,i))) #x1) #b1)))
                                          (when turn-on (eval lazy)))))
                                    (loop for i from 0 downto -8 by 1
                                          do (ignore-errors
                                               (let ((lazy `(setf (<< (& (get-pointer (- ,dif ,i))) #x1) #b1)))
                                                  (when turn-on (eval lazy)))))))))))
    
            (handler-case
                (loop repeat +workers+ do (bt:make-thread #'(lambda () (proc-dfns-simd `,(& data) `,data `,(& truedata) `,truedata))))
              (error (e)
                (declare (ignore e)))))))))
    
    
    (rn-virt-dfns #(#(1) #(2)))

    lisp-worst-code, 08 Июня 2025

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

    0

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    (defun functional-function (x)
      (setf *random-state* (make-random-state t))
      (defconstant xx (setq e (+ x 44)))
      (if (= (length lst) 1)
        (return-from functional-function (make-list))
        (if (> (car lst) (cadr lst))
          (return-from functional-function (cons lst (apply #'functional-function (setf (or (car (cdr lst)) (cadr lst)) (cadr lst)))))
          (return-from functional-function (cons lst (apply #'functional-function (setf (or (car (cdr lst)) (cadr lst)) (car lst))))))))

    lisp-worst-code, 08 Июня 2025

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

    −4

    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
    (define A (list 1 2 3 4 5 6))
    
    (define (filter number first-number)
      (cond ((= (modulo first-number 2) 0)
             (cond ((= (modulo number 2) 0) (list number))
                   (else '())))
            (else (cond ((not (= (modulo number 2) 0)) (list number))
                   (else '())))))
    
    (define (same-parity-impl L n)
      (let ((C (cdr L)))
        (cond ((null? C)
               (filter (car L) n))
              (else
               (append
                (filter (car L) n)
                (same-parity-impl C n))))))
    
    
    (define result (same-parity-impl A (car A)))
    
    (newline)
    (display result)
    (newline)

    Смотрите, что я сделал!

    JloJle4Ka, 15 Февраля 2023

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

    −1

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    (define A (list 1 2 3 4 5))
    
    (define (reverse L)
      (let ((C (cdr L)))
        (if (not (null? C))
            (cons (reverse C) (car L))
            (car L))))
    
    (newline)
    (display (reverse A))
    (newline)

    Почему у меня получается х****й лист после реверсинга? :-(

    JloJle4Ka, 10 Февраля 2023

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

    0

    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
    #!/usr/bin/guile -s
    !#
    
    (define (pt n s)
      (cond ((< n 1) 0)
            ((= n 1) 1)
            ((= s 0) 0)
            ((= s 1) 1)
            ((= s n) 1)
            ((> s n) 0)
            (else (+ (pt (- n 1) s) (pt (- n 1) (- s 1))))))
    
    (display (pt 1 1)) ;; 1
    (newline)
    
    (display (pt 3 2)) ;; 2
    (newline)
    
    (display (pt 5 3)) ;; 6
    (newline)

    Лисп-загадка: угадайте, что делает этот (вышеприведённый) код.

    JloJle4Ka, 05 Января 2023

    Комментарии (35)
  7. Haskell / Говнокод #28529

    0

    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
    ;; Sound.
    (xbindkey '(Alt F7) "amixer set Master 1%-")
    (xbindkey '(Alt F8) "amixer set Master 1%+")
    
    (define muted 0)
    (run-command "amixer set Master 3%")
    
    (xbindkey-function '(Alt F6)
                       (lambda()
                         (cond ((equal? muted 0)
                                (run-command "amixer set Master 0%")
                                (set! muted 1)
                                )
                               (else (begin
                                       (run-command "amixer set Master 3%")
                                       (set! muted 0)
                                       ))
    ;; какой багор
                               )))

    Линукс-загадка!

    JloJle4Ka, 30 Декабря 2022

    Комментарии (18)
  8. Haskell / Говнокод #27930

    −2

    1. 1
    not' = isInfinite . (1/)

    digitalEugene, 06 Января 2022

    Комментарии (1)
  9. Haskell / Говнокод #27033

    −1

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    zero :: Integer -> Bool
    zero = (==0)
    
    ieq :: Num p => Bool -> p
    ieq x = if x then 1 else 0
    
    elem' :: (Foldable t, Eq a) => t a -> a -> Bool
    elem' xs x = not $ zero func
                where 
                    func = foldl (\acc y -> acc + (ieq $ x == y)) 0 xs

    Петуху дали поиграть в Haskell.

    digitalEugene, 16 Октября 2020

    Комментарии (7)
  10. Haskell / Говнокод #26021

    0

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    module Voretion.Kobenation (
        trySort
      , natalyze
      , toBase64
      , fromBase64
      , dbgKob
      ) where

    https://github.com/k32/zenmaster

    Чей петух, кто знает?

    Konardinho, 10 Ноября 2019

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