From 261c592d79f1a254e0df36415a7b043d24449bdc Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 6 Aug 2014 01:14:43 +0900 Subject: [PATCH 1/3] move core syntaxes from (scheme base) to (picrin base core) --- piclib/picrin/macro.scm | 3 ++- piclib/scheme/base.scm | 6 +++++- src/init.c | 7 +++---- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/piclib/picrin/macro.scm b/piclib/picrin/macro.scm index d798df0f..7f9ab9e4 100644 --- a/piclib/picrin/macro.scm +++ b/piclib/picrin/macro.scm @@ -1,7 +1,8 @@ ;;; Hygienic Macros (define-library (picrin macro) - (import (scheme base) + (import (picrin base core) + (scheme base) (picrin dictionary)) ;; assumes no derived expressions are provided yet diff --git a/piclib/scheme/base.scm b/piclib/scheme/base.scm index 66fbe867..86d7a92e 100644 --- a/piclib/scheme/base.scm +++ b/piclib/scheme/base.scm @@ -1,5 +1,9 @@ (define-library (scheme base) - (import (picrin macro)) + (import (picrin base core) + (picrin macro)) + + (export define set! lambda quote + if begin define-syntax) ;; core syntax diff --git a/src/init.c b/src/init.c index f9c8dba8..c1b573db 100644 --- a/src/init.c +++ b/src/init.c @@ -62,10 +62,7 @@ pic_init_core(pic_state *pic) { size_t ai = pic_gc_arena_preserve(pic); - pic_deflibrary (pic, "(scheme base)") { - - /* load core syntaces */ - pic->lib->env = pic_null_syntactic_environment(pic); + pic_deflibrary (pic, "(picrin base core)") { pic_define_syntactic_keyword(pic, pic->lib->env, pic->sDEFINE, pic->rDEFINE); pic_define_syntactic_keyword(pic, pic->lib->env, pic->sSETBANG, pic->rSETBANG); pic_define_syntactic_keyword(pic, pic->lib->env, pic->sQUOTE, pic->rQUOTE); @@ -73,7 +70,9 @@ pic_init_core(pic_state *pic) pic_define_syntactic_keyword(pic, pic->lib->env, pic->sIF, pic->rIF); pic_define_syntactic_keyword(pic, pic->lib->env, pic->sBEGIN, pic->rBEGIN); pic_define_syntactic_keyword(pic, pic->lib->env, pic->sDEFINE_SYNTAX, pic->rDEFINE_SYNTAX); + } + pic_deflibrary (pic, "(scheme base)") { pic_init_bool(pic); DONE; pic_init_pair(pic); DONE; pic_init_port(pic); DONE; From 610e1013f761799e88e2a6b5e44f5ae545e192b2 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 6 Aug 2014 01:16:37 +0900 Subject: [PATCH 2/3] add (picrin base) library --- piclib/CMakeLists.txt | 1 + piclib/picrin/base.scm | 10 ++++++++++ piclib/picrin/macro.scm | 2 +- piclib/scheme/base.scm | 2 +- 4 files changed, 13 insertions(+), 2 deletions(-) create mode 100644 piclib/picrin/base.scm diff --git a/piclib/CMakeLists.txt b/piclib/CMakeLists.txt index 7da6043b..be0664d6 100644 --- a/piclib/CMakeLists.txt +++ b/piclib/CMakeLists.txt @@ -1,4 +1,5 @@ list(APPEND PICLIB_SCHEME_LIBS + ${PROJECT_SOURCE_DIR}/piclib/picrin/base.scm ${PROJECT_SOURCE_DIR}/piclib/picrin/macro.scm ${PROJECT_SOURCE_DIR}/piclib/scheme/base.scm diff --git a/piclib/picrin/base.scm b/piclib/picrin/base.scm new file mode 100644 index 00000000..34522c9f --- /dev/null +++ b/piclib/picrin/base.scm @@ -0,0 +1,10 @@ +(define-library (picrin base) + (import (picrin base core)) + + (export define + set! + quote + lambda + if + begin + define-syntax)) diff --git a/piclib/picrin/macro.scm b/piclib/picrin/macro.scm index 7f9ab9e4..7e2c8ff2 100644 --- a/piclib/picrin/macro.scm +++ b/piclib/picrin/macro.scm @@ -1,7 +1,7 @@ ;;; Hygienic Macros (define-library (picrin macro) - (import (picrin base core) + (import (picrin base) (scheme base) (picrin dictionary)) diff --git a/piclib/scheme/base.scm b/piclib/scheme/base.scm index 86d7a92e..a8041eed 100644 --- a/piclib/scheme/base.scm +++ b/piclib/scheme/base.scm @@ -1,5 +1,5 @@ (define-library (scheme base) - (import (picrin base core) + (import (picrin base) (picrin macro)) (export define set! lambda quote From 1d42771b54577a04990fde5bfbfd3b6b28dc2d05 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 6 Aug 2014 01:34:07 +0900 Subject: [PATCH 3/3] define 'define' as a user-level macro --- piclib/picrin/base.scm | 14 +++++++++++++- src/macro.c | 30 +++++++++--------------------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/piclib/picrin/base.scm b/piclib/picrin/base.scm index 34522c9f..d691bfde 100644 --- a/piclib/picrin/base.scm +++ b/piclib/picrin/base.scm @@ -1,5 +1,17 @@ (define-library (picrin base) - (import (picrin base core)) + (import (rename (picrin base core) (define define*)) + (scheme base) + (picrin macro)) + + (define-syntax define + (lambda (form use-env mac-env) + (if (symbol? (cadr 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))))))) (export define set! diff --git a/src/macro.c b/src/macro.c index 2253533b..27906051 100644 --- a/src/macro.c +++ b/src/macro.c @@ -160,36 +160,24 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv) static pic_value macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv) { - pic_sym sym; - pic_value formal, body, var, val; + pic_sym sym, rename; + pic_value var, val; - if (pic_length(pic, expr) < 2) { + if (pic_length(pic, expr) != 3) { pic_error(pic, "syntax error"); } - formal = pic_cadr(pic, expr); - if (pic_pair_p(formal)) { - var = pic_car(pic, formal); - } else { - if (pic_length(pic, expr) != 3) { - pic_error(pic, "syntax error"); - } - var = formal; - } + var = pic_cadr(pic, expr); if (! pic_sym_p(var)) { pic_error(pic, "binding to non-symbol object"); } sym = pic_sym(var); - if (! pic_find_rename(pic, senv, sym, NULL)) { - pic_add_rename(pic, senv, sym); + if (! pic_find_rename(pic, senv, sym, &rename)) { + rename = pic_add_rename(pic, senv, sym); } - body = pic_cddr(pic, expr); - if (pic_pair_p(formal)) { - val = macroexpand_lambda(pic, pic_cons(pic, pic_false_value(), pic_cons(pic, pic_cdr(pic, formal), body)), senv); - } else { - val = macroexpand(pic, pic_car(pic, body), senv); - } - return pic_list3(pic, pic_sym_value(pic->rDEFINE), macroexpand_symbol(pic, sym, senv), val); + val = macroexpand(pic, pic_list_ref(pic, expr, 2), senv); + + return pic_list3(pic, pic_sym_value(pic->rDEFINE), pic_sym_value(rename), val); } static pic_value