From d0713456ef67477e9af87ddbd1a952be2f0892b9 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 9 Jan 2014 00:39:45 +0900
Subject: [PATCH] add make-parameter and parameterize

---
 piclib/built-in.scm | 34 +++++++++++++++++++++++++++++++++-
 1 file changed, 33 insertions(+), 1 deletion(-)

diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index e7c9466b..6921d192 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -327,9 +327,38 @@
           let*-values
           define-values))
 
+;;; parameter
+(define-library (picrin parameter)
+  (import (scheme base)
+          (picrin macro)
+          (picrin core-syntax)
+          (picrin bootstrap-tools))
+
+  ;; reopen (pircin parameter)
+  ;; see src/var.c
+
+  (define-syntax parameterize
+    (er-macro-transformer
+     (lambda (form r compare)
+       (let ((bindings (cadr form))
+             (body (cddr form)))
+         (let ((vars (map car bindings)))
+           `(,(r 'let) (,@(map (lambda (var)
+                                 `(,(r var) (,var)))
+                            vars))
+              ,@bindings
+              (,(r 'let) ((,(r 'result) (begin ,@body)))
+                ,@(map (lambda (var)
+                         `(,(r 'parameter-set!) ,var ,(r var)))
+                       vars)
+                ,(r 'result))))))))
+
+  (export parameterize))
+
 (import (picrin macro)
         (picrin core-syntax)
-        (picrin multiple-value))
+        (picrin multiple-value)
+        (picrin parameter))
 
 (export let let* letrec letrec*
         quasiquote unquote unquote-splicing
@@ -344,6 +373,9 @@
         let*-values
         define-values)
 
+(export make-parameter
+        parameterize)
+
 (define (any pred list)
   (if (null? list)
       #f