From f7bbe31ee5abd3466949a4e11c7ec5fbc8e3de91 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 22 Jul 2014 14:47:57 +0900
Subject: [PATCH 1/5] change var API

---
 include/picrin/var.h |  8 ++---
 src/var.c            | 86 +++++++-------------------------------------
 2 files changed, 17 insertions(+), 77 deletions(-)

diff --git a/include/picrin/var.h b/include/picrin/var.h
index 9926c092..69eac2ca 100644
--- a/include/picrin/var.h
+++ b/include/picrin/var.h
@@ -19,10 +19,10 @@ struct pic_var {
 
 struct pic_var *pic_var_new(pic_state *, pic_value);
 
-pic_value pic_var_ref(pic_state *, const char *);
-void pic_var_set(pic_state *, const char *, pic_value);
-void pic_var_push(pic_state *, const char *, pic_value);
-void pic_var_pop(pic_state *, const char *);
+pic_value pic_var_ref(pic_state *, struct pic_var *);
+void pic_var_set(pic_state *, struct pic_var *, pic_value);
+void pic_var_push(pic_state *, struct pic_var *, pic_value);
+void pic_var_pop(pic_state *, struct pic_var *);
 
 #if defined(__cplusplus)
 }
diff --git a/src/var.c b/src/var.c
index 9cbb00e5..5bf215b6 100644
--- a/src/var.c
+++ b/src/var.c
@@ -6,30 +6,6 @@
 #include "picrin/var.h"
 #include "picrin/pair.h"
 
-static pic_value
-var_ref(pic_state *pic, struct pic_var *var)
-{
-  return pic_car(pic, var->stack);
-}
-
-static void
-var_set(pic_state *pic, struct pic_var *var, pic_value value)
-{
-  pic_set_car(pic, var->stack, value);
-}
-
-static void
-var_push(pic_state *pic, struct pic_var *var, pic_value value)
-{
-  var->stack = pic_cons(pic, value, var->stack);
-}
-
-static void
-var_pop(pic_state *pic, struct pic_var *var)
-{
-  var->stack = pic_cdr(pic, var->stack);
-}
-
 struct pic_var *
 pic_var_new(pic_state *pic, pic_value init)
 {
@@ -38,69 +14,33 @@ pic_var_new(pic_state *pic, pic_value init)
   var = (struct pic_var *)pic_obj_alloc(pic, sizeof(struct pic_var), PIC_TT_VAR);
   var->stack = pic_nil_value();
 
-  var_push(pic, var, init);
+  pic_var_push(pic, var, init);
 
   return var;
 }
 
 pic_value
-pic_var_ref(pic_state *pic, const char *name)
+pic_var_ref(pic_state *pic, struct pic_var *var)
 {
-  pic_value v;
-  struct pic_var *var;
-
-  v = pic_ref(pic, name);
-
-  pic_assert_type(pic, v, var);
-
-  var = pic_var_ptr(v);
-
-  return var_ref(pic, var);
+  return pic_car(pic, var->stack);
 }
 
 void
-pic_var_set(pic_state *pic, const char *name, pic_value value)
+pic_var_set(pic_state *pic, struct pic_var *var, pic_value value)
 {
-  pic_value v;
-  struct pic_var *var;
-
-  v = pic_ref(pic, name);
-
-  pic_assert_type(pic, v, var);
-
-  var = pic_var_ptr(v);
-
-  var_set(pic, var, value);
+  pic_set_car(pic, var->stack, value);
 }
 
 void
-pic_var_push(pic_state *pic, const char *name, pic_value value)
+pic_var_push(pic_state *pic, struct pic_var *var, pic_value value)
 {
-  pic_value v;
-  struct pic_var *var;
-
-  v = pic_ref(pic, name);
-
-  pic_assert_type(pic, v, var);
-
-  var = pic_var_ptr(v);
-
-  var_push(pic, var, value);
+  var->stack = pic_cons(pic, value, var->stack);
 }
 
 void
-pic_var_pop(pic_state *pic, const char *name)
+pic_var_pop(pic_state *pic, struct pic_var *var)
 {
-  pic_value v;
-  struct pic_var *var;
-
-  v = pic_ref(pic, name);
-
-  pic_assert_type(pic, v, var);
-
-  var = pic_var_ptr(v);
-
-  var_pop(pic, var);
+  var->stack = pic_cdr(pic, var->stack);
 }
 
 static pic_value
@@ -125,7 +65,7 @@ pic_var_var_ref(pic_state *pic)
 
   var = pic_var_ptr(v);
 
-  return var_ref(pic, var);
+  return pic_var_ref(pic, var);
 }
 
 static pic_value
@@ -139,7 +79,7 @@ pic_var_var_set(pic_state *pic)
   pic_assert_type(pic, v, var);
 
   var = pic_var_ptr(v);
