add equal?, member, for-each.

This commit is contained in:
Jan Nieuwenhuizen 2016-07-17 22:35:00 +02:00
parent 59cdf9632f
commit bba631edcd
4 changed files with 28 additions and 26 deletions

16
TODO
View file

@ -12,8 +12,6 @@
** run PEG
** parse C using PEG
http://piumarta.com/software/peg/
** missing
member (using equal?)
** implement core primitives: DONE
begin
define
@ -29,7 +27,7 @@ v #(v e c t o r)
v assq
v call-with-values
v char?
for-each
v for-each
v length
v list
v list->vector
@ -48,12 +46,16 @@ v vector-ref
v vector-set!
v vector?
v procedure?
*** any, each?
*** hook-up sc-expand, see guile-1.0?: scheme:eval-transformer
*** implement extras:
v (gensym)
** implement minimal needed for define-macro-based define-syntax
v char?
v assq
v define-macro
equal?
member
v equal?
v member
v let loop
v nested define-macro
v nested define
@ -64,7 +66,3 @@ v string->symbol
v and
v or
v ,@ unquote-splicing
** any, each?
** implement extras:
v (gensym)
** hook-up sc-expand, see guile-1.0?: scheme:eval-transformer

17
scm.mes
View file

@ -26,6 +26,13 @@
(define-macro (begin . rest)
`((lambda () ,@rest)))
(define (equal? a b) ;; FIXME: only 2 arg
(cond ((and (null? a) (null? b)) #t)
((and (pair? a) (pair? b))
(and (equal? (car a) (car b))
(equal? (cdr a) (cdr b))))
(#t (eq? a b))))
(define (vector . rest) (list->vector rest))
(define (apply f args)
@ -46,6 +53,11 @@
(#t (memq x (cdr lst)))))
(define memv memq)
(define (member x lst)
(cond ((null? lst) #f)
((equal? x (car lst)) lst)
(#t (member x (cdr lst)))))
(define-macro (or2 x y)
`(cond (,x ,x) (#t ,y)))
@ -105,6 +117,11 @@
((null? (cdr r))
(cons (f (car l) (caar r)) (map f (cdr l) (cdar r))))))
(define (identity x) x)
(define (for-each f l . r)
(apply map (cons f (cons l r)))
*unspecified*)
(define (not x)
(cond (x #f)
(#t #t)))

View file

@ -7,23 +7,6 @@
;;(display thing)
(newline))
(define (member x lst)
(display "MEMBER x=") (display x)
(display " lst=") (display lst)
(display " => ") (display (memq x lst))
(newline)
(memq x lst))
(display "mes:define-syntax...")
(define (equal? a b) ;; FIXME: only 2 arg + broken for lists
(display "EQUAL? a=") (display a)
(display " b=") (display b) (newline)
;;(eq? a b)
(cond ((and (null? a) (null? b)) #t)
((and (pair? a) (pair? b))
(and (equal? (car a) (car b))
(equal? (cdr a) (cdr b))))
(#t (eq? a b))))
(display "mes:define-syntax...")
;;(define (caddr x) (car (cdr (cdr x))))

View file

@ -259,6 +259,10 @@
(display (memq 'd '(a b c)))
(newline)
(display "member a: ")
(display (member '(a) '((a) b c)))
(newline)
(display "plus: ")
(display (+ 1 1 1 1))
(newline)