diff options
| -rw-r--r-- | lib.c | 197 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | struct.c | 22 | ||||
| -rw-r--r-- | struct.h | 3 | ||||
| -rw-r--r-- | tests/012/oop-seq.expected | 0 | ||||
| -rw-r--r-- | tests/012/oop-seq.tl | 56 | ||||
| -rw-r--r-- | txr.1 | 278 |
7 files changed, 529 insertions, 28 deletions
@@ -353,6 +353,10 @@ static val seq_iterable(seq_info_t si) case BGNUM: case FLNUM: return t; + case COBJ: + if (get_special_slot(si.obj, iter_begin_m)) + return t; + break; default: break; } @@ -568,6 +572,94 @@ static int seq_iter_peek_num(seq_iter_t *it, val *pval) return 1; } +static int seq_iter_get_oop(seq_iter_t *it, val *pval) +{ + val iter = it->ui.iter; + + if (it->ul.next != nao) { + val iter_step_meth = get_special_required_slot(iter, iter_step_m); + *pval = it->ul.next; + it->ui.iter = funcall1(iter_step_meth, iter); + it->ul.next = nao; + return 1; + } else { + val iter_more_meth = get_special_required_slot(iter, iter_more_m); + + if (!funcall1(iter_more_meth, iter)) { + return 0; + } else { + val iter_item_meth = get_special_required_slot(iter, iter_item_m); + val iter_step_meth = get_special_required_slot(iter, iter_step_m); + *pval = funcall1(iter_item_meth, iter); + it->ui.iter = funcall1(iter_step_meth, iter); + it->ul.next = nao; + return 1; + } + } +} + +static int seq_iter_peek_oop(seq_iter_t *it, val *pval) +{ + val iter = it->ui.iter; + + if (it->ul.next != nao) { + *pval = it->ul.next; + return 1; + } else { + val iter_more_meth = get_special_required_slot(iter, iter_more_m); + + if (funcall1(iter_more_meth, iter)) { + val iter_item_meth = get_special_required_slot(iter, iter_item_m); + it->ul.next = *pval = funcall1(iter_item_meth, iter); + } + + return 1; + } + + return 0; +} + +static int seq_iter_get_fast_oop(seq_iter_t *it, val *pval) +{ + val iter = it->ui.iter; + + if (iter) { + val item = it->ul.next; + val iter_step_meth = get_special_required_slot(iter, iter_step_m); + + if (item == nao) { + val iter_item_meth = get_special_required_slot(iter, iter_item_m); + *pval = funcall1(iter_item_meth, iter); + } else { + *pval = item; + } + + it->ui.iter = funcall1(iter_step_meth, iter); + it->ul.next = nao; + return 1; + } + + return 0; +} + +static int seq_iter_peek_fast_oop(seq_iter_t *it, val *pval) +{ + val iter = it->ui.iter; + + if (it->ul.next != nao) { + *pval = it->ul.next; + return 1; + } + + if (iter) { + val iter_item_meth = get_special_required_slot(iter, iter_item_m); + it->ul.next = *pval = funcall1(iter_item_meth, iter); + return 1; + } + + return 0; +} + val seq_geti(seq_iter_t *it) { val v = nil; @@ -703,6 +795,35 @@ static void seq_iter_init_with_info(val self, seq_iter_t *it, it->get = seq_iter_get_num; it->peek = seq_iter_peek_num; break; + case COBJ: + if (obj_struct_p(it->inf.obj)) { + val iter_begin_meth = get_special_slot(it->inf.obj, iter_begin_m); + if (iter_begin_meth) { + val iter = funcall1(iter_begin_meth, it->inf.obj); + if (iter == nil) { + it->ui.iter = nil; + it->ul.len = 0; + it->get = seq_iter_get_nil; + it->peek = seq_iter_peek_nil; + break; + } else { + val iter_more_meth = get_special_slot(iter, iter_more_m); + if (iter_more_meth) { + it->ui.iter = iter; + it->ul.next = nao; + it->get = seq_iter_get_oop; + it->peek = seq_iter_peek_oop; + } else { + it->ui.iter = iter; + it->ul.next = nao; + it->get = seq_iter_get_fast_oop; + it->peek = seq_iter_peek_fast_oop; + } + break; + } + } + } + /* fallthrough */ default: switch (it->inf.kind) { case SEQ_NIL: @@ -787,6 +908,8 @@ static void seq_iter_mark(val seq_iter) gc_mark(si->ui.iter); break; default: + if (cobjp(seq_iter) && obj_struct_p(seq_iter)) + gc_mark(si->ui.iter); break; } } @@ -830,16 +953,23 @@ val iter_begin(val obj) val self = lit("iter-begin"); seq_info_t sinf = seq_info(obj); - switch (sinf.kind) { - case SEQ_NIL: - case SEQ_LISTLIKE: - return sinf.obj; + switch (sinf.type) { + case CHR: + case NUM: + case BGNUM: + return obj; + case COBJ: + if (obj_struct_p(obj)) { + val iter_begin_meth = get_special_slot(obj, iter_begin_m); + if (iter_begin_meth) + return funcall1(iter_begin_meth, obj); + } + /* fallthrough */ default: - switch (sinf.type) { - case CHR: - case NUM: - case BGNUM: - return obj; + switch (sinf.kind) { + case SEQ_NIL: + case SEQ_LISTLIKE: + return sinf.obj; default: { val si_obj; @@ -870,6 +1000,11 @@ val iter_more(val iter) val item = nil; return if2(seq_peek(si, &item), t); } + if (obj_struct_p(iter)) { + val iter_more_meth = get_special_slot(iter, iter_more_m); + if (iter_more_meth) + return funcall1(iter_more_meth, iter); + } /* fallthrough */ default: return t; @@ -915,6 +1050,11 @@ val iter_step(val iter) (void) seq_get(si, &item); return iter; } + if (obj_struct_p(iter)) { + val iter_step_meth = get_special_slot(iter, iter_step_m); + if (iter_step_meth) + return funcall1(iter_step_meth, iter); + } /* fallthrough */ default: return cdr(iter); @@ -926,24 +1066,29 @@ val iter_reset(val iter, val obj) val self = lit("iter-reset"); seq_info_t sinf = seq_info(obj); - switch (sinf.kind) { - case SEQ_NIL: - case SEQ_LISTLIKE: - return sinf.obj; + switch (type(iter)) { + case CHR: + case NUM: + case BGNUM: + return obj; + case COBJ: + if (iter->co.cls == seq_iter_s) + { + struct seq_iter *si = coerce(struct seq_iter *, iter->co.handle); + seq_iter_init_with_info(self, si, sinf, 0); + return iter; + } + /* fallthrough */ default: - switch (type(iter)) { - case CHR: - case NUM: - case BGNUM: - return obj; - case COBJ: - if (iter->co.cls == seq_iter_s) - { - struct seq_iter *si = coerce(struct seq_iter *, iter->co.handle); - seq_iter_init_with_info(self, si, sinf, 0); - return iter; - } - /* fallthrough */ + if (cobjp(obj) && obj_struct_p(obj)) { + val iter_reset_meth = get_special_slot(obj, iter_reset_m); + if (iter_reset_meth) + return funcall2(iter_reset_meth, obj, iter); + } + switch (sinf.kind) { + case SEQ_NIL: + case SEQ_LISTLIKE: + return sinf.obj; default: return iter_begin(obj); } @@ -397,6 +397,7 @@ typedef struct seq_iter { cnum len; val vbound; cnum cbound; + val next; } ul; int (*get)(struct seq_iter *, val *pval); int (*peek)(struct seq_iter *, val *pval); @@ -105,9 +105,12 @@ val slot_s, derived_s; val 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, - &length_s, &car_s, &cdr_s, &rplaca_s, &rplacd_s + &length_s, &car_s, &cdr_s, &rplaca_s, &rplacd_s, + &iter_begin_s, &iter_more_s, &iter_item_s, &iter_step_s, &iter_reset_s }; static val struct_type_hash; @@ -141,6 +144,12 @@ void struct_init(void) 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); + iter_begin_s = intern(lit("iter-begin"), user_package); + iter_more_s = intern(lit("iter-more"), user_package); + iter_item_s = intern(lit("iter-item"), user_package); + iter_step_s = intern(lit("iter-step"), user_package); + iter_reset_s = intern(lit("iter-reset"), user_package); + struct_type_hash = make_hash(nil, nil, nil); slot_hash = make_hash(nil, nil, t); slot_type_hash = make_hash(nil, nil, nil); @@ -1932,6 +1941,17 @@ val get_special_slot(val obj, enum special_slot spidx) return get_special_static_slot(si->type, spidx, slot); } +val get_special_required_slot(val obj, enum special_slot spidx) +{ + val content = get_special_slot(obj, spidx); + if (content == nil) { + val slot = *special_sym[spidx]; + uw_throwf(error_s, lit("~s is missing required ~s slot"), + obj, slot, nao); + } + return content; +} + val get_special_slot_by_type(val stype, enum special_slot spidx) { struct struct_type *st = coerce(struct struct_type *, stype->co.handle); @@ -29,12 +29,14 @@ extern val struct_type_s, meth_s, print_s, make_struct_lit_s; extern val init_k, postinit_k; extern val slot_s, derived_s; extern val lambda_set_s; +extern val iter_begin_s, iter_more_s, iter_item_s, iter_step_s, iter_reset_s; extern struct cobj_ops struct_inst_ops; enum special_slot { equal_m, nullify_m, from_list_m, lambda_m, lambda_set_m, length_m, car_m, cdr_m, rplaca_m, rplacd_m, + iter_begin_m, iter_more_m, iter_item_m, iter_step_m, iter_reset_m, num_special_slots }; @@ -88,6 +90,7 @@ val static_slot_types(val slot); val slot_type_reg(val slot, val strct); val static_slot_type_reg(val slot, val strct); val get_special_slot(val obj, enum special_slot spidx); +val get_special_required_slot(val obj, enum special_slot spidx); val get_special_slot_by_type(val stype, enum special_slot spidx); INLINE int obj_struct_p(val obj) { return obj->co.ops == &struct_inst_ops; } void struct_init(void); diff --git a/tests/012/oop-seq.expected b/tests/012/oop-seq.expected new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/tests/012/oop-seq.expected diff --git a/tests/012/oop-seq.tl b/tests/012/oop-seq.tl new file mode 100644 index 00000000..919f34cc --- /dev/null +++ b/tests/012/oop-seq.tl @@ -0,0 +1,56 @@ +(load "../common") + +(defstruct counter-iter-fast () + cur-val + step + limit + (:method iter-item (me) + me.cur-val) + (:method iter-step (me) + (inc me.cur-val me.step) + (if (< me.cur-val me.limit) me))) + +(defstruct counter-fast () + init + step + limit + (:method iter-begin (me) + (if (< me.init me.limit) + (new counter-iter-fast + cur-val me.init + step me.step + limit me.limit)))) + +(defstruct counter-iter-canon () + cur-val + step + limit + (:method iter-item (me) + me.cur-val) + (:method iter-more (me) + (< me.cur-val me.limit)) + (:method iter-step (me) + (inc me.cur-val me.step) + me)) + +(defstruct counter-canon () + init + step + limit + (:method iter-begin (me) + (new counter-iter-canon + cur-val me.init + step me.step + limit me.limit))) + +(test (list-seq (new counter-canon init 0 step 2 limit 10)) + (0 2 4 6 8)) + +(test (list-seq (new counter-fast init 0 step 2 limit 10)) + (0 2 4 6 8)) + +(test (list-seq (new counter-canon init 0 step 1 limit 0)) + nil) + +(test (list-seq (new counter-fast init 0 step 1 limit 0)) + nil) @@ -29281,6 +29281,205 @@ function is itself inherited. If the same version of this function is shared by multiple structure types due to inheritance, this argument informs the function which of those types it is being invoked for. +.coNP Methods @ iter-begin and @ iter-reset +.synb +.mets << object .(iter-begin) +.mets << object .(iter-reset << iter ) +.syne +.desc +If an object supports the +.code iter-begin +method, it is considered iterable; the +.code iterable +function will return +.code t +if invoked on this object. + +The responsibility of the +.code iter-begin +method is to return an iterator object: an object which supports +certain special methods related to iteration, according to one of two +protocols, described below. + +The +.code iter-reset +method is optional. It is similar to +.code iter-begin +but takes an additional +.meta iter +argument, an iterator object that was previously returned by the +.code iter-begin +method of the same +.metn object . + +If +.code iter-reset +determines that +.meta iter +can be re-used for a new iteration, then it can suitably mutate the +state of +.meta iter +and return it. Otherwise, it behaves like +.code iter-begin +and returns a new iterator. + +There are two protocols for iteration: the fast protocol, and the canonical +protocol. +Both protocols require the iterator object returned by the +.code iter-begin +method to provide the methods +.code iter-item +and +.codn iter-step . +If the iterator also provides the +.code iter-more +method, then the protocol which applies is the canonical protocol. If +that method is absent, then the fast protocol is followed. + +Under the fast protocol, the +.code iter-more +method does not exist and is not involved. The iterable object's +.code iter-begin +method must return +.code nil +if the abstract sequence is empty. If an iterator is returned, it is assumed +that an object can be retrieved from the iterator by invoking its +.code iter-item +method. The iterator's +.code iter-next +method should return +.code nil +if there are no more objects in the abstract sequence, or else it should +return an iterator that obeys the fast protocol (possibly itself). + +Under the canonical protocol, the iterator implements the +.code iter-more +function. The iterable object's +.code iter-begin +always returns an iterator object. The iterator object's +.code iter-more +method is always invoked to determine whether another item is available +from the sequence. The iterator object's +.code iter-step +method is expected to return an iterator object which conforms to the +canonical protocol. + +.coNP Method @ iter-item +.synb +.mets << object .(iter-item) +.syne +.desc +The +.code iter-item +method is invoked on an iterator +.meta object +to retrieve the next item in the sequence. + +Under the fast protocol, it +is assumed that if +.meta object +was returned by an iterable object's +.code iter-begin +method, or by an iterator's +.code iter-step +method, that an item is available. This method will be unconditionally invoked. + +Under the canonical protocol for iteration, the +.code iter-more +method will be invoked on +.meta object +first. If that method yields true, then +.code iter-item +is expected to yield the next available item in the sequence. + +Note: calls to the +.code iter-item +function, with +.meta object +as its argument, invoke the +.code iter-item +method. It is possible for an application to call +.code iter-item +through this function or directly as a method call +without first calling +.codn iter-more . +No iteration mechanism in the \*(TL standard library behaves this way. +If the iterator +.meta object +has no more items available and +.code iter-more +is invoked anyway, no requirements apply to its behavior or return value. + +.coNP Method @ iter-step +.synb +.mets << object .(iter-step) +.syne +.desc +The +.code iter-step +method is invoked on an iterator object to produce an iterator object for the +remainder of the sequence, excluding the current item. + +Under the fast iteration protocol, this method returns +.code nil +if there are no more items in the sequence. + +Under the canonical iteration protocol, this method always returns +an iterator object. If no items remain in the sequence, then that +iterator object's +.code iter-more +method returns +.codn nil . +Furthermore, under this protocol, +.code iter-step +is not called if +.code iter-more +returns +.codn nil . + +Note: calls to the +.code iter-step +function, with +.meta object +as its argument, invoke the +.code iter-step +method. It is possible for an application to call +.code iter-step +through this function or directly as a method call +without first calling +.codn iter-more . +No iteration mechanism in the \*(TL standard library behaves this way. +If the iterator +.meta object +has no more items available and +.code iter-step +is invoked anyway, no requirements apply to its behavior or return value. + +.coNP Method @ iter-more +.synb +.mets << object .(iter-more) +.syne +.desc +If an iterator +.meta object +returned by +.code iter-begin +supports the +.code iter-more +method, then the canonical iteration protocol applies to that iteration +session. All subsequent iterators that are involved in the iteration +are assumed to conform to the protocol and should implement the +.code iter-more +method also. The behavior is unspecified otherwise. + +The +.code iter-more +method is used to interrogate an iterator whether more unvisited items +remain in the sequence. This method does not advance the iteration, +and does not change the state of the iterator. It is idempotent: if it is +called multiple times without any intervening call to any other method, +it yields the same value. + .SS* Sequence Manipulation Functions in this category uniformly manipulate abstract sequences. Lists, @@ -29354,7 +29553,7 @@ function returns if .meta object is iterable, otherwise -.conp nil . +.codn nil . If .meta object @@ -29362,6 +29561,12 @@ is a sequence according to the .code seqp function, then it is iterable. +If +.meta object +is a structure which supports the +.code iter-begin +method, then it is iterable. + Additional objects that are not sequences are also iterable: numeric or character ranges, and numbers. Future revisions of the language may specify additional iterable objects. @@ -33517,6 +33722,22 @@ group, and functions in the .code seq-begin group. The latter are obsolescent. +Application-defined iteration is possible via defining special methods on +structures. An object supports iteration by defining the special method +.code iter-begin +which is different from the +.code iter-begin +function. This special function returns an iterator object which supports +special methods +.codn iter-item , +.code iter-more +and +.codn iter-step . +Two protocols are supported, one of which is more efficient by eliminating the +.code iter-more +method. Details are specified in the section +.BR "Special Structure Functions" . + .coNP Function @ iter-begin .synb .mets (iter-begin << seq ) @@ -33560,6 +33781,12 @@ and are equivalent to .codn "(iter-begin X)" . +If +.meta seq +is a structure which supports the +.code iter-begin +method, then that method is called and its return value is returned. + .coNP Function @ iter-more .synb .mets (iter-more << iter ) @@ -33652,6 +33879,12 @@ lower than the limiting value. However, note the peculiar semantics of .code iter-item with regard to descending range iteration. +If +.meta iter +is a structure which supports the +.code iter-more +method, then that method is called and its return value is returned. + .coNP Function @ iter-item .synb .mets (iter-item << iter ) @@ -33738,6 +33971,12 @@ exactly the same values are visited as for the range .code 0..3 only in reverse order. +If +.meta iter +is a structure which supports the +.code iter-item +method, then that method is called and its return value is returned. + .coNP Function @ iter-step .synb .mets (iter-step << iter ) @@ -33798,6 +34037,12 @@ returns its successor, as if using the .code succ function. +If +.meta iter +is a structure which supports the +.code iter-step +method, then that method is called and its return value is returned. + .coNP Function @ iter-reset .synb .mets (iter-reset < iter << seq ) @@ -33824,6 +34069,37 @@ then it behaves exactly like being invoked on .metn seq . +If +.meta seq +is a structure which supports the +.code iter-reset +method, then that method is called and its return value is returned. +Note the reversed arguments. The +.code iter-reset +method is of the +.meta seq +object, not of +.metn iter . +That is to say, the call +.mono +.meti (iter-reset < iter << obj) +.onom +results in the +.mono +.meti << obj .(iter-reset << iter ) +.onom +call. If +.meta seq +is a structure which doesn't support +.code iter-reset +then +.meta iter +is ignored, +.code iter-begin +is invoked on +.meta seq +and the result is returned. + .coNP Function @ seq-begin .synb .mets (seq-begin << object ) |