$include_dir="/home/hyper-archives/boost-commit/include"; include("$include_dir/msg-header.inc") ?>
Subject: [Boost-commit] svn:boost r61500 - in trunk/libs/spirit/example/scheme: example example/scheme scheme test test/scheme test/utree utree utree/detail
From: joel_at_[hidden]
Date: 2010-04-22 23:12:28
Author: djowel
Date: 2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
New Revision: 61500
URL: http://svn.boost.org/trac/boost/changeset/61500
Log:
major features working
Added:
   trunk/libs/spirit/example/scheme/test/scheme/scheme_test.scm   (contents, props changed)
Text files modified: 
   trunk/libs/spirit/example/scheme/example/Jamfile                |     5 -                                       
   trunk/libs/spirit/example/scheme/example/scheme/factorial1.cpp  |     6 +-                                      
   trunk/libs/spirit/example/scheme/example/scheme/factorial2.cpp  |    11 ++-                                     
   trunk/libs/spirit/example/scheme/example/scheme/more_scheme.scm |    25 +++++++++                               
   trunk/libs/spirit/example/scheme/example/scheme/scheme_test.cpp |     6 +-                                      
   trunk/libs/spirit/example/scheme/example/scheme/some_scheme.scm |    10 ++-                                     
   trunk/libs/spirit/example/scheme/scheme/compiler.hpp            |    84 ++++++++++++++++++++++++++------        
   trunk/libs/spirit/example/scheme/scheme/interpreter.hpp         |   103 +++++++++++++++++++++++++-------------- 
   trunk/libs/spirit/example/scheme/scheme/intrinsics.hpp          |    18 ++++--                                  
   trunk/libs/spirit/example/scheme/test/Jamfile                   |     4                                         
   trunk/libs/spirit/example/scheme/test/scheme/factorial.scm      |     3 +                                       
   trunk/libs/spirit/example/scheme/test/scheme/scheme_test1.cpp   |    36 ++++++------                            
   trunk/libs/spirit/example/scheme/test/scheme/scheme_test2.cpp   |    13 ++++                                    
   trunk/libs/spirit/example/scheme/test/scheme/scheme_test3.cpp   |     4                                         
   trunk/libs/spirit/example/scheme/test/utree/utree_test.cpp      |     4                                         
   trunk/libs/spirit/example/scheme/utree/detail/utree_detail2.hpp |     8 +-                                      
   trunk/libs/spirit/example/scheme/utree/utree.hpp                |    32 ++++++++++-                             
   17 files changed, 259 insertions(+), 113 deletions(-)
Modified: trunk/libs/spirit/example/scheme/example/Jamfile
==============================================================================
--- trunk/libs/spirit/example/scheme/example/Jamfile	(original)
+++ trunk/libs/spirit/example/scheme/example/Jamfile	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -14,7 +14,7 @@
 
 exe sexpr_input_test : sexpr/sexpr_input_test.cpp ;
 exe sexpr_output_test : sexpr/sexpr_output_test.cpp ;
-exe sexpr_error_test : sexpr_error_test.cpp ;
+exe sexpr_error_test : sexpr/sexpr_error_test.cpp ;
 
 exe parse_qi_test
    : parse_qiexpr/generate_sexpr_to_ostream.cpp
@@ -30,8 +30,7 @@
 
 exe factorial1 : scheme/factorial1.cpp ;
 exe factorial2 : scheme/factorial2.cpp ;
-
-exe scheme_error_test : scheme/scheme_error_test.cpp ;
+exe scheme_test : scheme/scheme_test.cpp ;
 
 
 
Modified: trunk/libs/spirit/example/scheme/example/scheme/factorial1.cpp
==============================================================================
--- trunk/libs/spirit/example/scheme/example/scheme/factorial1.cpp	(original)
+++ trunk/libs/spirit/example/scheme/example/scheme/factorial1.cpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -5,7 +5,7 @@
     file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
 =============================================================================*/
 #include <boost/config/warning_disable.hpp>
