diff --git a/mes/module/mes/scm.mes b/mes/module/mes/scm.mes index 0c994714..bc58b53c 100644 --- a/mes/module/mes/scm.mes +++ b/mes/module/mes/scm.mes @@ -108,11 +108,6 @@ (define assv assq) (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) (let ((entry (assoc key alist))) (if entry (cdr entry) diff --git a/src/mes.c b/src/mes.c index 9e570b94..f4f8686d 100644 --- a/src/mes.c +++ b/src/mes.c @@ -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; } +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 list_to_symbol (SCM s) { @@ -857,6 +865,16 @@ assq (SCM x, SCM a) 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 set_car_x (SCM x, SCM e) {