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 ;;; parameter
(define-library (picrin parameter) (define-library (picrin parameter)
(import (scheme base) (import (scheme base)
(picrin macro) (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)))
(define-syntax with (define-syntax with
(ir-macro-transformer (ir-macro-transformer
@ -420,9 +387,6 @@
(,after) (,after)
result)))))) result))))))
(define (var-of parameter)
(dictionary-ref (attribute parameter) '@@var))
(define-syntax parameterize (define-syntax parameterize
(ir-macro-transformer (ir-macro-transformer
(lambda (form inject compare) (lambda (form inject compare)
@ -431,12 +395,13 @@
(let ((vars (map car formal)) (let ((vars (map car formal))
(vals (map cadr formal))) (vals (map cadr formal)))
`(with `(with
(lambda () ,@(map (lambda (var val) `(var-push! (var-of ,var) ,val)) vars vals)) (lambda ()
(lambda () ,@(map (lambda (var) `(var-pop! (var-of ,var))) vars)) ,@(map (lambda (var val) `(parameter-push! ,var ,val)) vars vals))
(lambda ()
,@(map (lambda (var) `(parameter-pop! ,var)) vars))
,@body)))))) ,@body))))))
(export make-parameter (export parameterize))
parameterize))
;;; Record Type ;;; Record Type
(define-library (picrin record) (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 static pic_value
pic_var_make_var(pic_state *pic) pic_var_make_parameter(pic_state *pic)
{ {
struct pic_proc *conv = NULL; struct pic_proc *conv = NULL;
pic_value init; pic_value init;
@ -62,7 +62,7 @@ pic_var_make_var(pic_state *pic)
} }
static pic_value static pic_value
pic_var_var_ref(pic_state *pic) pic_var_parameter_ref(pic_state *pic)
{ {
struct pic_var *var; struct pic_var *var;
pic_value v; pic_value v;
@ -77,7 +77,7 @@ pic_var_var_ref(pic_state *pic)
} }
static pic_value static pic_value
pic_var_var_set(pic_state *pic) pic_var_parameter_set(pic_state *pic)
{ {
struct pic_var *var; struct pic_var *var;
pic_value v, val; pic_value v, val;
@ -92,7 +92,7 @@ pic_var_var_set(pic_state *pic)
} }
static pic_value static pic_value
pic_var_var_push(pic_state *pic) pic_var_parameter_push(pic_state *pic)
{ {
struct pic_var *var; struct pic_var *var;
pic_value v, val; pic_value v, val;
@ -107,7 +107,7 @@ pic_var_var_push(pic_state *pic)
} }
static pic_value static pic_value
pic_var_var_pop(pic_state *pic) pic_var_parameter_pop(pic_state *pic)
{ {
struct pic_var *var; struct pic_var *var;
pic_value v; pic_value v;
@ -124,11 +124,11 @@ pic_var_var_pop(pic_state *pic)
void void
pic_init_var(pic_state *pic) pic_init_var(pic_state *pic)
{ {
pic_deflibrary ("(picrin var)") { pic_deflibrary ("(picrin parameter)") {
pic_defun(pic, "make-var", pic_var_make_var); pic_defun(pic, "make-parameter", pic_var_make_parameter);
pic_defun(pic, "var-ref", pic_var_var_ref); pic_defun(pic, "parameter-ref", pic_var_parameter_ref);
pic_defun(pic, "var-set!", pic_var_var_set); pic_defun(pic, "parameter-set!", pic_var_parameter_set);
pic_defun(pic, "var-push!", pic_var_var_push); pic_defun(pic, "parameter-push!", pic_var_parameter_push);
pic_defun(pic, "var-pop!", pic_var_var_pop); pic_defun(pic, "parameter-pop!", pic_var_parameter_pop);
} }
} }