lisp1.5.ss

(require mzlib/compat)

;;; (pairlis x y a)
;;; This procedure gives a key and value, corresponding elements of the lists x and
;;; y, and appends this to the hash table a.

;; ;; example
;; > (define *a* (make-hasheq))
;; > (hash-set! *a* 'd 'x)
;; > (hash-set! *a* 'e 'y)
;; > (pairlis '(a b c) '(u v w) *a*)
;; #hasheq((d . x) (c . w) (b . v) (e . y) (a . u))
;; > 

(define (pairlis x y a)
  (cond
   ((null? x)
    a)
   (else
    (hash-set! a (car x) (car y))
    (pairlis (cdr x) (cdr y) a))))

;;; evalquote is defined by using two main procedures, called myeval and myapply.
;;; myapply handles a function and its arguments, while myeval handles forms.
;;; Each of these procedures also has another argument that is used as a hash table
;;; for storing the values of bound variables and function names.

;; ;; example
;; > (evalquote '(lambda (x y) (cons (car x) y)) '((a b) (c d)))
;; (a c d)

(define (evalquote fn x)
  (myapply fn x (make-hasheq)))

(define (myapply fn x a)
  (if (atom? fn)
      (let ((head (car x)) (tail (cdr x)))
        (case fn
          ((car) (car head))
          ((cdr) (cdr head))
          ((cons) (cons head (car tail)))
          ((atom) (atom? head))
          ((eq) (eq? head (car tail)))
          (else (myapply (myeval fn a) x a))))
      (case (car fn)
        ((lambda) (myeval (third fn) (pairlis (cadr fn) x a)))
        ((label) (myapply (third fn) x (hash-set! a (cadr fn) (third fn))))
        (else (error " **** Unknown expression : " fn)))))

(define (myeval e a)
  (if (atom? e)
      (hash-ref a e)
      (let ((head (car e)) (tail (cdr e)))
        (if (atom? head)
            (case head
              ((quote) (car tail))
              ((cond) (evcon tail a))
              (else (myapply head (evlis tail a) a)))
            (myapply head (evlis tail a) a)))))

(define (evcon c a)
  (if (myeval (caar c) a)
      (myeval (cadar c) a)
      (evcon (cdr c) a)))

(define (evlis m a)
  (let loop ((m m) (acc '()))
    (if (null? m)
        (reverse acc)
        (loop (cdr m) (cons (myeval (car m) a) acc)))))