-
+#include <input/parse_sexpr_impl.hpp>
 #include <scheme/compiler.hpp>
 #include <utree/io.hpp>
 #include <iostream>
@@ -44,8 +44,8 @@
     using scheme::interpreter;
     using scheme::_1;
 
-    scheme::interpreter factorial(in);
-    std::cout << factorial(10) << std::endl;
+    scheme::interpreter program(in);
+    std::cout << program["factorial"](10) << std::endl;
 
     return 0;
 }
Modified: trunk/libs/spirit/example/scheme/example/scheme/factorial2.cpp
==============================================================================
--- trunk/libs/spirit/example/scheme/example/scheme/factorial2.cpp	(original)
+++ trunk/libs/spirit/example/scheme/example/scheme/factorial2.cpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -5,7 +5,7 @@
     file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
 =============================================================================*/
 #include <boost/config/warning_disable.hpp>
-
+#include <input/parse_sexpr_impl.hpp>
 #include <input/sexpr.hpp>
 #include <input/parse_sexpr_impl.hpp>
 #include <scheme/compiler.hpp>
@@ -19,9 +19,12 @@
     using scheme::interpreter;
     using scheme::utree;
 
-    utree src = "(define (factorial n) (if (<= n 0) 1 (* n (factorial (- n 1)))))";
-    scheme::interpreter factorial(src);
-    std::cout << factorial(10) << std::endl;
+    utree src =
+        "(define (factorial n) "
+            "(if (<= n 0) 1 (* n (factorial (- n 1)))))";
+
+    scheme::interpreter program(src);
+    std::cout << program["factorial"](10) << std::endl;
 
     return 0;
 }
Modified: trunk/libs/spirit/example/scheme/example/scheme/more_scheme.scm
==============================================================================
--- trunk/libs/spirit/example/scheme/example/scheme/more_scheme.scm	(original)
+++ trunk/libs/spirit/example/scheme/example/scheme/more_scheme.scm	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -28,4 +28,27 @@
     (display first)
     (display (begin 1 2 rest)))
 
-(display-all 123 456 999 666)
\ No newline at end of file
+(display-all 123 456 999 666)
+
+
+(define (foo x)
+    (define (bar y z) (list x y z))
+    (bar 9 (+ x 2)))
+
+(display (foo 100))
+
+; The hello-world for interpreters ;-)
+(define (factorial n)
+  (if (<= n 0) 1
+    (* n (factorial (- n 1)))))
+
+(display (factorial 10))
+
+
+
+(define (foo x)
+    (define (bar y z) (list x y z))
+    (bar 9 (+ x 2)))
+
+(define (main)
+    (display (foo 100))) ; prints ( 100 9 102 )
\ No newline at end of file
Modified: trunk/libs/spirit/example/scheme/example/scheme/scheme_test.cpp
==============================================================================
--- trunk/libs/spirit/example/scheme/example/scheme/scheme_test.cpp	(original)
+++ trunk/libs/spirit/example/scheme/example/scheme/scheme_test.cpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -40,9 +40,9 @@
         }
     }
 
-    scheme::interpreter f(in, filename);
-    if (!f.empty())
-        f();
+    scheme::interpreter program(in, filename);
+    scheme::function main_ = program["main"];
+    main_(); // call main
     return 0;
 }
 
Modified: trunk/libs/spirit/example/scheme/example/scheme/some_scheme.scm
==============================================================================
--- trunk/libs/spirit/example/scheme/example/scheme/some_scheme.scm	(original)
+++ trunk/libs/spirit/example/scheme/example/scheme/some_scheme.scm	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -1,5 +1,7 @@
-(define (foo x)
-    (define (bar y z) (list x y z))
-    (bar 9 x))
+; The hello-world for interpreters ;-)
+(define (factorial n)
+  (if (<= n 0) 1
+    (* n (factorial (- n 1)))))
 
