pure lisp written in Gauche

lisp.scm

#!/opt/local/bin/gosh
(define (myeval exp env)
  (cond ((atom? exp)
	 (if (number? exp)
	     exp
	     (assoc* exp env)))
	((eq? (car exp) 'quote:) (cadr exp))
	(else (myapply (car exp)
		       (eval-args (cdr exp) env) env))))

(define (eval-args exp env)
  (if (null? exp) '()
	     (cons (myeval (car exp) env)
		   (eval-args (cdr exp) env))))
	 
	 
(define (assoc* x y)
  (cond ((null? y)
	 (error-message x) '())
	((equal? x (caar y)) (cdar y))
	(else (assoc* x (cdr y)))))

(define (error-message x)
  (display " Error. not defined? : ")
  (display x)
  (newline))

(define (atom? x) (not (pair? x)))

(define (myatom? foo)
  (if (not (pair? foo)) 't 'nil))

(define (myeq? foo baz)
  (if (eqv? foo baz) 't 'nil))

(define (nil? x)
  (if (eq? x '()) #t #f))

(define (myapply func args env)
  (cond
   ((and (not (nil? func)) (atom? func))
    (cond
     ((eq? func 'car:) (car args))
     ((eq? func 'cdr:) (cdr args))
     ((eq? func 'cons:) (cons (car args) (cadr args)))
     ((eq? func 'atom:) (myatom? (car args)))
     ((eq? func 'eq:) (myeq? (car args) (cadr args)))
     (else
      (myapply (myeval func env) args env))))
   (else (error-message args))))

(define *prompt* "> ")
(define *version* "Delihiros Pure Lisp")
(define *environment* '())
(define (init-environment)
  (set! *environment* '((t . t) (nil . nil))))
(define (dpl)
  (display *version*)
  (newline)
  (init-environment)
  (display *prompt*)
  (do ((exp (read) (read)))
      ((and (list? exp)
	    (member (car exp) '(bye: quit: end: exit:)))
       'good-bye)
    (display (myeval exp *environment*))
    (newline)
    (display *prompt*)))

(define (main args)
  (dpl))