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

mes: Move assoc to core.

Browse source 
* mes/mes.c (assoc_string, assoc): New function.
* mes/module/mes/scm.mes (assoc): Remove.  Gains 12% performance for
MesCC.
This commit is contained in:
Jan Nieuwenhuizen 2018-10-19 22:38:19 +02:00
parent 4e0e4c83d8
commit 5ed45a4e24
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 18 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
mes/module/mes/scm.mes
View file

@ -108,11 +108,6 @@
(define assv assq) (define assv assq)
(define assv-ref assq-ref) (define assv-ref assq-ref)
(define (assoc key alist)
(if (not (pair? alist)) #f
(if (equal? key (caar alist)) (car alist)
(assoc key (cdr alist)))))
(define (assoc-ref alist key) (define (assoc-ref alist key)
(let ((entry (assoc key alist))) (let ((entry (assoc key alist)))
(if entry (cdr entry) (if entry (cdr entry)

18
src/mes.c
View file

@ -423,6 +423,14 @@ list_of_char_equal_p (SCM a, SCM b) ///((internal))
return (a == cell_nil && b == cell_nil) ? cell_t : cell_f; return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
} }
SCM
assoc_string (SCM x, SCM a) ///((internal))
{
while (a != cell_nil && list_of_char_equal_p (STRING (x), STRING (CAAR (a))) == cell_f)
a = CDR (a);
return a != cell_nil ? CAR (a) : cell_f;
}
SCM SCM
list_to_symbol (SCM s) list_to_symbol (SCM s)
{ {
@ -857,6 +865,16 @@ assq (SCM x, SCM a)
return a != cell_nil ? CAR (a) : cell_f; return a != cell_nil ? CAR (a) : cell_f;
} }
SCM
assoc (SCM x, SCM a)
{
if (TYPE (x) == TSTRING)
return assoc_string (x, a);
while (a != cell_nil && equal2_p (x, CAAR (a)) == cell_f)
a = CDR (a);
return a != cell_nil ? CAR (a) : cell_f;
}
SCM SCM
set_car_x (SCM x, SCM e) set_car_x (SCM x, SCM e)
{ {