core: Refactor eval.

* mes.c (eval_env): Rename from builtin_eval, Update callers.  Use switch.

define.c

@@ -25,12 +25,12 @@ define_env (scm *x, scm *a)
   scm *e;
   scm *name = cadr (x);
   if (name->type != PAIR)
-    e = builtin_eval (caddr (x), cons (cons (cadr (x), cadr (x)), a));
+    e = eval_env (caddr (x), cons (cons (cadr (x), cadr (x)), a));
   else {
     name = car (name);
     scm *p = pairlis (cadr (x), cadr (x), a);
     cache_invalidate_range (p, a);
-    e = builtin_eval (make_lambda (cdadr (x), cddr (x)), p);
+    e = eval_env (make_lambda (cdadr (x), cddr (x)), p);
   }
   if (eq_p (car (x), &symbol_define_macro) == &scm_t)
     e = make_macro (name, e);

mes.c

@@ -355,8 +355,8 @@ scm *
 evlis_env (scm *m, scm *a)
 {
   if (m == &scm_nil) return &scm_nil;
-  if (m->type != PAIR) return builtin_eval (m, a);
+  if (m->type != PAIR) return eval_env (m, a);
-  scm *e = builtin_eval (car (m), a);
+  scm *e = eval_env (car (m), a);
   return cons (e, evlis_env (cdr (m), a));
 }
 
@@ -392,7 +392,7 @@ apply_env (scm *fn, scm *x, scm *a)
   else if (fn->car == &scm_label)
     return apply_env (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a));
 #endif
-  scm *efn = builtin_eval (fn, a);
+  scm *efn = eval_env (fn, a);
   if (efn == &scm_f || efn == &scm_t) assert (!"apply bool");
   if (efn->type == NUMBER) assert (!"apply number");
   if (efn->type == STRING) assert (!"apply string");
@@ -401,13 +401,11 @@ apply_env (scm *fn, scm *x, scm *a)
 }
 
 scm *
