Revert memq, memv, assq, assv back to primitives

include/cyclone/runtime.h

@@ -347,6 +347,10 @@ extern const object primitive_cell;
 extern const object primitive_eq_127;
 extern const object primitive_eqv_127;
 extern const object primitive_equal_127;
+extern const object primitive_assq;
+extern const object primitive_assv;
+extern const object primitive_memq;
+extern const object primitive_memv;
 extern const object primitive_length;
 extern const object primitive_vector_91length;
 extern const object primitive_bytevector_91length;

runtime.c

@@ -3410,6 +3410,30 @@ void _apply(void *data, object cont, object args)
   dispatch(data, obj_obj2int(argc), (function_type)dispatch_apply_va, cont, cont, args);
 }
 
+void _assq(void *data, object cont, object args)
+{
+  Cyc_check_num_args(data, "assq  ", 2, args);
+  return_closcall1(data, cont, assq(data, car(args), cadr(args)));
+}
+
+void _assv(void *data, object cont, object args)
+{
+  Cyc_check_num_args(data, "assv  ", 2, args);
+  return_closcall1(data, cont, assq(data, car(args), cadr(args)));
+}
+
+void _memq(void *data, object cont, object args)
+{
+  Cyc_check_num_args(data, "memq", 2, args);
+  return_closcall1(data, cont, memqp(data, car(args), cadr(args)));
+}
+
+void _memv(void *data, object cont, object args)
+{
+  Cyc_check_num_args(data, "memv", 2, args);
+  return_closcall1(data, cont, memqp(data, car(args), cadr(args)));
+}
+
 void _char_91_125integer(void *data, object cont, object args)
 {
   Cyc_check_num_args(data, "char->integer", 1, args);
@@ -4316,6 +4340,10 @@ static primitive_type eqv_127_primitive =
     { {0}, primitive_tag, "eqv?", &_eqv_127 };
 static primitive_type equal_127_primitive =
     { {0}, primitive_tag, "equal?", &_equal_127 };
+static primitive_type assq_primitive = { {0}, primitive_tag, "assq", &_assq };
+static primitive_type assv_primitive = { {0}, primitive_tag, "assv", &_assv };
+static primitive_type memq_primitive = { {0}, primitive_tag, "memq", &_memq };
+static primitive_type memv_primitive = { {0}, primitive_tag, "memv", &_memv };
 static primitive_type length_primitive =
     { {0}, primitive_tag, "length", &_length };
 static primitive_type bytevector_91length_primitive =
@@ -4539,6 +4567,10 @@ const object primitive_cell = &cell_primitive;
 const object primitive_eq_127 = &eq_127_primitive;
 const object primitive_eqv_127 = &eqv_127_primitive;
 const object primitive_equal_127 = &equal_127_primitive;
+const object primitive_assq = &assq_primitive;
+const object primitive_assv = &assv_primitive;
+const object primitive_memq = &memq_primitive;
+const object primitive_memv = &memv_primitive;
 const object primitive_length = &length_primitive;
 const object primitive_bytevector_91length = &bytevector_91length_primitive;
 const object primitive_vector_91length = &vector_91length_primitive;

scheme/base.sld

@@ -10,11 +10,11 @@
   (import (scheme cyclone common))
   (export
     member
-    memv
+    ;memv
-    memq
+    ;memq
     assoc
-    assv
+    ;assv
-    assq
+    ;assq
     cons-source
     syntax-rules
     letrec*
@@ -542,8 +542,8 @@
         (if (pair? compare)
             (member-helper obj lst (car compare))
             (member-helper obj lst equal?)))
-    (define (memq obj lst) (member-helper obj lst eq?))
+    ;(define (memq obj lst) (member-helper obj lst eq?))
-    (define (memv obj lst) (member-helper obj lst eqv?))
+    ;(define (memv obj lst) (member-helper obj lst eqv?))
     
     (define (assoc-helper obj lst cmp?)
      (cond 
@@ -557,8 +557,8 @@
         (if (pair? compare)
             (assoc-helper obj alist (car compare))
             (assoc-helper obj alist equal?)))
-    (define (assq obj alist) (assoc-helper obj alist eq?))
+    ;(define (assq obj alist) (assoc-helper obj alist eq?))
-    (define (assv obj alist) (assoc-helper obj alist eqv?))
+    ;(define (assv obj alist) (assoc-helper obj alist eqv?))
 
     (define (foldl func accum lst)
       (if (null? lst)

scheme/cyclone/primitives.sld

@@ -97,12 +97,11 @@
          eqv?
          equal?
          Cyc-fast-member
-         ;assoc
+         Cyc-fast-assoc
-         ;assq
+         assv
-         ;assv
+         assq
-         ;memq
+         memq
-         ;memv
+         memv
-         ;member
          length
          set-car!
          set-cdr!
@@ -224,12 +223,11 @@
          (eqv? 2 2)
          (equal? 2 2)
          (Cyc-fast-member 2 2)
-         ;(assoc 2 2)
+         (Cyc-fast-assoc 2 2)
-         ;(assq 2 2)
+         (assq 2 2)
-         ;(assv 2 2)
+         (assv 2 2)
-         ;(memq 2 2)
+         (memq 2 2)
-         ;(memv 2 2)
+         (memv 2 2)
-         ;(member 2 2)
          (length 1 1)
          (set-car! 2 2)
          (set-cdr! 2 2)
@@ -531,6 +529,11 @@
          ((eq? p 'eqv?)          "Cyc_eq")
          ((eq? p 'equal?)        "equalp")
          ((eq? p 'Cyc-fast-member)  "memberp")
+         ((eq? p 'Cyc-fast-assoc)   "assoc")
+         ((eq? p 'assq)          "assq")
+         ((eq? p 'assv)          "assq")
+         ((eq? p 'memq)          "memqp")
+         ((eq? p 'memv)          "memqp")
          ((eq? p 'boolean?)      "Cyc_is_boolean")
          ((eq? p 'char?)         "Cyc_is_char")
          ((eq? p 'null?)         "Cyc_is_null")
@@ -576,6 +579,7 @@
         >=
         <=
         Cyc-fast-member
+        Cyc-fast-assoc
         apply
         car
         cdr
@@ -627,11 +631,11 @@
         Cyc-installation-dir
         Cyc-compilation-environment
         command-line-arguments
-        ;assq
+        assq
-        ;assv
+        assv
         ;assoc
-        ;memq
+        memq
-        ;memv
+        memv
         ;member
         length
         set-car!

scheme/eval.sld

@@ -199,12 +199,12 @@
       (list 'eq? eq?)
       (list 'eqv? eqv?)
       (list 'equal? equal?)
-      ;(list 'assoc assoc)
+      ;(list 'Cyc-fast-assoc Cyc-fast-assoc)
-      ;(list 'assq assq)
+      (list 'assq assq)
-      ;(list 'assv assv)
+      (list 'assv assv)
-      ;(list 'memq memq)
+      (list 'memq memq)
-      ;(list 'memv memv)
+      (list 'memv memv)
-      ;(list 'member member)
+      ;(list 'Cyc-fast-member Cyc-fast-member)
       (list 'length length)
       (list 'set-car! set-car!)
       (list 'set-cdr! set-cdr!)