add (picrin list) and (picrin base list)

piclib/CMakeLists.txt

@@ -1,6 +1,8 @@
 list(APPEND PICLIB_SCHEME_LIBS
   ${PROJECT_SOURCE_DIR}/piclib/picrin/base.scm
+  ${PROJECT_SOURCE_DIR}/piclib/picrin/list.scm
   ${PROJECT_SOURCE_DIR}/piclib/picrin/macro.scm
+
   ${PROJECT_SOURCE_DIR}/piclib/scheme/base.scm
 
   ${PROJECT_SOURCE_DIR}/piclib/picrin/array.scm

piclib/picrin/base.scm

@@ -1,17 +1,19 @@
 (define-library (picrin base)
   (import (rename (picrin base core) (define define*))
           (picrin base macro)
+          (picrin base list)
           (scheme base))
 
   (define-syntax define
     (lambda (form use-env mac-env)
-      (if (symbol? (cadr form))
+      (if (symbol? (car (cdr form)))
           (cons (make-identifier 'define* mac-env) (cdr form))
-          (list (make-identifier 'define mac-env)
+          (cons (make-identifier 'define mac-env)
-                (car (cadr form))
+                (cons (car (car (cdr form)))
-                (cons (make-identifier 'lambda mac-env)
+                      (cons (cons (make-identifier 'lambda mac-env)
-                      (cons (cdr (cadr form))
+                                  (cons (cdr (car (cdr form)))
-                            (cddr form)))))))
+                                        (cdr (cdr form))))
+                            '()))))))
 
   (export define
           set!

piclib/picrin/macro.scm

@@ -1,8 +1,9 @@
 ;;; Hygienic Macros
 
 (define-library (picrin macro)
-  (import (picrin base)
+  (import (picrin base macro)
-          (picrin base macro)
+          (picrin base)
+          (picrin list)
           (scheme base)
           (picrin dictionary))
 

piclib/scheme/base.scm

@@ -1,5 +1,6 @@
 (define-library (scheme base)
   (import (picrin base)
+          (picrin list)
           (picrin macro))
 
   (export define set! lambda quote
@@ -811,6 +812,35 @@
 
   (export define-record-type)
 
+  ;; 6.4 Pairs and lists
+
+  (export pair?
+          cons
+          car
+          cdr
+          set-car!
+          set-cdr!
+          null?
+          caar
+          cadr
+          cdar
+          cddr
+          list?
+          make-list
+          list
+          length
+          append
+          reverse
+          list-tail
+          list-ref
+          list-set!
+          list-copy
+          memq
+          memv
+          member
+          assq
+          assv
+          assoc)
 
   ;; 6.6 Characters
 

src/codegen.c

@@ -62,19 +62,20 @@ new_analyze_state(pic_state *pic)
 {
   analyze_state *state;
   xh_iter it;
-  struct pic_lib *stdlib;
+  struct pic_lib *stdlib, *listlib;
 
   state = pic_alloc(pic, sizeof(analyze_state));
   state->pic = pic;
   state->scope = NULL;
 
   stdlib = pic_find_library(pic, pic_read_cstr(pic, "(scheme base)"));
+  listlib = pic_find_library(pic, pic_read_cstr(pic, "(picrin base list)"));
 
   /* native VM procedures */
-  register_renamed_symbol(pic, state, rCONS, stdlib, "cons");
+  register_renamed_symbol(pic, state, rCONS, listlib, "cons");
-  register_renamed_symbol(pic, state, rCAR, stdlib, "car");
+  register_renamed_symbol(pic, state, rCAR, listlib, "car");
-  register_renamed_symbol(pic, state, rCDR, stdlib, "cdr");
+  register_renamed_symbol(pic, state, rCDR, listlib, "cdr");
-  register_renamed_symbol(pic, state, rNILP, stdlib, "null?");
+  register_renamed_symbol(pic, state, rNILP, listlib, "null?");
   register_renamed_symbol(pic, state, rADD, stdlib, "+");
   register_renamed_symbol(pic, state, rSUB, stdlib, "-");
   register_renamed_symbol(pic, state, rMUL, stdlib, "*");

src/pair.c

@@ -732,31 +732,36 @@ pic_pair_assoc(pic_state *pic)
 void
 pic_init_pair(pic_state *pic)
 {
-  pic_defun(pic, "pair?", pic_pair_pair_p);
+  pic_deflibrary (pic, "(picrin base list)") {
-  pic_defun(pic, "cons", pic_pair_cons);
+    pic_defun(pic, "pair?", pic_pair_pair_p);
-  pic_defun(pic, "car", pic_pair_car);
+    pic_defun(pic, "cons", pic_pair_cons);
-  pic_defun(pic, "cdr", pic_pair_cdr);
+    pic_defun(pic, "car", pic_pair_car);
-  pic_defun(pic, "set-car!", pic_pair_set_car);
+    pic_defun(pic, "cdr", pic_pair_cdr);
-  pic_defun(pic, "set-cdr!", pic_pair_set_cdr);
+    pic_defun(pic, "set-car!", pic_pair_set_car);
-  pic_defun(pic, "caar", pic_pair_caar);
+    pic_defun(pic, "set-cdr!", pic_pair_set_cdr);
-  pic_defun(pic, "cadr", pic_pair_cadr);
+    pic_defun(pic, "null?", pic_pair_null_p);
-  pic_defun(pic, "cdar", pic_pair_cdar);
+  }
-  pic_defun(pic, "cddr", pic_pair_cddr);
+
-  pic_defun(pic, "null?", pic_pair_null_p);
+  pic_deflibrary (pic, "(picrin list)") {
-  pic_defun(pic, "list?", pic_pair_list_p);
+    pic_defun(pic, "caar", pic_pair_caar);
-  pic_defun(pic, "make-list", pic_pair_make_list);
+    pic_defun(pic, "cadr", pic_pair_cadr);
-  pic_defun(pic, "list", pic_pair_list);
+    pic_defun(pic, "cdar", pic_pair_cdar);
-  pic_defun(pic, "length", pic_pair_length);
+    pic_defun(pic, "cddr", pic_pair_cddr);
-  pic_defun(pic, "append", pic_pair_append);
+    pic_defun(pic, "list?", pic_pair_list_p);
-  pic_defun(pic, "reverse", pic_pair_reverse);
+    pic_defun(pic, "make-list", pic_pair_make_list);
-  pic_defun(pic, "list-tail", pic_pair_list_tail);
+    pic_defun(pic, "list", pic_pair_list);
-  pic_defun(pic, "list-ref", pic_pair_list_ref);
+    pic_defun(pic, "length", pic_pair_length);
-  pic_defun(pic, "list-set!", pic_pair_list_set);
+    pic_defun(pic, "append", pic_pair_append);
-  pic_defun(pic, "list-copy", pic_pair_list_copy);
+    pic_defun(pic, "reverse", pic_pair_reverse);
-  pic_defun(pic, "memq", pic_pair_memq);
+    pic_defun(pic, "list-tail", pic_pair_list_tail);
-  pic_defun(pic, "memv", pic_pair_memv);
+    pic_defun(pic, "list-ref", pic_pair_list_ref);
-  pic_defun(pic, "member", pic_pair_member);
+    pic_defun(pic, "list-set!", pic_pair_list_set);
-  pic_defun(pic, "assq", pic_pair_assq);
+    pic_defun(pic, "list-copy", pic_pair_list_copy);
-  pic_defun(pic, "assv", pic_pair_assv);
+    pic_defun(pic, "memq", pic_pair_memq);
-  pic_defun(pic, "assoc", pic_pair_assoc);
+    pic_defun(pic, "memv", pic_pair_memv);
+    pic_defun(pic, "member", pic_pair_member);
+    pic_defun(pic, "assq", pic_pair_assq);
+    pic_defun(pic, "assv", pic_pair_assv);
+    pic_defun(pic, "assoc", pic_pair_assoc);
+  }
 }