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-22 19:19

what the fuck does it even do

Name: Anonymous 2013-03-22 19:22

>>2
it combines several defun into one pattern-matching multimethod, which also acts as an object, while topject is a default `sink` object, where all unhandled defuns go.

Name: Anonymous 2013-03-22 19:30

>>1-3
Please learn to use sage, or go back to /b/.

Name: Anonymous 2013-03-22 19:33

>>4
LLLLLLLLLLEEEEEEEEEEEELLLLLLLLLLLLLLLLLLLLLL
>LE ENCULER FACE
>MFW I DONT TAKE ORDERS FROM JEWISH MAGGOTS

Name: Anonymous 2013-03-22 19:35

>>4
Are you '>le implying that >>1-chan should have used sage on his thread? lol wut? What good would that do?

Name: Anonymous 2013-03-22 19:37

>>6
It makes you look like an oldfag, even if you are totally unable to understand continuations.

Name: Anonymous 2013-03-22 19:43

>>7
It makes you look like an oldfag if you sage the OP? When did anyone ever do that?

Name: Anonymous 2013-03-22 19:56

>>8
It makes you look like an imageboard retard if you post without sage when you have no valid reason to bump a thread.

Name: Anonymous 2013-03-22 20:00

>>9
Why should I care about your opinion about my look?

Name: Anonymous 2013-03-22 20:08

>>9
I have a giant dongle.

Name: Anonymous 2013-03-22 21:05

Any better way to implement LABELS, without SETF?

(defmacro labels (ds &body body)
  (let ((s (gensym))
        (m (gensym)))
    `(let ((,s (lambda (,s ,m)
                 (let ,(mapcar (lambda (d)
                                 `(,(car d) (lambda ,(second d)
                                              (funcall (funcall ,s ,s ',(car d)) ,@(second d)))))
                               ds)
                   (case ,m
                     ,@(mapcar (lambda (d) `(,(car d) (lambda ,@(cdr d)))) ds)
                     (otherwise ,@body))))))
       (funcall ,s ,s nil))))

Name: Anonymous 2013-03-22 21:06

That's all one defun? I thought LISP code was supposed to be more concise and used more small functions that did one thing

Name: Anonymous 2013-03-22 21:15

>>13
Yep. This function implements whole C/C++ like language, with OOP and local variables.

BTW, why can't IF itself be a macro?

(defun true (a b) (funcall a))
(defun false (a b) (funcall b))

(defmacro if (condition then else)
  `(funcall ,condition (lambda () ,then) (lambda () ,else)))

Name: Anonymous 2013-03-22 21:17

>>14
I'm pretty sure, compiler can easily optimize (lambda () ,then/,else) out.

Name: Anonymous 2013-03-22 21:33

use haskell, fuckheads

Name: Anonymous 2013-03-22 21:34

>>14>>15

Rare benefit of call-by-name is that one can implement if without a macro. Which Haskell surprising fails to do:
http://www.haskell.org/haskellwiki/If-then-else

Name: Anonymous 2013-03-22 21:39

>>17
Haskell is drunk on syntax. That's why I will never fully like it.

Name: Anonymous 2013-03-22 21:57

>>18
Syntax is optional, it's merely syntactic sugar. You can structure the code in the style of prefix operations.

Name: Anonymous 2013-03-22 22:13

>>19

Lisp                        | Haskell
----------------------------|---------------------------------------------------
$ sbcl                      | $ ghci
* +3                        | Prelude> +3
3                           | <interactive>:1:0: parse error on input `+'
*                           | Prelude>




Lisp                           | Haskell
-------------------------------|------------------------------------
map - '(1 2 3 4 5)             | map (-) [1,2,3,4,5,6]
(-1 -2 -3 -4 -5)               | No instance for (Show (a -> a))
                               |   arising from a use of `print'
                               |
map -                          | map negate
invalid number of arguments: 1 | No instance for (Show ([a] -> [a]))
Backtrace:                     |   arising from a use of `print'
  0: (map #<function>)         |
  1: (eval '(map -))           |

Name: Anonymous 2013-03-22 23:02

>>29
http://www.haskell.org/haskellwiki/Show_instance_for_functions
... It doesn't answer the question of why it can't at least show the type of the function (e.g. Num a => a -> a)...
Actually,
import Data.Typeable
instance (Show x, Show a, Typeable x, Typeable a) => Show (x -> a) where
    show = ("<function> :: " ++) . show . typeOf

Prelude Tools> (+3)
<function> :: Integer -> Integer
Prelude Tools> map (-) [1..5]
[<function> :: Integer -> Integer,<function> :: Integer -> Integer,<function> :: Integer -> Integer,<function> :: Integer -> Integer,<function> :: Integer -> Integer]
Prelude Tools> map (-)
<function> :: [Integer] -> [Integer -> Integer]
Prelude Tools>

Also, map in LISP is more like this (yes, with all that ugly-ass syntax!):
* (map 'list #'- '(1 2 3 4 5))
(-1 -2 -3 -4 -5)

Name: Anonymous 2013-03-22 23:12

>>21
map in LISP is more like implying CL is the only Lisp and you can't define your own map.

http://minus.com/l8RMBsjFYUxSg

Name: Kind Jewish Man 2013-03-22 23:17

(to a kind Jewish lad): See here, Jimmy? They have everything organised. Don't you like organised things? I think they are magnificent.

----------------------------------------------------------------

You know who's responsible for the code posted in >>1 don't you? That's right, the Jews are.

Name: Anonymous 2013-03-22 23:19

>>19
You know who's responsible for making it optional don't you? That's right, the Jews are. If it were up to me syntax would be compulsory.

Name: Anonymous 2013-03-22 23:21

>>22
>>20 specifically mentioned sbcl, and defining a non-standard map in CL (or any LISP intended for real work, unlike Scheme) is just asking for problems.

Name: Anonymous 2013-03-22 23:21

>>22
And message-passing achieves very succinct syntax, like for example a list delegating all unhandled messages to its elements. So Xs+1 can add 1 to every element of the, either consing or destructively.

Name: Anonymous 2013-03-22 23:25

>>25
Nope. Map is overused function, so defining it like (defmacro m (xs as &body body) `(mapcar (lambda ,as ,@body) ,xs)) can safe you a lot of typing

Name: Anonymous 2013-03-22 23:28

>>27
Note that you didn't name your non-standard version of map ``map'', thus avoiding all the problems >>25 was referring to.

Name: Anonymous 2013-03-22 23:29


$ grep '+' *.lisp | wc -l
      42
$ grep 'map' *.lisp | wc -l
      93
$ pwd
/Users/nikita/Documents/prj/symta/libs/symta
$


i.e. map has order of magnitude more use than arithmetic operator.

Name: Anonymous 2013-03-23 0:10

/Users/nikita/
Macfag.

Name: Anonymous 2013-03-23 0:11

OH GOD NIKITA USES MAC?

NIKITA, MACOS IS WRITTEN BY DA JEWS, THEY PUT BACKDOORS ALL OVER!

Name: Anonymous 2013-03-23 0:26

>>31
It's okay though, because even if they get in through a backdoor they can't do anything really harmful on a Mac, because it's a fucking Mac.

Name: Anonymous 2013-03-23 0:49

dubs help
check 'em groskis
lel

Name: Anonymous 2013-03-23 1:36

>>30-31
XDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD


LE E/G/IN /G/``FAG'' XD

LE STALLMAN FACE.JPEG

Name: Anonymous 2013-03-23 2:07

>>34
enjoy your governmental backdoors, cretin.

Name: Anonymous 2013-03-23 8:18

>>35
enjoy your tinfoil hat, imbecile

Name: Anonymous 2013-03-23 8:27

>>36
it's so comfy and protective, cretin

Name: VIPPER 2013-03-23 8:56

Another thread derailed with shitty and overused insults, well done.

Name: Anonymous 2013-03-23 9:03

>>38
Fuck off, faggot.

Name: VIPPER 2013-03-23 9:07

>>39
Suggest me a good programming board that doenst have people like yourself and im out of here for good.
Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List
All trademarks and copyrights on this site are owned by their respective parties. All comments and posts are the responsibility of their own posters.
- Tinychan + 2ch Mode -