-(display (foo 100))
\ No newline at end of file
+(define (main)
+    (display (factorial 10)))
\ No newline at end of file
Modified: trunk/libs/spirit/example/scheme/scheme/compiler.hpp
==============================================================================
--- trunk/libs/spirit/example/scheme/scheme/compiler.hpp	(original)
+++ trunk/libs/spirit/example/scheme/scheme/compiler.hpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -117,7 +117,9 @@
     public:
 
         environment(environment* parent = 0)
-          : outer(parent) {}
+          : outer(parent),
+            depth(parent? parent->depth + 1 : 0)
+        {}
 
         template <typename Function>
         void define(std::string const& name, Function const& f, int arity, bool fixed)
@@ -154,6 +156,7 @@
         }
 
         environment* parent() const { return outer; }
+        int level() const { return depth; }
 
     private:
 
@@ -161,6 +164,7 @@
 
         environment* outer;
         std::map<std::string, map_element> definitions;
+        int depth;
     };
 
 ///////////////////////////////////////////////////////////////////////////////
@@ -177,14 +181,15 @@
     {
         // we must hold f by reference because functions can be recursive
         boost::reference_wrapper<function const> f;
+        int level;
 
-        external_function(function const& f)
-          : f(f) {}
+        external_function(function const& f, int level)
+          : f(f), level(level) {}
 
         using base_type::operator();
         function operator()(actor_list const& elements) const
         {
-            return function(lambda_function(f, elements));
+            return function(lambda_function(f, elements, level));
         }
     };
 
@@ -239,9 +244,11 @@
             for (std::size_t i = 0; i < args.size(); ++i)
             {
                 if (!fixed_arity && (args.size() - 1) == i)
-                    local_env.define(args[i], boost::bind(varg, i), 0, false);
+                    local_env.define(args[i],
+                        boost::bind(varg, i, local_env.level()), 0, false);
                 else
-                    local_env.define(args[i], boost::bind(arg, i), 0, false);
+                    local_env.define(args[i],
+                        boost::bind(arg, i, local_env.level()), 0, false);
             }
 
             actor_list flist;
@@ -257,7 +264,7 @@
                 return protect(flist.front());
         }
 
-        bool is_define(utree const& item) const
+        static bool is_define(utree const& item)
         {
             if (item.which() != utree_type::list_type ||
                 item.begin()->which() != utree_type::symbol_type)
@@ -278,7 +285,7 @@
 
                 fragments.push_back(function());
                 function& f = fragments.back();
-                env.define(name, external_function(f), args.size(), fixed_arity);
+                env.define(name, external_function(f, env.level()), args.size(), fixed_arity);
                 f = make_lambda(args, fixed_arity, body)(); // unprotect (evaluate returns a function)
                 return f;
             }
