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

FIXED: Make defstruct into a macro instead, remove it from eval

Browse Source
This commit is contained in:
Erik 2016-03-09 20:12:53 +01:00
parent 7bd2430ef6
commit bee86345ac
7 changed files with 139 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
TODO.md
View File

@ -35,7 +35,6 @@
# Dynamic Runtime
- Ensure shadow stack is always properly popped (blew it)
- Remove support for dynamic struct getters
- Make defstruct into a macro instead, remove it from eval
- Should be error when ptr of wrong type is sent to baked function
- Binding to a function call in 'let' crashes process!!!
- Valgrind finds error with strdup in eval.c:312 ('apply' function)

35
lisp/structs.carp
View File

@ -1,4 +1,33 @@
(defn split-every-second [xs]
(match xs
() (list () ())
(_) (error "split-every-second needs an even number of arguments")
(a b & misc) (let [inside (split-every-second misc)]
(list (cons a (first inside))
(cons b (second inside))))))
(defmacro defstruct (struct-name struct-members)
(let [names-and-types (split-every-second (array-to-list struct-members))]
(list 'defstruct-internal (str struct-name)
(cons 'array (map str (first names-and-types)))
(cons 'array (second names-and-types)))))
(defn defstruct-internal [struct-name member-names member-types]
(do
(assert-eq (count member-names) (count member-types))
(build-constructor struct-name member-names member-types)
(eval (list 'def (symbol struct-name) {:struct true
:generic false
:name struct-name
:member-names member-names
:member-types member-types
:size (eval (list (symbol (str "size-" struct-name))))
:member-offsets (map (fn [member] (eval (list (symbol (str "offset-" member)))))
member-names)
:member-count (count member-names)}))))
(defn build-constructor [struct-name member-names member-types]
(let [member-names (if (array? member-names) (array-to-list member-names) member-names) ;; TODO: This conversion is UGGLY!
c-member-names (map c-ify-name member-names)
@ -38,9 +67,15 @@
(do
(def c c-program-string)
(save-and-compile constructor-name constructor-signature c-constructor-name c-file-name c-program-string proto deps false)
;; Compile lenses:
(map2 (fn [mem-name mem-type] (generate-struct-lens struct-name mem-name mem-type))
member-names
member-types)
;; Compile sizeof function
(let [size-signature (list :fn () :int)
size-proto (str "int size_" struct-name "()")
size-c (str size-proto " { return sizeof(" struct-name "); } ")]
(bake-struct-lens-function (new-builder) (str "size-" struct-name) size-signature size-proto size-c '()))
))))))
(defn generate-struct-lens [struct-name member-name member-type]

25
out/project.carp
View File

@ -10,22 +10,21 @@
;;(load-gl)
(defstruct Vector
[x :int
n :string
y :int])
;; (defstruct Vector
;; [x :int
;; n :string
;; y :int])
(defn f [x] (Vector x (+ x 10)))
(defn g [] (map-copy f [100 200 300]))
;; (defn f [x] (Vector x (+ x 10)))
;; (defn g [] (map-copy f [100 200 300]))
(defn test-print-array-of-vector []
(let [vecs [(Vector 1001 (string-copy "AAAAA") 1002)
(Vector 1003 (string-copy "BBBBB") 1004)
(Vector 1005 (string-copy "CCCCC") 1006)]]
;;(println* vecs)
vecs))
;; (defn test-print-array-of-vector []
;; (let [vecs [(Vector 1001 (string-copy "AAAAA") 1002)
;; (Vector 1003 (string-copy "BBBBB") 1004)
;; (Vector 1005 (string-copy "CCCCC") 1006)]]
;; ;;(println* vecs)
;; vecs))
;; (bake test-print-array-of-vector)
;; (test-print-array-of-vector)

148
src/eval.c
View File

@ -477,13 +477,25 @@ void apply(Obj *function, Obj **args, int arg_count) {
}
else if(function->tag == 'E' && obj_eq(env_lookup(function, obj_new_keyword("struct")), lisp_true)) {
// Evaluation of a struct-definition (a dictionary) in function position (which means that it is used as a constructor)
char *name = env_lookup(function, obj_new_keyword("name"))->s;
int struct_size = env_lookup(function, obj_new_keyword("size"))->i;
int member_count = env_lookup(function, obj_new_keyword("member-count"))->i;
Obj *name_obj = env_lookup(function, obj_new_keyword("name"));
assert_or_set_error(name_obj, "no key 'name' on struct definition: ", function);
char *name = name_obj->s;
Obj *struct_size_obj = env_lookup(function, obj_new_keyword("size"));
assert_or_set_error(struct_size_obj, "no key 'size' on struct definition: ", function);
int struct_size = struct_size_obj->i;
Obj *struct_member_count_obj = env_lookup(function, obj_new_keyword("member-count"));
assert_or_set_error(struct_member_count_obj, "no key 'member-count' on struct definition: ", function);
int member_count = struct_member_count_obj->i;
Obj *offsets_obj = env_lookup(function, obj_new_keyword("member-offsets"));
assert_or_set_error(offsets_obj, "no key 'member-offsets' on struct definition: ", function);
assert_or_set_error(offsets_obj->tag == 'A', "offsets must be an array: ", function);
Obj **offsets = offsets_obj->array;
Obj *member_types_obj = env_lookup(function, obj_new_keyword("member-types"));
assert_or_set_error(member_types_obj, "no key 'member-types' on struct definition: ", function);
assert_or_set_error(member_types_obj->tag == 'A', "member-types must be an array: ", function);
Obj **member_types = member_types_obj->array;
@ -513,7 +525,10 @@ void apply(Obj *function, Obj **args, int arg_count) {
*xp = x;
}
else if(args[i]->tag == 'Q') {
assert_or_set_error(obj_eq(member_type, type_ptr), "Can't assign pointer to a member of type ", obj_to_string(member_type));
assert_or_set_error(!obj_eq(member_type, type_char), "Can't assign char to a member of type ", obj_to_string(member_type));
assert_or_set_error(!obj_eq(member_type, type_int), "Can't assign int to a member of type ", obj_to_string(member_type));
assert_or_set_error(!obj_eq(member_type, type_float), "Can't assign float to a member of type ", obj_to_string(member_type));
assert_or_set_error(!obj_eq(member_type, type_string), "Can't assign string to a member of type ", obj_to_string(member_type));
void **vp = (void**)(((char*)new_struct->void_ptr) + offset);
*vp = args[i]->void_ptr;
}
@ -666,83 +681,84 @@ void eval_list(Obj *env, Obj *o) {
eval_internal(env, o->cdr->cdr->cdr->car);
}
}
else if(HEAD_EQ("defstruct")) {
assert_or_set_error(o->cdr->car, "Too few forms in 'defstruct' form: ", o);
assert_or_set_error(o->cdr->cdr->car, "Too few forms in 'defstruct' form: ", o);
assert_or_set_error(o->cdr->cdr->cdr->car == NULL, "Too many forms in 'defstruct' form: ", o);
/* else if(HEAD_EQ("defstruct")) { */
/* assert_or_set_error(o->cdr->car, "Too few forms in 'defstruct' form: ", o); */
/* assert_or_set_error(o->cdr->cdr->car, "Too few forms in 'defstruct' form: ", o); */
/* assert_or_set_error(o->cdr->cdr->cdr->car == NULL, "Too many forms in 'defstruct' form: ", o); */
assert_or_set_error(o->cdr->car->tag == 'Y', "First argument to 'defstruct' form must be a symbol (it's the name of the struct): ", o);
assert_or_set_error(o->cdr->cdr->car->tag == 'A', "Second argument to 'defstruct' form must be an array (with the members, i.e. [x :float, y :float]): ", o);
/* assert_or_set_error(o->cdr->car->tag == 'Y', "First argument to 'defstruct' form must be a symbol (it's the name of the struct): ", o); */
/* assert_or_set_error(o->cdr->cdr->car->tag == 'A', "Second argument to 'defstruct' form must be an array (with the members, i.e. [x :float, y :float]): ", o); */
char *name = o->cdr->car->s;
Obj *types = o->cdr->cdr->car;
/* char *name = o->cdr->car->s; */
/* Obj *types = o->cdr->cdr->car; */
Obj *struct_description = obj_new_environment(NULL);
env_extend(struct_description, obj_new_keyword("name"), obj_new_string(name));
/* Obj *struct_description = obj_new_environment(NULL); */
/* env_extend(struct_description, obj_new_keyword("name"), obj_new_string(name)); */
int member_count = types->count / 2;
/* int member_count = types->count / 2; */
Obj *member_types = obj_new_array(member_count);
Obj *member_names = obj_new_array(member_count);
Obj *offsets = obj_new_array(member_count);
int offset = 0;
bool generic = false;
for(int i = 0; i < member_count; i++) {
assert_or_set_error(types->array[i * 2]->tag == 'Y', "Struct member name must be symbol: ", types->array[i * 2]);
Obj *member_name = obj_new_string(types->array[i * 2]->s);
Obj *member_type = types->array[i * 2 + 1];
member_types->array[i] = member_type;
member_names->array[i] = member_name;
offsets->array[i] = obj_new_int(offset);
int size = 0;
if(obj_eq(member_type, type_float)) { size = 8; } // sizeof(float); }
else if(obj_eq(member_type, type_int)) { size = 8; } // sizeof(int); }
else if(obj_eq(member_type, type_char)) { size = 8; } // sizeof(char); }
else { size = sizeof(void*); }
/* Obj *member_types = obj_new_array(member_count); */
/* Obj *member_names = obj_new_array(member_count); */
/* Obj *offsets = obj_new_array(member_count); */
/* int offset = 0; */
/* bool generic = false; */
/* for(int i = 0; i < member_count; i++) { */
/* assert_or_set_error(types->array[i * 2]->tag == 'Y', "Struct member name must be symbol: ", types->array[i * 2]); */
/* Obj *member_name = obj_new_string(types->array[i * 2]->s); */
/* Obj *member_type = types->array[i * 2 + 1]; */
/* member_types->array[i] = member_type; */
/* member_names->array[i] = member_name; */
/* offsets->array[i] = obj_new_int(offset); */
/* int size = 0; */
/* if(obj_eq(member_type, type_float)) { size = 8; } // sizeof(float); } */
/* else if(obj_eq(member_type, type_int)) { size = 8; } // sizeof(int); } */
/* else if(obj_eq(member_type, type_char)) { size = 8; } // sizeof(char); } */
/* else { size = sizeof(void*); } */
/* char fixed_member_name[256]; */
/* snprintf(fixed_member_name, 255, "get-%s", member_name->s); */
/* /\* char fixed_member_name[256]; *\/ */
/* /\* snprintf(fixed_member_name, 255, "get-%s", member_name->s); *\/ */
/* Obj *struct_member_lookup = obj_new_environment(NULL); */
/* env_extend(struct_member_lookup, obj_new_keyword("struct-lookup"), lisp_true); */
/* env_extend(struct_member_lookup, obj_new_keyword("struct-ref"), struct_description); // immediate access to the struct description */
/* env_extend(struct_member_lookup, obj_new_keyword("member-offset"), obj_new_int(offset)); */
/* env_extend(struct_member_lookup, obj_new_keyword("member-name"), member_name); */
/* env_extend(struct_member_lookup, obj_new_keyword("member-type"), member_type); */
/* /\* Obj *struct_member_lookup = obj_new_environment(NULL); *\/ */
/* /\* env_extend(struct_member_lookup, obj_new_keyword("struct-lookup"), lisp_true); *\/ */
/* /\* env_extend(struct_member_lookup, obj_new_keyword("struct-ref"), struct_description); // immediate access to the struct description *\/ */
/* /\* env_extend(struct_member_lookup, obj_new_keyword("member-offset"), obj_new_int(offset)); *\/ */
/* /\* env_extend(struct_member_lookup, obj_new_keyword("member-name"), member_name); *\/ */
/* /\* env_extend(struct_member_lookup, obj_new_keyword("member-type"), member_type); *\/ */
/* env_extend(env, obj_new_symbol(fixed_member_name), struct_member_lookup); */
/* /\* env_extend(env, obj_new_symbol(fixed_member_name), struct_member_lookup); *\/ */
offset += size;
}
/* offset += size; */
/* } */
env_extend(struct_description, obj_new_keyword("member-offsets"), offsets);
env_extend(struct_description, obj_new_keyword("member-count"), obj_new_int(member_count));
env_extend(struct_description, obj_new_keyword("member-types"), member_types);
env_extend(struct_description, obj_new_keyword("member-names"), member_names);
env_extend(struct_description, obj_new_keyword("size"), obj_new_int(offset));
env_extend(struct_description, obj_new_keyword("generic"), generic ? lisp_true : lisp_false);
env_extend(struct_description, obj_new_keyword("struct"), lisp_true);
/* env_extend(struct_description, obj_new_keyword("member-offsets"), offsets); */
/* env_extend(struct_description, obj_new_keyword("member-count"), obj_new_int(member_count)); */
/* env_extend(struct_description, obj_new_keyword("member-types"), member_types); */
/* env_extend(struct_description, obj_new_keyword("member-names"), member_names); */
/* env_extend(struct_description, obj_new_keyword("size"), obj_new_int(offset)); */
/* env_extend(struct_description, obj_new_keyword("generic"), generic ? lisp_true : lisp_false); */
/* env_extend(struct_description, obj_new_keyword("struct"), lisp_true); */
Obj *struct_info_binding = obj_new_string(name);
//obj_string_mut_append(struct_info_binding, "-info");
/* Obj *struct_info_binding = obj_new_string(name); */
/* //obj_string_mut_append(struct_info_binding, "-info"); */
env_extend(env, obj_new_symbol(struct_info_binding->s), struct_description);
stack_push(struct_description);
/* env_extend(env, obj_new_symbol(struct_info_binding->s), struct_description); */
/* stack_push(struct_description); */
// Will call this function now: (build-constructor struct-name member-names member-types)
Obj *call_to_build_constructor = obj_list(obj_new_symbol("build-constructor"), obj_new_string(name), member_names, member_types);
/* // Will call this function now: (build-constructor struct-name member-names member-types) */
/* Obj *call_to_build_constructor = obj_list(obj_new_symbol("build-constructor"), obj_new_string(name), member_names, member_types); */
shadow_stack_push(call_to_build_constructor);
//printf("Call to build-constructor: \n%s\n", obj_to_string(call_to_build_constructor)->s);
eval_internal(global_env, call_to_build_constructor);
shadow_stack_pop();
/* shadow_stack_push(call_to_build_constructor); */
/* //printf("Call to build-constructor: \n%s\n", obj_to_string(call_to_build_constructor)->s); */
/* eval_internal(global_env, call_to_build_constructor); */
/* stack_pop(); */
/* shadow_stack_pop(); */
if(eval_error) {
printf("Error when calling build-constructor:\n");
printf("%s\n", obj_to_string(eval_error)->s);
return;
}
}
/* if(eval_error) { */
/* printf("Error when calling build-constructor:\n"); */
/* printf("%s\n", obj_to_string(eval_error)->s); */
/* return; */
/* } */
/* } */
else if(HEAD_EQ("match")) {
eval_internal(env, o->cdr->car);
if(eval_error) { return; }

8
src/primops.c
View File

@ -220,6 +220,14 @@ Obj *p_list(Obj** args, int arg_count) {
return first;
}
Obj *p_array(Obj** args, int arg_count) {
Obj *a = obj_new_array(arg_count);
for(int i = 0; i < arg_count; i++) {
a->array[i] = args[i];
}
return a;
}
Obj *p_str(Obj** args, int arg_count) {
Obj *s = obj_new_string("");
for(int i = 0; i < arg_count; i++) {

1
src/primops.h
View File

@ -15,6 +15,7 @@ Obj *p_div(Obj** args, int arg_count);
//Obj *p_mod(Obj** args, int arg_count);
Obj *p_eq(Obj** args, int arg_count);
Obj *p_list(Obj** args, int arg_count);
Obj *p_array(Obj** args, int arg_count);
Obj *p_str(Obj** args, int arg_count);
Obj *p_str_append_bang(Obj** args, int arg_count);
Obj *p_str_replace(Obj** args, int arg_count);

1
src/repl.c
View File

@ -163,6 +163,7 @@ void env_new_global() {
//register_primop("mod", p_mod);
register_primop("=", p_eq);
register_primop("list", p_list);
register_primop("array", p_array);
register_primop("str", p_str);
register_primop("str-append!", p_str_append_bang);
register_primop("str-replace", p_str_replace);