mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-21 22:59:16 +02:00
Experimental changes
This commit is contained in:
parent
88784bb5ff
commit
88f5d29930
3 changed files with 18 additions and 3 deletions
|
@ -377,9 +377,11 @@ extern const object primitive_call_95cc;
|
||||||
|
|
||||||
/* Globals that are needed by the runtime */
|
/* Globals that are needed by the runtime */
|
||||||
extern object Cyc_glo_eval;
|
extern object Cyc_glo_eval;
|
||||||
|
extern object Cyc_glo_eval_from_c;
|
||||||
extern object Cyc_glo_call_cc;
|
extern object Cyc_glo_call_cc;
|
||||||
|
|
||||||
#define __glo_eval Cyc_glo_eval
|
#define __glo_eval Cyc_glo_eval
|
||||||
|
#define __glo_eval_91from_91c Cyc_glo_eval_from_c
|
||||||
#define __glo_call_95cc Cyc_glo_call_cc
|
#define __glo_call_95cc Cyc_glo_call_cc
|
||||||
|
|
||||||
object Cyc_default_exception_handler(void *data, int argc, closure _, object err);
|
object Cyc_default_exception_handler(void *data, int argc, closure _, object err);
|
||||||
|
|
|
@ -348,6 +348,7 @@ void clear_mutations(void *data) {
|
||||||
/* Runtime globals */
|
/* Runtime globals */
|
||||||
object Cyc_glo_call_cc = nil;
|
object Cyc_glo_call_cc = nil;
|
||||||
object Cyc_glo_eval = nil;
|
object Cyc_glo_eval = nil;
|
||||||
|
object Cyc_glo_eval_from_c = nil;
|
||||||
|
|
||||||
/* Exception handler */
|
/* Exception handler */
|
||||||
object Cyc_default_exception_handler(void *data, int argc, closure _, object err) {
|
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);
|
make_cons(c, func, args);
|
||||||
//printf("JAE DEBUG, sending to eval: ");
|
//printf("JAE DEBUG, sending to eval: ");
|
||||||
//Cyc_display(&c, stderr);
|
//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,
|
// TODO: would be better to compare directly against symbols here,
|
||||||
// but need a way of looking them up ahead of time.
|
// 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
|
//TODO: need to quote certain object types (symbols and null at a minimum) in the args list
|
||||||
// before passing everything to eval.
|
// before passing everything to eval.
|
||||||
make_cons(c, cadr(func), args);
|
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) {
|
} else if (strncmp(((symbol)fobj)->pname, "procedure", 10) == 0) {
|
||||||
make_cons(c, func, args);
|
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 {
|
} else {
|
||||||
make_cons(c, func, args);
|
make_cons(c, func, args);
|
||||||
Cyc_rt_raise2(data, "Unable to evaluate: ", &c);
|
Cyc_rt_raise2(data, "Unable to evaluate: ", &c);
|
||||||
|
|
|
@ -16,6 +16,7 @@
|
||||||
(export
|
(export
|
||||||
;environment
|
;environment
|
||||||
eval
|
eval
|
||||||
|
eval-from-c ; non-standard
|
||||||
create-environment ; non-standard
|
create-environment ; non-standard
|
||||||
setup-environment ; non-standard
|
setup-environment ; non-standard
|
||||||
)
|
)
|
||||||
|
@ -48,6 +49,17 @@
|
||||||
((analyze exp *global-environment*) *global-environment*)
|
((analyze exp *global-environment*) *global-environment*)
|
||||||
((analyze exp (car env)) (car env))))
|
((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
|
;; Expression handling helper functions
|
||||||
(define (self-evaluating? exp)
|
(define (self-evaluating? exp)
|
||||||
|
|
Loading…
Add table
Reference in a new issue