diff options
| -rw-r--r-- | arith.c | 3 | ||||
| -rw-r--r-- | buf.c | 3 | ||||
| -rw-r--r-- | chksum.c | 9 | ||||
| -rw-r--r-- | ffi.c | 30 | ||||
| -rw-r--r-- | gc.c | 3 | ||||
| -rw-r--r-- | genchksum.txr | 3 | ||||
| -rw-r--r-- | gzio.c | 6 | ||||
| -rw-r--r-- | hash.c | 6 | ||||
| -rw-r--r-- | lib.c | 20 | ||||
| -rw-r--r-- | lib.h | 9 | ||||
| -rw-r--r-- | parser.c | 3 | ||||
| -rw-r--r-- | rand.c | 8 | ||||
| -rw-r--r-- | regex.c | 6 | ||||
| -rw-r--r-- | socket.c | 3 | ||||
| -rw-r--r-- | stream.c | 36 | ||||
| -rw-r--r-- | struct.c | 19 | ||||
| -rw-r--r-- | struct.h | 2 | ||||
| -rw-r--r-- | strudel.c | 3 | ||||
| -rw-r--r-- | sysif.c | 7 | ||||
| -rw-r--r-- | syslog.c | 3 | ||||
| -rw-r--r-- | tests/012/oop.tl | 10 | ||||
| -rw-r--r-- | tree.c | 6 | ||||
| -rw-r--r-- | txr.1 | 39 | ||||
| -rw-r--r-- | unwind.c | 3 | ||||
| -rw-r--r-- | vm.c | 6 |
25 files changed, 173 insertions, 73 deletions
@@ -5151,7 +5151,8 @@ static struct cobj_ops psq_ops = cobj_ops_init(cobj_equal_handle_op, cptr_print_op, cobj_destroy_free_op, cobj_mark_op, - cobj_handle_hash_op); + cobj_handle_hash_op, + 0); static val quant_fun(val psqo, varg args) { @@ -1125,7 +1125,8 @@ static struct strm_ops buf_strm_ops = stream_print_op, stream_destroy_op, buf_strm_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("buf-stream"), buf_strm_put_string, buf_strm_put_char, @@ -204,7 +204,8 @@ static struct cobj_ops sha1_ops = cobj_ops_init(cobj_equal_handle_op, cobj_print_op, cobj_destroy_free_op, cobj_mark_op, - cobj_handle_hash_op); + cobj_handle_hash_op, + 0); val sha1_begin(void) { @@ -389,7 +390,8 @@ static struct cobj_ops sha256_ops = cobj_ops_init(cobj_equal_handle_op, cobj_print_op, cobj_destroy_free_op, cobj_mark_op, - cobj_handle_hash_op); + cobj_handle_hash_op, + 0); val sha256_begin(void) { @@ -574,7 +576,8 @@ static struct cobj_ops md5_ops = cobj_ops_init(cobj_equal_handle_op, cobj_print_op, cobj_destroy_free_op, cobj_mark_op, - cobj_handle_hash_op); + cobj_handle_hash_op, + 0); val md5_begin(void) { @@ -346,28 +346,32 @@ static struct cobj_ops ffi_type_builtin_ops = ffi_type_print_op, cobj_destroy_free_op, ffi_type_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); static struct cobj_ops ffi_type_struct_ops = cobj_ops_init(eq, ffi_type_print_op, ffi_type_struct_destroy_op, ffi_struct_type_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); static struct cobj_ops ffi_type_ptr_ops = cobj_ops_init(eq, ffi_type_print_op, cobj_destroy_free_op, ffi_ptr_type_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); static struct cobj_ops ffi_type_enum_ops = cobj_ops_init(eq, ffi_type_print_op, cobj_destroy_free_op, ffi_enum_type_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); cnum ffi_type_size(struct txr_ffi_type *tft) { @@ -440,7 +444,8 @@ static struct cobj_ops ffi_closure_ops = ffi_closure_print_op, ffi_closure_destroy_op, ffi_closure_mark_op, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); #endif @@ -5412,7 +5417,8 @@ static struct cobj_ops ffi_call_desc_ops = ffi_call_desc_print_op, ffi_call_desc_destroy_op, ffi_call_desc_mark_op, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes, val name_in) @@ -5954,14 +5960,16 @@ static struct cobj_ops carray_borrowed_ops = carray_print_op, cobj_destroy_free_op, carray_mark_op, - cobj_eq_hash_op); + cobj_eq_hash_op, + copy_carray); static struct cobj_ops carray_owned_ops = cobj_ops_init(eq, carray_print_op, carray_destroy_op, carray_mark_op, - cobj_eq_hash_op); + cobj_eq_hash_op, + copy_carray); val make_carray(val type, mem_t *data, cnum nelem, val ref, cnum offs) { @@ -6888,7 +6896,8 @@ static struct cobj_ops carray_mmap_ops = carray_print_op, carray_munmap_op, carray_mark_op, - cobj_eq_hash_op); + cobj_eq_hash_op, + copy_carray); val mmap_wrap(val type, val len, val prot, val flags, val source_opt, val offset_opt, val addr_opt) @@ -7091,7 +7100,8 @@ static struct cobj_ops union_ops = cobj_print_op, union_destroy_op, union_mark_op, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); static val make_union_common(mem_t *data, struct txr_ffi_type *tft) { @@ -1319,7 +1319,8 @@ static struct cobj_ops prot_array_ops = cobj_ops_init(eq, cobj_print_op, cobj_destroy_free_op, prot_array_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); val *gc_prot_array_alloc(cnum size, val *obj) { diff --git a/genchksum.txr b/genchksum.txr index b86108fb..d3de9815 100644 --- a/genchksum.txr +++ b/genchksum.txr @@ -169,7 +169,8 @@ static struct cobj_ops @{s.cname}_ops = cobj_ops_init(cobj_equal_handle_op, cobj_print_op, cobj_destroy_free_op, cobj_mark_op, - cobj_handle_hash_op); + cobj_handle_hash_op, + 0); val @{s.cname}_begin(void) { @@ -443,7 +443,8 @@ static struct strm_ops gzio_ops_rd = gzio_stream_print, gzio_stream_destroy, gzio_stream_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("gzip-input-stream"), 0, 0, @@ -471,7 +472,8 @@ static struct strm_ops gzio_ops_wr = gzio_stream_print, gzio_stream_destroy, gzio_stream_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("gzip-output-stream"), gzio_put_string, gzio_put_char, @@ -955,7 +955,8 @@ static struct cobj_ops hash_ops = cobj_ops_init(hash_equal_op, hash_print_op, cobj_destroy_free_op, hash_mark, - hash_hash_op); + hash_hash_op, + copy_hash); static val hash_assoc(val key, ucnum hash, val list) { @@ -1281,7 +1282,8 @@ static struct cobj_ops hash_iter_ops = cobj_ops_init(eq, cobj_print_op, cobj_destroy_free_op, hash_iter_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); void hash_iter_init(struct hash_iter *hi, val hash, val self) { @@ -1251,7 +1251,8 @@ struct cobj_ops seq_iter_cobj_ops = cobj_ops_init(eq, cobj_print_op, cobj_destroy_free_op, seq_iter_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + copy_iter); val seq_begin(val obj) { @@ -10660,7 +10661,8 @@ static struct cobj_ops cptr_ops = cobj_ops_init(cobj_equal_handle_op, cptr_print_op, cobj_destroy_stub_op, cobj_mark_op, - cobj_handle_hash_op); + cobj_handle_hash_op, + copy_cptr); val cptr_typed(mem_t *handle, val type_sym, struct cobj_ops *ops) { @@ -13298,18 +13300,8 @@ val copy(val seq) case CPTR: return copy_cptr(seq); case COBJ: - if (seq->co.cls == hash_cls) - return copy_hash(seq); - if (seq->co.cls == random_state_cls) - return make_random_state(seq, nil); - if (seq->co.cls == carray_cls) - return copy_carray(seq); - if (seq->co.cls == tree_cls) - return copy_search_tree(seq); - if (seq->co.cls == tree_iter_cls) - return copy_tree_iter(seq); - if (obj_struct_p(seq)) - return copy_struct(seq); + if (seq->co.ops->clone) + return seq->co.ops->clone(seq); /* fallthrough */ default: type_mismatch(lit("copy: cannot copy object of type ~s"), @@ -311,15 +311,16 @@ struct cobj_ops { void (*destroy)(val self); void (*mark)(val self); ucnum (*hash)(val self, int *count, ucnum seed); + val (*clone)(val self); val (*equalsub)(val self); }; -#define cobj_ops_init(equal, print, destroy, mark, hash) \ - { equal, print, destroy, mark, hash, 0 } +#define cobj_ops_init(equal, print, destroy, mark, hash, clone) \ + { equal, print, destroy, mark, hash, clone, 0 } #define cobj_ops_init_ex(equal, print, destroy, mark, hash, \ - equalsub) \ - { equal, print, destroy, mark, hash, equalsub } + clone, equalsub) \ + { equal, print, destroy, mark, hash, clone, equalsub } /* Default operations for above structure. * Default equal is eq @@ -121,7 +121,8 @@ static struct cobj_ops parser_ops = cobj_ops_init(eq, cobj_print_op, parser_destroy, parser_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); void parser_common_init(parser_t *p) { @@ -69,11 +69,17 @@ val random_state_s, random_state_var_s, random_warmup_s; struct cobj_class *random_state_cls; +static val random_state_clone(val rand_state) +{ + return make_random_state(rand_state, nil); +} + static struct cobj_ops random_state_ops = cobj_ops_init(eq, cobj_print_op, cobj_destroy_free_op, cobj_mark_op, - cobj_eq_hash_op); + cobj_eq_hash_op, + random_state_clone); /* Source: bits from /dev/random on a Linux server */ static rand32_t rand_tab[16] = { @@ -822,7 +822,8 @@ static struct cobj_ops char_set_obj_ops = cobj_ops_init(eq, cobj_print_op, char_set_cobj_destroy, cobj_mark_op, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); static nfa_state_t *nfa_state_accept(void) { @@ -1495,7 +1496,8 @@ static struct cobj_ops regex_obj_ops = cobj_ops_init(eq, regex_print, regex_destroy, regex_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); static val reg_nullable(val); @@ -678,7 +678,8 @@ static_def(struct strm_ops dgram_strm_ops = dgram_print, dgram_destroy, dgram_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("dgram-sock"), dgram_put_string, dgram_put_char, @@ -491,7 +491,8 @@ static struct strm_ops null_ops = stream_print_op, stream_destroy_op, stream_mark_op, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("null-stream"), null_put_string, null_put_char, null_put_byte, null_get_line, null_get_char, null_get_byte, @@ -1094,7 +1095,8 @@ static struct strm_ops stdio_ops = stdio_stream_print, stdio_stream_destroy, stdio_stream_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("file-stream"), stdio_put_string, stdio_put_char, @@ -1332,7 +1334,8 @@ static struct strm_ops tail_ops = stdio_stream_print, stdio_stream_destroy, stdio_stream_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("tail-stream"), stdio_put_string, stdio_put_char, @@ -1413,7 +1416,8 @@ static struct strm_ops pipe_ops = stdio_stream_print, stdio_stream_destroy, stdio_stream_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("pipe-stream"), stdio_put_string, stdio_put_char, @@ -1892,7 +1896,8 @@ static struct strm_ops dir_ops = stream_print_op, dir_destroy, dir_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("dir-stream"), 0, 0, 0, dir_get_line, @@ -2011,7 +2016,8 @@ static struct strm_ops string_in_ops = stream_print_op, stream_destroy_op, string_in_stream_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("string-input-stream"), 0, 0, 0, string_in_get_line, @@ -2090,7 +2096,8 @@ static struct strm_ops byte_in_ops = stream_print_op, byte_in_stream_destroy, stream_mark_op, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("byte-input-stream"), 0, 0, 0, 0, 0, byte_in_get_byte, @@ -2225,7 +2232,8 @@ static struct strm_ops strlist_in_ops = stream_print_op, stream_destroy_op, strlist_in_stream_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("strlist-input-stream"), 0, 0, 0, strlist_in_get_line, @@ -2374,7 +2382,8 @@ static struct strm_ops string_out_ops = stream_print_op, string_out_stream_destroy, stream_mark_op, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("string-output-stream"), string_out_put_string, string_out_put_char, @@ -2497,7 +2506,8 @@ static struct strm_ops strlist_out_ops = stream_print_op, stream_destroy_op, strlist_out_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("strlist-output-stream"), strlist_out_put_string, strlist_out_put_char, @@ -2678,7 +2688,8 @@ static struct strm_ops cat_stream_ops = cat_stream_print, stream_destroy_op, cat_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("catenated-stream"), 0, 0, 0, cat_get_line, @@ -2937,7 +2948,8 @@ static struct strm_ops record_adapter_ops = stream_print_op, stream_destroy_op, record_adapter_mark_op, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("record-adapter"), delegate_put_string, delegate_put_char, delegate_put_byte, record_adapter_get_line, delegate_get_char, delegate_get_byte, @@ -107,12 +107,12 @@ val struct_type_s, meth_s, print_s, make_struct_lit_s; val init_k, postinit_k; val slot_s, derived_s; -val nullify_s, from_list_s, lambda_set_s; +val copy_s, nullify_s, from_list_s, lambda_set_s; val iter_begin_s, iter_more_s, iter_item_s, iter_step_s, iter_reset_s; static val *special_sym[num_special_slots] = { - &equal_s, &nullify_s, &from_list_s, &lambda_s, &lambda_set_s, + &equal_s, ©_s, &nullify_s, &from_list_s, &lambda_s, &lambda_set_s, &length_s, &length_lt_s, &car_s, &cdr_s, &rplaca_s, &rplacd_s, &iter_begin_s, &iter_more_s, &iter_item_s, &iter_step_s, &iter_reset_s, &plus_s @@ -149,6 +149,7 @@ void struct_init(void) postinit_k = intern(lit("postinit"), keyword_package); slot_s = intern(lit("slot"), user_package); derived_s = intern(lit("derived"), user_package); + copy_s = intern(lit("copy"), user_package); nullify_s = intern(lit("nullify"), user_package); from_list_s = intern(lit("from-list"), user_package); lambda_set_s = intern(lit("lambda-set"), user_package); @@ -1875,6 +1876,15 @@ static ucnum struct_inst_hash(val obj, int *count, ucnum seed) return out; } +static val struct_inst_clone(val strct) +{ + val copy_meth = get_special_slot(strct, copy_m); + + return if3(copy_meth, + funcall1(copy_meth, strct), + copy_struct(strct)); +} + static val get_special_static_slot(struct struct_type *st, enum special_slot idx, val stslot) { @@ -2038,9 +2048,10 @@ val get_special_slot_by_type(val stype, enum special_slot spidx) static_def(struct cobj_ops struct_type_ops = cobj_ops_init(eq, struct_type_print, struct_type_destroy, - struct_type_mark, cobj_eq_hash_op)); + struct_type_mark, cobj_eq_hash_op, 0)); struct cobj_ops struct_inst_ops = cobj_ops_init_ex(struct_inst_equal, struct_inst_print, cobj_destroy_free_op, struct_inst_mark, - struct_inst_hash, struct_inst_equalsub); + struct_inst_hash, struct_inst_clone, + struct_inst_equalsub); @@ -36,7 +36,7 @@ extern struct cobj_ops struct_inst_ops; extern struct cobj_class *struct_cls; enum special_slot { - equal_m, nullify_m, from_list_m, lambda_m, lambda_set_m, + equal_m, copy_m, nullify_m, from_list_m, lambda_m, lambda_set_m, length_m, length_lt_m, car_m, cdr_m, rplaca_m, rplacd_m, iter_begin_m, iter_more_m, iter_item_m, iter_step_m, iter_reset_m, plus_m, @@ -241,7 +241,8 @@ static struct strm_ops strudel_ops = stream_print_op, stream_destroy_op, strudel_mark_op, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("struct-delegate-stream"), strudel_put_string, strudel_put_char, strudel_put_byte, strudel_get_line, strudel_get_char, strudel_get_byte, @@ -2245,7 +2245,8 @@ static struct cobj_ops cptr_dl_ops = cobj_ops_init(cobj_equal_handle_op, cptr_print_op, cptr_dl_destroy_op, cobj_mark_op, - cobj_handle_hash_op); + cobj_handle_hash_op, + 0); static val dlopen_wrap(val name, val flags) { @@ -2403,7 +2404,9 @@ static struct cobj_ops opendir_ops = cobj_ops_init(eq, cobj_print_op, opendir_free, opendir_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); + static val opendir_wrap(val path, val prefix_p) { val self = lit("opendir"); @@ -225,7 +225,8 @@ static_def(struct strm_ops syslog_strm_ops = stream_print_op, cobj_destroy_free_op, syslog_mark, - cobj_eq_hash_op), + cobj_eq_hash_op, + 0), wli("syslog-stream"), syslog_put_string, syslog_put_char, diff --git a/tests/012/oop.tl b/tests/012/oop.tl index 5cdd3ec3..8bf8b4b4 100644 --- a/tests/012/oop.tl +++ b/tests/012/oop.tl @@ -149,3 +149,13 @@ c.(tweak) :error c.(increment 1) (api-z increment #S(api-z) 1) c.(decrement) :error)) + +(defstruct node () + left right) + +(test (copy (new node left 1 right 2)) #S(node left 1 right 2)) + +(defmeth node copy (me) + (new node left (succ me.left) right (succ me.right))) + +(test (copy (new node left 1 right 2)) #S(node left 2 right 3)) @@ -849,7 +849,8 @@ static struct cobj_ops tree_ops = cobj_ops_init(tree_equal_op, tree_print_op, cobj_destroy_free_op, tree_mark, - tree_hash_op); + tree_hash_op, + copy_search_tree); val tree(val keys_in, val key_fn, val less_fn, val equal_fn, val dup_in) { @@ -967,7 +968,8 @@ static struct cobj_ops tree_iter_ops = cobj_ops_init(eq, cobj_print_op, cobj_destroy_free_op, tree_iter_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + copy_tree_iter); val tree_begin(val tree, val lowkey, val highkey) { @@ -21523,6 +21523,13 @@ the type of the argument, as follows: .meti (copy-hash << object ) .onom .IP "struct type" +If +.meta object +implements the special +.code copy +method, then that method is invoked and the return value of that +method call is returned as the copy. Otherwise the object is copied +as if by: .mono .meti (copy-struct << object ) .onom @@ -32002,10 +32009,15 @@ method similar to the following: .brev which can then be invoked on whatever object needs copying. -(Note that this method is not a special structure function, and is thus -not taken into account by the + +Note that a method named +.code copy +is a special structure function. When an object provides this +method, the .code copy -function.) +function uses the method to copy the object, rather than using +.codn copy-struct . + Since this logic is generic, it can be placed in a base method. The .code copied @@ -33484,6 +33496,27 @@ which looks up the function in the struct .meta type directly. +.coNP Method @ copy +.synb +.mets << object .(copy) +.syne +.desc +The special method +.code copy +is expected to produce a copy of the object. The +.code copy +function will use this method if it is available, otherwise fall back on +.codn copy-struct . +The method is responsible for all semantics of the copy operation; +whatever object the method returns is taken to be a copy of +.metn object . + +It is a recommended practice that the returned object be of the same type as +.metn object . +It is also a recommended practice that the returned object be newly created, +distinct from any object which existed prior to the method being called. The +objects held in that object's slots need not be new. + .coNP Method @ equal .synb .mets << object .(equal) @@ -1062,7 +1062,8 @@ static struct cobj_ops cont_ops = cobj_ops_init(eq, cobj_print_op, cont_destroy, cont_mark, - cobj_eq_hash_op); + cobj_eq_hash_op, + 0); static void call_copy_handlers(uw_frame_t *upto) { @@ -1357,14 +1357,16 @@ static_def(struct cobj_ops vm_desc_ops = cobj_print_op, vm_desc_destroy, vm_desc_mark, - cobj_eq_hash_op)); + cobj_eq_hash_op, + 0)); static_def(struct cobj_ops vm_closure_ops = cobj_ops_init(eq, cobj_print_op, cobj_destroy_free_op, vm_closure_mark, - cobj_eq_hash_op)); + cobj_eq_hash_op, + 0)); void vm_init(void) { |