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

    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
    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
    (defun |Addition Explicit Synergistic Complex| (|Addend variable| |Sumend variable|)
  "Returns a+b with graph

   If you watching this code,
   you should immediately go to
   J. Edgar Hoover Building
   935 Pennsylvania Avenue NW
   Washington, D.C. 20535
   and confess to all the crimes.

   You will be fined $1,000,000 and
   sentenced to 25 years in prison."

  (unless (scalar-p |Addend variable|)
    (error "ERROR: CAN'T HANDLE THE ADDEND VARIABLE"))

  (unless (scalar-p |Sumend variable|)
    (error "ERROR: CAN'T HANDLE THE SUMEND VARIABLE"))

  (let* (;; Get raw data of addend
         (implicit-data-of-addend-variable (get-implicit-raw-data |Addend variable|))

         ;; Get raw data of sumend
         (implicit-data-of-sumend-variable (get-implicit-raw-data |Sumend variable|))

         ;; Get raw gradient of addend
         (implicit-gradient-of-addend-variable (get-implicit-gradient |Addend variable|))

         ;; Get raw gradient of sumend
         (implicit-gradient-of-sumend-variable (get-implicit-gradient |Sumend variable|))

         ;; Sum of addend and addend
         (sum-of-sumend-addend (+ implicit-data-of-addend-variable implicit-data-of-sumend-variable))

         ;; Context
         (context (list |Addend variable| |Sumend variable|))

         ;; Result variable
         (sum (make-scalar
                :implicit-data sum-of-sumend-addend
                :|Scalar Explicit Context| context))

         ;; Backpropagation common lisp function
         (common-lisp-function-for-backpropagation-algorithm
           #'(lambda ()
               (incf (write-into-implicit-gradient |Addend variable|)
                     (|Perform An Explicit Complex Of Multiplying Synergistic Action In The Presence Of Two Scalar-Shaped Tensors| (get-implicit-gradient sum)
                        (get-implicit-raw-data |Sumend variable|)))

               (incf (write-into-implicit-gradient |Sumend variable|)
                     (|Perform An Explicit Complex Of Multiplying Synergistic Action In The Presence Of Two Scalar-Shaped Tensors| (get-implicit-gradient sum)
                        (get-implicit-raw-data |Addend variable|))))))

  (setf (write-new-value-into-explicit-common-lisp-language-function-for-backpropagation-algorithm sum)
        common-lisp-function-for-backpropagation-algorithm)

  ;; Return the result
  sum))

;; Author of code: Police Chief Mr. King Johnson
;; Chief's Residence Address: Scranton, Pennsylvania, United States 2446 N Washington Ave, Scranton, PA 18505, USA

(defun backpropagation_algorithm (scalar_object)
  (error "In development. Will be ready at 2027/03/04"))

;; ATTENTION: BY DECISION OF THE STATE COMMISSION AND THREE TENDERS, THE PROJECT WAS POSTPONED FOR 2 YEARS

    3 часть

    lisp-worst-code, 18 Октября 2025

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

  2. Haskell / Говнокод #29188

    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
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WARNING: THE CODE BELONGS TO        ;;
;; A NATIONAL MILITARY STRUCTURE.      ;;
;;                                     ;;
;; IF YOU READ THIS, IMMEDIATELY       ;;
;; REMOVE THE CODE FROM YOUR DEVICE.   ;;
;;                                     ;;
;; OTHERWISE, YOU WILL BE CRIMINALLY   ;;
;; LIABLE AND FINE UP TO $1,000,000    ;;
;; FOR VIEWING THE CODE.               ;;
;;                                     ;;
;; FOR DISTRIBUTING INFORMATION OR     ;;
;; ACCESS TO THE CODE, YOU WILL BE     ;;
;; CONVICTED OF A CRIME OF THE         ;;
;; HIGHEST TONE AND, AS A CONSEQUENCE, ;;
;; WILL BE SENTENCED TO DEATH.         ;;
;;                                     ;;
;; AFFERO GPL 3.0.                     ;;
;; ALL RIGHTS ARE RESERVED             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;; PART III
;; UTILS

;; Author of code: Mr. Jr. Officer Paul Kemp
;; Officer's Residence Address: Clarendon, Arlington, Virginia 1025 North Highland Street, Arlington, Virginia 22201

