Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

Lisp Help

Name: Anonymous 2013-03-22 19:18

Help me refactoring following funcion. It was growing and growing, and now I can barely navigate across it.

(defun merge-lambs (name ls)
  (let* ((a (unisym))
         (ms (make-hash-table :test 'equal)) ; methods
         (mm nil) ; multimethod
         (vars nil) ; object variables
         (w (unisym)) ; wild
         (wild nil)
         (h (unisym))
         (init (unisym))
         (vs nil)
         (close (has-arrow? (rhd ls)))
         (used-vars (make-hash-table :test 'equal))
         )
    (unless close (setf name nil))
    ($map (fn (l)
            (setf l ($split #'arrow? l))
            (when (> (len l) 1)
              (setf l (lst (1st l)
                           (fold (2nd l)
                                 (fn (a b) (st ($$a $"|" $$b)))
                                 (drop 2 l)))))
            (if (< (len l) 2)
                (let ((x (lhd l)))
                  (setf l (if (equal (2nd x) ":")
                              (st ($(lhd x) $(drop 2 x)))
                              (st ($nil $x))))
                  (let ((x (lhd l)))
                    (cond ((stringp x)
                           (if (gethash x used-vars)
                               (error "redeclaration of `~a`" X)
                               (setf (gethash x used-vars) t)))
                          ((unesc? x) (setf l (st ($nil $(expand-set (2nd x) (2nd l))))))
                          ))
                  (setf (gethash "Var" ms) (st ($$(gethash "Var" ms) $l)))
                  )
                (let* ((l (st ($(lhd l) (_ do $$(ltl l)))))
                       (hd (lhd (lhd l)))
                       (n hd))
                  (if (fn-sym? hd)
                      (setf l (st ($(ltl (lhd l)) $$(ltl l))))
                      (setf n "?"))
                  (setf l (st ((|[]| $(lhd l)) $$(ltl l))))
                  (setf (gethash n ms) (st ($l $$(gethash n ms)))))
                  )
            nil)
          ls)
    (setf vars (gethash "Var" ms))
    (remhash "Var" ms)
    (maphash (fn (hd ls)
               ;;(setf ls (rev ls))
               (let* ((x (chain-lambs a ls nil))
                      (*checked-lst-method* (if (string= hd "?") nil hd))
                      (y (when *checked-lst-method*
                           (chain-lambs a ls nil))))
                 (setf (gethash hd ms) (cons x y))))
             ms)
    (setf wild (car (gethash "?" ms)))
    (remhash "?" ms)
    (maphash (fn (k v) (setf vs (st (($k $(cdr v) (_ fn ($a) $(car v))) $$vs))))
             ms)
    (setf mm (if (= (hash-table-count ms) 0)
                 wild
                 (st (_ let (($w (_ fn () $wild)) ($h (_ host (aref $a 0))))
                       (_ if (_ host (stringp $h))
                             $(search-method h ($map #'rtl vs) (st (_ host (topject (|@| $name) $a))))
                             (_ host (funcall $w)))))))
    (when name (setf mm (st (_ host (block $name ($"@" $mm))))))
    (setf mm (st (_ fn ($a) $mm)))
    (when name (setf mm (st (_ name $name $mm))))
    (when vars
      (let ((vi (st (_ do $$($map (fn (v) (if (1st v)
                                              (st (_ set $$v))
                                              (2nd v)))
                                  vars)))))
      (setf mm (if close
                   (st (_ do (_ set $init (_ fn $(when name (lst name))
                                             $vi))
                             $mm))
                   vi))))
    (unless (= (hash-table-count ms) 0)
      (setf mm (st (_ let ($$($map (fn (v) (lst (lhd v) nil)) vs))
                     (_ do $$($map (fn (v) (st (_ set $(1st v) $(3rd v)))) vs)
                           $mm)))))
    (let ((vars (keep #'1st vars)))
      (when vars
        (setf mm (st (_ let $($map (fn (v) (st ($(1st v) n))) vars)
                        $mm)))))
    (when name
      (setf mm (st (_ let (($name $nil))
                      (_ do (_ set $name $mm)
                         $name)))))
    (when (and vars close)
      ;; generate call to init closure
      (let ((tmp (unisym)))
        (setf mm (st (_ let (($init $nil))
                        (_ let (($tmp $mm))
                           (_ do (_ host (funcall $init $$(when name (lst tmp))))
                                 $tmp)))))))
    mm))

Name: Anonymous 2013-03-23 10:52

>>44
That was pretty bad. It's also how /prog/ was at the very beginning, looking way back in the post list. It was awful. Namedropping everywhere and questions answered in the third paragraph of the programming tutorial they aren't actually reading.

Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List