From bc47968ea1a03edc4fa68609607700183b6fe3ba Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 6 Aug 2014 02:07:02 +0900 Subject: [PATCH] add (picrin list) and (picrin base list) --- piclib/CMakeLists.txt | 2 ++ piclib/picrin/base.scm | 14 +++++----- piclib/picrin/macro.scm | 5 ++-- piclib/scheme/base.scm | 30 +++++++++++++++++++++ src/codegen.c | 11 ++++---- src/pair.c | 59 ++++++++++++++++++++++------------------- 6 files changed, 81 insertions(+), 40 deletions(-) diff --git a/piclib/CMakeLists.txt b/piclib/CMakeLists.txt index be0664d6..3d08eb27 100644 --- a/piclib/CMakeLists.txt +++ b/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 diff --git a/piclib/picrin/base.scm b/piclib/picrin/base.scm index 15aca1cf..b7174be3 100644 --- a/piclib/picrin/base.scm +++ b/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) - (car (cadr form)) - (cons (make-identifier 'lambda mac-env) - (cons (cdr (cadr form)) - (cddr form))))))) + (cons (make-identifier 'define mac-env) + (cons (car (car (cdr form))) + (cons (cons (make-identifier 'lambda mac-env) + (cons (cdr (car (cdr form))) + (cdr (cdr form)))) + '())))))) (export define set! diff --git a/piclib/picrin/macro.scm b/piclib/picrin/macro.scm index 9c0471ac..016fa95d 100644 --- a/piclib/picrin/macro.scm +++ b/piclib/picrin/macro.scm @@ -1,8 +1,9 @@ ;;; Hygienic Macros (define-library (picrin macro) - (import (picrin base) - (picrin base macro) + (import (picrin base macro) + (picrin base) + (picrin list) (scheme base) (picrin dictionary)) diff --git a/piclib/scheme/base.scm b/piclib/scheme/base.scm index a8041eed..39ddfe2c 100644 --- a/piclib/scheme/base.scm +++ b/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 diff --git a/src/codegen.c b/src/codegen.c index 63c7a2c9..b8023e5c 100644 --- a/src/codegen.c +++ b/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, rCAR, stdlib, "car"); - register_renamed_symbol(pic, state, rCDR, stdlib, "cdr"); - register_renamed_symbol(pic, state, rNILP, stdlib, "null?"); + register_renamed_symbol(pic, state, rCONS, listlib, "cons"); + register_renamed_symbol(pic, state, rCAR, listlib, "car"); + register_renamed_symbol(pic, state, rCDR, listlib, "cdr"); + 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, "*"); diff --git a/src/pair.c b/src/pair.c index f2960adb..d8bb8d70 100644 --- a/src/pair.c +++ b/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_defun(pic, "cons", pic_pair_cons); - pic_defun(pic, "car", pic_pair_car); - pic_defun(pic, "cdr", pic_pair_cdr); - pic_defun(pic, "set-car!", pic_pair_set_car); - pic_defun(pic, "set-cdr!", pic_pair_set_cdr); - pic_defun(pic, "caar", pic_pair_caar); - pic_defun(pic, "cadr", pic_pair_cadr); - pic_defun(pic, "cdar", pic_pair_cdar); - pic_defun(pic, "cddr", pic_pair_cddr); - pic_defun(pic, "null?", pic_pair_null_p); - pic_defun(pic, "list?", pic_pair_list_p); - pic_defun(pic, "make-list", pic_pair_make_list); - pic_defun(pic, "list", pic_pair_list); - pic_defun(pic, "length", pic_pair_length); - pic_defun(pic, "append", pic_pair_append); - pic_defun(pic, "reverse", pic_pair_reverse); - pic_defun(pic, "list-tail", pic_pair_list_tail); - pic_defun(pic, "list-ref", pic_pair_list_ref); - pic_defun(pic, "list-set!", pic_pair_list_set); - pic_defun(pic, "list-copy", pic_pair_list_copy); - pic_defun(pic, "memq", pic_pair_memq); - 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); + pic_deflibrary (pic, "(picrin base list)") { + pic_defun(pic, "pair?", pic_pair_pair_p); + pic_defun(pic, "cons", pic_pair_cons); + pic_defun(pic, "car", pic_pair_car); + pic_defun(pic, "cdr", pic_pair_cdr); + pic_defun(pic, "set-car!", pic_pair_set_car); + pic_defun(pic, "set-cdr!", pic_pair_set_cdr); + pic_defun(pic, "null?", pic_pair_null_p); + } + + pic_deflibrary (pic, "(picrin list)") { + pic_defun(pic, "caar", pic_pair_caar); + pic_defun(pic, "cadr", pic_pair_cadr); + pic_defun(pic, "cdar", pic_pair_cdar); + pic_defun(pic, "cddr", pic_pair_cddr); + pic_defun(pic, "list?", pic_pair_list_p); + pic_defun(pic, "make-list", pic_pair_make_list); + pic_defun(pic, "list", pic_pair_list); + pic_defun(pic, "length", pic_pair_length); + pic_defun(pic, "append", pic_pair_append); + pic_defun(pic, "reverse", pic_pair_reverse); + pic_defun(pic, "list-tail", pic_pair_list_tail); + pic_defun(pic, "list-ref", pic_pair_list_ref); + pic_defun(pic, "list-set!", pic_pair_list_set); + pic_defun(pic, "list-copy", pic_pair_list_copy); + pic_defun(pic, "memq", pic_pair_memq); + 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); + } }