Jump to content
  • Advertisement
Sign in to follow this  
Nathan Baum

Lisp Pimpin'

This topic is 4819 days old which is more than the 365 day threshold we allow for new replies. Please post a new topic.

If you intended to correct an error in the post then please contact us.

Recommended Posts

I figured it was about time I pimped mo' Lisp on yo asses.
(defpackage turbine (:use) (:nicknames tb))

(defconstant tb::*fail* 'tb::*fail*)

(defmethod tb::fail ()
  (block nil
     (handler-bind ((control-error #'(lambda (&rest ignore) (return))))
               (throw tb::*fail* tb::*fail*))))

(defmacro tb::fail-if (test value)
  (if test value (tb::fail)))

(shadow 'with-gensyms)
(defmacro with-gensyms (syms &body body)
  `(let ,(mapcar #'(lambda (sym) `(,sym (gensym))) syms)
      ,@body))

(defmacro defpredicate (name pred)
  `(defmethod ,name (&rest args)
     (if (apply #',pred args)
         (car (last args))
       (tb::fail))))

(defmacro tb::suspend (value &body forms)
  `(values ,value
     #'(lambda () ,@forms)))

(defun tb::make-generator (fn init-args)
  (let ((the-fn #'(lambda () (apply fn init-args))))
    #'(lambda () (if (null the-fn) (tb::fail)
                  (multiple-value-bind (result new-fn)
                                       (funcall the-fn)
                    (setf the-fn new-fn)
                    result)))))

(defmacro tb::defgen (name lambda-list &body body)
  `(setf (get (defun ,name ,lambda-list ,@body) 'tb::generator) t))

(setf (get 'tb::iota 'tb::generator) t)

(defun genfunp (symb)
  (get symb 'tb::generator))

(defun extract-generators (form)
  (let (names forms)
    (labels
      ((addgen (name form) (setf names (cons name names)
                                 forms (cons form forms)))
       (walker (form) (cond ((not (consp form)) form)
                            ((or (not (consp (car form)))
                                 (not (genfunp (caar form))))
                                (cons (walker (car form))
                                      (walker (cdr form))))
                            (t (with-gensyms (gen-name)
                                  (addgen gen-name
                                            `(tb::make-generator #',(caar form) ,(cdar form)))
                                  `(,gen-name ,@(walker (cdr form))))))))
      (let ((x (walker (list form))))
        (values (reverse names) (reverse forms) (car x))))))

(defmacro tb::if (test then else)
  (let ((block-name (gensym))
    (tag (gensym)))
    `(block ,block-name
        (catch ',tag
          (catch 'tb::*fail*
            (throw ',tag ,test))
            (return-from ,block-name ,else))
        ,then)))

(defun closure-reader (stream char)
  (declare (ignore char))
  `(lambda (&rest args)
      (destructuring-bind (&optional _1 _2 _3 _4 _5 _6 _7 _8 _9 &rest _>) args
        (let ((_ _1) (_* args))
          ,@(read-delimited-list #\] stream t)))))
(set-macro-character #\[ #'closure-reader nil)
(set-macro-character #\] #'(lambda (stream char) t) t)

(defmacro tb::every (subject &body body)
  (with-gensyms (loop-name ever-successful result)
    (multiple-value-bind (symbol-names init-forms subject) (extract-generators subject)
      (let ((init-args (mapcar [(gensym)] init-forms)))
      `(let ,(mapcar [`(,_1 (list ,@(third _2)))] init-args init-forms)
      ,(let ((init-forms (mapcar [(list (first _2) (second _2) _1)]
                                 init-args init-forms)))
      (let ((fnames (mapcar [(gensym)] init-forms)))
      `(let ,(mapcar [`(,_1 ,_2)] fnames init-forms)
             (let ,(mapcar [`(,_1 (funcall ,_2))] symbol-names fnames)
               (let* ((,ever-successful nil) 
                      (,result (loop named ,loop-name 
                        do (tb::if ,subject (tb::guard (setf ,ever-successful t) ,@body) nil)
                        do ,(with-gensyms (block-name)
                               `(block ,block-name
                                      ,@(mapcar [`(tb::if (setf ,_1 (funcall ,_2))
                                                          (return-from ,block-name)
                                                    (progn (setf ,_2 ,_3)
                                                            (setf ,_1 (funcall ,_2))))]
                                           symbol-names fnames init-forms)
                                      (return-from ,loop-name))))))
                  (if ,ever-successful ,result (tb::fail))))))))))))

(import '(t nil) 'tb)

(defmacro tb::guard (&body forms)
  `(catch 'tb::*fail* ,@forms))

(defmacro tb::or (&rest forms)
  (with-gensyms (block-name)
  `(block ,block-name
     ,@(mapcar #'(lambda (form) `(tb::guard (return-from ,block-name ,form)))
                         forms))))

