                      `(progn ,init (while ,cond ,body ,inc)))))
     (lambda   . ,(lambda (lm)
                    (destructuring-bind (fn params body) lm
-                     `(lambda ,(if (stringp params) () params) ,body))))
+                     `(lambda ,params ,body))))
     (inc-pre  . ,(lambda (expr)
                    (let ((id (cadr expr)))
                      `(setq ,id (1+ ,id)))))

    (message   . ,(lambda (msg)
                    (destructuring-bind (obj at f args) msg
                      `(funcall (cdr (assq ,f (cdr ,obj)))
                                ,@(psl--apply obj args)))))
    (field     . ,(lambda (field) `(quote ,field)))
    (index-str . ,(lambda (index) `(intern ,(nth 1 index))))
    (by-id     . ,#'cadr))
  "Syntax tree manipulation functions.")

(defun psl--apply (f args)
  (if (stringp args)
      (list f)
    (cons f args)))

(defun psl--funcall (f args)
  `(funcall ,f ,@(if (stringp args) () args)))

(defun psl--tuck (names)
  (if (stringp (nth 1 names))
      (list (car names))
    (cons (car names) (cadadr names))))

(defun psl-make-object (fields)
  (if (null fields)
      ()
    (if (assq (caar fields) (cdr fields))
        '((error "Multiply-defined fields"))
      (cons `(cons (quote ,(caar fields)) ,(cdar fields))
            (psl-make-object (cdr fields))))))

;;; Parser functions


    (args     . ,(apply-partially 'nth 1))
    (ids      . ,#'psl--tuck)
    (exprs    . ,#'psl--tuck)
    (funcall  . ,(lambda (call)
                   `(funcall ,(nth 0 call) ,@(nth 1 call))))
    (aexprs   . ,#'psl--tuck)
    (block    . ,(lambda (exprs) (cons 'progn (nth 1 exprs))))
    (true     . ,(lambda (true) t))
    (false    . ,(lambda (false) nil))
    (pair     . ,(lambda (pair) (cons (nth 0 pair) (nth 2 pair))))
    (pairs    . ,(lambda (pairs) (cons (car pairs) (cadadr pairs))))
    (object   . ,(lambda (obj)
                   (let ((fields (nth 1 obj)))
                     `(list 'object ,@(psl--make-object fields)))))
    (if       . ,(lambda (expr)
                   (destructuring-bind (if cond then else) expr
                     `(if ,cond ,then ,else))))
