/[guile]/guile/guile-core/libguile/list.c
ViewVC logotype

Diff of /guile/guile-core/libguile/list.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.66 by xxhanwen, Sat Jul 20 14:08:33 2002 UTC revision 1.67 by mdj, Tue Mar 11 19:57:52 2003 UTC
# Line 1  Line 1 
1  /* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc.  /* Copyright (C) 1995,1996,1997,2000,2001, 2003 Free Software Foundation, Inc.
2   *   *
3   * This program is free software; you can redistribute it and/or modify   * This program is free software; you can redistribute it and/or modify
4   * it under the terms of the GNU General Public License as published by   * it under the terms of the GNU General Public License as published by
# Line 47  Line 47 
47    
48  #include "libguile/validate.h"  #include "libguile/validate.h"
49  #include "libguile/list.h"  #include "libguile/list.h"
50    #include "libguile/eval.h"
51    
52  #ifdef __STDC__  #ifdef __STDC__
53  #include <stdarg.h>  #include <stdarg.h>
# Line 830  SCM_DEFINE (scm_delete1_x, "delete1!", 2 Line 831  SCM_DEFINE (scm_delete1_x, "delete1!", 2
831  }  }
832  #undef FUNC_NAME  #undef FUNC_NAME
833    
834    SCM_DEFINE (scm_filter, "filter", 2, 0, 0,
835                (SCM pred, SCM list),
836                "Return all the elements of 2nd arg @var{list} that satisfy predicate @var{pred}.\n"
837                "The list is not disordered -- elements that appear in the result list occur\n"
838                "in the same order as they occur in the argument list. The returned list may\n"
839                "share a common tail with the argument list. The dynamic order in which the\n"
840                "various applications of pred are made is not specified.\n\n"
841                "@lisp\n"
842                "(filter even? '(0 7 8 8 43 -4)) => (0 8 8 -4)\n"
843                "@end lisp")
844    #define FUNC_NAME s_scm_filter
845    {
846      scm_t_trampoline_1 call = scm_trampoline_1 (pred);
847      SCM walk;
848      SCM *prev;
849      SCM res = SCM_EOL;
850      SCM_ASSERT (call, pred, 1, FUNC_NAME);
851      SCM_VALIDATE_LIST (2, list);
852      
853      for (prev = &res, walk = list;
854           SCM_CONSP (walk);
855           walk = SCM_CDR (walk))
856        {
857          if (!SCM_FALSEP (call (pred, SCM_CAR (walk))))
858            {
859              *prev = scm_cons (SCM_CAR (walk), SCM_EOL);
860              prev = SCM_CDRLOC (*prev);
861            }
862        }
863    
864      return res;
865    }
866    #undef FUNC_NAME
867    
868    SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0,
869                (SCM pred, SCM list),
870                "Linear-update variant of @code{filter}.")
871    #define FUNC_NAME s_scm_filter_x
872    {
873      scm_t_trampoline_1 call = scm_trampoline_1 (pred);
874      SCM walk;
875      SCM *prev;
876      SCM_ASSERT (call, pred, 1, FUNC_NAME);
877      SCM_VALIDATE_LIST (2, list);
878      
879      for (prev = &list, walk = list;
880           SCM_CONSP (walk);
881           walk = SCM_CDR (walk))
882        {
883          if (!SCM_FALSEP (call (pred, SCM_CAR (walk))))
884            prev = SCM_CDRLOC (walk);
885          else
886            *prev = SCM_CDR (walk);
887        }
888    
889      return list;
890    }
891    #undef FUNC_NAME
892    
893    
894  void  void

Legend:
Removed from v.1.66  
changed lines
  Added in v.1.67

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26