@@ -482,7 +489,24 @@
             scheme::function f;
             try
             {
-                f = compile(program, env, fragments, line, source_file);
+                if (!compiler::is_define(program))
+                {
+                    if (source_file != "")
+                        std::cerr << source_file;
+
+                    int progline = (program.which() == utree_type::list_type)
+                        ? program.tag() : line;
+
+                    if (progline != -1)
+                        std::cerr << '(' << progline << ')';
+
+                    std::cerr << " : Error! scheme: Function definition expected." << std::endl;
+                    continue; // try the next expression
+                }
+                else
+                {
+                    f = compile(program, env, fragments, line, source_file);
+                }
             }
             catch (compilation_error const&)
             {
@@ -501,6 +525,7 @@
         env.define("front", front, 1, true);
         env.define("back", back, 1, true);
         env.define("rest", rest, 1, true);
+        env.define("=", equal, 2, true);
         env.define("<", less_than, 2, true);
         env.define("<=", less_than_equal, 2, true);
         env.define("+", plus, 2, false);
@@ -512,7 +537,7 @@
     ///////////////////////////////////////////////////////////////////////////
     // interpreter
     ///////////////////////////////////////////////////////////////////////////
-    struct interpreter : actor<interpreter>
+    struct interpreter
     {
         template <typename Source>
         interpreter(
@@ -529,21 +554,46 @@
             }
         }
 
-        interpreter(utree const& program, environment* outer = 0)
+        interpreter(
+            utree const& program,
+            environment* outer = 0)
         {
             if (outer == 0)
                 build_basic_environment(env);
             compile_all(program, env, flist, fragments);
         }
 
-        utree eval(args_type args) const
+        function operator[](std::string const& name)
         {
-            return flist.back()(args);
-        }
+            boost::tuple<compiled_function*, int, bool> r = env.find(name);
+            if (boost::get<0>(r))
+            {
+                compiled_function* cf = boost::get<0>(r);
+                int arity = boost::get<1>(r);
+                bool fixed_arity = boost::get<2>(r);
+                actor_list flist;
 
-        bool empty() const
-        {
-            return flist.empty() || flist.back().empty();
+                if (arity > 0)
+                {
+                    for (int i = 0; i < (arity-1); ++i)
+                        flist.push_back(arg(i));
+
+                    if (fixed_arity)
+                        flist.push_back(arg(arity-1));
+                    else
+                        flist.push_back(varg(arity-1));
+                }
+                return (*cf)(flist);
+            }
+            else
+            {
+                std::cerr
+                    << " : Error! scheme: Function "
+                    << name
+                    << " not found."
+                    << std::endl;
+                return function();
+            }
         }
 
         environment env;
Modified: trunk/libs/spirit/example/scheme/scheme/interpreter.hpp
==============================================================================
--- trunk/libs/spirit/example/scheme/scheme/interpreter.hpp	(original)
+++ trunk/libs/spirit/example/scheme/scheme/interpreter.hpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -38,14 +38,14 @@
         typedef utree result_type;
         typedef actor<Derived> base_type;
 
-        utree operator()(args_type args) const
+        utree operator()(scope const& env) const
         {
-            return derived().eval(args);
+            return derived().eval(env);
         }
 
         utree operator()() const
         {
-            return derived().eval(args_type());
+            return derived().eval(scope());
         }
 
         template <typename A0>
@@ -69,10 +69,10 @@
         #include <scheme/detail/function_call.hpp>
 
         template <std::size_t n>
-        static args_type
+        static scope
         get_range(boost::array<utree, n> const& array)
         {
-            return args_type(array.begin(), array.end());
+            return scope(array.begin(), array.end());
         }
 
         Derived const& derived() const
@@ -107,9 +107,9 @@
             return f.which() != utree_type::function_type;
         }
 
-        utree eval(args_type args) const
+        utree eval(scope const& env) const
         {
-            return f.eval(args);
+            return f.eval(env);
         }
     };
 
@@ -121,7 +121,7 @@
         utree val;
         value_function(utree const& val) : val(val) {}
 
-        utree eval(args_type /*args*/) const
+        utree eval(scope /*env*/) const
         {
             return utree(boost::ref(val));
         }
@@ -149,23 +149,32 @@
     struct argument_function : actor<argument_function>
     {
         std::size_t n;
-        argument_function(std::size_t n) : n(n) {}
-
-        utree eval(args_type args) const
-        {
-            if (args[n].which() != utree_type::function_type)
-                return utree(boost::ref(args[n]));
+        std::size_t level;
+        argument_function(std::size_t n, std::size_t level = 0)
+          : n(n),
+            level(level)
+        {}
+
+        utree eval(scope const& env) const
+        {
+            scope const* eptr = &env;
+            while (level != eptr->level())
+                eptr = eptr->outer();
+
+            utree const& arg = (*eptr)[n];
+            if (arg.which() != utree_type::function_type)
+                return utree(boost::ref(arg));
             else
-                return args[n].eval(args);
+                return arg.eval(*eptr);
         }
     };
 
     struct argument
     {
         typedef function result_type;
-        function operator()(std::size_t n) const
+        function operator()(std::size_t n, std::size_t level = 0) const
         {
-            return function(argument_function(n));
+            return function(argument_function(n, level));
         }
     };
 
@@ -187,14 +196,28 @@
     ///////////////////////////////////////////////////////////////////////////
     struct vararg_function : actor<vararg_function>
     {
+        std::size_t level;
         std::size_t n;
-        vararg_function(std::size_t n) : n(n) {}
+        vararg_function(std::size_t n, std::size_t level = 0)
+          : n(n),
+            level(level)
+        {}
+
+        utree eval(scope const& env) const
+        {
+            scope const* eptr = &env;
+            while (level != eptr->level())
+                eptr = eptr->outer();
 
-        utree eval(args_type args) const
-        {
             utree result;
-            for (std::size_t i = n; i < args.size(); ++i)
-                result.push_back(boost::ref(args[i]));
+            for (std::size_t i = n; i < eptr->size(); ++i)
+            {
+                utree const& arg = (*eptr)[i];
+                if (arg.which() != utree_type::function_type)
+                    result.push_back(utree(boost::ref(arg)));
+                else
+                    result.push_back(arg.eval(*eptr));
+            }
             return result;
         }
     };
@@ -202,9 +225,9 @@
     struct vararg
     {
         typedef function result_type;
-        function operator()(std::size_t n) const
+        function operator()(std::size_t n, std::size_t level = 0) const
         {
-            return function(vararg_function(n));
+            return function(vararg_function(n, level));
         }
     };
 
@@ -286,9 +309,9 @@
             BOOST_ASSERT(!a.empty());
         }
 
-        utree eval(args_type args) const
+        utree eval(scope const& env) const
         {
-            return derived().eval(a(args));
+            return derived().eval(a(env));
         }
 
         Derived const& derived() const
@@ -323,9 +346,9 @@
             BOOST_ASSERT(!b.empty());
         }
 
-        utree eval(args_type args) const
+        utree eval(scope const& env) const
         {
-            return derived().eval(a(args), b(args));
+            return derived().eval(a(env), b(env));
         }
 
         Derived const& derived() const
@@ -364,16 +387,16 @@
             }
         }
 
-        utree eval(args_type args) const
+        utree eval(scope const& env) const
         {
             BOOST_ASSERT(!elements.empty());
             actor_list::const_iterator i = elements.begin();
-            utree result = (*i++)(args);
+            utree result = (*i++)(env);
             boost::iterator_range<actor_list::const_iterator>
                 rest(i++, elements.end());
             BOOST_FOREACH(function const& element, rest)
             {
-                if (!derived().eval(result, element(args)))
+                if (!derived().eval(result, element(env)))
                     break; // allow short-circuit evaluation
             }
             return result;
@@ -399,16 +422,22 @@
     ///////////////////////////////////////////////////////////////////////////
     struct lambda_function : actor<lambda_function>
     {
+        int level;
         actor_list elements;
         // we must hold f by reference because functions can be recursive
         boost::reference_wrapper<function const> f;
 
-        lambda_function(function const& f, actor_list const& elements)
-          : elements(elements), f(f) {}
+        lambda_function(function const& f, actor_list const& elements, int level = 0)
+          : elements(elements), f(f), level(level) {}
 
         typedef utree result_type;
-        utree eval(args_type args) const
+        utree eval(scope const& env) const
         {
+            // Get the parent scope
+            scope const* outer = &env;
+            while (level != outer->level())
+                outer = outer->outer();
+
             if (!elements.empty())
             {
                 boost::scoped_array<utree>
@@ -416,14 +445,14 @@
                 std::size_t i = 0;
                 BOOST_FOREACH(function const& element, elements)
                 {
-                    fargs[i++] = element(args);
+                    fargs[i++] = element(env);
                 }
                 utree const* fi = fargs.get();
-                return f.get()(args_type(fi, fi+elements.size()));
+                return f.get()(scope(fi, fi+elements.size(), outer));
             }
             else
             {
-                return f.get()();
+                return f.get()(scope(0, 0, outer));
             }
         }
     };
Modified: trunk/libs/spirit/example/scheme/scheme/intrinsics.hpp
==============================================================================
--- trunk/libs/spirit/example/scheme/scheme/intrinsics.hpp	(original)
+++ trunk/libs/spirit/example/scheme/scheme/intrinsics.hpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -9,6 +9,7 @@
 
 #include <scheme/interpreter.hpp>
 #include <utree/operators.hpp>
+#include <iostream>
 
 namespace scheme
 {
@@ -30,9 +31,9 @@
         }
 
         typedef utree result_type;
-        utree eval(args_type args) const
+        utree eval(scope const& env) const
         {
-            return cond(args).get<bool>() ? then(args) : else_(args);
+            return cond(env).get<bool>() ? then(env) : else_(env);
         }
     };
 
