Changeset 12940 in project for chicken


Ignore:
Timestamp:
01/06/09 11:39:46 (11 years ago)
Author:
felix winkelmann
Message:

length checks argument for being cyclic (suggested by Taylor Campbell)

Location:
chicken/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/NEWS

    r12939 r12940  
    77- `regex' unit: removed `regexp*' and `regex-optimize'
    88- added `CHICKEN_new_finalizable_gc_root()'
     9- `length' checks its argument for being cyclic
    910
    10114.0.0x3
  • chicken/trunk/TODO

    r12939 r12940  
    3434** libraries/build
    3535*** path-handling for process invocation
    36 **** try Lars Nilsson's suggestion
     36**** try Lars Nilsson's suggestion or Tobia's CreateProcess
    3737**** append ".exe" on windows
     38*** library/runtime: cyclic list checks for assq/assv/assoc/memq/memv/member
     39    and C_i_list_tail
    3840
    3941
  • chicken/trunk/chicken.h

    r12939 r12940  
    451451#define C_NOT_A_CLOSURE_ERROR                         9
    452452#define C_CONTINUATION_CANT_RECEIVE_VALUES_ERROR      10
     453#define C_BAD_ARGUMENT_TYPE_CYCLIC_LIST_ERROR         11
    453454#define C_TOO_DEEP_RECURSION_ERROR                    12
    454455#define C_CANT_REPRESENT_INEXACT_ERROR                13
     
    14461447C_fctexport C_word C_fcall C_i_member(C_word x, C_word lst) C_regparm;
    14471448C_fctexport C_word C_fcall C_i_length(C_word lst) C_regparm;
     1449C_fctexport C_word C_fcall C_u_i_length(C_word lst) C_regparm;
    14481450C_fctexport C_word C_fcall C_i_inexact_to_exact(C_word n) C_regparm;
    14491451C_fctexport C_word C_fcall C_i_check_closure_2(C_word x, C_word loc) C_regparm;
  • chicken/trunk/library.scm

    r12937 r12940  
    37723772        ((9) (apply ##sys#signal-hook #:type-error loc "call of non-procedure" args))
    37733773        ((10) (apply ##sys#error loc "continuation can not receive multiple values" args))
     3774        ((11) (apply ##sys#error loc "argument is cyclic" args))
    37743775        ((12) (apply ##sys#signal-hook #:limit-error loc "recursion too deep" args))
    37753776        ((13) (apply ##sys#signal-hook #:type-error loc "inexact number can not be represented as an exact number" args))
  • chicken/trunk/runtime.c

    r12939 r12940  
    14721472    break;
    14731473
     1474  case C_BAD_ARGUMENT_TYPE_CYCLIC_LIST_ERROR:
     1475    msg = C_text("argument is cyclic");
     1476    c = 1;
     1477    break;
     1478
    14741479  case C_TOO_DEEP_RECURSION_ERROR:
    14751480    msg = C_text("recursion too deep");
     
    52535258C_regparm C_word C_fcall C_i_length(C_word lst)
    52545259{
     5260  C_word fast = lst, slow = lst;
    52555261  int n = 0;
    52565262
    5257   if(lst != C_SCHEME_END_OF_LIST) {
    5258     if(!C_immediatep(lst) && C_block_header(lst) == C_PAIR_TAG) {
    5259       do {
    5260         lst = C_u_i_cdr(lst);
    5261         ++n;
    5262       } while(!C_immediatep(lst) && C_block_header(lst) == C_PAIR_TAG);
    5263     }
    5264     else barf(C_BAD_ARGUMENT_TYPE_ERROR, "length", lst);
     5263  while(slow != C_SCHEME_END_OF_LIST) {
     5264    if(fast != C_SCHEME_END_OF_LIST) {
     5265      if(!C_immediatep(fast) && C_block_header(fast) == C_PAIR_TAG) {
     5266        fast = C_u_i_cdr(fast);
     5267     
     5268        if(fast != C_SCHEME_END_OF_LIST) {
     5269          if(!C_immediatep(fast) && C_block_header(fast) == C_PAIR_TAG) {
     5270            fast = C_u_i_cdr(fast);
     5271          }
     5272          else barf(C_NOT_A_PROPER_LIST_ERROR, "length", lst);
     5273        }
     5274
     5275        if(fast == slow)
     5276          barf(C_BAD_ARGUMENT_TYPE_CYCLIC_LIST_ERROR, "length", lst);
     5277      }
     5278    }
     5279
     5280    if(C_immediatep(slow) || C_block_header(lst) != C_PAIR_TAG)
     5281      barf(C_NOT_A_PROPER_LIST_ERROR, "length", lst);
     5282
     5283    slow = C_u_i_cdr(slow);
     5284    ++n;
     5285  }
     5286
     5287  return C_fix(n);
     5288}
     5289
     5290
     5291C_regparm C_word C_fcall C_u_i_length(C_word lst)
     5292{
     5293  int n = 0;
     5294
     5295  while(!C_immediatep(lst) && C_block_header(lst) == C_PAIR_TAG) {
     5296    lst = C_u_i_cdr(lst);
     5297    ++n;
    52655298  }
    52665299
Note: See TracChangeset for help on using the changeset viewer.