Pass symbol to set-global functions

This commit is contained in:
Justin Ethier 2020-01-24 14:19:10 -05:00
parent 6b6b77124d
commit a6ce8c4ba1
5 changed files with 25 additions and 16 deletions

View file

@ -105,11 +105,13 @@ void set_env_variables(char **vars);
object cell_get(object cell);
#define global_set(glo,value) Cyc_global_set(data, (object *)&glo, value)
object Cyc_global_set(void *thd, object * glo, object value);
#define global_set(glo,value) Cyc_global_set(data, NULL, (object *)&glo, value)
#define global_set_id(id,glo,value) Cyc_global_set(data, id, (object *)&glo, value)
object Cyc_global_set(void *thd, object sym, object * glo, object value);
#define global_set2(thd,k,glo,value) Cyc_global_set2(thd, k, (object *)&glo, value)
object Cyc_global_set2(void *thd, object cont, object * glo, object value);
#define global_set2(thd,k,glo,value) Cyc_global_set2(thd, k, NULL, (object *)&glo, value)
#define global_set2_id(thd,k,id,glo,value) Cyc_global_set2(thd, k, id, (object *)&glo, value)
object Cyc_global_set2(void *thd, object cont, object sym, object * glo, object value);
/* Variable argument count support

View file

@ -22,7 +22,7 @@
static uint32_t Cyc_utf8_decode(uint32_t* state, uint32_t* codep, uint32_t byte);
static int Cyc_utf8_count_code_points_and_bytes(uint8_t* s, char_type *codepoint, int *cpts, int *bytes);
object Cyc_global_set(void *thd, object * glo, object value)
object Cyc_global_set(void *thd, object identifier, object * glo, object value)
{
gc_mut_update((gc_thread_data *) thd, *glo, value);
*(glo) = value;
@ -30,7 +30,7 @@ object Cyc_global_set(void *thd, object * glo, object value)
return value;
}
object Cyc_global_set2(void *thd, object cont, object * glo, object value)
object Cyc_global_set2(void *thd, object cont, object identifier, object * glo, object value)
{
int do_gc = 0;
value = share_object(thd, NULL, value, &do_gc);
@ -562,6 +562,7 @@ object share_object(gc_thread_data *data, object var, object value, int *run_gc)
}
// Objs w/children force minor GC to guarantee everything is relocated:
case cvar_tag:
case closure0_tag:
case closure1_tag:
case closureN_tag:
case pair_tag:

View file

@ -191,7 +191,7 @@
(new-var (cdr var/new-var))
(body
`((Cyc-seq
(set-global-unsafe! ,var ,rsym)
(set-global-unsafe! ,(list 'quote var) ,var ,rsym)
,acc)))
)
`(Cyc-memoize

View file

@ -279,8 +279,8 @@
(Cyc-fast-list-3 3 3)
(Cyc-fast-list-4 4 4)
(cell-get 1 1)
(set-global! 2 2)
(set-global-unsafe! 2 2)
(set-global! 3 3)
(set-global-unsafe! 3 3)
(set-cell! 2 2)
(cell 1 1)
(eq? 2 2)
@ -691,8 +691,8 @@
((eq? p 'cell) "set_cell_as_expr")
((eq? p 'cell-get) "car") ;; Unsafe as cell gets added by compiler
((eq? p 'set-cell!) "Cyc_set_cell")
((eq? p 'set-global!) "global_set2")
((eq? p 'set-global-unsafe!) "global_set")
((eq? p 'set-global!) "global_set2_id")
((eq? p 'set-global-unsafe!) "global_set_id")
(else
(error "unhandled primitive: " p))))

View file

@ -848,11 +848,17 @@ if (acc) {
((prim? exp) exp)
((quote? exp) exp)
((lambda? exp) (error `(Unexpected lambda in wrap-mutables ,exp)))
((set!? exp) `(,(if (member (set!->var exp) globals)
'set-global!
'set-cell!)
((set!? exp)
(cond
((member (set!->var exp) globals)
`(set-global!
,(list 'quote (set!->var exp))
,(set!->var exp)
,(wrap-mutables (set!->exp exp) globals)))
,(wrap-mutables (set!->exp exp) globals)) )
(else
`(set-cell!
,(set!->var exp)
,(wrap-mutables (set!->exp exp) globals))) ))
((if? exp) `(if ,(wrap-mutables (if->condition exp) globals)
,(wrap-mutables (if->then exp) globals)
,(wrap-mutables (if->else exp) globals)))