artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Add memq.

Browse source 
* lib/mes.c (memq): New function.
* module/mes/scm.mes (memq): Remove.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-05 11:03:09 +02:00
parent 76e1b0582f
commit 6a9621ebf3
2 changed files with 27 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
module/mes/scm.mes
View file

@ -109,7 +109,7 @@
(define assv-ref assq-ref)
(define (assoc key alist)
(if (null? alist) #f ;; IF
(if (null? alist) #f
(if (equal? key (caar alist)) (car alist)
(assoc key (cdr alist)))))
@ -124,14 +124,10 @@
(let ((entry (set-cdr! entry value)))
alist))))
(define (memq x lst)
(if (null? lst) #f ;; IF
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
(define memv memq)
(define (member x lst)
(if (null? lst) #f ;; IF
(if (null? lst) #f
(if (equal? x (car lst)) lst
(member x (cdr lst)))))

25
src/lib.c
View file

@ -243,3 +243,28 @@ xassq (SCM x, SCM a) ///for speed in core only
while (a != cell_nil && x != CDAR (a)) a = CDR (a);
return a != cell_nil ? CAR (a) : cell_f;
}
SCM
memq (SCM x, SCM a)
{
switch (TYPE (x))
{
case TCHAR:
case TNUMBER:
{
SCM v = VALUE (x);
while (a != cell_nil && v != VALUE (CAR (a))) a = CDR (a); break;
}
case TKEYWORD:
{
SCM v = STRING (x);
while (a != cell_nil && v != STRING (CAR (a))) a = CDR (a); break;
}
// case TSYMBOL:
// case TSPECIAL:
default:
while (a != cell_nil && x != CAR (a)) a = CDR (a); break;
}
return a != cell_nil ? a : cell_f;
}