[Boost-commit] svn:boost r61240 - in trunk/libs/spirit/example/scheme: . test

Subject: [Boost-commit] svn:boost r61240 - in trunk/libs/spirit/example/scheme: . test
From: joel_at_[hidden]
Date: 2010-04-13 08:53:07

Author: djowel
Date: 2010-04-13 08:53:06 EDT (Tue, 13 Apr 2010)
New Revision: 61240
URL: http://svn.boost.org/trac/boost/changeset/61240

Log:
updates
Text files modified: 
   trunk/libs/spirit/example/scheme/scheme_compiler.hpp    |    47 +++++++++++++--------                   
   trunk/libs/spirit/example/scheme/scheme_interpreter.hpp |    11 ++--                                    
   trunk/libs/spirit/example/scheme/scheme_intinsics.hpp   |    38 ++++++++++++++--                        
   trunk/libs/spirit/example/scheme/test/utree_test.cpp    |    87 ++++++++++++++++++++------------------- 
   4 files changed, 111 insertions(+), 72 deletions(-)

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-13 08:53:06 EDT (Tue, 13 Apr 2010)
@@ -55,11 +55,12 @@
         std::map<std::string, compiled_function> definitions;
     };
 
-    actor compile(utree const& ast, environment& env, actor_list& fragments);
-
 ///////////////////////////////////////////////////////////////////////////////
 //  The compiler
 ///////////////////////////////////////////////////////////////////////////////
