From bba631edcd3966b2cc04dd05f6499afcd5f1cbbd Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sun, 17 Jul 2016 22:35:00 +0200
Subject: [PATCH] add equal?, member, for-each.

---
 TODO       | 16 +++++++---------
 scm.mes    | 17 +++++++++++++++++
 syntax.mes | 17 -----------------
 test.mes   |  4 ++++
 4 files changed, 28 insertions(+), 26 deletions(-)

diff --git a/TODO b/TODO
index d0cfd1f6..0247dc36 100644
--- a/TODO
+++ b/TODO
@@ -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
diff --git a/scm.mes b/scm.mes
index 32e11d0c..419d0295 100755
--- a/scm.mes
+++ b/scm.mes
@@ -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)))
diff --git a/syntax.mes b/syntax.mes
index 1b33cd26..914bb1cb 100644
--- a/syntax.mes
+++ b/syntax.mes
@@ -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))))
diff --git a/test.mes b/test.mes
index 7df3dd29..991a1139 100644
--- a/test.mes
+++ b/test.mes
@@ -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)