diff --git a/TODO b/TODO index e37e1be8..40f9f43c 100644 --- a/TODO +++ b/TODO @@ -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 diff --git a/scm.mes b/scm.mes index 214d26e1..9f8ce9b3 100755 --- a/scm.mes +++ b/scm.mes @@ -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) diff --git a/test.mes b/test.mes index 23e126df..a4d0567a 100644 --- a/test.mes +++ b/test.mes @@ -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?)