/[guile]/guile/guile-core/srfi/srfi-1.c
ViewVC logotype

Diff of /guile/guile-core/srfi/srfi-1.c

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

revision 1.1 by mdj, Sun Dec 1 13:10:51 2002 UTC revision 1.2 by mdj, Sun Dec 1 13:56:11 2002 UTC
# Line 288  equal_trampoline (SCM proc, SCM arg1, SC Line 288  equal_trampoline (SCM proc, SCM arg1, SC
288  SCM_DEFINE (scm_srfi1_member, "member", 2, 1, 0,  SCM_DEFINE (scm_srfi1_member, "member", 2, 1, 0,
289             (SCM x, SCM lst, SCM pred),             (SCM x, SCM lst, SCM pred),
290              "Return the first sublist of @var{lst} whose car is\n"              "Return the first sublist of @var{lst} whose car is\n"
291              "@code{equal?} to @var{x} where the sublists of @var{lst} are\n"              "@var{equal?} to @var{x} where the sublists of @var{lst} are\n"
292              "the non-empty lists returned by @code{(list-tail @var{lst}\n"              "the non-empty lists returned by @code{(list-tail @var{lst}\n"
293              "@var{k})} for @var{k} less than the length of @var{lst}.  If\n"              "@var{k})} for @var{k} less than the length of @var{lst}.  If\n"
294              "@var{x} does not occur in @var{lst}, then @code{#f} (not the\n"              "@var{x} does not occur in @var{lst}, then @code{#f} (not the\n"
295              "empty list) is returned.")              "empty list) is returned.  If optional third argument @var{equal?}\n"
296                "isn't given, @code{equal?} is used for comparison.\n"
297                "(Extended from R5RS.)\n")
298  #define FUNC_NAME s_scm_srfi1_member  #define FUNC_NAME s_scm_srfi1_member
299  {  {
300    scm_t_trampoline_2 equal_p;    scm_t_trampoline_2 equal_p;
# Line 312  SCM_DEFINE (scm_srfi1_member, "member", Line 314  SCM_DEFINE (scm_srfi1_member, "member",
314    return SCM_BOOL_F;    return SCM_BOOL_F;
315  }  }
316  #undef FUNC_NAME  #undef FUNC_NAME
317    
318    SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0,
319                (SCM key, SCM alist, SCM pred),
320                "Behaves like @code{assq} but uses third argument @var{pred?}\n"
321                "for key comparison.  If @var{pred?} is not supplied,\n"
322                "@code{equal?} is used.  (Extended from R5RS.)\n")
323    #define FUNC_NAME s_scm_srfi1_assoc
324    {
325      SCM ls = alist;
326      scm_t_trampoline_2 equal_p;
327      if (SCM_UNBNDP (pred))
328        equal_p = equal_trampoline;
329      else
330        {
331          equal_p = scm_trampoline_2 (pred);
332          SCM_ASSERT (equal_p, pred, 3, FUNC_NAME);
333        }
334      for(; SCM_CONSP (ls); ls = SCM_CDR (ls))
335        {
336          SCM tmp = SCM_CAR (ls);
337          SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
338                           "association list");
339          if (SCM_NFALSEP (equal_p (pred, SCM_CAR (tmp), key)))
340            return tmp;
341        }
342      SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
343                       "association list");
344      return SCM_BOOL_F;
345    }
346    #undef FUNC_NAME
347    
348  void  void
349  scm_init_srfi_1 (void)  scm_init_srfi_1 (void)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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