scm.mes: add assq-set!, assq-ref.

This commit is contained in:
Jan Nieuwenhuizen 2016-07-23 01:38:25 +02:00
parent e63f3b2ee4
commit 5105f1e516
3 changed files with 29 additions and 3 deletions

10
TODO
View file

@ -7,6 +7,16 @@ Find out how to hook-up sc-expand in eval/apply.
** bugs
See bugs/
** run PEG
*** Simple Guile test:
make guile-peg
*** PEG on Mes does not work yet:
make peg
**** v define-syntax-rule
**** v assq-ref
**** v assq-set!
**** datum->syntax
**** syntax->datum
**** syntax-case
** parse C using PEG
http://piumarta.com/software/peg/
** implement core primitives: DONE

12
scm.mes
View file

@ -107,7 +107,19 @@
((and (pair? p) (eq? (car p) '*lambda*)))
(#t #f)))
(define (assq-set! alist key val)
(let ((entry (assq key alist)))
(cond (entry (set-cdr! entry val)
alist)
(#t (cons (cons key val) alist)))))
(define (assq-ref alist key)
(let ((entry (assq key alist)))
(if entry (cdr entry)
#f)))
(define assv assq)
(define (memq x lst)
(cond ((null? lst) #f)
((eq? x (car lst)) lst)

View file

@ -132,6 +132,10 @@
(pass-if "memq" (sequal? (memq 'b '(a b c)) '(b c)))
(pass-if "memq" (seq? (memq 'd '(a b c)) #f))
(pass-if "member" (sequal? (member '(a) '((a) b c)) '((a) b c)))
(pass-if "assq-ref" (seq? (assq-ref '((b . 1) (c . 2)) 'c) 2))
(pass-if "assq-ref 2" (seq? (assq-ref '((b . 1) (c . 2)) 'a) #f))
(pass-if "assq-set!" (sequal? (assq-set! '((b . 1)) 'a 0) '((a . 0) (b . 1))))
(pass-if "assq-set! 2" (sequal? (assq-set! '((a . 0)) 'a 1) '((a . 1))))
;; works, but debugging is foo
;; (cond ((defined? 'loop2)
@ -191,7 +195,7 @@
(pass-if "closure 3" (sequal? (x) '(0 0)))
(pass-if "closure 4 "
(seq? (begin
(seq? (let ()
(let ((count (let ((counter 0))
(lambda ()
counter))))
@ -200,7 +204,7 @@
(pass-if "closure 5 "
(seq?
(begin
(let ()
(define name? 2)
(define (foo)
(define name? 0)
@ -210,7 +214,7 @@
(pass-if "closure 6 "
(seq?
(begin
(let ()
(define foo
(lambda ()
(define name? symbol?)