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

rename assoc to assq.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-11 10:48:25 +02:00
parent 081cb4a94f
commit 1621cfd284
5 changed files with 28 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
TODO
View file

@ -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

4
loop2.mes
View file

@ -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

20
mes.c
View file

@ -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

16
mes.mes
View file

@ -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))

14
mes.scm
View file

@ -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))