Experimental changes

This commit is contained in:
Justin Ethier 2016-02-04 23:40:59 -05:00
parent 88784bb5ff
commit 88f5d29930
3 changed files with 18 additions and 3 deletions

View file

@ -377,9 +377,11 @@ extern const object primitive_call_95cc;
/* Globals that are needed by the runtime */
extern object Cyc_glo_eval;
extern object Cyc_glo_eval_from_c;
extern object Cyc_glo_call_cc;
#define __glo_eval Cyc_glo_eval
#define __glo_eval_91from_91c Cyc_glo_eval_from_c
#define __glo_call_95cc Cyc_glo_call_cc
object Cyc_default_exception_handler(void *data, int argc, closure _, object err);

View file

@ -348,6 +348,7 @@ void clear_mutations(void *data) {
/* Runtime globals */
object Cyc_glo_call_cc = nil;
object Cyc_glo_eval = nil;
object Cyc_glo_eval_from_c = nil;
/* Exception handler */
object Cyc_default_exception_handler(void *data, int argc, closure _, object err) {
@ -2094,7 +2095,7 @@ object apply(void *data, object cont, object func, object args){
make_cons(c, func, args);
//printf("JAE DEBUG, sending to eval: ");
//Cyc_display(&c, stderr);
((closure)__glo_eval)->fn(data, 2, __glo_eval, cont, &c, nil);
((closure)__glo_eval_91from_91c)->fn(data, 2, __glo_eval_91from_91c, cont, &c, nil);
// TODO: would be better to compare directly against symbols here,
// but need a way of looking them up ahead of time.
@ -2103,10 +2104,10 @@ object apply(void *data, object cont, object func, object args){
//TODO: need to quote certain object types (symbols and null at a minimum) in the args list
// before passing everything to eval.
make_cons(c, cadr(func), args);
((closure)__glo_eval)->fn(data, 3, __glo_eval, cont, &c, nil);
((closure)__glo_eval_91from_91c)->fn(data, 3, __glo_eval_91from_91c, cont, &c, nil);
} else if (strncmp(((symbol)fobj)->pname, "procedure", 10) == 0) {
make_cons(c, func, args);
((closure)__glo_eval)->fn(data, 3, __glo_eval, cont, &c, nil);
((closure)__glo_eval_91from_91c)->fn(data, 3, __glo_eval_91from_91c, cont, &c, nil);
} else {
make_cons(c, func, args);
Cyc_rt_raise2(data, "Unable to evaluate: ", &c);

View file

@ -16,6 +16,7 @@
(export
;environment
eval
eval-from-c ; non-standard
create-environment ; non-standard
setup-environment ; non-standard
)
@ -48,6 +49,17 @@
((analyze exp *global-environment*) *global-environment*)
((analyze exp (car env)) (car env))))
(define (eval-from-c exp . _env)
(let ((env (if (null? _env) *global-environment* (car _env))))
(eval (wrapc exp) env)))
(define (wrapc exp)
(cond
((symbol? exp)
`(quote ,exp))
(else
exp)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Expression handling helper functions
(define (self-evaluating? exp)