Post Lisp Code

JUST POST SOME FUCK ING LISP!!!!

(defun generate-expr (&key fn-list term-list max-depth method)
  (if (or (= max-depth 0)
      (and (eq method :grow)
           (< (random 1.0)
          (/ (length term-list) (+ (length term-list) (length fn-list))))))
      (nth (random (length term-list)) term-list)
      (let* ((fn (nth (random (length fn-list)) fn-list))
         (arity (length `(swank-backend:arglist ,fn))))
    (cons fn (loop for i from 0 to arity
         collect (generate-expr :fn-list fn-list :term-list term-list :max-depth (1- max-depth) :method method))))))

(setq faggot 'you)

check this

>>29

smack 'em

Post Lisp Code

Here is some code from newest Symta:

  (let* ((xs (filter-keywords nil nil ls))
         (ks (car xs))
         (ls (cdr xs))
         (a (unisym))
         (ms (make-hash-table :test 'equal))
         (mm nil))
    ($map (fn (l)
            (let ((hd (lhd (lhd l))))
              (if (fn-sym? hd)
                  (setf l (st ($(ltl (lhd l)) $$(ltl l))))
                  (setf hd "_"))
              (setf (gethash hd ms)
                    (st ($$(gethash hd ms)
                           $(st ((|[]| $(lhd l)) $$(ltl l))))))))
          ls)
    (maphash (fn (hd ls)
               (let* ((x (chain-lambs a ls nil))
                      (*checked-lst-method* (not (string= hd "_")))
                      (y (when *checked-lst-method* (chain-lambs a ls nil))))
                 (setf (gethash hd ms) (cons y x))))
             ms)
    (setf mm (car (gethash "_" ms)))
    (remhash "_" ms)
    (unless (= (hash-table-count ms) 0)
      (let* ((d (unisym))
             (h (unisym))
             (vs nil))
        (maphash (fn (k v) (setf vs (st (($k $(car v) (_fn ($a) $(cdr v))) $$vs))))
                 ms)
        (setf mm
              (st (_let (($d nil) $$($map (fn (v) (lst (lhd v) nil)) vs))
                    (do (set_l $d (_fn () $mm))
                        $$($map (fn (v) (st (set_l $(1st v) $(3rd v)))) vs)
                        (_let (($h (cl (aref $a 0))))
                           (_if (cl (stringp $h))
                                $(search-method h ($map #'rtl vs) d)
                                (c $d)))))))
        ))
    (when name (setf mm (st (cl (block $name ($"@" $mm))))))
    (st (_fn ($a $$(if ks (lst ks))) $mm)))

Wow, this thread is so not post-lisp.  I am disappointed.

>>14
LISP 0666: The Embodiment of Lambda Knight

check 'em

No

>>29
Come back to /prog/, please ;_;

Updated version of my match macro, which I'm using for Symta:

(defun includes (v xs)
  (when (consp xs)
    (or (eql (car xs) v)
        (includes v (cdr xs)))))

(defun match-hole (key hole hit miss)
  (unless (consp hole)
    (return-from match-hole
      (if (and hole (symbolp hole) (not (keywordp hole)) (not (eql hole t)))
          (if (string= (symbol-name hole) "_")
              hit
              `(let ((,hole ,key))
                 ,hit))
          `(if (equal ',hole ,key)
               ,hit
               ,miss))))
  (when (eql (car hole) '=)
    (return-from match-hole
       (match-hole key (second hole) (match-hole key (third hole) hit miss) miss)))
  (when (eql (car hole) 'or)
    (return-from match-hole
      `(if (match ,key ,@(mapcar (lambda (x) `(,x t)) (cdr hole)))
           ,hit
           ,miss)))
  (when (eql (car hole) 'not)
    (return-from match-hole
      `(if (match ,key ,@(mapcar (lambda (x) `(,x t)) (cdr hole)))
           ,miss
           ,hit)))
  (when (eql (car hole) '/)
    (return-from match-hole
      (let ((g (gensym)))
        `(let ((,g (,(second hole) ,key)))
           ,(match-hole g (third hole) hit miss)))))
  (when (includes '! hole)
    (let ((xs (split '! hole)))
      (return-from match-hole
        `(let ((,@(car xs) ,key))
           (if ,(!body (cdr xs))
               ,hit
               ,miss)))))
  (when (and (eql (car hole) 'quote)
             (= (length hole) 2))
    (return-from match-hole
      `(if (equal ,(second hole) ,key)
           ,hit
           ,miss)))
  (let ((x (gensym))
        (hit (match-hole key (cdr hole) hit miss)))
    `(if (consp ,key)
         (let ((,x (car ,key))
               (,key (cdr ,key)))
           ,(match-hole x (car hole) hit miss))
         ,miss)))

(defmacro match (keyform &body cases)
  (let ((key (gensym))
        (b (gensym)))
    `(let ((,key ,keyform))
       (block ,b
         (tagbody
           ,@(reduce (lambda (next case)
                       (let ((miss (gensym))
                             (hit `(return-from ,b (progn ,@(cdr case)))))
                         `(,(match-hole key (car case) hit `(go ,miss)) ,miss ,@next)))
                     (cons nil (nreverse cases))))))))

#|
;; example usage:
(defun flatten (x)
  (match x ((x . xs) (append (flatten x) (flatten xs)))
           ((x ! and x (atom x)) (list x))))
|#

>>45
And that code is now totally outdated, because most of the boilerplate gets implemented using Symta itself and in a simpler way. I.e. if one wants lazy lists or finger trees, he could just implement them and they would work like builtin lists.

(LAMBDA (A)
  (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
           (TYPE FIXNUM A))
  (LET ((REG (MAKE-ARRAY 256 :ELEMENT-TYPE 'FIXNUM :INITIAL-ELEMENT 0)))
    (DECLARE (TYPE (SIMPLE-ARRAY FIXNUM (256)) REG)
             (IGNORABLE REG))
    (LABELS ((#:L980 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L981 A A #:R975 #:R976 #:R977 #:R978 #:R979))
             (#:L981 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L982 A #:R974 A #:R976 #:R977 #:R978 #:R979))
             (#:L982 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L983 #:R974 #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
             (#:L983 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L984 (1- A) #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
             (#:L984 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L985 A A #:R975 #:R976 #:R977 #:R978 #:R979))
             (#:L985 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L986 #:R976 #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
             (#:L986 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L987 (+ A #:R975) #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
             (#:L987 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L988 A #:R974 #:R975 A #:R977 #:R978 #:R979))
             (#:L988 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L989 #:R974 #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
             (#:L989 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (IF (ZEROP A)
                   (#:L990 A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                   (#:L983 A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)))
             (#:L990 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (#:L991 #:R976 #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
             (#:L991 (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE
                (TYPE FIXNUM A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
                (IGNORABLE A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               (:EXIT A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
             (:EXIT (A #:R974 #:R975 #:R976 #:R977 #:R978 #:R979)
               (DECLARE (IGNORE #:R974 #:R975 #:R976 #:R977 #:R978 #:R979))
               A))
      (#:L980 A 0 0 0 0 0 0))))

Some generated code using labels and tail-calls rather than the tagbody/goto combination.

>>53
(SAFETY 0)
back to premature optimization, ``please!''

(DUBS (CHECK EM))

>>54
without (SAFETY 0) you wouldn't have been born

>>54
It's not premature optimization, as this was the final step in optimizing the program.

>>57
edit: After it was already correct