(defmethod tb::identical? (x y)
  (tb::fail-if (eq x y) y))

(defmethod tb::equal? (x y)
  (tb::fail-if (equalp x y) y))

(import '(1- 1+ + * - / max min abs) 'tb)

(defpredicate tb::> >)
(defpredicate tb::< <)
(defpredicate tb::>= >=)
(defpredicate tb::<= <=)
(defpredicate tb::/= [(not (equalp _1 _2))])
(defpredicate tb::== equalp)

(defpredicate tb::even? [(evenp _)])
(defpredicate tb::integer? integerp)

(defmacro tb::not (form)
  `(tb::if ,form (tb::fail) nil))

(defmacro tb::and (&rest args)
  `(progn ,@args))

(import '(format setq) 'tb)
(import '(&optional &rest &body &key) 'tb)

(in-package tb)

(defgen iota (from to &optional (by 1))
  (if (>= from to) from
    (suspend from (iota (+ from by) to))))


That beautiful flower is the beginnings of the definition of a minilanguage similar in spirit to the Icon programming language. Predicates either succeed, producing their last argument as a value, or fail, producing no value and short-circuiting evaluation up to the nearest failure guard. Generators produce sequences of values, and the every form repeatedly evaluates an expression until all generators are exhausted, executing the body for those iterations where the test was successful. If no tests where successful, the every fails as a whole. In the completed language, one would be able to do things like (if (== (one-of foo bar baz) (gen 10 20 30)) (print "One of foo, bar or baz is equal to 10, 20 or 30")), or (print "Foo appears before bar in \"" string "\" in positions: ") (every (print (> (find string "foo") (find string "bar"))) " "). Right now, it allows for stupidly concise, although terribly inefficient (I'm no compiler writer), code like the following:
(every (setq i (iota 1 100))
  (format t "~A is prime~%" i (not (every (> i (integer? (/ i (iota 1 (1- i)))) 1)))))


Roughly, it says: For every i from 1 to 100, say it's prime if there are no numbers from 1 to i - 1 by which i is divisible. The particularly odd thing is not simply conciseness -- in the prime number case, the program could be equally concise in almost any language -- but the fact that the algorithm can be turned inside out, if that happens to suit the problem at hand: compare (every (print (> (find string "foo") (find string "bar"))) with an equivalent in your favourite programming language. The fact that I'm able to knock up something this weird in only several hours, which interacts almost seamlessly with standard Lisp (only almost, sadly) is telling of Lisp's deep-rooted flexibility. In summary: Lisp rox your sox. PS. If you feel like trying it out, I only know it works in CLISP. Plus, I've only been testing it for about 4 hours. Plan accordingly.

Share this post


Link to post
Share on other sites
Advertisement
Jeez, you lisp guys should start a religion or something. [wink]

Seriously though, I was planning on giving lisp a try this summer. What would you say is the best tutorial/book to learn from?

(By the way, did you catch the Pascal's Triangle thread? Good stuff.)

Share this post


Link to post
Share on other sites
Ah, the brackets, they blind me! [wink]

I love the variety in different languages. Someday I've got to write a 3D renderer in a functional language like OCaml. Or Prolog!

Share this post


Link to post
Share on other sites
Quote:
Original post by FReY
Lisp is a wonderful way to learn purely recursive programming.


Lisp is also a good way to drive yourself insane and choke to death on parenthesis. It is fun...

Share this post


Link to post
Share on other sites
Quote:

Lisp is also a good way to drive yourself insane and choke to death on parenthesis.


Not if you have a cool IDE that matches your parentheses up for you :)

Share this post


Link to post
Share on other sites
Although my joke above might have sounded a bit 'flamey', I really do get a kick out of functional programming. Is anyone in the commercial game industry using Lisp (or any other functional language) as part of their titles (say, as a scripting language?).

Or what about Prolog? I've used Prolog to prototype a few things, and it's really easy to build a text parser out of, but is it used in (commercial) games at all?

Share this post


Link to post
Share on other sites
Quote:
Original post by Trapper Zoid
Is anyone in the commercial game industry using Lisp (or any other functional language) as part of their titles (say, as a scripting language?).


That's the wrong question to ask I think. "What great games can be written in Lisp that cannot be written in C++?" is the right one.

You may search on Jak and Daxter for an example of using Lisp to create the compiler for a Lisp-like scripting language. They had no suitable Lisp on the console they targeted so they made their own - and even with this huge overhead they still got out ahead.

Share this post


Link to post
Share on other sites
Sign in to follow this  

  • Advertisement
×

Important Information

By using GameDev.net, you agree to our community Guidelines, Terms of Use, and Privacy Policy.

We are the game development community.

Whether you are an indie, hobbyist, AAA developer, or just trying to learn, GameDev.net is the place for you to learn, share, and connect with the games industry. Learn more About Us or sign up!

Sign me up!