-  var_set(pic, var, val);
+  pic_var_set(pic, var, val);
   return pic_none_value();
 }
 
@@ -154,7 +94,7 @@ pic_var_var_push(pic_state *pic)
   pic_assert_type(pic, v, var);
 
   var = pic_var_ptr(v);
-  var_push(pic, var, val);
+  pic_var_push(pic, var, val);
   return pic_none_value();
 }
 
@@ -169,7 +109,7 @@ pic_var_var_pop(pic_state *pic)
   pic_assert_type(pic, v, var);
 
   var = pic_var_ptr(v);
-  var_pop(pic, var);
+  pic_var_pop(pic, var);
   return pic_none_value();
 }
 

From e3887691d2593d2b4f96cb3838d01a7e69b0aa0c Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 23 Jul 2014 09:05:35 +0900
Subject: [PATCH 2/5] applicable var

---
 src/vm.c | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/vm.c b/src/vm.c
index 7dc788cc..8e2ddb6c 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -712,6 +712,15 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
     L_CALL:
       x = pic->sp[-c.u.i];
       if (! pic_proc_p(x)) {
+
+        if (pic_var_p(x)) {
+          if (c.u.i != 1) {
+            pic_errorf(pic, "invalid call-sequence for var object");
+          }
+          POP();
+          PUSH(pic_var_ref(pic, pic_var_ptr(x)));
+          NEXT;
+        }
 	pic_errorf(pic, "invalid application: ~s", x);
       }
       proc = pic_proc_ptr(x);

From 424216ca2301f30af768f0798bd1c61a8d783074 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 23 Jul 2014 09:11:31 +0900
Subject: [PATCH 3/5] manage converter in var

---
 include/picrin/var.h |  3 ++-
 src/gc.c             |  3 +++
 src/var.c            | 14 +++++++++++---
 3 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/include/picrin/var.h b/include/picrin/var.h
index 69eac2ca..d3bbaf4e 100644
--- a/include/picrin/var.h
+++ b/include/picrin/var.h
@@ -12,12 +12,13 @@ extern "C" {
 struct pic_var {
   PIC_OBJECT_HEADER
   pic_value stack;
+  struct pic_proc *conv;
 };
 
 #define pic_var_p(o) (pic_type(o) == PIC_TT_VAR)
 #define pic_var_ptr(o) ((struct pic_var *)pic_ptr(o))
 
-struct pic_var *pic_var_new(pic_state *, pic_value);
+struct pic_var *pic_var_new(pic_state *, pic_value, struct pic_proc * /* = NULL */);
 
 pic_value pic_var_ref(pic_state *, struct pic_var *);
 void pic_var_set(pic_state *, struct pic_var *, pic_value);
diff --git a/src/gc.c b/src/gc.c
index e673f045..3d28aa96 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -469,6 +469,9 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_VAR: {
     struct pic_var *var = (struct pic_var *)obj;
     gc_mark(pic, var->stack);
+    if (var->conv) {
+      gc_mark_object(pic, (struct pic_object *)var->conv);
+    }
     break;
   }
   case PIC_TT_IREP: {
diff --git a/src/var.c b/src/var.c
index 5bf215b6..a5df8bb0 100644
--- a/src/var.c
+++ b/src/var.c
@@ -7,12 +7,13 @@
 #include "picrin/pair.h"
 
 struct pic_var *
-pic_var_new(pic_state *pic, pic_value init)
+pic_var_new(pic_state *pic, pic_value init, struct pic_proc *conv)
 {
   struct pic_var *var;
 
   var = (struct pic_var *)pic_obj_alloc(pic, sizeof(struct pic_var), PIC_TT_VAR);
   var->stack = pic_nil_value();
+  var->conv = conv;
 
   pic_var_push(pic, var, init);
 
@@ -28,12 +29,18 @@ pic_var_ref(pic_state *pic, struct pic_var *var)
 void
 pic_var_set(pic_state *pic, struct pic_var *var, pic_value value)
 {
+  if (var->conv != NULL) {
+    value = pic_apply1(pic, var->conv, value);
+  }
   pic_set_car(pic, var->stack, value);
 }
 
 void
 pic_var_push(pic_state *pic, struct pic_var *var, pic_value value)
 {
+  if (var->conv != NULL) {
+    value = pic_apply1(pic, var->conv, value);
+  }
   var->stack = pic_cons(pic, value, var->stack);
 }
 
@@ -46,11 +53,12 @@ pic_var_pop(pic_state *pic, struct pic_var *var)
 static pic_value
 pic_var_make_var(pic_state *pic)
 {
+  struct pic_proc *conv = NULL;
   pic_value init;
 
-  pic_get_args(pic, "o", &init);
+  pic_get_args(pic, "o|l", &init, &conv);
 
-  return pic_obj_value(pic_var_new(pic, init));
+  return pic_obj_value(pic_var_new(pic, init, conv));
 }
 
 static pic_value

From 8846776f2f1e496e94f2330b3fba5453304f6ea8 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 23 Jul 2014 09:18:58 +0900
Subject: [PATCH 4/5] refactor (picrin parameter)

---
 piclib/prelude.scm | 47 ++++++----------------------------------------
 src/var.c          | 22 +++++++++++-----------
 2 files changed, 17 insertions(+), 52 deletions(-)

diff --git a/piclib/prelude.scm b/piclib/prelude.scm
index d31363a2..ac6ebef4 100644
--- a/piclib/prelude.scm
+++ b/piclib/prelude.scm
@@ -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)
diff --git a/src/var.c b/src/var.c
index a5df8bb0..2524350f 100644
--- a/src/var.c
+++ b/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);
   }
 }

