From 60c304cbb8763107773b00d78d7d83fe6a4970fc Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Mon, 4 Jul 2011 22:04:40 +0900
Subject: [PATCH] adding flatten-dot and update-free-vars

---
 lib/chibi/ast.c      | 5 +++++
 lib/chibi/ast.module | 3 ++-
 lib/chibi/ast.scm    | 9 +++++----
 3 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c
index 8a6f94c7..43b8c829 100644
--- a/lib/chibi/ast.c
+++ b/lib/chibi/ast.c
@@ -303,6 +303,10 @@ static sexp sexp_error_string (sexp ctx sexp_api_params(self, n), sexp x) {
   return sexp_c_string(ctx, strerror(err), -1);
 }
 
+static sexp sexp_update_free_vars (sexp ctx sexp_api_params(self, n), sexp x) {
+  return sexp_free_vars(ctx, x, SEXP_NULL);
+}
+
 #define sexp_define_type(ctx, name, tag) \
   sexp_env_define(ctx, env, sexp_intern(ctx, name, -1), sexp_type_by_index(ctx, tag));
 
@@ -409,5 +413,6 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
   sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op);
   sexp_define_foreign(ctx, env, "string-contains", 2, sexp_string_contains);
   sexp_define_foreign_opt(ctx, env, "integer->error-string", 1, sexp_error_string, SEXP_FALSE);
+  sexp_define_foreign(ctx, env, "update-free-vars!", 1, sexp_update_free_vars);
   return SEXP_VOID;
 }
diff --git a/lib/chibi/ast.module b/lib/chibi/ast.module
index 0ea29740..e9173877 100644
--- a/lib/chibi/ast.module
+++ b/lib/chibi/ast.module
@@ -32,7 +32,8 @@
    port-line port-line-set!
    type-name type-cpl type-parent type-slots
    object-size integer->immediate gc
-   string-contains integer->error-string)
+   string-contains integer->error-string
+   flatten-dot update-free-vars!)
   (import (scheme))
   (include-shared "ast")
   (include "ast.scm"))
diff --git a/lib/chibi/ast.scm b/lib/chibi/ast.scm
index 4834c302..e71cbfe7 100644
--- a/lib/chibi/ast.scm
+++ b/lib/chibi/ast.scm
@@ -50,10 +50,6 @@
               (lp2 (cdr ls2) found?))
              (else
               (lp2 (cdr ls2) found?)))))))))
-  (define (flatten-dot x)
-    (cond ((pair? x) (cons (car x) (flatten-dot (cdr x))))
-          ((null? x) x)
-          (else (list x))))
   (define (extend-env lam env)
     (cons (map (lambda (x) (cons x lam)) (flatten-dot (lambda-params lam))) env))
   (let lp ((x ast) (env '()))
@@ -66,6 +62,11 @@
      ((pair? x) (for-each (lambda (x) (lp x env)) x))))
   renames)
 
+(define (flatten-dot x)
+  (cond ((pair? x) (cons (car x) (flatten-dot (cdr x))))
+        ((null? x) x)
+        (else (list x))))
+
 (define (get-rename id lam renames)
   (let ((ls (assq lam renames)))
     (if (not ls)