refactor (picrin parameter)
This commit is contained in:
parent
424216ca23
commit
8846776f2f
|
@ -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
22
src/var.c
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue