Arc Forumnew | comments | leaders | submitlogin
Exemplary examples of LOOP
6 points by vsingh 5881 days ago | 16 comments
Some of us were discussing the Common Lisp LOOP macro (http://arclanguage.org/item?id=2821) and I thought it would be a good idea to have a thread to collect particularly excellent examples of LOOP in use.

Post your favorite LOOP code here, and we'll see if we can come up with a solution in Arc using either the existing operators or, if necessary, some new ones.



9 points by drcode 5881 days ago | link

Here's a fully functional (as in, working) version of the ROBOTS game I wrote in CL that has heavy LOOP abuse (and FORMAT abuse). It would make a great arc exercise for someone :-)

BTW- Collisions of robots causes debris deadly to other robots.

-Conrad Barski

  (defun robots ()
    (loop named main
        with directions = '((q . -65) (w . -64) (e . -63) (a . -1)
                            (d .   1) (z .  63) (x .  64) (c . 65))
        for pos = 544
        then (progn (format t "~%qwe/asd/zxc to move, (t)eleport, (l)eave:")
		     (let* ((c (read))
			     (d (assoc c directions)))
		        (cond (d (+ pos (cdr d)))
			       ((eq 't c) (random 1024))
			       ((eq 'l c) (return-from main 'bye))
			       (t pos))))
        for monsters = (loop repeat 10
		             collect (random 1024))
        then (loop for mpos in monsters
                   collect (if (> (count mpos monsters) 1)
			         mpos
                               (cdar (sort (loop for (k . d) in directions
					            for new-mpos = (+ mpos d)
                                                 collect (cons (+ (abs (- (mod new-mpos 64) 
                                                                          (mod pos 64)))
                                                                  (abs (- (ash new-mpos -6)
                                                                          (ash pos -6))))
                                                               new-mpos))
                                           '<
                                           :key #'car))))
        when (loop for mpos in monsters
                   always (> (count mpos monsters) 1))
        return 'player-wins
        do (format t
                   "~%|~{~<|~%|~,65:;~A~>~}|"
                   (loop for p 
                         below 1024
                         collect (cond ((member p monsters) 
                                        (cond ((= p pos) (return-from main 'player-loses))
                                              ((> (count p monsters) 1) #\#)
                                              (t #\A)))
                                       ((= p pos) 
                                        #\@)
                                       (t 
                                        #\ ))))))

-----

3 points by vsingh 5881 days ago | link

Kenny Tilton submitted:

   (loop for y in whatever
         for py = (pfft y)
         when py collect (yo-mama (cons y py)))
The Arc solution is required to be roughly as efficient as the above code.

-----

4 points by vsingh 5881 days ago | link

Here's my Arc solution:

    (mappend [awhen (pfft _) (list (yo-mama (cons _ it)))] whatever)
The implementation of mappend in arc.arc is currently very inefficient, but it could easily be fixed to bring this code on par with the LOOP version.

-----

3 points by kennytilton 5881 days ago | link

See my point? Even in this incredibly simple iterative task you are forced into a clever trick leveraging how append works and then totally artificially taking each thing you want to collect and wrapping it in a list of one.

Looked at another way, you are not really going out and getting lists of variable length and then appending them, you are just using this trick to avoid collecting nils.

In this case the issue is not efficiency, it is that the loop DSL provides a more natural way for the developer to express themself. Now scale this to a loop that does three things at once, perhaps partitioning a list into several while counting or summing something else and the non-loop version explodes in complexity exponentially while the loop version gracefully grows linearally. (Say that three times fast.)

-----

3 points by vsingh 5881 days ago | link

I got a little carried away with being clever in that version. But look at the canonical Arc version:

   (rev:accum collect
      (each y whatever
         (awhen (pfft y) (collect (yo-mama (cons y it))))))
This version is pretty straightforward in expressing my intent.

As for the scaling issue, I'm still thinking about your other example. I'm not sure it's a good thing that Loop allows more and more to be tacked on. Subroutines in imperative-style languages like C++ have the same agglutinative property, and we're all familiar with the results of that.

-----

1 point by kennytilton 5881 days ago | link

Where on earth in your intent was reversal? Either the semantic or the run-time cost (ie, now you have introduced an efficiency issue that was not there with mappend/list.

You cannot win this fight, find a white flag, run it up. Why can you not win? Because loop the DSL was written with the most common iterative design patterns in mind, and hard-coded to make them both more succinct, more efficient, and to play well with other iterative patterns we occasionally want to run merged as one iteration.

This is what DSLs are for! Read On Lisp. We build the language up to our requirements. Loop is about iteration, and Lisp stands for list-processing. 2+2 left as an exercise. :)

-----

3 points by vsingh 5881 days ago | link

I suppose I ought to have written it like this the first time:

   (w/collect
      (each y whatever
         (awhen (pfft y) (collect (yo-mama (cons y it))))))
'w/collect' being the first new operator to result from our discussion.

-----

1 point by kennytilton 5880 days ago | link

"w/collect' being the first new operator to result from our discussion."

Oh. Where can I find w/collect? And do you mean it has been added to Official Arc? I must be missing out on the action.

-----

4 points by almkglor 5880 days ago | link

It's not on the arc-wiki. However I can certainly imagine how it would look like as a naive implementation:

  (mac w/collect body
    `(rev:accum collect ,@body))
Here's a slightly more optimized form which removes the need to reverse and adds only one additional variable to the environment built by accum:

  (mac w/collect body
    (w/uniq (hd tl)
      `(let (,hd ,tl collect) nil
          (= collect
            (fn (x)
              (if hd (do (= (cdr tl) (cons x nil)) (= tl (cdr tl)))
                      (do (= hd (cons x nil)) (= tl hd)))
               x))
          ,@body
          ,hd)))

-----

3 points by raymyers 5881 days ago | link

In cases anyone wants to take the efficiency thing seriously, this is what we are up against:

   http://paste.lisp.org/display/56189
And mind you, we don't even have one of those fancy-pants `goto' things.

-----

1 point by kennytilton 5881 days ago | link

That reminds me, I ended up reinventing Cells over the table in Arc because the real deal was so big it would have been a heckuva project, but I started on the actual code and... whoa! I have one chunk I found easiest to express as a very simple state machine using Common Lisp's tagbody/go and I had very little confidence in my conversion to a functional solution.

-----

2 points by kennytilton 5881 days ago | link

No, I did not submit this. Bad form, old chap.

I chose not to submit anything, because it would just turn into a silly game. If I wanted to make my point, I would simply itemize all the capabilities of loop, but that would be too big a task.

Delete everything but the "Pfft!" and you have my contribution.

-----

6 points by kennytilton 5881 days ago | link

Here's my damn submission:

  (defun ix-render-oblong (lbox thickness baser slices stacks)
  (unless slices (setq slices 0))
  (unless stacks (setq stacks (if (zerop thickness)
                                  0 (min 10
                                      (max 1  ;; force 3d if nonzero thickness
                                        (round (abs thickness) 2))))))
  (when (eql (abs thickness) (abs baser))
    (setf thickness (* .99 thickness)))
  (trc nil "oblong" baser thickness etages)
      
  (loop
    with theta = (/ pi 2 slices)
    with etages = stacks ;; french floors (etages) zero = ground floor
    with lw/2 = (/ (r-width lbox) 2)
    with lh/2 = (/ (r-height lbox) 2)
    with bx = (- lw/2 baser)
    with by = (- lh/2 baser)
    for etage upto etages
    for oe = 0 then ie
    for ie = (unless (= etage etages)
               (* (/ (1+ etage) etages)
                 (/ pi 2)))
    for ii = (if (not ie)
                 0 ;; throwaway value to avoid forever testing if nil
               (+ (* (abs thickness)
                    (- 1 (cos ie)))))
        
    for ox = lw/2 then ix
    for oy = lh/2 then iy
    for oz = 0 then iz
    for oc = (cornering baser slices) then ic
    for ic = (when ie
               (cornering (- baser ii) slices))
    for ix = (- lw/2 ii)
    for iy = (- lh/2 ii)
    for iz = (when ie
               (* thickness (sin ie)))
    
    do (trc nil "staging" etage ie)
        
        
    (gl-translatef (+ (r-left lbox) lw/2)(+ (r-bottom lbox) lh/2) 0)

    (with-gl-begun ((if ie
                        gl_quad_strip
                      gl_polygon))
      
      (loop for (dx dy no-turn-p)
          in '((1 1)(-1 1)(-1 -1)(1 -1)(1 1 t))
            ;;for dbg = (and (eql dx 1)(eql dy 1)(not no-turn-p))
            do (destructuring-bind (xyn0 ix0 iy0 ox0 oy0) 
                   (cons (+ (if oc (/ theta 2) 0)
                           (ecase dx (1 (ecase dy (1 0)(-1 (/ pi -2))))
                             (-1 (ecase dy (1 (/ pi 2))(-1 pi)))))
                     (if oc
                         (case (* dx dy)
                           (1 (list (* dx ix)(* dy by)(* dx ox)(* dy by)))
                           (-1 (list (* dx bx)(* dy iy)(* dx bx)(* dy oy))))
                        (list (* dx ix)(* dy iy)(* dx ox)(* dy oy))))
                  
                 ;; --- lay-down start/only -------------
                 (when ie
                   (ogl-vertex-normaling ie xyn0 ix0 iy0 iz))
                 (ogl-vertex-normaling  oe xyn0 ox0 oy0 oz)
                 
                 (trc nil "cornering!!!!!!----------------" dx dy)
                 ;; --- corner if slices and not just finishing strip
                 
                 (unless no-turn-p
                   (trc nil "------ start ------------------" (length oc)(length ic))
                   (loop for (oxn . oyn) in oc
                       for icrem = ic then (cdr icrem)
                       for (ixn . iyn) = (car icrem)
                       for xyn upfrom (+ xyn0 theta) by theta
                          do (macrolet
                                 ((vtx (elev gx sx gy sy gz)
                                    `(progn
                                       (when (minusp (* dx dy))
                                         (rotatef ,sx ,sy))
                                       (ogl-vertex-normaling ,elev xyn
                                         (incf ,gx (* dx ,sx))
                                         (incf ,gy (* dy ,sy))
                                         ,gz))))
                               (trc nil "ocn icn" oxn oyn (car icrem))
                               (when icrem
                                 (vtx ie ix0 ixn iy0 iyn iz))
                               (vtx oe ox0 oxn oy0 oyn oz)))))))
    (gl-translatef (- (+ (r-left lbox) lw/2))
      (- (+ (r-bottom lbox) lh/2)) 0)))
Macroexpand that. :)

-----

4 points by kennytilton 5881 days ago | link

"I would simply itemize all the capabilities of loop, but that would be too big a task."

Oooh, look! Someone did it for me:

http://www.lispworks.com/documentation/HyperSpec/Body/m_loop...

-----

2 points by vsingh 5881 days ago | link

Sorry about that! I overassumed. I'd change it to "vsingh submits the following" but it won't let me edit it anymore.

Thanks for your new contribution.

-----

1 point by kennytilton 5881 days ago | link

New contribution?! That was a joke, a painful transliteration of a couple of pages of graph paper formulas and diagrams working out the parameterized construction of a 3-dimensional button out of insanely small OpenGL atoms, including the torturous calculation of normals to support lighting.

I steered this thread to the Common Lisp Hyperspec entry on loop. By reading that and examining your own use of Arc iterators you can deduce how it can express them all more briefly and with fewer parens. That immediately helps the hacker over one bump... when it is time to iterate I type "(loop " without thinking and just take it from there -- no worrying about whether it is a sequence, list, or hash table, or whether I will need temp variable to be defined in a let/with statement, loop includes a mechanism for that, etc etc etc...

-----