From aeb9c2bcee1af26c6096870faae77ba69a8c8101 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Wed, 23 Jul 2014 09:24:28 +0900
Subject: [PATCH 5/5] define current-*-ports in port.c

---
 piclib/prelude.scm | 10 ----------
 src/port.c         | 21 ++++++++++++++++-----
 2 files changed, 16 insertions(+), 15 deletions(-)

diff --git a/piclib/prelude.scm b/piclib/prelude.scm
index ac6ebef4..0a4db18b 100644
--- a/piclib/prelude.scm
+++ b/piclib/prelude.scm
@@ -707,16 +707,6 @@
 
 ;;; 6.13. Input and output
 
-(import (picrin port))
-
-(define current-input-port (make-parameter standard-input-port))
-(define current-output-port (make-parameter standard-output-port))
-(define current-error-port (make-parameter standard-error-port))
-
-(export current-input-port
-        current-output-port
-        current-error-port)
-
 (define (call-with-port port proc)
   (dynamic-wind
       (lambda () #f)
diff --git a/src/port.c b/src/port.c
index 6f9b6673..de01f62e 100644
--- a/src/port.c
+++ b/src/port.c
@@ -11,6 +11,7 @@
 #include "picrin/port.h"
 #include "picrin/string.h"
 #include "picrin/blob.h"
+#include "picrin/var.h"
 
 pic_value
 pic_eof_object()
@@ -42,7 +43,7 @@ pic_stdout(pic_state *pic)
   return pic_port_ptr(pic_apply(pic, proc, pic_nil_value()));
 }
 
-static pic_value
+static struct pic_port *
 port_new_stdport(pic_state *pic, xFILE *file, short dir)
 {
   struct pic_port *port;
@@ -51,7 +52,7 @@ port_new_stdport(pic_state *pic, xFILE *file, short dir)
   port->file = file;
   port->flags = dir | PIC_PORT_TEXT;
   port->status = PIC_PORT_OPEN;
-  return pic_obj_value(port);
+  return port;
 }
 
 struct pic_port *
@@ -688,12 +689,22 @@ pic_port_flush(pic_state *pic)
 void
 pic_init_port(pic_state *pic)
 {
+  struct pic_port *STDIN, *STDOUT, *STDERR;
+
+  STDIN = port_new_stdport(pic, xstdin, PIC_PORT_IN);
+  STDOUT = port_new_stdport(pic, xstdout, PIC_PORT_OUT);
+  STDERR = port_new_stdport(pic, xstderr, PIC_PORT_OUT);
+
   pic_deflibrary ("(picrin port)") {
-    pic_define(pic, "standard-input-port", port_new_stdport(pic, xstdin, PIC_PORT_IN));
-    pic_define(pic, "standard-output-port", port_new_stdport(pic, xstdout, PIC_PORT_OUT));
-    pic_define(pic, "standard-error-port", port_new_stdport(pic, xstderr, PIC_PORT_OUT));
+    pic_define(pic, "standard-input-port", pic_obj_value(STDIN));
+    pic_define(pic, "standard-output-port", pic_obj_value(STDOUT));
+    pic_define(pic, "standard-error-port", pic_obj_value(STDERR));
   }
 
+  pic_define(pic, "current-input-port", pic_obj_value(pic_var_new(pic, pic_obj_value(STDIN), NULL)));
+  pic_define(pic, "current-output-port", pic_obj_value(pic_var_new(pic, pic_obj_value(STDOUT), NULL)));
+  pic_define(pic, "current-error-port", pic_obj_value(pic_var_new(pic, pic_obj_value(STDERR), NULL)));
+
   pic_defun(pic, "input-port?", pic_port_input_port_p);
   pic_defun(pic, "output-port?", pic_port_output_port_p);
   pic_defun(pic, "textual-port?", pic_port_textual_port_p);