carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-10-11 20:49:05 +03:00
Code Issues Projects Releases Wiki Activity

tests run again, solved segfault

Browse Source
This commit is contained in:
Erik Svedäng 2016-04-23 23:21:04 +02:00
parent 38d0a90c80
commit 28ed8a4603
3 changed files with 21 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
examples/project.carp
View File

@ -11,7 +11,8 @@
(def more [(A) (A) (A)])
(defn f []
stuff)
more)
;;(while true (bake-global "more" ()))

12
lisp/globals.carp
View File

@ -35,26 +35,30 @@
c-code (str (type-build t) " " c-variable-name " = " init-value ";")
init-closure-name (str variable-name "-init-closure")
deps (list)]
(do
(do
(compiler/bake-src variable-name prototype c-code t deps)
(reset! deps (cons (symbol init-closure-name) deps))
(when (= "NULL" init-value)
(do
;; OBS! Must set the value of the global after baking it since the bake leaves it set to NULL
(eval (list 'reset! (symbol variable-name) evaled))
;;(println "baking...")
(bake-init-closure init-closure-name variable-name evaled t)
;;(eval (list 'reset! (symbol variable-name) evaled))
;;(println "baked!")
))
:baked))))))
(defn bake-init-closure [func-name global-name body return-type]
(let [func-def (list 'defn (symbol func-name) [] (list 'reset! (symbol global-name) body))]
(do
;;(println (str "Defining init closure for " global-name ": " func-def))
(println (str "Defining init closure for " global-name ": " func-def))
(eval func-def)
;;(eval (list 'meta-set! (symbol func-name) :signature (list 'quote (list :fn () return-type))))
(compiler/bake-function-and-its-dependers func-name)
(graph/update-node! func-name :is-init-closure true)
)))
;;(eval (list 'meta-set! (symbol func-name) :signature (list 'quote (list :fn () return-type))))
;; (defn bake-init-closure [func-name global-name body return-type]
;; (let [func-code (list 'fn [] (list 'reset! (symbol global-name) (read (str body))))
;; signature (list :fn () return-type)]

12
src/obj_string.c
View File

@ -279,6 +279,11 @@ void obj_to_string_internal(Process *process, Obj *total, const Obj *o, bool prn
}
else if(o->tag == 'R') {
shadow_stack_push(process, (struct Obj *)o);
if(!o->void_ptr) {
eval_error = obj_new_string("Pointer to global is NULL.\n");
return;
}
Obj *type_lookup;
//printf("o %p %p\n", o, o->void_ptr);
@ -289,7 +294,8 @@ void obj_to_string_internal(Process *process, Obj *total, const Obj *o, bool prn
else if(o->meta && (type_lookup = env_lookup(process, o->meta, obj_new_keyword("type")))) {
//printf("type %s\n", obj_to_string(type_lookup)->s);
if(type_lookup->tag == 'C' && type_lookup->cdr->car && obj_eq(process, type_lookup->car, obj_new_keyword("Array"))) {
void *dereffed = *(void**)o->void_ptr;
void *dereffed = *(void**)o->void_ptr;
assert(dereffed);
Obj *x = primitive_to_obj(process, dereffed, type_lookup);
shadow_stack_push(process, x);
obj_string_mut_append(total, obj_to_string(process, x)->s);
@ -298,22 +304,26 @@ void obj_to_string_internal(Process *process, Obj *total, const Obj *o, bool prn
else if(obj_eq(process, type_lookup, type_int)) {
//int i = 123;
void *dereffed = *(void**)o->void_ptr;
assert(dereffed);
Obj *x = primitive_to_obj(process, dereffed, type_int);
obj_string_mut_append(total, obj_to_string(process, x)->s);
}
else if(obj_eq(process, type_lookup, type_float)) {
//int i = 123;
void *dereffed = *(void**)o->void_ptr;
assert(dereffed);
Obj *x = primitive_to_obj(process, dereffed, type_float);
obj_string_mut_append(total, obj_to_string(process, x)->s);
}
else if(obj_eq(process, type_lookup, type_string)) {
void *dereffed = *(void**)o->void_ptr;
assert(dereffed);
Obj *x = primitive_to_obj(process, dereffed, type_string);
obj_string_mut_append(total, x->s);
}
else {
void *dereffed = *(void**)o->void_ptr;
assert(dereffed);
Obj *x = primitive_to_obj(process, dereffed, type_lookup);
print_generic_array_or_struct(process, total, type_lookup, (struct Obj *)x);
/* obj_string_mut_append(total, "<ptr"); */