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

refactor (picrin parameter)

This commit is contained in:
Yuichi Nishiwaki 2014-07-23 09:18:58 +09:00
parent 424216ca23
commit 8846776f2f
2 changed files with 17 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
piclib/prelude.scm
View File

@ -373,40 +373,7 @@
;;; parameter
(define-library (picrin parameter)
(import (scheme base)
(picrin macro)
(picrin var)
(picrin attribute)
(picrin dictionary))
(define (single? x)
(and (list? x) (= (length x) 1)))
(define (double? x)
(and (list? x) (= (length x) 2)))
(define (%make-parameter init conv)
(let ((var (make-var (conv init))))
(define (parameter . args)
(cond
((null? args)
(var-ref var))
((single? args)
(var-set! var (conv (car args))))
((double? args)
(var-set! var ((cadr args) (car args))))
(else
(error "invalid arguments for parameter"))))
(dictionary-set! (attribute parameter) '@@var var)
parameter))
(define (make-parameter init . conv)
(let ((conv
(if (null? conv)
(lambda (x) x)
(car conv))))
(%make-parameter init conv)))
(picrin macro))
(define-syntax with
(ir-macro-transformer
@ -420,9 +387,6 @@
(,after)
result))))))
(define (var-of parameter)
(dictionary-ref (attribute parameter) '@@var))
(define-syntax parameterize
(ir-macro-transformer
(lambda (form inject compare)
@ -431,12 +395,13 @@
(let ((vars (map car formal))
(vals (map cadr formal)))
`(with
(lambda () ,@(map (lambda (var val) `(var-push! (var-of ,var) ,val)) vars vals))
(lambda () ,@(map (lambda (var) `(var-pop! (var-of ,var))) vars))
(lambda ()
,@(map (lambda (var val) `(parameter-push! ,var ,val)) vars vals))
(lambda ()
,@(map (lambda (var) `(parameter-pop! ,var)) vars))
,@body))))))
(export make-parameter
parameterize))
(export parameterize))
;;; Record Type
(define-library (picrin record)

22
src/var.c
View File

@ -51,7 +51,7 @@ pic_var_pop(pic_state *pic, struct pic_var *var)
}
static pic_value
pic_var_make_var(pic_state *pic)
pic_var_make_parameter(pic_state *pic)
{
struct pic_proc *conv = NULL;
pic_value init;
@ -62,7 +62,7 @@ pic_var_make_var(pic_state *pic)
}
static pic_value
pic_var_var_ref(pic_state *pic)
pic_var_parameter_ref(pic_state *pic)
{
struct pic_var *var;
pic_value v;
@ -77,7 +77,7 @@ pic_var_var_ref(pic_state *pic)
}
static pic_value
pic_var_var_set(pic_state *pic)
pic_var_parameter_set(pic_state *pic)
{
struct pic_var *var;
pic_value v, val;
@ -92,7 +92,7 @@ pic_var_var_set(pic_state *pic)
}
static pic_value
pic_var_var_push(pic_state *pic)
pic_var_parameter_push(pic_state *pic)
{
struct pic_var *var;
pic_value v, val;
@ -107,7 +107,7 @@ pic_var_var_push(pic_state *pic)
}
static pic_value
pic_var_var_pop(pic_state *pic)
pic_var_parameter_pop(pic_state *pic)
{
struct pic_var *var;
pic_value v;
@ -124,11 +124,11 @@ pic_var_var_pop(pic_state *pic)
void
pic_init_var(pic_state *pic)
{
pic_deflibrary ("(picrin var)") {
pic_defun(pic, "make-var", pic_var_make_var);
pic_defun(pic, "var-ref", pic_var_var_ref);
pic_defun(pic, "var-set!", pic_var_var_set);
pic_defun(pic, "var-push!", pic_var_var_push);
pic_defun(pic, "var-pop!", pic_var_var_pop);
pic_deflibrary ("(picrin parameter)") {
pic_defun(pic, "make-parameter", pic_var_make_parameter);
pic_defun(pic, "parameter-ref", pic_var_parameter_ref);
pic_defun(pic, "parameter-set!", pic_var_parameter_set);
pic_defun(pic, "parameter-push!", pic_var_parameter_push);
pic_defun(pic, "parameter-pop!", pic_var_parameter_pop);
}
}