diff --git a/TODO b/TODO index 6adbe13b..6be3f626 100644 --- a/TODO +++ b/TODO @@ -12,7 +12,7 @@ set! v "string" v #(v e c t o r) #\CHAR -assq +v assq call-with-values v char? v length diff --git a/loop2.mes b/loop2.mes index b33dcc50..a61e4076 100644 --- a/loop2.mes +++ b/loop2.mes @@ -28,7 +28,7 @@ (define (scm-define-macro x a) (cons '*macro* (cons (cons (caadr e) (cons 'lambda (cons (cdadr e) (cddr e)))) - (cdr (assoc '*macro* a))))) + (cdr (assq '*macro* a))))) (define (loop2 r e a) ;; (display '____loop2) @@ -47,7 +47,7 @@ ((eq? (car e) 'define-macro) (loop2 *unspecified* (readenv a) (cons (scm-define-macro e a) a))) ((eq? (car e) 'set!) - (loop2 (set-cdr! (assoc (cadr e) a) (eval (caddr e) a)) (readenv a) a)) + (loop2 (set-cdr! (assq (cadr e) a) (eval (caddr e) a)) (readenv a) a)) (#t (loop2 (eval e a) (readenv a) a)))) EOF diff --git a/mes.c b/mes.c index feb59c35..19adb534 100644 --- a/mes.c +++ b/mes.c @@ -182,13 +182,13 @@ set_cdr_x (scm *x, scm *e) scm * set_x (scm *x, scm *e, scm *a) { - return set_cdr_x (assoc (x, a), e); + return set_cdr_x (assq (x, a), e); } scm * set_env_x (scm *x, scm *e, scm *a) { - return set_cdr_x (assoc (x, a), e); + return set_cdr_x (assq (x, a), e); } scm * @@ -244,7 +244,7 @@ pairlis (scm *x, scm *y, scm *a) } scm * -assoc (scm *x, scm *a) +assq (scm *x, scm *a) { if (a == &scm_nil) { #if DEBUG @@ -254,7 +254,7 @@ assoc (scm *x, scm *a) } if (eq_p (caar (a), x) == &scm_t) return car (a); - return assoc (x, cdr (a)); + return assq (x, cdr (a)); } scm * @@ -315,7 +315,7 @@ eval_ (scm *e, scm *a) else if (e->type == VECTOR) return e; else if (atom_p (e) == &scm_t) { - scm *y = assoc (e, a); + scm *y = assq (e, a); if (y == &scm_f) { printf ("eval: no such symbol: %s\n", e->name); exit (1); @@ -353,7 +353,7 @@ eval_ (scm *e, scm *a) else if (car (e) == &scm_symbol_cond) return evcon (cdr (e), a); #if MACROS - else if ((macro = assoc (car (e), cdr (assoc (&scm_macro, a)))) != &scm_f) + else if ((macro = assq (car (e), cdr (assq (&scm_macro, a)))) != &scm_f) return eval (apply_ (cdr (macro), cdr (e), a), a); #endif // MACROS return apply (car (e), evlis (cdr (e), a), a); @@ -1069,13 +1069,13 @@ define_macro (scm *x, scm *a) printf ("\nc:define_macro a="); scm *aa =cons (&scm_macro, cons (define_lambda (x), - cdr (assoc (&scm_macro, a)))); + cdr (assq (&scm_macro, a)))); display (aa); puts (""); #endif return cons (&scm_macro, cons (define_lambda (x), - cdr (assoc (&scm_macro, a)))); + cdr (assq (&scm_macro, a)))); } scm * @@ -1089,7 +1089,7 @@ loop (scm *r, scm *e, scm *a) if (e == &scm_nil) return r; else if (eq_p (e, &scm_symbol_EOF) == &scm_t) - return apply (cdr (assoc (&scm_symbol_loop2, a)), + return apply (cdr (assq (&scm_symbol_loop2, a)), cons (&scm_unspecified, cons (&scm_t, cons (a, &scm_nil))), a); else if (eq_p (e, &scm_symbol_EOF2) == &scm_t) return r; @@ -1143,7 +1143,7 @@ eval (scm *e, scm *a) puts (""); #endif - scm *eval__ = assoc (&scm_symbol_eval, a); + scm *eval__ = assq (&scm_symbol_eval, a); assert (eval__ != &scm_f); eval__ = cdr (eval__); if (builtin_p (eval__) == &scm_t diff --git a/mes.mes b/mes.mes index b9edfd8f..ee19daf1 100644 --- a/mes.mes +++ b/mes.mes @@ -41,13 +41,13 @@ ;; (#t (cons (cons (car x) (car y)) ;; (pairlis (cdr x) (cdr y) a))))) -;; (define (assoc x a) -;; ;;(stderr "assoc x=~a\n" x) -;; ;;(debug "assoc x=~a a=~a\n" x a) +;; (define (assq x a) +;; ;;(stderr "assq x=~a\n" x) +;; ;;(debug "assq x=~a a=~a\n" x a) ;; (cond ;; ((null? a) #f) ;; ((eq? (caar a) x) (car a)) -;; (#t (assoc x (cdr a))))) +;; (#t (assq x (cdr a))))) ;; ;; Page 13 ;; (define (eval-quote fn x) @@ -109,7 +109,7 @@ (begin-env (cdr body) a)))) (define (set-env! x e a) - (set-cdr! (assoc x a) e)) + (set-cdr! (assq x a) e)) (define (eval e a) ;;(debug "eval e=~a a=~a\n" e a) @@ -127,7 +127,7 @@ ((number? e) e) ((string? e) e) ((vector? e) e) - ((atom? e) (cdr (assoc e a))) + ((atom? e) (cdr (assq e a))) ((builtin? e) e) ((atom? (car e)) (cond @@ -137,10 +137,10 @@ ((eq? (car e) 'unquote) (eval (cadr e) a)) ((eq? (car e) 'quasiquote) (eval-quasiquote (cadr e) a)) ((eq? (car e) 'cond) (evcon (cdr e) a)) - ((pair? (assoc (car e) (cdr (assoc '*macro* a)))) + ((pair? (assq (car e) (cdr (assq '*macro* a)))) (c:eval (c:apply - (cdr (assoc (car e) (cdr (assoc '*macro* a)))) + (cdr (assq (car e) (cdr (assq '*macro* a)))) (cdr e) a) a)) diff --git a/mes.scm b/mes.scm index f882c87e..e7bf3480 100755 --- a/mes.scm +++ b/mes.scm @@ -108,13 +108,13 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@" (#t (cons (cons (car x) (car y)) (pairlis (cdr x) (cdr y) a))))) -(define (assoc x a) - ;;(stderr "assoc x=~a\n" x) - ;;(debug "assoc x=~a a=~a\n" x a) +(define (assq x a) + ;;(stderr "assq x=~a\n" x) + ;;(debug "assq x=~a a=~a\n" x a) (cond ((null? a) #f) ((eq? (caar a) x) (car a)) - (#t (assoc x (cdr a))))) + (#t (assq x (cdr a))))) (define (append x y) (cond ((null? x) y) @@ -153,7 +153,7 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@" (evlis . ,evlis) (evcon . ,evcon) (pairlis . ,pairlis) - (assoc . ,assoc) + (assq . ,assq) (eval . ,eval-environment) (apply . ,apply-environment) @@ -200,12 +200,12 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@" (define (mes-define-macro x a) (cons '*macro* (cons (mes-define-lambda x a) - (cdr (assoc '*macro* a))))) + (cdr (assq '*macro* a))))) (define (loop r e a) (cond ((null? e) r) ((eq? e 'exit) - (apply (cdr (assoc 'loop a)) + (apply (cdr (assq 'loop a)) (cons *unspecified* (cons #t (cons a '()))) a)) ((atom? e) (loop (eval e a) (readenv a) a))