From 973ce046f5b0de5d111a43e1c6fe1e0dc19fa6cf Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Fri, 19 Aug 2016 23:50:06 -0400
Subject: [PATCH] Added member/assoc scheme functions

---
 scheme/base.sld | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/scheme/base.sld b/scheme/base.sld
index eb25bf0a..bc0019ec 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -9,6 +9,12 @@
 (define-library (scheme base)
   (import (scheme cyclone common))
   (export
+    member
+    memv
+    memq
+    assoc
+    assv
+    assq
     cons-source
     syntax-rules
     letrec*
@@ -533,6 +539,33 @@
     (define (string>=? str1 str2) (>= (string-cmp str1 str2) 0))
     ; TODO: generalize to multiple arguments: (define (string<? str1 str2 . strs)
 
+    (define (member-helper obj lst cmp-proc)
+     (cond 
+       ((null? lst) #f)
+       ((cmp-proc obj (car lst)) lst)
+       (else (member-helper obj (cdr lst) cmp-proc))))
+    (define (member obj lst . compare) 
+        (if (pair? compare)
+            (member-helper obj lst (car compare))
+            (member-helper obj lst equal?)))
+    (define (memq obj lst) (member-helper obj lst eq?))
+    (define (memv obj lst) (member-helper obj lst eqv?))
+    
+    (define (assoc-helper obj lst cmp?)
+     (cond 
+       ((null? lst) #f)
+       ((and (pair? (car lst))
+             (cmp? obj (car (car lst))))
+        (car lst))
+       (else (assoc-helper obj (cdr lst) cmp?))))
+      
+    (define (assoc obj alist . compare)
+        (if (pair? compare)
+            (assoc-helper obj alist (car compare))
+            (assoc-helper obj alist equal?)))
+    (define (assq obj alist) (assoc-helper obj alist eq?))
+    (define (assv obj alist) (assoc-helper obj alist eqv?))
+
     (define (foldl func accum lst)
       (if (null? lst)
         accum