+    actor compile(
+        utree const& ast, environment& env, actor_list& fragments);
+
     struct external_function : composite<external_function>
     {
         // we must hold f by reference because functions can be recursive
@@ -78,9 +79,9 @@
     struct compiler
     {
         typedef actor result_type;
-
         environment& env;
         actor_list& fragments;
+
         compiler(environment& env, actor_list& fragments)
           : env(env), fragments(fragments)
         {
@@ -109,60 +110,69 @@
             return actor();
         }
 
-        void define_function(
-            std::string const& name,
+        actor make_lambda(
             std::vector<std::string> const& args,
             utree const& body) const
         {
             environment local_env(&this->env);
             for (std::size_t i = 0; i < args.size(); ++i)
                 local_env.define(args[i], boost::bind(arg, i));
-
-            fragments.push_back(actor());
-            actor& f = fragments.back();
-            env.define(name, external_function(f));
-            f = compile(body, local_env, fragments);
+            return compile(body, local_env, fragments);
         }
 
-        void define_nullary_function(
+        void define_function(
             std::string const& name,
+            std::vector<std::string> const& args,
             utree const& body) const
         {
             fragments.push_back(actor());
             actor& f = fragments.back();
             env.define(name, external_function(f));
-            f = compile(body, env, fragments);
+            f = make_lambda(args, body);
         }
 
         template <typename Iterator>
         actor operator()(boost::iterator_range<Iterator> const& range) const
         {
             std::string name(get_symbol(*range.begin()));
-            std::string fname;
 
             if (name == "define")
             {
+                std::string fname;
+                std::vector<std::string> args;
+
                 Iterator i = range.begin(); ++i;
                 if (i->which() == utree_type::list_type)
                 {
-                    // a function
+                    // (define (f x) ...body...)
                     utree const& decl = *i++;
                     Iterator di = decl.begin();
                     fname = get_symbol(*di++);
-                    std::vector<std::string> args;
                     while (di != decl.end())
                         args.push_back(get_symbol(*di++));
-                    define_function(fname, args, *i);
                 }
                 else
                 {
-                    // constants (nullary functions)
+                    // (define f ...body...)
                     fname = get_symbol(*i++);
-                    define_nullary_function(fname, *i);
                 }
+
+                define_function(fname, args, *i);
                 return actor(val(utf8_symbol("<define " + fname + ">")));
             }
 
+            if (name == "lambda")
+            {
+                // (lambda (x) ...body...)
+                Iterator i = range.begin(); ++i;
+                utree const& arg_names = *i++;
+                Iterator ai = arg_names.begin();
+                std::vector<std::string> args;
+                while (ai != arg_names.end())
+                    args.push_back(get_symbol(*ai++));
+                return make_lambda(args, *i);
+            }
+
             if (compiled_function* mf = env.find(name))
             {
                 actor_list flist;
@@ -204,6 +214,7 @@
     void build_basic_environment(environment& env)
     {
         env.define("if", if_);
+        env.define("<", less_than);
         env.define("<=", less_than_equal);
         env.define("+", plus);
         env.define("-", minus);

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-13 08:53:06 EDT (Tue, 13 Apr 2010)
@@ -272,14 +272,14 @@
     };
 
     ///////////////////////////////////////////////////////////////////////////
-    // vararg_function
+    // nary_function
     ///////////////////////////////////////////////////////////////////////////
     template <typename Derived>
-    struct vararg_function : composite<Derived>
+    struct nary_function : composite<Derived>
     {
-        typedef vararg_function<Derived> base_type;
+        typedef nary_function<Derived> base_type;
         actor_list elements;
-        vararg_function(actor_list const& elements)
+        nary_function(actor_list const& elements)
           : elements(elements) {}
 
         using composite<Derived>::operator();
@@ -291,7 +291,8 @@
                 rest(i++, elements.end());
             BOOST_FOREACH(actor const& element, rest)
             {
-                derived().eval(result, element(args));
+                if (!derived().eval(result, element(args)))
+                    break; // allow short-circuit evaluation
             }
             return result;
         }

Modified: trunk/libs/spirit/example/scheme/scheme_intinsics.hpp
==============================================================================
--- trunk/libs/spirit/example/scheme/scheme_intinsics.hpp	(original)
+++ trunk/libs/spirit/example/scheme/scheme_intinsics.hpp	2010-04-13 08:53:06 EDT (Tue, 13 Apr 2010)
@@ -46,6 +46,29 @@
     if_composite const if_ = if_composite();
 
     ///////////////////////////////////////////////////////////////////////////
+    // less_than
+    ///////////////////////////////////////////////////////////////////////////
+    struct less_than_function
+      : binary_function<less_than_function>
+    {
+        less_than_function(actor const& a, actor const& b)
+          : base_type(a, b) {}
+
+        typedef utree result_type;
+        utree eval(utree const& a, utree const& b) const
+        {
+            return a < b;
+        }
+    };
+
+    struct less_than_composite
+      : binary_composite<less_than_function> {};
+
+    less_than_composite const less_than
+        = less_than_composite();
+    less_than_composite const lt = less_than; // synonym
+
+    ///////////////////////////////////////////////////////////////////////////
     // less_than_equal
     ///////////////////////////////////////////////////////////////////////////
     struct less_than_equal_function
@@ -71,14 +94,15 @@
     ///////////////////////////////////////////////////////////////////////////
     // plus
     ///////////////////////////////////////////////////////////////////////////
-    struct plus_function : vararg_function<plus_function>
+    struct plus_function : nary_function<plus_function>
     {
         plus_function(actor_list const& elements)
           : base_type(elements) {}
 
-        void eval(utree& result, utree const& element) const
+        bool eval(utree& result, utree const& element) const
         {
             result = result + element;
+            return true;
         }
     };
 
@@ -88,14 +112,15 @@
     ///////////////////////////////////////////////////////////////////////////
     // minus
     ///////////////////////////////////////////////////////////////////////////
-    struct minus_function : vararg_function<minus_function>
+    struct minus_function : nary_function<minus_function>
     {
         minus_function(actor_list const& elements)
           : base_type(elements) {}
 
-        void eval(utree& result, utree const& element) const
+        bool eval(utree& result, utree const& element) const
         {
             result = result - element;
+            return true;
         }
     };
 
@@ -105,14 +130,15 @@
     ///////////////////////////////////////////////////////////////////////////
     // times
     ///////////////////////////////////////////////////////////////////////////
-    struct times_function : vararg_function<times_function>
+    struct times_function : nary_function<times_function>
     {
         times_function(actor_list const& elements)
           : base_type(elements) {}
 
-        void eval(utree& result, utree const& element) const
+        bool eval(utree& result, utree const& element) const
         {
             result = result * element;
+            return true;
         }
     };
 

Modified: trunk/libs/spirit/example/scheme/test/utree_test.cpp
==============================================================================
--- trunk/libs/spirit/example/scheme/test/utree_test.cpp	(original)
+++ trunk/libs/spirit/example/scheme/test/utree_test.cpp	2010-04-13 08:53:06 EDT (Tue, 13 Apr 2010)
@@ -9,6 +9,7 @@
 
 #include "../utree.hpp"
 #include "../utree_operators.hpp"
+#include "../utree_io.hpp"
 #include <iostream>
 
 inline std::ostream& println(std::ostream& out, scheme::utree const& val)
@@ -23,49 +24,49 @@
 {
     using scheme::utree;
 
-    //~ {
-        //~ // test the size
-        //~ std::cout << "size of utree is: "
-            //~ << sizeof(scheme::utree) << " bytes" << std::endl;
-    //~ }
-
-    //~ {
-        //~ utree val;
-        //~ println(std::cout, val);
-    //~ }
-
-    //~ {
-        //~ utree val(true);
-        //~ println(std::cout, val);
-    //~ }
-
-    //~ {
-        //~ utree val(123);
-        //~ println(std::cout, val);
-    //~ }
-
-    //~ {
-        //~ utree val(123.456);
-        //~ println(std::cout, val);
-    //~ }
-
-    //~ {
-        //~ utree val("Hello, World");
-        //~ println(std::cout, val);
-        //~ utree val2;
-        //~ val2 = val;
-        //~ println(std::cout, val2);
-        //~ utree val3("Hello, World. Chuckie is back!!!");
-        //~ val = val3;
-        //~ println(std::cout, val);
-
-        //~ utree val4("Apple");
-        //~ utree val5("Apple");
-        //~ BOOST_ASSERT(val4 == val5);
-
-        //~ utree val6("ApplePie");
-        //~ BOOST_ASSERT(val4 < val6);
-    //~ }
+    {
+        // test the size
+        std::cout << "size of utree is: "
+            << sizeof(scheme::utree) << " bytes" << std::endl;
+    }
+
+    {
+        utree val;
+        println(std::cout, val);
+    }
+
+    {
+        utree val(true);
+        println(std::cout, val);
+    }
+
+    {
+        utree val(123);
+        println(std::cout, val);
+    }
+
+    {
+        utree val(123.456);
+        println(std::cout, val);
+    }
+
+    {
+        utree val("Hello, World");
+        println(std::cout, val);
+        utree val2;
+        val2 = val;
+        println(std::cout, val2);
+        utree val3("Hello, World. Chuckie is back!!!");
+        val = val3;
+        println(std::cout, val);
+
+        utree val4("Apple");
+        utree val5("Apple");
+        BOOST_ASSERT(val4 == val5);
+
+        utree val6("ApplePie");
+        BOOST_ASSERT(val4 < val6);
+    }
 
     {
         utree val;