}
scm *
-eval_quote (scm *fn, scm *x)
-{
- return apply (fn, x, &scm_nil);
-}
-
-scm *
-apply_ (scm *fn, scm *x, scm *a)
+apply_env_ (scm *fn, scm *x, scm *a)
{
#if DEBUG
- printf ("apply fn=");
+ printf ("apply_env fn=");
display (fn);
printf (" x=");
display (x);
return call (&scm_call_with_values_env, append2 (x, cons (a, &scm_nil)));
if (builtin_p (fn) == &scm_t)
return call (fn, x);
- return apply (eval (fn, a), x, a);
+ return apply_env (eval (fn, a), x, a);
}
else if (car (fn) == &scm_lambda)
return begin_env (cddr (fn), pairlis (cadr (fn), x, a));
else if (car (fn) == &scm_label)
- return apply (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a));
+ return apply_env (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a));
return &scm_unspecified;
}
return evcon (cdr (e), a);
#if MACROS
else if ((macro = assq (car (e), cdr (assq (&scm_macro, a)))) != &scm_f)
- return eval (apply_ (cdr (macro), cdr (e), a), a);
+ return eval (apply_env_ (cdr (macro), cdr (e), a), a);
#endif // MACROS
- return apply (car (e), evlis (cdr (e), a), a);
+ return apply_env (car (e), evlis (cdr (e), a), a);
}
- return apply (car (e), evlis (cdr (e), a), a);
+ return apply_env (car (e), evlis (cdr (e), a), a);
}
scm *
scm *
call_with_values_env (scm *producer, scm *consumer, scm *a)
{
- scm *v = apply_ (producer, &scm_nil, a);
+ scm *v = apply_env_ (producer, &scm_nil, a);
if (v->type == VALUES)
v = v->cdr;
- return apply_ (consumer, v, a);
+ return apply_env_ (consumer, v, a);
}
scm *
if (e == &scm_nil)
return r;
else if (eq_p (e, &scm_symbol_EOF) == &scm_t)
- return apply (cdr (assq (&scm_symbol_loop2, a)),
+ return apply_env (cdr (assq (&scm_symbol_loop2, a)),
cons (&scm_unspecified, cons (&scm_t, cons (a, &scm_nil))), a);
else if (eq_p (e, &scm_symbol_EOF2) == &scm_t)
return r;
}
scm *
-apply (scm *fn, scm *x, scm *a)
+apply_env (scm *fn, scm *x, scm *a)
{
#if DEBUG
- printf ("\nc:apply fn=");
+ printf ("\nc:apply_env fn=");
display (fn);
printf (" x=");
display (x);
puts ("");
#endif
- if (fn == &scm_apply_)
+ if (fn == &scm_apply_env_)
return eval_ (x, a);
- return apply_ (fn, x, a);
+ return apply_env_ (fn, x, a);
}
bool evalling_p = false;
|| evalling_p)
return eval_ (e, a);
evalling_p = true;
- scm *r = apply (eval__, cons (e, cons (a, &scm_nil)), a);
+ scm *r = apply_env (eval__, cons (e, cons (a, &scm_nil)), a);
evalling_p = false;
return r;
}
;; ;; Page 13
;; (define (eval-quote fn x)
;; ;(debug "eval-quote fn=~a x=~a" fn x)
-;; (apply fn x '()))
+;; (apply-env fn x '()))
(define (evcon c a)
;;(debug "evcon c=~a a=~a\n" c a)
(#t (cons (eval (car m) a) (evlis (cdr m) a)))))
-(define (apply fn x a)
- ;; (display 'mes-apply:)
+(define (apply-env fn x a)
+ ;; (display 'mes-apply-env:)
;; (newline)
;; (display 'fn:)
;; (display fn)
((atom? fn)
(cond
((eq? fn 'current-module)
- (c:apply current-module '() a))
+ (c:apply-env current-module '() a))
((eq? fn 'call-with-values)
- (c:apply 'call-with-values x a))
+ (c:apply-env 'call-with-values x a))
((builtin? fn)
(call fn x))
- (#t (apply (eval fn a) x a))))
+ (#t (apply-env (eval fn a) x a))))
((eq? (car fn) 'lambda)
(begin-env (cddr fn) (pairlis (cadr fn) x a)))
- ((eq? (car fn) 'label) (apply (caddr fn) x (cons (cons (cadr fn)
+ ((eq? (car fn) 'label) (apply-env (caddr fn) x (cons (cons (cadr fn)
(caddr fn)) a)))))
(define (begin-env body a)
((eq? (car e) 'cond) (evcon (cdr e) a))
((pair? (assq (car e) (cdr (assq '*macro* a))))
(c:eval
- (c:apply
+ (c:apply-env
(cdr (assq (car e) (cdr (assq '*macro* a))))
(cdr e)
a)
a))
- (#t (apply (car e) (evlis (cdr e) a) a))))
- (#t (apply (car e) (evlis (cdr e) a) a))))
+ (#t (apply-env (car e) (evlis (cdr e) a) a))))
+ (#t (apply-env (car e) (evlis (cdr e) a) a))))
(define (eval-quasiquote e a)
;; (display 'mes-eval-quasiquote:)
pair?
;; ADDITIONAL PRIMITIVES
- apply
number?
procedure?
<
(eval e (append a environment)))
(define (apply-environment fn e a)
- (apply fn e (append a environment)))
+ (apply-env fn e (append a environment)))
(define (readenv a)
(let ((x (guile:read)))
(assq . ,assq)
(eval . ,eval-environment)
- (apply . ,apply-environment)
+ (apply-env . ,apply-environment)
(readenv . ,readenv)
(display . ,guile:display)
(define (loop r e a)
(cond ((null? e) r)
((eq? e 'exit)
- (apply (cdr (assq 'loop a))
- (cons *unspecified* (cons #t (cons a '())))
- a))
+ (apply-env (cdr (assq 'loop a))
+ (cons *unspecified* (cons #t (cons a '())))
+ a))
((atom? e) (loop (eval e a) (readenv a) a))
((eq? (car e) 'define)
(loop *unspecified* (readenv a) (cons (mes-define e a) a)))