@@ -65,12 +66,12 @@
             }
         }
 
-        utree eval(args_type args) const
+        utree eval(scope const& env) const
         {
             utree result;
             BOOST_FOREACH(function const& element, elements)
             {
-                result.push_back(element(args));
+                result.push_back(element(env));
             }
             return result;
         }
@@ -101,7 +102,7 @@
             }
         }
 
-        utree eval(args_type args) const
+        utree eval(scope const& env) const
         {
             BOOST_ASSERT(!elements.empty());
             actor_list::const_iterator end = elements.end(); --end;
@@ -109,9 +110,9 @@
                 head_elements(elements.begin(), end);
             BOOST_FOREACH(function const& element, head_elements)
             {
-                element(args);
+                element(env);
             }
-            return (*end)(args);
+            return (*end)(env);
         }
     };
 
@@ -198,6 +199,9 @@
     ///////////////////////////////////////////////////////////////////////////
     // binary intrinsics
     ///////////////////////////////////////////////////////////////////////////
+    SCHEME_BINARY_INTRINSIC(equal, a == b);
+    equal_composite const eq = equal; // synonym
+
     SCHEME_BINARY_INTRINSIC(less_than, a < b);
     less_than_composite const lt = less_than; // synonym
 
Modified: trunk/libs/spirit/example/scheme/test/Jamfile
==============================================================================
--- trunk/libs/spirit/example/scheme/test/Jamfile	(original)
+++ trunk/libs/spirit/example/scheme/test/Jamfile	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -22,8 +22,8 @@
 
     # run utree tests
     [ run utree/utree_test.cpp                    : : : : ]
-    [ run scheme/scheme_test1.cpp                 : scheme/scheme_test1.scm : : : ]
-    [ run scheme/scheme_test2.cpp                 : scheme/factorial.scm : : : ]
+    #[ run scheme/scheme_test1.cpp                 : scheme/scheme_test1.scm : : : ]
+    [ run scheme/scheme_test2.cpp                 : scheme/scheme_test.scm test1 test2 test3 test4 : : : ]
     [ run scheme/scheme_test3.cpp                 : : : : ]
 
     ;
Modified: trunk/libs/spirit/example/scheme/test/scheme/factorial.scm
==============================================================================
--- trunk/libs/spirit/example/scheme/test/scheme/factorial.scm	(original)
+++ trunk/libs/spirit/example/scheme/test/scheme/factorial.scm	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -2,3 +2,6 @@
 (define (factorial n)
   (if (<= n 0) 1
     (* n (factorial (- n 1)))))