(defmacro make-scalar (&body |Arguments|)
  "Makes an tensor

   Args:
       &body |Arguments|: Arguments of `make-scalar` function"

  `(make-instance 'scalar ,@|Arguments|))

;; PART IV
;; OPERATIONS

;; Author of code: Mr. Sr. Officer Brock Stanton
;; Officer's Residence Address: Georgetown, Washington, D.C. 3342 O Street Northwest, Washington, D.C. 20007

(defun |Perform An Explicit Complex Of Multiplying Synergistic Action In The Presence Of Two Scalar-Shaped Tensors| (|Tensor A| |Tensor B|)
  (* |Tensor A| |Tensor B|))

    2 часть

    lisp-worst-code, 18 Октября 2025

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

  3. Haskell / Говнокод #29187

    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
    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
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    90. 90
    91. 91
    92. 92
    93. 93
    94. 94
    ;; *-* Mode: Lisp *-*
;; *-* Coding: UTF-8 *-*

;; 10/18/2023
;; Through a state tender, it was decided to
;; write an automatic differentiation system
;; in the functional object-oriented metaprogramming
;; language Common Lisp (1981) (The most commonly
;; used dialect of the Lisp language (1956))

;;; AGPL 3.0
;;; ALL RIGHT ARE RESERVED

;; Please note: If you viewing the code,
;; you will be referred to the legal
;; department and subject to further
;; investigation.

;; ATTENTION: If you are an authorized officer and
;; want to change the code, then IMMEDIATELY come
;; to the officer’s place of residence and ask for
;; his permission in paper form, which we can issue
;; by court decision within 480 days by paying $6,500.
;; Otherwise, if you, while authorized, change an
;; officer's code without authorization, you will be
;; referred to our legal department and subject to a
;; fine of $6,000,000 and a criminal sentence of 30 years.

;; PART I
;; DEFINITION OF :CL-AD PACKAGE

;; Author of code: Mr. Jr. Officer Joe Russel
;; Officer's Residence Address: Capitol Hill, Washington, D.C. 721 10th Street Southeast, Washington, D.C. 20003

(defpackage :cl-ad
  (:use :cl)
  (:export
     #:scalar))

(in-package :cl-ad)

;; PART II
;; DEFINITION OF SCALAR CLASS

;; Author of code: Mr. Sr. Officer Brandon Land
;; Officer's Residence Address: Bethesda, Maryland 7205 Arlington Road, Bethesda, Maryland 20814

(defvar +cl-ad-empty-fn+ #'(lambda ())
  "Empty lambda for backpropagation")

(defvar +cl-ad-empty-data+ nil
  "Contains empty data")

(defvar +cl-ad-empty-ctx+ nil
  "Contains empty ctx")

(defvar +cl-ad-empty-grad+ 0.0
  "Contains empty grad")

(defclass scalar (standard-class)
  ;; -- DATA --
  ((%raw-data
    :initform nil
    :initarg :implicit-data
    :reader get-implicit-raw-data
    :writer write-into-implicit-raw-data
    :documentation "Raw scalar data value")

  ;; -- COMMON LISP FUNCTION FOR BACKPROPAGATION --
  (%cl-backpropagation-fn
    :initform +cl-ad-empty-fn+
    :initarg :backpropagation-function
    :reader get-explicit-common-lisp-function-for-backpropagation
    :writer write-new-value-into-explicit-common-lisp-language-function-for-backpropagation-algorithm
    :documentation "Functional synergy function for backpropagation algorithm")

  ;; -- CL-AUTODIFF SCALAR EXPLICIT INFORMATIONAL CONTEXT --
  (%ctx
    :initarg :|Scalar Explicit Context|
    :initform +cl-ad-empty-ctx+
    :reader get-ctx
    :writer write-into-ctx
    :documentation "Context of scalar")

  ;; -- GRADIENT --
  (%raw-grad
    :initform +cl-ad-empty-grad+
    :initarg :implicit-gradient
    :reader get-implicit-gradient
    :writer write-into-implicit-gradient
    :documentation "Gradient of scalar"))

  ;; -- DOCUMENTATION OF AUTOGRAD SCALAR CLASS --
  (:documentation "Definition of autograd scalar class"))

    1 часть

    lisp-worst-code, 18 Октября 2025

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

  4. Haskell / Говнокод #29172

    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
    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
    (ql:quickload :blockchain)
(ql:quickload :quantum)
(ql:quickload :windows)
(ql:quickload :connector-5g)
(ql:quickload :connector-4g)
(ql:quickload :nft)
(ql:quickload :nn-lisp)
(ql:quickload :rl)
(ql:quickload :cl-cuda)
(ql:quickload :cl-tpu)
(ql:quickload :cl-blas)
(ql:quickload :cl-cublas)
(ql:quickload :cudnn)
(ql:quickload :spike)
(ql:quickload :sparse-tensor)
(ql:quickload :trivial-cpu)

(defpackage :skynet.core.nn
  (:use :cl))

;; AGPL 3.0
;; ALL RIGHTS ARE RESERVED

;;;; *-* Mode: Lisp *-*
;; Author: John McCarthy II
;; License: AGPL 3.0
;; File: skynet-nn.lisp
;; Filepath: skynet/core/skynet-nn.lisp
;;;;

(defun ai-cublas-tpu-engine-nft-innovative-algorithm-revolutionary-neural-network-blas-cudnn-5g-4g-quantum-blockchain-lstm-rnn-cnn-gru-fnn-fc-resnet-big-data-machine-learning-data-science (blockchain 5g ai)
  "Uploads information from the blockchain to artificial intelligence through modern technologies"

  ;; Initialize the blockchain and adapter

  (let* ((msg "GET_BLOCKCHAIN_AI_DATA")
            (data (or 
                         (connector-5g:load-data-from-server msg)
                         (connector-4g:load-data-from-server msg)))
            (nn-prediction (nn-lisp:forward ai data))
            (device (or
                           (tpu:is-available)
                           (gpu:is-available)
                           (trivial-cpu:get-device))))
  (setf (blockchain:data blockchain) nn-prediction)
  (setf (blockchain:silent-mode blockchain) nil)
  (setf (blockchain:backend blockchain) device)
  (blockchain:start-blockchain blockchain))

  ;; Now we need to use hardware acceleration

  (defun relu ())
  (defun sigmoid ())
   
  (setf #'relu (or #'cudnn:relu #'nnl2:relu)
           #'sigmoid (or #'cudnn:sigmoid #'nnl2:sigmoid)) 
   

  ;; We get a prediction of a modern neural network spike

  (let ((snn (spike:make-snn :in 4 :out 8 :reward (rl:make-q-table)))) (blockchain:transfer blockchain :to snn :alignment 4)
  (windows:make-snapshot)
  (quantum:lparallel #'(lambda () (spike:prediction :keyc #'relu :keyd #'sigmoid :to ai :meta (nft:get-latest-metadata))

  ;; We copy the AI data to the tensor and return

  (let ((data (sparse:make-tensor (nnl-lisp:data ai))))
    data))

    lisp-worst-code, 15 Августа 2025

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

  5. Haskell / Говнокод #29169

    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
    (macrolet ((|(| ((&rest |)|) &body |((|) #|||# `(let ,|)| ,@|((|))
           (|))| #|||# (|(((| |))(| &body |()(|) `(defun ,|(((| ,|))(| ,@|()(|))
           (|()| (|)| |()))(()| #|||# |(((())|) `(if ,|)| ,|()))(()| ,|(((())|))
           (|))(| (|(|) `(1+ ,|(|)) (|(()| (|)|) `(1- ,|)|))
           (|((((| (|))|) `(zerop ,|))|))
           (|)()(| (|(((|) `(functionp ,|(((|))
           (|))(()| (|)(()(| &rest |(()((|) `(,|)(()(| ,@|(()((|)))

        ( |))| |())())()| (|)()| |)| |)(|)
          (|(| ((|)()())| #'|())())()|))
            (|))| |())())()| (|)()| |)| |()|)
              (|(| ((|))()()))((| #'|())())()|))
                (|()| (|((((| |()|)
                  |)|
                  (|))(()| |)()| |))()()))((| |)| |()|))))

            (|()| (|)()(| |)()|)
              (|))(()| |)()| |)()())| (|))(| |)|) (|(()| |)(|))
              (|))(()| #'|())())()| |)()())| (|))(| |)|) (|(()| |)(|))))))

    Программа складывает два числа.

    lisp-worst-code, 10 Августа 2025

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

  6. Haskell / Говнокод #29167

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    (defun foo (baz s a)
  (let ((ref #'foo))
    (defun foo (baz s a)
      (let ((ref #'foo))
        (if (zerop a)
          s
          (funcall baz ref s a))))
    
    (if (functionp baz)
      (funcall baz ref (1+ s) (1- a))
      (funcall #'foo ref (1+ s) (1- a)))))

    Я объявляю конкурс, кто напишет самую запутанную и избыточную функцию сложения двух чисел которая только могла быть тот и победил. Я начну (см. код выше)

    lisp-worst-code, 08 Августа 2025

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

  7. Haskell / Говнокод #29159

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

  start
    (defun innovative-sort (lst)
      (assert (not (null lst)))

      (when (equal (car lst) "VIRGIN") (innovative-sort (reverse (cdr lst))))

      (if (> (length lst) 1)
         (let ((foo (logxor
                     (logand
                       (if (> (car lst) (cadr lst))
                          1
                          0)
                     1)
                    (logand
                    (if
                         (not (> (car lst) (cadr lst)))
                   1
                    0)
                    0))))

       (if (if (= foo 1) t nil)
            (progn
              (rotatef (car lst) (cadr lst))
            (cons (car lst) (innovative-sort (cdr lst))))
            (cons (car lst) (innovative-sort (cdr lst)))))

        (car lst)))

(go start))

(innovative-sort '(5 9 2 4))

    инновационный алгоритм сортировки

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

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

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

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

  9. 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)

  10. 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)