Solutions to exercises from "lecture notes 8"




(defun my-equal (x y)
  (or (eql x y)
      (and (stringp x)
           (stringp y)
           (string= x y))
      (and (consp x)
           (consp y)
           (my-equal (car x) (car y))
           (my-equal (cdr x) (cdr y)))))

(defun my-eql (x y)
  (or (eq x y)
      (and (numberp x)
           (numberp y)
           (= x y))
      (and (characterp x)
           (characterp y)
           (char= x y))))

(defun date()
  (multiple-value-bind
      (second minute hour date month year day daylight-p zone)
      (get-decoded-time)
    (unless (zerop zone)
      (error "Have not yet coded names for zone ~a" zone))
    (format nil
            "~a ~a ~a ~a:~a:~a ~a ~a"
            (aref #("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") day)
            (aref #(nil "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") month)
            date
            hour minute second
            (if daylight-p "BST" "GMT")
            year)))

;; error in question - sorry - it's COMPILING the crude version
;; (defun first-arg (first second) first) which produces a warning
(defun first-arg (first second)
  (declare (ignore second))
  first)

(defun position-three-returning-from-nil (list number)
  (let ((count 0))
    (dolist (var list)
      (if (= var number)
          (return-from nil count))
      (incf count))))

(defun position-three-returning-from-self (list number)
  (let ((count 0))
    (dolist (var list)
      (if (= var number)
          (return-from position-three-returning-from-self count))
      (incf count))))

(defun double-all (list)
  (mapcar (lambda (x)
            (if (numberp x)
                (+ x x)
              (return-from double-all)))
          list))

;;;;;;;;;;

(defun my-make-array (length)
  (let* ((table (make-hash-table)))
    (setf (gethash 'length table) length)
    table))

(defun my-length (table)
  (gethash 'length table))

(defun check-index (table index)
  (or (< -1 index (my-length table))
      (error "Index ~a out of bounds" index)))

(defun my-aref (table index)
  (check-index table index)
  (gethash index table))

(defun my-setf-aref (table index new-value)
  (check-index table index)
  (setf (gethash index table) new-value))

(defsetf my-aref my-setf-aref) ; cute addon - can now say (setf (my-aref table index) new-value)
 

 If you have tried the exercises, looked at the solutions and still do not understand what's going on, I am available for consultation at the times advertised on my office door. Bring your code with you in BOTH the following forms:

 

Nick Levine
                                                                               last modified 2000-11-24
                                                         Copyright (C) Nick Levine 1999. All rights reserved.
$Id: //info.ravenbrook.com/user/ndl/lisp/declarative/lectures/solutions/solutions-8.html#2 $