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

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

0

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

(ql:quickload :cl-json)

(defmacro penetrate-json (val shifrate)
  `(if (null ,shifrate)
     ,val)

  `(case ,shifrate
     (#XA (penetrate-json (car ,val) (cadr ,shifrate)))
     (#XF (penetrate-json (cdr ,val) (cadr ,shifrate)))
     (#XFF (penetrate-json (caadar ,val) (cadr ,shifrate)))
     (#XFA (penetrate-json (cddddr ,val) (cadr ,shifrate)))
     (#XAF (penetrate-json (caddar ,val) (cadr ,shifrate)))
     (#XFFF (penetrate-json (cdaadr ,val) (cadr ,shifrate)))
     (#XFAF (penetrate-json (cddadr ,val) (cadr ,shifrate)))
     (#XAAA (penetrate-json (caaddr ,val) (cadr ,shifrate)))))

(let ((parsed (with-open-file (stream "C:/Users/lisps/PycharmProjects/pythonProject/.venv/Scripts/commonlisp/test" :direction :input)
                (json:decode-json-from-source stream))))

  (setf (cdadar (penetrate-json (assoc :pidorasik parsed) `(,#XA ,#XFAF ,#XFFF ,#XAF ,#XF ,#XAAA ,#XFAF ,#XFF))) 100) ; oh my fucking gosh

  (with-open-file (stream "C:/Users/lisps/PycharmProjects/pythonProject/.venv/Scripts/commonlisp/test" :direction :output :if-exists :supersede)
    (json:encode-json parsed stream)))

car/cdr ад

lisp-worst-code, 06 Июля 2025

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

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

+1

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

(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)

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

0

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

(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)

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

0

1
2
3
4
5
6
7
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)

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

−4

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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)

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

−1

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

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

0

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
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)

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

0

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
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)

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

−2

1

not' = isInfinite . (1/)

digitalEugene, 06 Января 2022

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

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

−1

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

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