[plt-scheme] define-macro defining define-macro

Hi,
I'm fiddling with making my own version of the casting spels with lisp
tutorial as a way to get a better handle on macros;
( see http://www.lisperati.com/actions.html )


I'm having trouble getting the big macro-defining macro working

To give some context, the author (Conrad Barski) uses 'spels' instead of macros;

;;in scheme
(define-macro (defspel . arguments)
  `(define-macro , at arguments))

An example

(defspel (walk direction)
  `(walk-direction ',direction))


My problem is I can't quite get my head about the macro-defining-macro
'game-action'

I get the error ;
"procedure application: expected procedure, given: (cond
(*chain-welded* (set! *bucket-filled* 't) '(the bucket is now full of
water)) (else '(the water level is too low to reach.))) (no arguments)
"
  [backtrace gives a DrScheme internal error - but I am on 372 so it's
probably my fault]

I'm pretty sure I need to call it with the cond backquoted- but I am wrong.

Can anyone point me in the right direction?

Cheers,

stephen


;; http://www.lisperati.com/actions.html (in tutorial)
;; http://www.lisperati.com/code.html / (in code context)
;; NON-Functioning
(defspel game-action
  (lambda (command subj obj place . rest)
    `(defspel (,command subject object)
       `(cond ((and (equal? *location* ,',place)
                    (equal? ',subject ,',subj)
                    (equal? ',object ,',obj)
                    (have ,',subj))
               ,,rest)
              (else '(i cant ,',command like that.))))))

;; it is used with
(game-action dunk bucket well garden
             `(cond
                (*chain-welded* (set! *bucket-filled* 't) '(the bucket
is now full of water))
                (else '(the water level is too low to reach.))
                ))

;; and which is used like this
(dunk bucket well)


;;;;;;;;;;;


;;;scheme version  lang:pretty-big- output-style: current-print

(require (lib "list.ss")
         (lib "etc.ss")

         (lib "defmacro.ss"))

;; providing lisp forms
(define (remove-if-not pred? alist)
  (filter pred? alist))
;; another
(define-macro push
  (lambda (item place)
    `(set! ,place (cons ,item ,place))))
;;


(define *objects* '(whiskey-bottle bucket frog chain))

(define *map* '((living-room
                 (you are in the living-room of a wizard's house.
there is a wizard snoring loudly on the couch.)
                 (west door garden)
                 (upstairs stairway attic))
                (garden
                 (you are in a beautiful garden. there is a well in
front of you.)
                 (east door living-room))
                (attic
                 (you are in the attic of the abandoned house. there
is a giant welding torch in the corner.)
                 (downstairs stairway living-room))))

(define *object-locations* '((whiskey-bottle living-room)
                             (bucket living-room)
                             (chain garden)
                             (frog garden)))

(define *location* 'living-room)

(define (describe-location location map)
  (second (assoc location map)))

(define (describe-path path)
  `(there is a ,(second path) going ,(first path) from here.))

(define (describe-paths location the-map)
  (apply append (map describe-path (cddr (assoc location the-map)))))

(define (is-at obj loc obj-loc)
  (equal? (second (assoc obj obj-loc)) loc))

(define (describe-floor loc objs obj-loc)
  (apply append (map (lambda (x)
                       `(you see a ,x on the floor.))
                     (remove-if-not (lambda (x)
                                      (is-at x loc obj-loc))
                                    objs))))

(define (look)
  (append (describe-location *location* *map*)
          (describe-paths *location* *map*)
          (describe-floor *location* *objects* *object-locations*)))

(define (walk-direction direction)
  (let ((next (assoc direction (cddr (assoc *location* *map*)))))
    (cond (next (set! *location* (third next)) (look))
          (#t '(you cant go that way.)))))

(define-macro (defspel . arguments)
  `(define-macro , at arguments))
(defspel (walk direction)
  `(walk-direction ',direction))
(define (pickup-object object)
  (cond ((is-at object *location* *object-locations*)
         (begin
           (push (list object 'body) *object-locations*)

           `(you are now carrying the ,object)))
        (#t '(you cannot get that.))))
(defspel (pickup object)
  `(pickup-object ',object))
(define (inventory)
  (remove-if-not (lambda (x)
                   (is-at x 'body *object-locations*))
                 *objects*))
(define (have object)
  (member object (inventory)))
(define *chain-welded* #f)
(define *bucket-filled* null)

;;; another
;(define-macro push
;  (lambda (item place)
;    `(set! ,place (cons ,item ,place))))
(defspel game-action
  (lambda (command subj obj place . rest)
    `(defspel (,command subject object)
       `(cond ((and (equal? *location* ,',place)
                    (equal? ',subject ,',subj)
                    (equal? ',object ,',obj)
                    (have ,',subj))
               ,,rest)
              (else '(i cant ,',command like that.))))))

(game-action dunk bucket well garden
             `(cond
                (*chain-welded* (set! *bucket-filled* 't) '(the bucket
is now full of water))
                (else '(the water level is too low to reach.))
                ))

(game-action weld chain bucket 'attic
             `(cond ((and (have 'bucket) (set! *chain-welded* 't))
'(the chain is now securely welded to the bucket.))
                    (else '(you do not have a bucket.))))


(game-action splash bucket wizard 'living-room
             `(cond ((not *bucket-filled*) '(the bucket has nothing in it.))
                    ((have 'frog) '(the wizard awakens and sees that
you stole his frog. he is so upset he banishes you to the
netherworlds- you lose! the end.))
                    (else '(the wizard awakens from his slumber and
greets you warmly. he hands you the magic low-carb donut- you win! the
end.))))
;;;;
(look)
*object-locations*

(pickup bucket)
*object-locations*
;; walkthrough
(inventory)
(walk upstairs)
(walk east)
(walk downstairs)
(walk west)
(dunk bucket well)
------------


-full LISP code from http://www.lisperati.com/code.html ->
(defparameter tpl:*print-length* nil)

(defparameter *objects* '(whiskey-bottle bucket frog chain))

(defparameter *map* '((living-room (you are in the living-room of a
wizard's house. there is a wizard snoring loudly on the couch.)
                     (west door garden)
                     (upstairs stairway attic))
              (garden (you are in a beautiful garden. there is a well
in front of you.)
                      (east door living-room))
              (attic (you are in the attic of the abandoned house.
there is a giant welding torch in the corner.)
                     (downstairs stairway living-room))))

(defparameter *object-locations* '((whiskey-bottle living-room)
                           (bucket living-room)
                           (chain garden)
                           (frog garden)))

(defparameter *location* 'living-room)

(defun describe-location (location map)
  (second (assoc location map)))

(defun describe-path (path)
  `(there is a ,(second path) going ,(first path) from here.))

(defun describe-paths (location map)
  (apply #'append (mapcar #'describe-path (cddr (assoc location map)))))

(defun is-at (obj loc obj-loc)
  (eq (second (assoc obj obj-loc)) loc))

(defun describe-floor (loc objs obj-loc)
  (apply #'append (mapcar (lambda (x)
                            `(you see a ,x on the floor.))
                          (remove-if-not (lambda (x)
                                           (is-at x loc obj-loc))
                                         objs))))

(defun look ()
  (append (describe-location *location* *map*)
          (describe-paths *location* *map*)
          (describe-floor *location* *objects* *object-locations*)))

(defun walk-direction (direction)
  (let ((next (assoc direction (cddr (assoc *location* *map*)))))
    (cond (next (setf *location* (third next)) (look))
          (t '(you cant go that way.)))))

(defmacro defspel (&rest rest) `(defmacro , at rest))

(defspel walk (direction)
  `(walk-direction ',direction))

(defun pickup-object (object)
  (cond ((is-at object *location* *object-locations*) (push (list
object 'body) *object-locations*) `(you are now carrying the ,object))
        (t '(you cannot get that.))))

(defspel pickup (object)
  `(pickup-object ',object))

(defun inventory ()
  (remove-if-not (lambda (x)
                   (is-at x 'body *object-locations*))
                 *objects*))

(defun have (object)
  (member object (inventory)))

(defparameter *chain-welded* nil)

(defparameter *bucket-filled* nil)

(defspel game-action (command subj obj place &rest rest)
  `(defspel ,command (subject object)
     `(cond ((and (eq *location* ',',place)
                  (eq ',subject ',',subj)
                  (eq ',object ',',obj)
                  (have ',',subj))
             ,@',rest)
            (t '(i cant ,',command like that.)))))

(game-action weld chain bucket attic
             (cond ((and (have 'bucket) (setf *chain-welded* 't))
'(the chain is now securely welded to the bucket.))
                   (t '(you do not have a bucket.))))

(game-action dunk bucket well garden
             (cond (*chain-welded* (setf *bucket-filled* 't) '(the
bucket is now full of water))
                   (t '(the water level is too low to reach.))))

(game-action splash bucket wizard living-room
             (cond ((not *bucket-filled*) '(the bucket has nothing in it.))
                   ((have 'frog) '(the wizard awakens and sees that
you stole his frog. he is so upset he banishes you to the
netherworlds- you lose! the end.))
                   (t '(the wizard awakens from his slumber and greets
you warmly. he hands you the magic low-carb donut- you win! the
end.))))