Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-21 14:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Experimental changes

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
include/cyclone/runtime.h
View file

@ -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);

7
runtime.c
View file

@ -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);

12
scheme/eval.sld
View file

@ -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)