scm.mes: add assq-set!, assq-ref.
This commit is contained in:
parent
e63f3b2ee4
commit
5105f1e516
10
TODO
10
TODO
|
@ -7,6 +7,16 @@ Find out how to hook-up sc-expand in eval/apply.
|
||||||
** bugs
|
** bugs
|
||||||
See bugs/
|
See bugs/
|
||||||
** run PEG
|
** 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
|
** parse C using PEG
|
||||||
http://piumarta.com/software/peg/
|
http://piumarta.com/software/peg/
|
||||||
** implement core primitives: DONE
|
** implement core primitives: DONE
|
||||||
|
|
12
scm.mes
12
scm.mes
|
@ -107,7 +107,19 @@
|
||||||
((and (pair? p) (eq? (car p) '*lambda*)))
|
((and (pair? p) (eq? (car p) '*lambda*)))
|
||||||
(#t #f)))
|
(#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 assv assq)
|
||||||
|
|
||||||
(define (memq x lst)
|
(define (memq x lst)
|
||||||
(cond ((null? lst) #f)
|
(cond ((null? lst) #f)
|
||||||
((eq? x (car lst)) lst)
|
((eq? x (car lst)) lst)
|
||||||
|
|
10
test.mes
10
test.mes
|
@ -132,6 +132,10 @@
|
||||||
(pass-if "memq" (sequal? (memq 'b '(a b c)) '(b c)))
|
(pass-if "memq" (sequal? (memq 'b '(a b c)) '(b c)))
|
||||||
(pass-if "memq" (seq? (memq 'd '(a b c)) #f))
|
(pass-if "memq" (seq? (memq 'd '(a b c)) #f))
|
||||||
(pass-if "member" (sequal? (member '(a) '((a) b c)) '((a) b c)))
|
(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
|
;; works, but debugging is foo
|
||||||
;; (cond ((defined? 'loop2)
|
;; (cond ((defined? 'loop2)
|
||||||
|
@ -191,7 +195,7 @@
|
||||||
(pass-if "closure 3" (sequal? (x) '(0 0)))
|
(pass-if "closure 3" (sequal? (x) '(0 0)))
|
||||||
|
|
||||||
(pass-if "closure 4 "
|
(pass-if "closure 4 "
|
||||||
(seq? (begin
|
(seq? (let ()
|
||||||
(let ((count (let ((counter 0))
|
(let ((count (let ((counter 0))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
counter))))
|
counter))))
|
||||||
|
@ -200,7 +204,7 @@
|
||||||
|
|
||||||
(pass-if "closure 5 "
|
(pass-if "closure 5 "
|
||||||
(seq?
|
(seq?
|
||||||
(begin
|
(let ()
|
||||||
(define name? 2)
|
(define name? 2)
|
||||||
(define (foo)
|
(define (foo)
|
||||||
(define name? 0)
|
(define name? 0)
|
||||||
|
@ -210,7 +214,7 @@
|
||||||
|
|
||||||
(pass-if "closure 6 "
|
(pass-if "closure 6 "
|
||||||
(seq?
|
(seq?
|
||||||
(begin
|
(let ()
|
||||||
(define foo
|
(define foo
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(define name? symbol?)
|
(define name? symbol?)
|
||||||
|
|
Loading…
Reference in New Issue