+
+(define (test1)
+    (= (factorial 10) 3628800))
\ No newline at end of file
Added: trunk/libs/spirit/example/scheme/test/scheme/scheme_test.scm
==============================================================================
--- (empty file)
+++ trunk/libs/spirit/example/scheme/test/scheme/scheme_test.scm	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -0,0 +1,35 @@
+; These tests demostrate the functionality of the scheme
+; compiler/interpreter
+
+(define (dbl x) (+ x x))
+
+(define len 123)
+
+(define (test1)
+    (= (dbl len) 246))
+
+; The hello-world for interpreters ;-)
+(define (factorial n)
+  (if (<= n 0) 1
+    (* n (factorial (- n 1)))))
+
+(define (test2)
+    (= (factorial 10) 3628800))
+
+; Fibonacci using lambda
+(define fib
+  (lambda (n)
+    (if (< n 2)
+        n
+        (+ (fib (- n 1)) (fib (- n 2))))))
+
+(define (test3) (= (fib 10) 55))
+
+; nested functions
+(define (foo x)
+    (define (bar y z) (list x y z))
+    (bar 9 (+ x 2)))
+
+(define (test4)
+    (= (foo 100) (quote ( 100 9 102 ))))
+
Modified: trunk/libs/spirit/example/scheme/test/scheme/scheme_test1.cpp
==============================================================================
--- trunk/libs/spirit/example/scheme/test/scheme/scheme_test1.cpp	(original)
+++ trunk/libs/spirit/example/scheme/test/scheme/scheme_test1.cpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -58,25 +58,25 @@
         BOOST_TEST(s != std::string("\xef\xbb\xbf"));
     }
 
-    scheme::utree program;
-    BOOST_TEST(scheme::input::parse_sexpr_list(in, program, filename));
+    //~ scheme::utree program;
+    //~ BOOST_TEST(scheme::input::parse_sexpr_list(in, program, filename));
 
-    scheme::environment env;
-    scheme::build_basic_environment(env);
-    scheme::actor_list fragments;
-    scheme::actor_list flist;
-    compile_all(program, env, flist, fragments, filename);
-
-    scheme::actor_list::iterator i = flist.begin();
-
-    BOOST_TEST((*i++)(555) == 1110);
-    BOOST_TEST((*i++)() == 123);
-    BOOST_TEST((*i++)() == 246);
-    BOOST_TEST((*i++)(5) == 120);
-    BOOST_TEST((*i++)() == 3628800);
-    BOOST_TEST((*i++)(5) == 5);
-    BOOST_TEST((*i++)() == 55);
-    BOOST_TEST((*i++)() == 21);
+    //~ scheme::environment env;
+    //~ scheme::build_basic_environment(env);
+    //~ scheme::actor_list fragments;
+    //~ scheme::actor_list flist;
+    //~ compile_all(program, env, flist, fragments, filename);
+
+    //~ scheme::actor_list::iterator i = flist.begin();
+
+    //~ BOOST_TEST((*i++)(555) == 1110);
+    //~ BOOST_TEST((*i++)() == 123);
+    //~ BOOST_TEST((*i++)() == 246);
+    //~ BOOST_TEST((*i++)(5) == 120);
+    //~ BOOST_TEST((*i++)() == 3628800);
+    //~ BOOST_TEST((*i++)(5) == 5);
+    //~ BOOST_TEST((*i++)() == 55);
+    //~ BOOST_TEST((*i++)() == 21);
 
     return boost::report_errors();
 }
Modified: trunk/libs/spirit/example/scheme/test/scheme/scheme_test2.cpp
==============================================================================
--- trunk/libs/spirit/example/scheme/test/scheme/scheme_test2.cpp	(original)
+++ trunk/libs/spirit/example/scheme/test/scheme/scheme_test2.cpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -39,8 +39,17 @@
     using scheme::interpreter;
     using scheme::_1;
 
-    scheme::interpreter factorial(in);
-    BOOST_TEST(factorial(10) == 3628800);
+    scheme::interpreter program(in);
+
+    for (int i = 2; i < argc; ++i)
+    {
+        bool r = program[argv[i]]() == true;
+        if (r)
+            std::cout << "Success: " << argv[i] << std::endl;
+        else
+            std::cout << "Fail: " << argv[i] << std::endl;
+        BOOST_TEST(r);
+    }
 
     return boost::report_errors();
 }
Modified: trunk/libs/spirit/example/scheme/test/scheme/scheme_test3.cpp
==============================================================================
--- trunk/libs/spirit/example/scheme/test/scheme/scheme_test3.cpp	(original)
+++ trunk/libs/spirit/example/scheme/test/scheme/scheme_test3.cpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -21,8 +21,8 @@
     using scheme::utree;
 
     utree src = "(define (factorial n) (if (<= n 0) 1 (* n (factorial (- n 1)))))";