-builtin_eval (scm *e, scm *a)
+eval_env (scm *e, scm *a)
 {
-  if (e->type == FUNCTION) return e;
+  switch (e->type)
-  if (e->type == SCM) return e;
+    {
-  if (e->type == SYMBOL) return assert_defined (assq_ref_cache (e, a));
+    case PAIR:
-  if (e->type != PAIR) return e;
-  if (e->car->type != PAIR)
       {
         if (e->car == &symbol_quote)
           return cadr (e);
@@ -431,7 +429,7 @@ builtin_eval (scm *e, scm *a)
         if (e->car == &symbol_primitive_load)
           return load_env (a);
 #else
-      if (e->car == &symbol_define) {
+if (e->car == &symbol_define) {
         fprintf (stderr, "C DEFINE: ");
         display_ (stderr,
                   e->cdr->car->type == SYMBOL
@@ -443,23 +441,26 @@ builtin_eval (scm *e, scm *a)
       assert (e->car != &symbol_define_macro);
 #endif
       if (e->car == &symbol_set_x)
-        return set_env_x (cadr (e), builtin_eval (caddr (e), a), a);
+        return set_env_x (cadr (e), eval_env (caddr (e), a), a);
 #if QUASIQUOTE
       if (e->car == &symbol_unquote)
-        return builtin_eval (cadr (e), a);
+        return eval_env (cadr (e), a);
       if (e->car == &symbol_quasiquote)
         return eval_quasiquote (cadr (e), add_unquoters (a));
 #endif //QUASIQUOTE
 #if QUASISYNTAX
       if (e->car == &symbol_unsyntax)
-        return builtin_eval (cadr (e), a);
+        return eval_env (cadr (e), a);
       if (e->car == &symbol_quasisyntax)
         return eval_quasisyntax (cadr (e), add_unsyntaxers (a));
 #endif //QUASISYNTAX
       scm *x = expand_macro_env (e, a);
-      if (x != e) return builtin_eval (x, a);
+      if (x != e) return eval_env (x, a);
-    }
       return apply_env (e->car, evlis_env (e->cdr, a), a);
+      }
+    case SYMBOL: return assert_defined (assq_ref_cache (e, a));
+    default: return e;
+    }
 }
 
 scm *
@@ -491,7 +492,7 @@ begin_env (scm *e, scm *a)
 {
   scm *r = &scm_unspecified;
   while (e != &scm_nil) {
-    r = builtin_eval (e->car, a);
+    r = eval_env (e->car, a);
     e = e->cdr;
   }
   return r;
@@ -500,10 +501,10 @@ begin_env (scm *e, scm *a)
 scm *
 builtin_if (scm *e, scm *a)
 {
-  if (builtin_eval (car (e), a) != &scm_f)
+  if (eval_env (car (e), a) != &scm_f)
-    return builtin_eval (cadr (e), a);
+    return eval_env (cadr (e), a);
   if (cddr (e) != &scm_nil)
-    return builtin_eval (caddr (e), a);
+    return eval_env (caddr (e), a);
   return &scm_unspecified;
 }
 

module/mes/base-0.mes

@@ -26,8 +26,8 @@
 
 ;;; Code:
 
-;;(define (apply f x) (apply-env f x (current-module)))
+(define (primitive-eval e) (eval-env e (current-module)))
-(define (primitive-eval e) (eval e (current-module)))
+(define eval eval-env)
 (define (expand-macro e) (expand-macro-env e (current-module)))
 
 (define quotient /)

module/mes/loop-0.mes

@@ -37,8 +37,8 @@
 ((label loop-0
         (lambda (r e a)
           ;; (display "***LOOP-0*** ... e=") (display e) (newline)
-          (if (null? e) (eval (cons 'begin (read-file-env (read-env a) a)) a)
+          (if (null? e) (eval-env (cons 'begin (read-file-env (read-env a) a)) a)
-              (if (atom? e) (loop-0 (eval e a) (read-env a) a)
+              (if (atom? e) (loop-0 (eval-env e a) (read-env a) a)
                   (if (eq? (car e) 'define)
                       ((lambda (aa)     ; env:define
                          ;; (display "0DEFINE name=") (display (cadr e)) (newline)
@@ -47,8 +47,8 @@
                          (set-cdr! (assq '*closure* a) a)
                          (loop-0 *unspecified* (read-env a) a))
                        (cons            ; sexp:define
-                        (if (atom? (cadr e)) (cons (cadr e) (eval (caddr e) a))
+                        (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))
-                            (cons (caadr e) (eval (cons 'lambda (cons (cdadr e) (cddr e))) a)))
+                            (cons (caadr e) (eval-env (cons 'lambda (cons (cdadr e) (cddr e))) a)))
                         '()))
                       (if (eq? (car e) 'define-macro)
                           ((lambda (name+entry) ; env:macro
@@ -64,10 +64,10 @@
                                                  (cdr name+entry)))
                                '())))
                                         ; sexp:define
-                           (if (atom? (cadr e)) (cons (cadr e) (eval (caddr e) a))
+                           (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))
-                               (cons (caadr e) (eval (cons 'lambda (cons (cdadr e) (cddr e))) a)))
+                               (cons (caadr e) (eval-env (cons 'lambda (cons (cdadr e) (cddr e))) a)))
                            '())
-                          (loop-0 (eval e a) (read-env a) a)))))))
+                          (loop-0 (eval-env e a) (read-env a) a)))))))
  *unspecified* (read-env '()) (current-module))
 
 ()

module/mes/mes-0.mes

@@ -79,8 +79,8 @@
 (define (evlis-env m a)
   (cond
    ((null? m) '())
-   ((not (pair? m)) (eval m a))
+   ((not (pair? m)) (eval-env m a))
-   (#t (cons (eval (car m) a) (evlis-env (cdr m) a)))))
+   (#t (cons (eval-env (car m) a) (evlis-env (cdr m) a)))))
 
 (define (apply-env fn x a) 
   (cond
@@ -89,7 +89,7 @@
      ((builtin? fn) (call fn x))
      ((eq? fn 'call-with-values) (call call-with-values-env (append x (cons a '()))))
      ((eq? fn 'current-module) a)
-     (#t (apply-env (eval fn a) x a))))
+     (#t (apply-env (eval-env fn a) x a))))
    ((eq? (car fn) 'lambda)
     (let ((p (pairlis (cadr fn) x a)))
       (cache-invalidate-range p (cdr a))
@@ -106,7 +106,7 @@
           (cache-invalidate-range p (cdr a))
           r))))
    ;;((eq? (car fn) 'label) (apply-env (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a)))
-   (#t (apply-env (eval fn a) x a))))
+   (#t (apply-env (eval-env fn a) x a))))
 
 (define (eval-expand e a)
   (cond
@@ -122,9 +122,9 @@
      ((eq? (car e) 'if) (eval-if-env (cdr e) a))
      ((eq? (car e) 'define) (env:define (cons (sexp:define e a) '()) a))
      ((eq? (car e) 'define-macro) (env:define (env:macro (sexp:define e a)) a))
-     ((eq? (car e) 'set!) (set-env! (cadr e) (eval (caddr e) a) a))
+     ((eq? (car e) 'set!) (set-env! (cadr e) (eval-env (caddr e) a) a))
-     ((eq? (car e) 'apply-env) (apply-env (eval (cadr e) a) (evlis-env (caddr e) a) a))
+     ((eq? (car e) 'apply-env) (apply-env (eval-env (cadr e) a) (evlis-env (caddr e) a) a))
-     ((eq? (car e) 'unquote) (eval (cadr e) a))
+     ((eq? (car e) 'unquote) (eval-env (cadr e) a))
      ((eq? (car e) 'quasiquote) (eval-quasiquote (cadr e) (add-unquoters a)))
      (#t (apply-env (car e) (evlis-env (cdr e) a) a))))
    (#t (apply-env (car e) (evlis-env (cdr e) a) a))))
@@ -140,7 +140,7 @@
 (define (add-unquoters a)
   (cons %the-unquoters a))
 
-(define (eval e a)
+(define (eval-env e a)
   (eval-expand (expand-macro-env e a) a))
 
 (define (expand-macro-env e a)
@@ -152,27 +152,27 @@
 
 (define (eval-begin-env e a)
   (if (null? e) *unspecified*
-      (if (null? (cdr e)) (eval (car e) a)
+      (if (null? (cdr e)) (eval-env (car e) a)
           (begin
-            (eval (car e) a)
+            (eval-env (car e) a)
             (eval-begin-env (cdr e) a)))))
 
 (define (eval-if-env e a)
-  (if (eval (car e) a) (eval (cadr e) a)
+  (if (eval-env (car e) a) (eval-env (cadr e) a)
-      (if (pair? (cddr e)) (eval (caddr e) a))))
+      (if (pair? (cddr e)) (eval-env (caddr e) a))))
 
 (define (eval-quasiquote e a)
   (cond ((null? e) e)
         ((atom? e) e)
-        ((eq? (car e) 'unquote) (eval (cadr e) a))
+        ((eq? (car e) 'unquote) (eval-env (cadr e) a))
         ((and (pair? (car e))
               (eq? (caar e) 'unquote-splicing))
-         (append2 (eval (cadar e) a) (eval-quasiquote (cdr e) a)))
+         (append2 (eval-env (cadar e) a) (eval-quasiquote (cdr e) a)))
         (#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a)))))
 
 (define (sexp:define e a)
-  (if (atom? (cadr e)) (cons (cadr e) (eval (caddr e) a))
+  (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))
-      (cons (caadr e) (eval (cons 'lambda (cons (cdadr e) (cddr e))) a))))
+      (cons (caadr e) (eval-env (cons 'lambda (cons (cdadr e) (cddr e))) a))))
 
 (define (env:define a+ a)
   (set-cdr! a+ (cdr a))

module/mes/repl.mes

@@ -160,7 +160,7 @@ along with Mes.  If not, see <http://www.gnu.org/licenses/>.
               (begin
                 (meta (cadr sexp))
                 (loop a))
-              (let ((e (eval sexp a)))
+              (let ((e (eval-env sexp a)))
                 (if (eq? e *unspecified*) (loop a)
                     (let ((id (string->symbol (string-append "$" (number->string count)))))
                       (set! count (+ count 1))

quasiquote.c

@@ -39,10 +39,10 @@ eval_quasiquote (scm *e, scm *a)
   if (e == &scm_nil) return e;
   else if (atom_p (e) == &scm_t) return e;
   else if (eq_p (car (e), &symbol_unquote) == &scm_t)
-    return builtin_eval (cadr (e), a);
+    return eval_env (cadr (e), a);
   else if (e->type == PAIR && e->car->type == PAIR
            && eq_p (caar (e), &symbol_unquote_splicing) == &scm_t)
-      return append2 (builtin_eval (cadar (e), a), eval_quasiquote (cdr (e), a));
+      return append2 (eval_env (cadar (e), a), eval_quasiquote (cdr (e), a));
   return cons (eval_quasiquote (car (e), a), eval_quasiquote (cdr (e), a));
 }
 
@@ -90,10 +90,10 @@ eval_quasisyntax (scm *e, scm *a)
   if (e == &scm_nil) return e;
   else if (atom_p (e) == &scm_t) return e;
   else if (eq_p (car (e), &symbol_unsyntax) == &scm_t)
-    return builtin_eval (cadr (e), a);
+    return eval_env (cadr (e), a);
   else if (e->type == PAIR && e->car->type == PAIR
            && eq_p (caar (e), &symbol_unsyntax_splicing) == &scm_t)
-      return append2 (builtin_eval (cadar (e), a), eval_quasisyntax (cdr (e), a));
+      return append2 (eval_env (cadar (e), a), eval_quasisyntax (cdr (e), a));
   return cons (eval_quasisyntax (car (e), a), eval_quasisyntax (cdr (e), a));
 }