conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add (picrin list) and (picrin base list)

This commit is contained in:
Yuichi Nishiwaki 2014-08-06 02:07:02 +09:00
parent f70b6c5240
commit bc47968ea1
6 changed files with 81 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
piclib/CMakeLists.txt
View File

@ -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

14
piclib/picrin/base.scm
View File

@ -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!

5
piclib/picrin/macro.scm
View File

@ -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))

30
piclib/scheme/base.scm
View File

@ -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

11
src/codegen.c
View File

@ -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, "*");

59
src/pair.c
View File

@ -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);
}
}