-    scheme::interpreter factorial(src);
-    BOOST_TEST(factorial(10) == 3628800);
+    scheme::interpreter program(src);
+    BOOST_TEST(program["factorial"](10) == 3628800);
 
     return boost::report_errors();
 }
Modified: trunk/libs/spirit/example/scheme/test/utree/utree_test.cpp
==============================================================================
--- trunk/libs/spirit/example/scheme/test/utree/utree_test.cpp	(original)
+++ trunk/libs/spirit/example/scheme/test/utree/utree_test.cpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -22,7 +22,7 @@
 
 struct one_two_three
 {
-    scheme::utree operator()(scheme::args_type) const
+    scheme::utree operator()(scheme::scope) const
     {
         return scheme::utree(123);
     }
@@ -280,7 +280,7 @@
     {
         // test functions
         utree f = scheme::stored_function<one_two_three>();
-        f.eval(scheme::args_type());
+        f.eval(scheme::scope());
     }
 
     {
Modified: trunk/libs/spirit/example/scheme/utree/detail/utree_detail2.hpp
==============================================================================
--- trunk/libs/spirit/example/scheme/utree/detail/utree_detail2.hpp	(original)
+++ trunk/libs/spirit/example/scheme/utree/detail/utree_detail2.hpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -577,9 +577,9 @@
     };
 
     template <typename F>
-    utree stored_function<F>::operator()(args_type args) const
+    utree stored_function<F>::operator()(scope const& env) const
     {
-        return f(args);
+        return f(env);
     }
 
     template <typename F>
@@ -1289,10 +1289,10 @@
         s.tag(tag);
     }
 
-    inline utree utree::eval(args_type args) const
+    inline utree utree::eval(scope const& env) const
     {
         BOOST_ASSERT(get_type() == type::function_type);
-        return (*pf)(args);
+        return (*pf)(env);
     }
 }
 
Modified: trunk/libs/spirit/example/scheme/utree/utree.hpp
==============================================================================
--- trunk/libs/spirit/example/scheme/utree/utree.hpp	(original)
+++ trunk/libs/spirit/example/scheme/utree/utree.hpp	2010-04-22 23:12:26 EDT (Thu, 22 Apr 2010)
@@ -135,12 +135,12 @@
     // Our function type
     ///////////////////////////////////////////////////////////////////////////
     class utree;
-    typedef boost::iterator_range<utree const*> args_type;
+    class scope;
 
     struct function_base
     {
         virtual ~function_base() {};
-        virtual utree operator()(args_type args) const = 0;
+        virtual utree operator()(scope const& env) const = 0;
         virtual function_base* clone() const = 0;
     };
 
@@ -150,7 +150,7 @@
         F f;
         stored_function(F f = F());
         virtual ~stored_function();
-        virtual utree operator()(args_type args) const;
+        virtual utree operator()(scope const& env) const;
         virtual function_base* clone() const;
     };
 
@@ -317,7 +317,7 @@
         short tag() const;
         void tag(short tag);
 
-        utree eval(args_type args) const;
+        utree eval(scope const& env) const;
 
     private:
 
@@ -348,6 +348,30 @@
             function_base* pf;
         };
     };
+
+    ///////////////////////////////////////////////////////////////////////////
+    // The scope
+    ///////////////////////////////////////////////////////////////////////////
+    class scope : public boost::iterator_range<utree const*>
+    {
+    public:
+
+        scope(utree const* first = 0,
+            utree const* last = 0,
+            scope const* parent = 0)
+          : boost::iterator_range<utree const*>(first, last),
+            parent(parent),
+            depth(parent? parent->depth + 1 : 0)
+        {}
+
+        scope const* outer() const { return parent; }
+        int level() const { return depth; }
+
+    private:
+
+        scope const* parent;
+        int depth;
+    };
 }
 
 #if defined(BOOST_MSVC)