Boost logo

Boost-Commit :

Subject: [Boost-commit] svn:boost r63602 - in branches/release/libs/spirit/example: . scheme scheme/example scheme/example/generate_qiexpr scheme/example/parse_qiexpr scheme/example/scheme scheme/example/sexpr scheme/input scheme/output scheme/qi scheme/scheme scheme/scheme/detail scheme/support scheme/test scheme/test/qi scheme/test/scheme scheme/test/utree scheme/utree scheme/utree/detail
From: hartmut.kaiser_at_[hidden]
Date: 2010-07-04 12:30:43


Author: hkaiser
Date: 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
New Revision: 63602
URL: http://svn.boost.org/trac/boost/changeset/63602

Log:
Spirit: Added Scheme example to release branch
Added:
   branches/release/libs/spirit/example/scheme/
   branches/release/libs/spirit/example/scheme/example/
   branches/release/libs/spirit/example/scheme/example/Jamfile (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/generate_qiexpr/
   branches/release/libs/spirit/example/scheme/example/generate_qiexpr/generate_qi_test.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/generate_qiexpr/generate_qiexpr.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/generate_qiexpr/generate_sexpr_to_ostream.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/generate_qiexpr/input.txt (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/parse_qiexpr/
   branches/release/libs/spirit/example/scheme/example/parse_qiexpr/generate_sexpr_to_ostream.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/parse_qiexpr/input.txt (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/parse_qiexpr/parse_qi_test.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/parse_qiexpr/parse_qiexpr.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/scheme/
   branches/release/libs/spirit/example/scheme/example/scheme/call_factorial.scm (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/scheme/factorial.scm (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/scheme/factorial1.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/scheme/factorial2.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/scheme/scheme_error.scm (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/scheme/try_scheme.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/sexpr/
   branches/release/libs/spirit/example/scheme/example/sexpr/out.txt (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_error_test.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_input_test.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_output_test.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_output_test.txt (contents, props changed)
   branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_test.txt (contents, props changed)
   branches/release/libs/spirit/example/scheme/input/
   branches/release/libs/spirit/example/scheme/input/error_handler.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/input/parse_sexpr.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/input/parse_sexpr_impl.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/input/sexpr.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/input/string.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/output/
   branches/release/libs/spirit/example/scheme/output/generate_sexpr.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/output/generate_sexpr_impl.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/output/sexpr.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/output/utree_traits.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/qi/
   branches/release/libs/spirit/example/scheme/qi/component_names.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/qi/generate_qiexpr.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/qi/generate_qiexpr_impl.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/qi/parse_qiexpr.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/qi/parse_qiexpr_impl.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/qi/qiexpr_generator.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/qi/qiexpr_parser.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/scheme/
   branches/release/libs/spirit/example/scheme/scheme/compiler.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/scheme/detail/
   branches/release/libs/spirit/example/scheme/scheme/detail/composite_call.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/scheme/detail/function_call.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/scheme/interpreter.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/scheme/intrinsics.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/sexpr_output_test.txt (contents, props changed)
   branches/release/libs/spirit/example/scheme/support/
   branches/release/libs/spirit/example/scheme/support/line_pos_iterator.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/test/
   branches/release/libs/spirit/example/scheme/test/Jamfile (contents, props changed)
   branches/release/libs/spirit/example/scheme/test/qi/
   branches/release/libs/spirit/example/scheme/test/qi/calc.scm (contents, props changed)
   branches/release/libs/spirit/example/scheme/test/qi/qi_interpreter.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/test/scheme/
   branches/release/libs/spirit/example/scheme/test/scheme/scheme_test.scm (contents, props changed)
   branches/release/libs/spirit/example/scheme/test/scheme/scheme_test1.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/test/scheme/scheme_test2.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/test/scheme/scheme_test3.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/test/sexpr_output_test.txt (contents, props changed)
   branches/release/libs/spirit/example/scheme/test/utree/
   branches/release/libs/spirit/example/scheme/test/utree/utree_test.cpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/todo.txt (contents, props changed)
   branches/release/libs/spirit/example/scheme/utree/
   branches/release/libs/spirit/example/scheme/utree/detail/
   branches/release/libs/spirit/example/scheme/utree/detail/utree_detail1.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/utree/detail/utree_detail2.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/utree/io.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/utree/operators.hpp (contents, props changed)
   branches/release/libs/spirit/example/scheme/utree/utree.hpp (contents, props changed)
Properties modified:
   branches/release/libs/spirit/example/ (props changed)

Added: branches/release/libs/spirit/example/scheme/example/Jamfile
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/Jamfile 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,36 @@
+#==============================================================================
+# Copyright (c) 2001-2007 Joel de Guzman
+#
+# Distributed under the Boost Software License, Version 1.0. (See accompanying
+# file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+#==============================================================================
+project spirit-scheme-examples
+ : requirements
+ <toolset>gcc:<c++-template-depth>300
+ <include>../
+ :
+ :
+ ;
+
+exe sexpr_input_test : sexpr/sexpr_input_test.cpp ;
+exe sexpr_output_test : sexpr/sexpr_output_test.cpp ;
+exe sexpr_error_test : sexpr/sexpr_error_test.cpp ;
+
+exe parse_qi_test
+ : parse_qiexpr/generate_sexpr_to_ostream.cpp
+ parse_qiexpr/parse_qi_test.cpp
+ parse_qiexpr/parse_qiexpr.cpp
+ ;
+
+exe generate_qi_test
+ : parse_qiexpr/parse_qiexpr.cpp
+ generate_qiexpr/generate_qi_test.cpp
+ generate_qiexpr/generate_qiexpr.cpp
+ ;
+
+exe factorial1 : scheme/factorial1.cpp ;
+exe factorial2 : scheme/factorial2.cpp ;
+exe try_scheme : scheme/try_scheme.cpp ;
+
+
+

Added: branches/release/libs/spirit/example/scheme/example/generate_qiexpr/generate_qi_test.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/generate_qiexpr/generate_qi_test.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,121 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#include <boost/config/warning_disable.hpp>
+#include <boost/detail/lightweight_test.hpp>
+#include <boost/lexical_cast.hpp>
+
+#define BOOST_SPIRIT_UNICODE
+
+#include <iostream>
+#include <fstream>
+#include <iterator>
+
+#include <utree/utree.hpp>
+#include <utree/operators.hpp>
+#include <output/generate_sexpr.hpp>
+#include <qi/parse_qiexpr.hpp>
+#include <qi/generate_qiexpr.hpp>
+
+///////////////////////////////////////////////////////////////////////////////
+bool test_rhs(std::string const& str, scheme::utree& result)
+{
+ if (scheme::input::parse_qi_expr(str, result))
+ {
+ std::string scheme_str;
+ scheme::output::generate_sexpr(scheme_str, result);
+
+ std::string strout;
+ if (scheme::output::generate_qi_expr(result, strout))
+ {
+ std::cout << strout << std::endl;
+ return true;
+ }
+ else
+ {
+ std::cout << "generate error: " << result << std::endl;
+ }
+ }
+ else
+ {
+ std::cout << "parse error" << std::endl;
+ }
+ return false;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+bool test_rule(std::string str)
+{
+ // construct a rule
+ str = "name = " + str;
+
+ // parse it
+ scheme::utree result;
+ BOOST_TEST(scheme::input::parse_qi_rule(str, result));
+
+ std::string strout;
+ if (scheme::output::generate_qi_expr(result, strout))
+ {
+ std::cout << strout << std::endl;
+ return true;
+ }
+ return false;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+bool test_grammar(std::string str)
+{
+ // parse it
+ scheme::utree result;
+ if (scheme::input::parse_qi_grammar(str, result))
+ {
+ std::string scheme_str;
+ scheme::output::generate_sexpr_list(scheme_str, result);
+
+ std::string strout;
+ if (scheme::output::generate_qi_expr_list(result, strout))
+ {
+ std::cout << strout << std::endl;
+ return true;
+ }
+ }
+ return false;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main(int argc, char **argv)
+{
+ std::string rules;
+ int i = 0;
+
+ std::string str;
+ while (std::getline(std::cin, str))
+ {
+ if (str.empty() || str[0] == 'q' || str[0] == 'Q')
+ break;
+ str += '\n';
+
+ bool r = false;
+ scheme::utree result;
+ BOOST_TEST(r = test_rhs(str, result));
+
+ if (r && result.which() != scheme::utree_type::nil_type)
+ {
+ BOOST_TEST(r = test_rule(str));
+ if (r)
+ {
+ rules += "rule" + boost::lexical_cast<std::string>(++i)
+ + " = " + str + "\n";
+ }
+ }
+ }
+
+ // now test grammar rule
+ BOOST_TEST(test_grammar(rules));
+
+ return boost::report_errors();
+}

Added: branches/release/libs/spirit/example/scheme/example/generate_qiexpr/generate_qiexpr.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/generate_qiexpr/generate_qiexpr.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,23 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#define BOOST_SPIRIT_KARMA_DEBUG
+
+#include <utree/operators.hpp>
+
+#include <qi/generate_qiexpr.hpp>
+#include <qi/generate_qiexpr_impl.hpp>
+
+// explicit template instantiation for the function generate_qiexpr
+namespace scheme { namespace output
+{
+ template bool generate_qi_expr(utree& u, std::string& str);
+ template bool generate_qi_expr_list(utree& u, std::string& str);
+}}
+
+namespace scheme
+{
+ std::ostream& operator<<(std::ostream& out, nil const& x);
+}

Added: branches/release/libs/spirit/example/scheme/example/generate_qiexpr/generate_sexpr_to_ostream.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/generate_qiexpr/generate_sexpr_to_ostream.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,39 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#include <output/generate_sexpr.hpp>
+#include <output/generate_sexpr_impl.hpp>
+
+#include <fstream>
+
+///////////////////////////////////////////////////////////////////////////////
+// explicit template instantiation for the function parse_sexpr
+namespace scheme { namespace output
+{
+ template bool generate_sexpr(BOOST_TYPEOF(std::cout)&, utree const& result);
+ template bool generate_sexpr(std::string& str, utree const& result);
+ template bool generate_sexpr_list(std::string& str, utree const& result);
+}}
+
+#if defined(SCHEME_USE_SPIRIT_IO)
+namespace scheme
+{
+ std::ostream& operator<<(std::ostream& out, utree const& x)
+ {
+ output::generate_sexpr(out, x);
+ return out;
+ }
+}
+#endif
+
+///////////////////////////////////////////////////////////////////////////////
+// this is needed if grammar debugging is on
+namespace boost { namespace spirit { namespace traits
+{
+ void print_attribute(std::ostream& out, scheme::utree const& val)
+ {
+ scheme::output::generate_sexpr(out, val);
+ }
+}}}

Added: branches/release/libs/spirit/example/scheme/example/generate_qiexpr/input.txt
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/generate_qiexpr/input.txt 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,47 @@
+char_
+
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+// parser primitives
+char_
+char_("abc")
+char_('a')
+char_('a', 'b')
+'a'
+"abc"
+
+// sequences
+char_ >> char_
+char_ >> char_('a') >> char_('a', 'b')
+(char_ >> char_('a')) >> char_('a', 'b')
+char_ >> (char_('a') >> char_('a', 'b'))
+char_ >> (char_('a')) >> char_('a', 'b')
+
+// alternatives and sequences
+char_ | char_
+char_ | char_('a') >> char_('a', 'b')
+(char_ | char_('a')) | char_('a', 'b')
+char_ >> (char_('a') | char_('a', 'b'))
+char_ >> char_('a') | char_('a', 'b')
+(char_ >> char_('a')) | char_('a', 'b')
+
+// unary operators
+*double_
++*double_
++long_
+!+long_
+&int_ >> double_
+!int_ >> *double_
+char_ >> *(',' >> char_)
+
+// directives
+lexeme[*double_]
+
+// calculator :-P
+int_ >> *(('+' >> int_) | ('-' >> int_))
+
+
+

Added: branches/release/libs/spirit/example/scheme/example/parse_qiexpr/generate_sexpr_to_ostream.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/parse_qiexpr/generate_sexpr_to_ostream.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,27 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#include <output/generate_sexpr.hpp>
+#include <output/generate_sexpr_impl.hpp>
+
+#include <fstream>
+
+///////////////////////////////////////////////////////////////////////////////
+// explicit template instantiation for the function parse_sexpr
+namespace scheme { namespace output
+{
+ template bool generate_sexpr(BOOST_TYPEOF(std::cout)&, utree const& result);
+ template bool generate_sexpr_list(BOOST_TYPEOF(std::cout)&, utree const& result);
+}}
+
+///////////////////////////////////////////////////////////////////////////////
+// this is needed if grammar debugging is on
+namespace boost { namespace spirit { namespace traits
+{
+ void print_attribute(std::ostream& out, scheme::utree const& val)
+ {
+ scheme::output::generate_sexpr(out, val);
+ }
+}}}

Added: branches/release/libs/spirit/example/scheme/example/parse_qiexpr/input.txt
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/parse_qiexpr/input.txt 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,42 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+// parser primitives
+char_
+char_("abc")
+char_('a')
+char_('a', 'b')
+'a'
+"abc"
+
+// sequences
+char_ >> char_
+char_ >> char_('a') >> char_('a', 'b')
+(char_ >> char_('a')) >> char_('a', 'b')
+char_ >> (char_('a') >> char_('a', 'b'))
+char_ >> (char_('a')) >> char_('a', 'b')
+
+// alternatives and sequences
+char_ | char_
+char_ | char_('a') >> char_('a', 'b')
+(char_ | char_('a')) | char_('a', 'b')
+char_ >> (char_('a') | char_('a', 'b'))
+char_ >> char_('a') | char_('a', 'b')
+(char_ >> char_('a')) | char_('a', 'b')
+
+// unary operators
+*double_
++*double_
++long_
+!+long_
+&int_ >> double_
+!int_ >> *double_
+char_ >> *(',' >> char_)
+
+// directives
+lexeme[*double_]
+
+
+

Added: branches/release/libs/spirit/example/scheme/example/parse_qiexpr/parse_qi_test.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/parse_qiexpr/parse_qi_test.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,110 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#include <boost/config/warning_disable.hpp>
+#include <boost/detail/lightweight_test.hpp>
+#include <boost/lexical_cast.hpp>
+
+#define BOOST_SPIRIT_UNICODE
+
+#include <iostream>
+#include <fstream>
+#include <iterator>
+
+#include <utree/utree.hpp>
+#include <qi/parse_qiexpr.hpp>
+#include <output/generate_sexpr.hpp>
+
+///////////////////////////////////////////////////////////////////////////////
+bool parse_rhs(std::string const& str, scheme::utree& result)
+{
+ if (scheme::input::parse_qi_expr(str, result))
+ {
+ if (scheme::output::generate_sexpr(std::cout, result))
+ {
+ std::cout << std::endl;
+ return true;
+ }
+ else
+ {
+ std::cout << "generate error" << std::endl;
+ }
+ }
+ else
+ {
+ std::cout << "parse error" << std::endl;
+ }
+ return false;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+bool parse_rule(std::string str)
+{
+ // construct a rule
+ str = "name = " + str;
+
+ // parse it
+ scheme::utree result;
+ if (scheme::input::parse_qi_rule(str, result))
+ {
+ if (scheme::output::generate_sexpr(std::cout, result))
+ {
+ std::cout << std::endl;
+ return true;
+ }
+ }
+ return false;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+bool parse_grammar(std::string str)
+{
+ // parse it
+ scheme::utree result;
+ if (scheme::input::parse_qi_grammar(str, result))
+ {
+ if (scheme::output::generate_sexpr_list(std::cout, result))
+ {
+ std::cout << std::endl;
+ return true;
+ }
+ }
+ return false;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main(int argc, char **argv)
+{
+ std::string rules;
+ int i = 0;
+
+ std::string str;
+ while (std::getline(std::cin, str))
+ {
+ if (str.empty() || str[0] == 'q' || str[0] == 'Q')
+ break;
+ str += '\n';
+
+ bool r = false;
+ scheme::utree result;
+ BOOST_TEST(r = parse_rhs(str, result));
+ if (r && result.which() != scheme::utree_type::nil_type)
+ {
+ BOOST_TEST(r = parse_rule(str));
+ if (r)
+ {
+ rules += "rule" + boost::lexical_cast<std::string>(++i)
+ + " = " + str + "\n";
+ }
+ }
+ }
+
+ // now test grammar rule
+ BOOST_TEST(parse_grammar(rules));
+
+ return boost::report_errors();
+}

Added: branches/release/libs/spirit/example/scheme/example/parse_qiexpr/parse_qiexpr.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/parse_qiexpr/parse_qiexpr.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,18 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#include <string>
+
+#include <qi/parse_qiexpr.hpp>
+#include <qi/parse_qiexpr_impl.hpp>
+
+// explicit template instantiation for the function parse_qiexpr
+namespace scheme { namespace input
+{
+ template bool parse_qi_expr(std::string const&, utree& result);
+ template bool parse_qi_rule(std::string const&, utree& result);
+ template bool parse_qi_grammar(std::string const&, utree& result);
+}}
+

Added: branches/release/libs/spirit/example/scheme/example/scheme/call_factorial.scm
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/scheme/call_factorial.scm 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,7 @@
+; The hello-world for interpreters ;-)
+(define (factorial n)
+ (if (<= n 0) 1
+ (* n (factorial (- n 1)))))
+
+(define (main)
+ (display (factorial 10)))
\ No newline at end of file

Added: branches/release/libs/spirit/example/scheme/example/scheme/factorial.scm
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/scheme/factorial.scm 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,4 @@
+; The hello-world for interpreters ;-)
+(define (factorial n)
+ (if (<= n 0) 1
+ (* n (factorial (- n 1)))))

Added: branches/release/libs/spirit/example/scheme/example/scheme/factorial1.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/scheme/factorial1.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,58 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ 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>
+#include <fstream>
+
+void ignore_bom(std::ifstream& in)
+{
+ // Ignore the BOM marking the beginning of a UTF-8 file in Windows
+ char c = in.peek();
+ if (c == '\xef')
+ {
+ char s[3];
+ in >> s[0] >> s[1] >> s[2];
+ s[3] = '\0';
+ if (s != std::string("\xef\xbb\xbf"))
+ {
+ std::cerr << "Error: Unexpected characters from input file: "
+ << filename << std::endl;
+ return 1;
+ }
+ }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main()
+{
+ char const* filename = "factorial.scm";
+ std::ifstream in(filename, std::ios_base::in);
+
+ if (!in)
+ {
+ std::cerr << "Error: Could not open input file: "
+ << filename << std::endl;
+ return -1;
+ }
+ ignore_bom(in);
+
+ using scheme::interpreter;
+ using scheme::function;
+
+ interpreter program(in);
+ function factorial = program["factorial"];
+ std::cout << factorial(10) << std::endl;
+
+ return 0;
+}
+
+

Added: branches/release/libs/spirit/example/scheme/example/scheme/factorial2.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/scheme/factorial2.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,34 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ 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>
+#include <utree/io.hpp>
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main()
+{
+ using scheme::interpreter;
+ using scheme::function;
+ using scheme::utree;
+
+ utree src =
+ "(define (factorial n) "
+ "(if (<= n 0) 1 (* n (factorial (- n 1)))))";
+
+ interpreter program(src);
+ function factorial = program["factorial"];
+ std::cout << factorial(10) << std::endl;
+
+ return 0;
+}
+
+

Added: branches/release/libs/spirit/example/scheme/example/scheme/scheme_error.scm
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/scheme/scheme_error.scm 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,20 @@
+(define what blah) ; blah not found
+
+(define
+ (foo x)
+ (+ x 456))
+
+(define
+ (bar x)
+ (+ x y)) ; y not found
+
+(define (f1) (foo 123))
+(define (f2) (foo z)) ; z not found
+
+(define foo 123) ; redefinition
+
+(define (f3) (foo 123 456)) ; incorrect arity
+
+(define (f4) (bar 999)) ; bar should not be found
+
+(define (main) ) ; no body
\ No newline at end of file

Added: branches/release/libs/spirit/example/scheme/example/scheme/try_scheme.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/scheme/try_scheme.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,57 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#include <boost/config/warning_disable.hpp>
+
+#include <input/sexpr.hpp>
+#include <input/parse_sexpr_impl.hpp>
+#include <scheme/compiler.hpp>
+#include <utree/io.hpp>
+#include <fstream>
+
+int check_file(std::ifstream& in, char const* filename)
+{
+ if (!in)
+ {
+ std::cerr << filename << " not found" << std::endl;
+ return -1;
+ }
+
+ // Ignore the BOM marking the beginning of a UTF-8 file in Windows
+ char c = in.peek();
+ if (c == '\xef')
+ {
+ char s[3];
+ in >> s[0] >> s[1] >> s[2];
+ s[3] = '\0';
+ if (s != std::string("\xef\xbb\xbf"))
+ {
+ std::cerr << "Error: Unexpected characters from input file: "
+ << filename << std::endl;
+ return -1;
+ }
+ }
+ return 0;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main(int argc, char **argv)
+{
+ char const* filename = filename = argv[1];
+ std::ifstream in(filename, std::ios_base::in);
+ if (check_file(in, filename) != 0)
+ return -1;
+
+ scheme::interpreter program(in, filename);
+ scheme::function main_ = program["main"];
+ if (!main_.empty())
+ main_(); // call main
+ return 0;
+}
+
+

Added: branches/release/libs/spirit/example/scheme/example/sexpr/out.txt
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/sexpr/out.txt 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,2 @@
+success: (123.45 true false 255 63 "this is a € string" "Τη γλώσσα μου έδωσαν ελληνική" #0123456789abcdef123456789abcdef# (92 ("another string" apple Sîne)))
+

Added: branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_error_test.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_error_test.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,52 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#include <boost/config/warning_disable.hpp>
+
+#include <input/sexpr.hpp>
+#include <input/parse_sexpr_impl.hpp>
+#include <utree/io.hpp>
+#include <iostream>
+#include <fstream>
+
+inline std::ostream& println(std::ostream& out, scheme::utree const& val)
+{
+ out << val << std::endl;
+ return out;
+}
+
+void test(std::string const& in, std::string const& file)
+{
+ scheme::utree result;
+ if (scheme::input::parse_sexpr(in, result, file))
+ {
+ std::cout << "success: ";
+ println(std::cout, result);
+ std::cout << std::endl;
+ }
+ else
+ {
+ std::cout << "parse error" << std::endl;
+ }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main()
+{
+ test("(abc def)", "ok.sexpr");
+ test("(abc (123 456) def)", "ok.sexpr");
+ test("(abc \n(\"a string\" 456) \ndef)", "ok.sexpr");
+ test("(abc \n(\"a string\" 456 \ndef)", "missing close paren.sexpr");
+ test("(abc \n(\"a string 456) \ndef)", "missing double quote.sexpr");
+ test("(abc \n(\"a string\" 0xggg) \ndef)", "erronoeus hex.sexpr");
+ test("(abc \n(\"a \\zstring\" 999) \ndef)", "erronoeus escape.sexpr");
+ test("(abc \n(\"a \uzstring\" 999) \ndef)", "erronoeus escape.sexpr");
+ return 0;
+}
+
+

Added: branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_input_test.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_input_test.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,76 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#include <boost/config/warning_disable.hpp>
+
+#include <input/sexpr.hpp>
+#include <input/parse_sexpr_impl.hpp>
+#include <utree/io.hpp>
+#include <iostream>
+#include <fstream>
+
+inline std::ostream& println(std::ostream& out, scheme::utree const& val)
+{
+ out << val << std::endl;
+ return out;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main(int argc, char **argv)
+{
+ char const* filename = NULL;
+ if (argc > 1)
+ {
+ filename = argv[1];
+ }
+ else
+ {
+ std::cerr << "Error: No input file provided." << std::endl;
+ return 1;
+ }
+
+ std::ifstream in(filename, std::ios_base::in);
+
+ if (!in)
+ {
+ std::cerr << "Error: Could not open input file: "
+ << filename << std::endl;
+ return 1;
+ }
+
+ // Ignore the BOM marking the beginning of a UTF-8 file in Windows
+ char c = in.peek();
+ if (c == '\xef')
+ {
+ char s[3];
+ in >> s[0] >> s[1] >> s[2];
+ s[3] = '\0';
+ if (s != std::string("\xef\xbb\xbf"))
+ {
+ std::cerr << "Error: Unexpected characters from input file: "
+ << filename << std::endl;
+ return 1;
+ }
+ }
+
+ scheme::utree result;
+ if (scheme::input::parse_sexpr(in, result))
+ {
+ std::cout << "success: ";
+ println(std::cout, result);
+ std::cout << std::endl;
+ }
+ else
+ {
+ std::cout << "parse error" << std::endl;
+ }
+
+ return 0;
+}
+
+

Added: branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_output_test.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_output_test.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,105 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#include <boost/config/warning_disable.hpp>
+
+#define BOOST_SPIRIT_UNICODE
+
+#include <iostream>
+#include <fstream>
+#include <iterator>
+
+#include <input/parse_sexpr_impl.hpp>
+#include <output/generate_sexpr_impl.hpp>
+
+namespace client
+{
+ bool parse_sexpr_from_file(char const* filename, scheme::utree& result)
+ {
+ std::ifstream in(filename, std::ios_base::in);
+
+ if (!in)
+ {
+ std::cerr << "Error: Could not open input file: "
+ << filename << std::endl;
+ exit(-1);
+ }
+
+ // Ignore the BOM marking the beginning of a UTF-8 file in Windows
+ char c = in.peek();
+ if (c == '\xef')
+ {
+ char s[3];
+ in >> s[0] >> s[1] >> s[2];
+ s[3] = '\0';
+ if (s != std::string("\xef\xbb\xbf"))
+ {
+ std::cerr << "Error: Unexpected characters from input file: "
+ << filename << std::endl;
+ exit(-1);
+ }
+ }
+
+ return scheme::input::parse_sexpr(in, result);
+ }
+
+ bool generate_sexpr_to_file(scheme::utree const& tree, char const* filename)
+ {
+ std::ofstream out(filename);
+
+ if (!out)
+ {
+ std::cerr << "Error: Could not open output file: "
+ << filename << std::endl;
+ exit(-1);
+ }
+
+ return scheme::output::generate_sexpr(out, tree);
+ }
+}
+
+int main(int argc, char **argv)
+{
+ char const* filename_in = NULL;
+ if (argc > 1)
+ {
+ filename_in = argv[1];
+ }
+ else
+ {
+ std::cerr << "Error: No input file provided." << std::endl;
+ return -1;
+ }
+
+ char const* filename_out = NULL;
+ if (argc > 2)
+ {
+ filename_out = argv[2];
+ }
+ else
+ {
+ std::cerr << "Error: No output file provided." << std::endl;
+ return -1;
+ }
+
+ scheme::utree result;
+ if (client::parse_sexpr_from_file(filename_in, result))
+ {
+ if (client::generate_sexpr_to_file(result, filename_out))
+ {
+ std::cout << "success!" << std::endl;
+ }
+ else
+ {
+ std::cout << "generate error" << std::endl;
+ }
+ }
+ else
+ {
+ std::cout << "parse error" << std::endl;
+ }
+
+ return 0;
+}

Added: branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_output_test.txt
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_output_test.txt 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1 @@
+( 123.45 true false 255 63 "this is a € string" "Τη γλώσσα μου έδωσαν ελληνική" b0123456789abcdef0123456789abcdef ( 92 ( "another string" apple Sîne ) ) )
\ No newline at end of file

Added: branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_test.txt
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/example/sexpr/sexpr_test.txt 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,13 @@
+(
+ 123.45
+ true
+ false
+ 0xFF
+ 077
+ "this is a \u20AC string" ; A UTF-8 string
+ "Τη γλώσσα μου έδωσαν ελληνική" ; Another UTF-8 string
+ #0123456789ABCDEF0123456789abcdef# ; A binary stream
+ (
+ 92 ("another string" apple Sîne)
+ )
+)
\ No newline at end of file

Added: branches/release/libs/spirit/example/scheme/input/error_handler.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/input/error_handler.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,46 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_SEXPR_ERROR_HANDLER)
+#define BOOST_SPIRIT_SEXPR_ERROR_HANDLER
+
+#include <boost/spirit/home/support/info.hpp>
+#include <boost/spirit/include/phoenix_core.hpp>
+#include <support/line_pos_iterator.hpp>
+#include <string>
+#include <iostream>
+
+namespace scheme { namespace input
+{
+ template <typename Iterator>
+ struct error_handler
+ {
+ template <typename, typename, typename, typename>
+ struct result { typedef void type; };
+
+ std::string source_file;
+ error_handler(std::string const& source_file = "")
+ : source_file(source_file) {}
+
+ void operator()(
+ Iterator first, Iterator last,
+ Iterator err_pos, boost::spirit::info const& what) const
+ {
+ Iterator eol = err_pos;
+ int line = get_line(err_pos);
+
+ if (source_file != "")
+ std::cerr << source_file;
+
+ if (line != -1)
+ std::cerr << '(' << line << ')';
+
+ std::cerr << " : Error! Expecting " << what << std::endl;
+ }
+ };
+}}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/input/parse_sexpr.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/input/parse_sexpr.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,63 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+// Copyright (c) 2001-2010 Joel de Guzman
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_PARSE_SEXPR)
+#define BOOST_SPIRIT_PARSE_SEXPR
+
+#include <utree/utree.hpp>
+#include <input/sexpr.hpp>
+#include <boost/utility/enable_if.hpp>
+#include <boost/type_traits/is_base_of.hpp>
+#include <iosfwd>
+#include <string>
+
+namespace scheme { namespace input
+{
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool parse_sexpr(
+ std::basic_istream<Char>& is,
+ utree& result,
+ std::string const& source_file = "");
+
+ template <typename Char>
+ bool parse_sexpr_list(
+ std::basic_istream<Char>& is,
+ utree& result,
+ std::string const& source_file = "");
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Range>
+ typename boost::disable_if<
+ boost::is_base_of<std::ios_base, Range>, bool>::type
+ parse_sexpr(
+ Range const& rng,
+ utree& result,
+ std::string const& source_file = "");
+
+ template <typename Range>
+ typename boost::disable_if<
+ boost::is_base_of<std::ios_base, Range>, bool>::type
+ parse_sexpr_list(
+ Range const& rng,
+ utree& result,
+ std::string const& source_file = "");
+
+ ///////////////////////////////////////////////////////////////////////////
+ bool parse_sexpr(
+ utree const& in,
+ utree& result,
+ std::string const& source_file = "");
+
+ bool parse_sexpr_list(
+ utree const& in,
+ utree& result,
+ std::string const& source_file = "");
+}}
+
+#endif
+
+

Added: branches/release/libs/spirit/example/scheme/input/parse_sexpr_impl.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/input/parse_sexpr_impl.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,142 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+// Copyright (c) 2001-2010 Joel de Guzman
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_PARSE_SEXPR_IMPL)
+#define BOOST_SPIRIT_PARSE_SEXPR_IMPL
+
+#include <iostream>
+#include <string>
+#include <boost/spirit/include/support_istream_iterator.hpp>
+#include <boost/spirit/include/qi_parse.hpp>
+
+#include <input/sexpr.hpp>
+#include <input/parse_sexpr.hpp>
+#include <support/line_pos_iterator.hpp>
+
+namespace scheme { namespace input
+{
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool parse_sexpr(
+ std::basic_istream<Char>& is,
+ utree& result,
+ std::string const& source_file)
+ {
+ // no white space skipping in the stream!
+ is.unsetf(std::ios::skipws);
+
+ typedef
+ boost::spirit::basic_istream_iterator<Char>
+ stream_iterator_type;
+ stream_iterator_type sfirst(is);
+ stream_iterator_type slast;
+
+ typedef line_pos_iterator<stream_iterator_type> iterator_type;
+ iterator_type first(sfirst);
+ iterator_type last(slast);
+
+ scheme::input::sexpr<iterator_type> p(source_file);
+ scheme::input::sexpr_white_space<iterator_type> ws;
+
+ using boost::spirit::qi::phrase_parse;
+ return phrase_parse(first, last, p, ws, result);
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool parse_sexpr_list(
+ std::basic_istream<Char>& is,
+ utree& result,
+ std::string const& source_file)
+ {
+ // no white space skipping in the stream!
+ is.unsetf(std::ios::skipws);
+
+ typedef
+ boost::spirit::basic_istream_iterator<Char>
+ stream_iterator_type;
+ stream_iterator_type sfirst(is);
+ stream_iterator_type slast;
+
+ typedef line_pos_iterator<stream_iterator_type> iterator_type;
+ iterator_type first(sfirst);
+ iterator_type last(slast);
+
+ scheme::input::sexpr<iterator_type> p(source_file);
+ scheme::input::sexpr_white_space<iterator_type> ws;
+
+ using boost::spirit::qi::phrase_parse;
+ bool ok = phrase_parse(first, last, +p, ws, result);
+ result.tag(1); // line
+ return ok;
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Range>
+ typename boost::disable_if<boost::is_base_of<std::ios_base, Range>, bool>::type
+ parse_sexpr(
+ Range const& rng,
+ utree& result,
+ std::string const& source_file)
+ {
+ typedef
+ line_pos_iterator<typename Range::const_iterator>
+ iterator_type;
+
+ scheme::input::sexpr<iterator_type> p(source_file);
+ scheme::input::sexpr_white_space<iterator_type> ws;
+
+ iterator_type first(rng.begin());
+ iterator_type last(rng.end());
+
+ using boost::spirit::qi::phrase_parse;
+ return phrase_parse(first, last, p, ws, result);
+ }
+
+ template <typename Range>
+ typename boost::disable_if<boost::is_base_of<std::ios_base, Range>, bool>::type
+ parse_sexpr_list(
+ Range const& rng,
+ utree& result,
+ std::string const& source_file)
+ {
+ typedef
+ line_pos_iterator<typename Range::const_iterator>
+ iterator_type;
+
+ scheme::input::sexpr<iterator_type> p(source_file);
+ scheme::input::sexpr_white_space<iterator_type> ws;
+
+ iterator_type first(rng.begin());
+ iterator_type last(rng.end());
+
+ using boost::spirit::qi::phrase_parse;
+ bool ok = phrase_parse(first, last, +p, ws, result);
+ result.tag(1); // line
+ return ok;
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ bool parse_sexpr(
+ utree const& in,
+ utree& result,
+ std::string const& source_file)
+ {
+ return parse_sexpr(in.get<utf8_string_range>(), result, source_file);
+ }
+
+ bool parse_sexpr_list(
+ utree const& in,
+ utree& result,
+ std::string const& source_file)
+ {
+ return parse_sexpr_list(in.get<utf8_string_range>(), result, source_file);
+ }
+}}
+
+#endif
+
+

Added: branches/release/libs/spirit/example/scheme/input/sexpr.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/input/sexpr.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,146 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_SEXPR)
+#define BOOST_SPIRIT_SEXPR
+
+#include <string>
+
+#include <boost/cstdint.hpp>
+#include <boost/spirit/include/qi.hpp>
+#include <boost/spirit/include/phoenix_core.hpp>
+#include <boost/spirit/include/phoenix_container.hpp>
+#include <boost/spirit/include/phoenix_statement.hpp>
+#include <boost/spirit/include/phoenix_operator.hpp>
+#include <boost/regex/pending/unicode_iterator.hpp>
+
+#include <utree/utree.hpp>
+#include <utree/operators.hpp>
+#include <input/string.hpp>
+#include <input/error_handler.hpp>
+
+namespace scheme { namespace input
+{
+ using boost::spirit::standard::char_;
+ using boost::spirit::standard::space;
+ using boost::spirit::qi::grammar;
+ using boost::spirit::qi::rule;
+ using boost::spirit::qi::eol;
+ using boost::spirit::qi::uint_parser;
+ using boost::spirit::qi::real_parser;
+ using boost::spirit::qi::strict_real_policies;
+ using boost::spirit::qi::int_;
+ using boost::spirit::qi::hex;
+ using boost::spirit::qi::oct;
+ using boost::spirit::qi::bool_;
+ using boost::spirit::qi::no_case;
+ using boost::spirit::qi::lexeme;
+ using boost::spirit::qi::on_error;
+ using boost::spirit::qi::fail;
+ using boost::spirit::qi::_val;
+ using boost::spirit::qi::_1;
+ using boost::spirit::qi::_2;
+ using boost::spirit::qi::_3;
+ using boost::spirit::qi::_4;
+ using boost::spirit::qi::locals;
+ using boost::spirit::qi::raw;
+ using boost::spirit::qi::eps;
+ using boost::spirit::qi::omit;
+ using boost::spirit::info;
+
+ typedef boost::uint32_t uchar; // a unicode code point
+
+ template <typename Iterator>
+ struct sexpr_white_space : grammar<Iterator>
+ {
+ sexpr_white_space() : sexpr_white_space::base_type(start)
+ {
+ start =
+ space // tab/space/cr/lf
+ | ';' >> *(char_ - eol) >> eol // comments
+ ;
+ }
+
+ rule<Iterator> start;
+ };
+
+ struct save_line_pos_
+ {
+ template <typename Utree, typename Range>
+ struct result { typedef void type; };
+
+ template <typename Range>
+ void operator()(utree& ast, Range const& rng) const
+ {
+ int n = get_line(rng.begin());
+ BOOST_ASSERT(n <= (std::numeric_limits<short>::max)());
+ ast.tag(n);
+ }
+ };
+
+ boost::phoenix::function<save_line_pos_> const
+ save_line_pos = save_line_pos_();
+
+ template <typename Iterator,
+ typename ErrorHandler = input::error_handler<Iterator> >
+ struct sexpr : grammar<Iterator, sexpr_white_space<Iterator>, utree()>
+ {
+ sexpr(std::string const& source_file = "")
+ : sexpr::base_type(start), error_handler(ErrorHandler(source_file))
+ {
+ real_parser<double, strict_real_policies<double> > strict_double;
+ uint_parser<unsigned char, 16, 2, 2> hex2;
+
+ start = element.alias();
+ element = atom | list;
+
+ list %= '('
+ > omit[raw[eps] [save_line_pos(_val, _1)]]
+ > *element
+ > ')'
+ ;
+
+ atom = strict_double
+ | integer
+ | bool_
+ | string
+ | byte_str
+ | symbol
+ ;
+
+ std::string exclude = std::string(" ();\"\x01-\x1f\x7f") + '\0';
+ symbol = lexeme[+(~char_(exclude))];
+
+ integer = lexeme[no_case["0x"] > hex]
+ | lexeme['0' >> oct]
+ | int_
+ ;
+
+ byte_str = lexeme['#' > +hex2 > '#'];
+
+ start.name("sexpr");
+ list.name("list");
+ atom.name("atom");
+ symbol.name("symbol");
+ integer.name("integer");
+ byte_str.name("byte_str");
+
+ on_error<fail>(start, error_handler(_1, _2, _3, _4));
+ }
+
+ rule<Iterator, sexpr_white_space<Iterator>, utree()>
+ start, element, list;
+ rule<Iterator, int()> integer;
+ rule<Iterator, utree()> atom;
+ rule<Iterator, utf8_symbol()> symbol;
+ rule<Iterator, binary_string()> byte_str;
+ scheme::input::string<Iterator> string;
+
+ function<ErrorHandler> const error_handler;
+ };
+}}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/input/string.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/input/string.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,114 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_SEXPR_STRING)
+#define BOOST_SPIRIT_SEXPR_STRING
+
+#include <string>
+
+#include <boost/cstdint.hpp>
+#include <boost/spirit/include/qi.hpp>
+#include <boost/spirit/include/phoenix_core.hpp>
+#include <boost/spirit/include/phoenix_container.hpp>
+#include <boost/spirit/include/phoenix_statement.hpp>
+#include <boost/spirit/include/phoenix_operator.hpp>
+#include <boost/regex/pending/unicode_iterator.hpp>
+
+#include <utree/utree.hpp>
+#include <utree/operators.hpp>
+
+namespace scheme { namespace input
+{
+ using boost::spirit::standard::char_;
+ using boost::spirit::qi::grammar;
+ using boost::spirit::qi::rule;
+ using boost::spirit::qi::_val;
+ using boost::spirit::qi::_r1;
+ using boost::spirit::qi::_1;
+ using boost::spirit::qi::uint_parser;
+ using boost::phoenix::function;
+
+ typedef boost::uint32_t uchar; // a unicode code point
+
+ namespace detail
+ {
+ struct push_utf8
+ {
+ template <typename S, typename C>
+ struct result { typedef void type; };
+
+ void operator()(std::string& utf8, uchar code_point) const
+ {
+ typedef std::back_insert_iterator<std::string> insert_iter;
+ insert_iter out_iter(utf8);
+ boost::utf8_output_iterator<insert_iter> utf8_iter(out_iter);
+ *utf8_iter++ = code_point;
+ }
+ };
+
+ struct push_esc
+ {
+ template <typename S, typename C>
+ struct result { typedef void type; };
+
+ void operator()(std::string& utf8, uchar c) const
+ {
+ switch (c)
+ {
+ case 'b': utf8 += '\b'; break;
+ case 't': utf8 += '\t'; break;
+ case 'n': utf8 += '\n'; break;
+ case 'f': utf8 += '\f'; break;
+ case 'r': utf8 += '\r'; break;
+ case '"': utf8 += '"'; break;
+ case '\\': utf8 += '\\'; break;
+ }
+ }
+ };
+ }
+
+ template <typename Iterator>
+ struct string : grammar<Iterator, std::string()>
+ {
+ string() : string::base_type(start)
+ {
+ uint_parser<uchar, 16, 4, 4> hex4;
+ uint_parser<uchar, 16, 8, 8> hex8;
+ function<detail::push_utf8> push_utf8;
+ function<detail::push_esc> push_esc;
+
+ char_esc
+ = '\\'
+ > ( ('u' > hex4) [push_utf8(_r1, _1)]
+ | ('U' > hex8) [push_utf8(_r1, _1)]
+ | char_("btnfr\\\"'") [push_esc(_r1, _1)]
+ )
+ ;
+
+ char_lit
+ = '\''
+ > (char_esc(_val) | (~char_('\'')) [_val += _1])
+ > '\''
+ ;
+
+ start
+ = '"'
+ > *(char_esc(_val) | (~char_('"')) [_val += _1])
+ > '"'
+ ;
+
+ char_esc.name("char_esc");
+ char_lit.name("char_lit");
+ start.name("string");
+ }
+
+ rule<Iterator, void(std::string&)> char_esc;
+ rule<Iterator, std::string()> char_lit;
+ rule<Iterator, std::string()> start;
+ };
+}}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/output/generate_sexpr.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/output/generate_sexpr.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,33 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(SCHEME_OUTPUT_GENERATE_SEXPR_MAR_29_2010_1210PM)
+#define SCHEME_OUTPUT_GENERATE_SEXPR_MAR_29_2010_1210PM
+
+#include <utree/utree.hpp>
+#include <output/sexpr.hpp>
+
+namespace scheme { namespace output
+{
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool generate_sexpr(std::basic_ostream<Char>& os, utree const& tree);
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool generate_sexpr_list(std::basic_ostream<Char>& os, utree const& tree);
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool generate_sexpr(std::basic_string<Char>& str, utree const& tree);
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool generate_sexpr_list(std::basic_string<Char>& str, utree const& tree);
+}}
+
+#endif
+
+

Added: branches/release/libs/spirit/example/scheme/output/generate_sexpr_impl.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/output/generate_sexpr_impl.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,81 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(SCHEME_OUTPUT_GENERATE_SEXPR_IMPL_MAR_29_2010_1210PM)
+#define SCHEME_OUTPUT_GENERATE_SEXPR_MAR_IMPL_29_2010_1210PM
+
+#include <boost/spirit/include/karma_generate.hpp>
+#include <boost/spirit/include/karma_char.hpp>
+#include <boost/spirit/include/karma_list.hpp>
+#include <boost/spirit/include/support_ostream_iterator.hpp>
+
+#include <output/sexpr.hpp>
+#include <output/generate_sexpr.hpp>
+
+namespace scheme { namespace output
+{
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool generate_sexpr(std::basic_ostream<Char>& os, utree const& tree)
+ {
+ typedef boost::spirit::ostream_iterator output_iterator_type;
+
+ using boost::spirit::karma::space;
+ using boost::spirit::karma::generate_delimited;
+
+ scheme::output::sexpr<output_iterator_type> g;
+
+ return generate_delimited(output_iterator_type(os), g, space, tree);
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool generate_sexpr_list(std::basic_ostream<Char>& os, utree const& tree)
+ {
+ typedef boost::spirit::ostream_iterator output_iterator_type;
+
+ using boost::spirit::karma::space;
+ using boost::spirit::karma::eol;
+ using boost::spirit::karma::generate_delimited;
+
+ scheme::output::sexpr<output_iterator_type> g;
+
+ return generate_delimited(output_iterator_type(os), g % eol, space, tree);
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool generate_sexpr(std::basic_string<Char>& os, utree const& tree)
+ {
+ typedef std::basic_string<Char> string_type;
+ typedef std::back_insert_iterator<string_type> output_iterator_type;
+
+ using boost::spirit::karma::space;
+ using boost::spirit::karma::generate_delimited;
+
+ scheme::output::sexpr<output_iterator_type> g;
+ return generate_delimited(output_iterator_type(os), g, space, tree);
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Char>
+ bool generate_sexpr_list(std::basic_string<Char>& os, utree const& tree)
+ {
+ typedef std::basic_string<Char> string_type;
+ typedef std::back_insert_iterator<string_type> output_iterator_type;
+
+ using boost::spirit::karma::space;
+ using boost::spirit::karma::eol;
+ using boost::spirit::karma::generate_delimited;
+
+ scheme::output::sexpr<output_iterator_type> g;
+
+ return generate_delimited(output_iterator_type(os), g % eol, space, tree);
+ }
+}}
+
+#endif
+
+

Added: branches/release/libs/spirit/example/scheme/output/sexpr.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/output/sexpr.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,80 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(SCHEME_OUTPUT_SEXPR_MAR_8_2010_829AM)
+#define SCHEME_OUTPUT_SEXPR_MAR_8_2010_829AM
+
+#include <utree/utree.hpp>
+#include <output/utree_traits.hpp>
+
+#include <string>
+
+#include <boost/cstdint.hpp>
+#include <boost/mpl/bool.hpp>
+#include <boost/spirit/include/karma.hpp>
+
+///////////////////////////////////////////////////////////////////////////////
+namespace scheme { namespace output
+{
+ using boost::spirit::karma::grammar;
+ using boost::spirit::karma::space_type;
+ using boost::spirit::karma::rule;
+ using boost::spirit::karma::double_;
+ using boost::spirit::karma::int_;
+ using boost::spirit::karma::string;
+ using boost::spirit::karma::bool_;
+ using boost::spirit::karma::eps;
+ using boost::spirit::karma::uint_generator;
+ using boost::spirit::karma::hex;
+ using boost::spirit::karma::right_align;
+
+ template <typename OutputIterator>
+ struct sexpr : grammar<OutputIterator, space_type, utree()>
+ {
+ sexpr() : sexpr::base_type(start)
+ {
+ uint_generator<unsigned char, 16> hex2;
+
+ start = double_
+ | int_
+ | bool_
+ | string_
+ | symbol
+ | byte_str
+ | list
+ | nil
+ | ref_
+ ;
+
+ list = '(' << *start << ')';
+
+ string_ = '"' << string << '"';
+ symbol = string;
+ byte_str = '#' << *right_align(2, '0')[hex2] << '#';
+ nil = eps << "<nil>";
+ ref_ = start;
+
+ start.name("start");
+ list.name("list");
+ string_.name("string_");
+ symbol.name("symbol");
+ byte_str.name("byte_str");
+ nil.name("nil");
+ ref_.name("ref_");
+ }
+
+ typedef boost::iterator_range<utree::const_iterator> utree_list;
+
+ rule<OutputIterator, space_type, utree()> start;
+ rule<OutputIterator, space_type, utree_list()> list;
+ rule<OutputIterator, utf8_symbol_range()> symbol;
+ rule<OutputIterator, utf8_string_range()> string_;
+ rule<OutputIterator, binary_range()> byte_str;
+ rule<OutputIterator, nil()> nil;
+ rule<OutputIterator, space_type, utree()> ref_;
+ };
+}}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/output/utree_traits.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/output/utree_traits.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,318 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(SCHEME_OUTPUT_UTREE_TRAITS_APR_16_2010_0655AM)
+#define SCHEME_OUTPUT_UTREE_TRAITS_APR_16_2010_0655AM
+
+#include <utree/utree.hpp>
+
+#include <string>
+
+#include <boost/cstdint.hpp>
+#include <boost/spirit/include/karma.hpp>
+
+///////////////////////////////////////////////////////////////////////////////
+namespace boost
+{
+ template <typename T>
+ inline T get(scheme::utree const& x)
+ {
+ return x.get<T>();
+ }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+namespace boost { namespace spirit { namespace traits
+{
+ ///////////////////////////////////////////////////////////////////////////
+ // the specialization below tells Spirit to handle scheme::utree as if it
+ // where a 'real' variant (in the context of karma)
+ template <>
+ struct not_is_variant<scheme::utree, karma::domain>
+ : mpl::false_ {};
+
+ ///////////////////////////////////////////////////////////////////////////
+ // this specialization tells Spirit how to extract the type of the value
+ // stored in the given utree node
+ template <>
+ struct variant_which<scheme::utree>
+ {
+ static int call(scheme::utree const& u) { return u.which(); }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // The specializations below tell Spirit to verify whether an attribute
+ // type is compatible with a given variant type
+ template <>
+ struct compute_compatible_component_variant<
+ scheme::utree, iterator_range<scheme::utree::iterator> >
+ : mpl::true_
+ {
+ typedef iterator_range<scheme::utree::iterator> compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::list_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<
+ scheme::utree, iterator_range<scheme::utree::const_iterator> >
+ : mpl::true_
+ {
+ typedef iterator_range<scheme::utree::const_iterator> compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::list_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<scheme::utree, scheme::nil>
+ : mpl::true_
+ {
+ typedef scheme::nil compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::nil_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<scheme::utree, bool>
+ : mpl::true_
+ {
+ typedef bool compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::bool_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<scheme::utree, int>
+ : mpl::true_
+ {
+ typedef int compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::int_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<scheme::utree, double>
+ : mpl::true_
+ {
+ typedef double compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::double_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<
+ scheme::utree, scheme::utf8_string_range>
+ : mpl::true_
+ {
+ typedef scheme::utf8_string_range compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::string_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<
+ scheme::utree, scheme::utf8_string>
+ : mpl::true_
+ {
+ typedef scheme::utf8_string compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::string_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<
+ scheme::utree, scheme::utf8_symbol_range>
+ : mpl::true_
+ {
+ typedef scheme::utf8_symbol_range compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::symbol_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<
+ scheme::utree, scheme::utf8_symbol>
+ : mpl::true_
+ {
+ typedef scheme::utf8_symbol compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::symbol_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<
+ scheme::utree, scheme::binary_range>
+ : mpl::true_
+ {
+ typedef scheme::binary_range compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::binary_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<
+ scheme::utree, scheme::binary_string>
+ : mpl::true_
+ {
+ typedef scheme::binary_string compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::binary_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<scheme::utree, scheme::utree>
+ : mpl::true_
+ {
+ typedef scheme::utree compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d >= scheme::utree_type::nil_type &&
+ d <= scheme::utree_type::reference_type;
+ }
+ };
+
+ template <>
+ struct compute_compatible_component_variant<
+ scheme::utree, std::vector<scheme::utree> >
+ : mpl::true_
+ {
+ typedef scheme::utree compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d >= scheme::utree_type::nil_type &&
+ d <= scheme::utree_type::reference_type;
+ }
+ };
+
+ template <typename Sequence>
+ struct compute_compatible_component_variant<scheme::utree, Sequence
+ , mpl::false_
+ , typename enable_if<fusion::traits::is_sequence<Sequence> >::type>
+ : mpl::true_
+ {
+ typedef iterator_range<scheme::utree::const_iterator> compatible_type;
+
+ static bool is_compatible(int d)
+ {
+ return d == scheme::utree_type::list_type;
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <>
+ struct symbols_lookup<scheme::utree, scheme::utf8_symbol>
+ {
+ typedef std::string type;
+
+ static type call(scheme::utree const& t)
+ {
+ scheme::utf8_symbol_range r = boost::get<scheme::utf8_symbol_range>(t);
+ return std::string(r.begin(), r.end());
+ }
+ };
+
+ template <>
+ struct symbols_lookup<scheme::utf8_symbol, scheme::utf8_symbol>
+ {
+ typedef std::string type;
+
+ static type call(scheme::utf8_symbol const& t)
+ {
+ return t;
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <>
+ struct extract_from_attribute<scheme::utree, scheme::utf8_symbol>
+ {
+ typedef std::string type;
+
+ template <typename Context>
+ static type call(scheme::utree const& t, Context&)
+ {
+ scheme::utf8_symbol_range r = boost::get<scheme::utf8_symbol_range>(t);
+ return std::string(r.begin(), r.end());
+ }
+ };
+
+ template <>
+ struct extract_from_attribute<scheme::utree, scheme::utf8_string>
+ {
+ typedef std::string type;
+
+ template <typename Context>
+ static type call(scheme::utree const& t, Context&)
+ {
+ scheme::utf8_string_range r = boost::get<scheme::utf8_string_range>(t);
+ return std::string(r.begin(), r.end());
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <>
+ struct transform_attribute<scheme::utree const, scheme::utf8_string, karma::domain>
+ {
+ typedef std::string type;
+
+ static type pre(scheme::utree const& t)
+ {
+ scheme::utf8_string_range r = boost::get<scheme::utf8_string_range>(t);
+ return std::string(r.begin(), r.end());
+ }
+ };
+
+ template <>
+ struct transform_attribute<scheme::utree const, scheme::utf8_symbol, karma::domain>
+ {
+ typedef std::string type;
+
+ static type pre(scheme::utree const& t)
+ {
+ scheme::utf8_symbol_range r = boost::get<scheme::utf8_symbol_range>(t);
+ return std::string(r.begin(), r.end());
+ }
+ };
+}}}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/qi/component_names.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/qi/component_names.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,83 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_QI_COMPONENT_NAMES)
+#define BOOST_SPIRIT_QI_COMPONENT_NAMES
+
+///////////////////////////////////////////////////////////////////////////////
+namespace scheme { namespace qi
+{
+ ///////////////////////////////////////////////////////////////////////////
+ // a list of names for all supported parser primitives taking no parameters
+ static char const* const primitives0[] =
+ {
+ // character parsers
+ "char_"
+ , "alnum", "alpha", "blank", "cntrl", "digit", "graph"
+ , "print", "punct"
+ , "space", "xdigit"
+ , "lower", "upper"
+
+ // numerics
+ , "long_long", "long_", "int_", "short_"
+ , "ulong_long", "ulong_", "uint_", "ushort_"
+ , "bin", "oct", "hex"
+ , "bool_", "true_", "false_"
+ , "long_double", "double_", "float_"
+
+ // binary
+ , "qword", "dword", "word", "byte_"
+ , "little_qword", "little_dword", "little_word"
+ , "big_qword", "big_dword", "big_word"
+
+ // auxiliary
+ , "eol", "eoi", "eps"
+ , 0
+ };
+
+ // a list of names for all supported parser primitives taking 1 parameter
+ static char const* const primitives1[] =
+ {
+ // character parsers
+ "char_", "lit", "string"
+ , 0
+ };
+
+ // a list of names for all supported parser primitives taking 2 parameter
+ static char const* const primitives2[] =
+ {
+ "char_"
+ , 0
+ };
+
+ // a list of names for all supported parser directives taking 0 parameter
+ static char const* const directives0[] =
+ {
+ // manage skip parser
+ "lexeme", "skip", "no_skip"
+
+ // case management
+ , "no_case"
+
+ // auxiliary
+ , "omit", "raw"
+
+ // encoding
+ , "ascii", "standard", "standard_wide", "iso8859_1"
+#if defined BOOST_SPIRIT_UNICODE
+ , "unicode"
+#endif
+ , 0
+ };
+
+ // a list of names for all supported unary parser operators
+ static char const* const unary_names[] =
+ {
+ "*", "+", "-", "!", "&"
+ , 0
+ };
+}}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/qi/generate_qiexpr.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/qi/generate_qiexpr.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,22 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_GENERATE_QIEXPR)
+#define BOOST_SPIRIT_GENERATE_QIEXPR
+
+#include <utree/utree.hpp>
+
+namespace scheme { namespace output
+{
+ template <typename String>
+ bool generate_qi_expr(utree& result, String& str);
+
+ template <typename String>
+ bool generate_qi_expr_list(utree& result, String& str);
+}}
+
+#endif
+
+

Added: branches/release/libs/spirit/example/scheme/qi/generate_qiexpr_impl.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/qi/generate_qiexpr_impl.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,44 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_GENERATE_QIEXPR_IMPL)
+#define BOOST_SPIRIT_GENERATE_QIEXPR_IMPL
+
+#include <iostream>
+#include <boost/spirit/include/karma_generate.hpp>
+
+#include <qi/qiexpr_generator.hpp>
+#include <qi/generate_qiexpr.hpp>
+
+namespace scheme { namespace output
+{
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename String>
+ bool generate_qi_expr(utree& u, String& str)
+ {
+ using boost::spirit::karma::space;
+
+ typedef std::back_insert_iterator<String> output_iterator_type;
+
+ scheme::qi::qiexpr_generator<output_iterator_type> g;
+ return generate_delimited(output_iterator_type(str), g, space, u);
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename String>
+ bool generate_qi_expr_list(utree& u, String& str)
+ {
+ using boost::spirit::karma::space;
+
+ typedef std::back_insert_iterator<String> output_iterator_type;
+
+ scheme::qi::qiexpr_generator<output_iterator_type> g;
+ return generate_delimited(output_iterator_type(str), g.grammar_, space, u);
+ }
+}}
+
+#endif
+
+

Added: branches/release/libs/spirit/example/scheme/qi/parse_qiexpr.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/qi/parse_qiexpr.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,25 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_PARSE_QIEXPR)
+#define BOOST_SPIRIT_PARSE_QIEXPR
+
+#include <utree/utree.hpp>
+
+namespace scheme { namespace input
+{
+ template <typename String>
+ bool parse_qi_expr(String const& str, utree& result);
+
+ template <typename String>
+ bool parse_qi_rule(String const& str, utree& result);
+
+ template <typename String>
+ bool parse_qi_grammar(String const& str, utree& result);
+}}
+
+#endif
+
+

Added: branches/release/libs/spirit/example/scheme/qi/parse_qiexpr_impl.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/qi/parse_qiexpr_impl.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,63 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_PARSE_QIEXPR_IMPL)
+#define BOOST_SPIRIT_PARSE_QIEXPR_IMPL
+
+#include <iostream>
+#include <boost/spirit/include/support_istream_iterator.hpp>
+#include <boost/spirit/include/qi_parse.hpp>
+
+#include <qi/qiexpr_parser.hpp>
+#include <qi/parse_qiexpr.hpp>
+
+namespace scheme { namespace input
+{
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename String>
+ bool parse_qi_expr(String const& str, utree& result)
+ {
+ typedef typename String::const_iterator iterator_type;
+
+ scheme::qi::qiexpr_parser<iterator_type> p;
+ scheme::qi::qiexpr_white_space<iterator_type> ws;
+
+ iterator_type begin = str.begin();
+ iterator_type end = str.end();
+ return phrase_parse(begin, end, p, ws, result) && begin == end;
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename String>
+ bool parse_qi_rule(String const& str, utree& result)
+ {
+ typedef typename String::const_iterator iterator_type;
+
+ scheme::qi::qiexpr_parser<iterator_type> p;
+ scheme::qi::qiexpr_white_space<iterator_type> ws;
+
+ iterator_type begin = str.begin();
+ iterator_type end = str.end();
+ return phrase_parse(begin, end, p.rule_, ws, result) && begin == end;
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename String>
+ bool parse_qi_grammar(String const& str, utree& result)
+ {
+ typedef typename String::const_iterator iterator_type;
+
+ scheme::qi::qiexpr_parser<iterator_type> p;
+ scheme::qi::qiexpr_white_space<iterator_type> ws;
+
+ iterator_type begin = str.begin();
+ iterator_type end = str.end();
+ return phrase_parse(begin, end, p.grammar_, ws, result) && begin == end;
+ }
+}}
+
+#endif
+
+

Added: branches/release/libs/spirit/example/scheme/qi/qiexpr_generator.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/qi/qiexpr_generator.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,175 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_QIEXPR_GENERATOR)
+#define BOOST_SPIRIT_QIEXPR_GENERATOR
+
+#include <string>
+
+#include <boost/cstdint.hpp>
+#include <boost/spirit/include/karma.hpp>
+#include <boost/spirit/include/phoenix.hpp>
+
+#include <utree/utree.hpp>
+#include <utree/operators.hpp>
+#include <output/utree_traits.hpp>
+#include <qi/component_names.hpp>
+
+///////////////////////////////////////////////////////////////////////////////
+namespace boost { namespace spirit { namespace traits
+{
+ template <typename Out>
+ void print_attribute(Out& out, scheme::utree const& val);
+}}}
+
+///////////////////////////////////////////////////////////////////////////////
+namespace scheme { namespace qi
+{
+ using boost::spirit::karma::grammar;
+ using boost::spirit::karma::rule;
+ using boost::spirit::karma::space_type;
+ using boost::spirit::karma::symbols;
+
+ ///////////////////////////////////////////////////////////////////////////
+ namespace traits
+ {
+ template <typename Count>
+ struct deref_spec
+ : boost::spirit::result_of::terminal<boost::spirit::tag::repeat(Count)>
+ {};
+ }
+
+ template <typename Count>
+ inline typename traits::deref_spec<Count>::type
+ deref_spec(Count const& count)
+ {
+ using boost::spirit::karma::repeat;
+ return repeat(count);
+ }
+
+ typedef traits::deref_spec<int>::type deref_tag_type;
+ deref_tag_type const deref = deref_spec(1);
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename OutputIterator>
+ struct qiexpr_generator : grammar<OutputIterator, space_type, utree()>
+ {
+ qiexpr_generator() : qiexpr_generator::base_type(start)
+ {
+ namespace phoenix = boost::phoenix;
+
+ using boost::spirit::karma::eps;
+ using boost::spirit::karma::ascii::string;
+ using boost::spirit::karma::omit;
+ using boost::spirit::karma::_r1;
+ using boost::spirit::karma::strict;
+ using boost::spirit::karma::eol;
+ using boost::phoenix::ref;
+
+ start =
+ nil
+ | rule_
+ ;
+
+ grammar_ =
+ nil
+ | rule_ % eol
+ ;
+
+ rule_ =
+ &symbol(ref("define"))
+ << deref[rule_name] << '=' << deref[alternative]
+ | alternative
+ ;
+
+ alternative =
+ &symbol(ref("qi:|"))
+ << '(' << strict[permutation % '|'] << ')'
+ | permutation
+ ;
+
+ permutation =
+ &symbol(ref("qi:^"))
+ << '(' << strict[sequence % '^'] << ')'
+ | sequence
+ ;
+
+ sequence =
+ &symbol(ref("qi:>>"))
+ << '(' << strict[term % ">>"] << ')'
+ | term
+ ;
+
+ term = strict[
+ unary << '(' << deref[alternative] << ')'
+ | primitive2 << '(' << literal << ',' << literal << ')'
+ | primitive1 << '(' << literal << ')'
+ | primitive0_rule
+ | directive0 << '[' << deref[alternative] << ']'
+ | alternative_rule
+ ];
+
+ primitive0_rule = strict[deref[primitive0]];
+ alternative_rule = alternative;
+
+ rule_name = strict[deref[any_symbol]];
+
+ any_symbol = string;
+ symbol = string(_r1);
+ literal = '"' << string << '"';
+ nil = eps;
+
+ // fill the symbol tables with all known primitive parser names
+ std::string name("qi:");
+ for (char const* const* p = primitives0; *p; ++p)
+ primitive0.add(utf8_symbol(name + *p));
+
+ for (char const* const* p = primitives1; *p; ++p)
+ primitive1.add(utf8_symbol(name + *p));
+
+ for (char const* const* p = primitives2; *p; ++p)
+ primitive2.add(utf8_symbol(name + *p));
+
+ for (char const* const* p = unary_names; *p; ++p)
+ unary.add(utf8_symbol(name + *p));
+
+ for (char const* const* p = directives0; *p; ++p)
+ directive0.add(utf8_symbol(name + *p));
+
+ BOOST_SPIRIT_DEBUG_NODE(start);
+ BOOST_SPIRIT_DEBUG_NODE(grammar_);
+ BOOST_SPIRIT_DEBUG_NODE(rule_);
+ BOOST_SPIRIT_DEBUG_NODE(rule_name);
+ BOOST_SPIRIT_DEBUG_NODE(alternative);
+ BOOST_SPIRIT_DEBUG_NODE(permutation);
+ BOOST_SPIRIT_DEBUG_NODE(sequence);
+ BOOST_SPIRIT_DEBUG_NODE(term);
+ BOOST_SPIRIT_DEBUG_NODE(nil);
+ BOOST_SPIRIT_DEBUG_NODE(literal);
+ BOOST_SPIRIT_DEBUG_NODE(symbol);
+ BOOST_SPIRIT_DEBUG_NODE(any_symbol);
+ BOOST_SPIRIT_DEBUG_NODE(primitive0_rule);
+ BOOST_SPIRIT_DEBUG_NODE(alternative_rule);
+ }
+
+ typedef rule<OutputIterator, space_type, utree()> delimiting_rule_type;
+
+ delimiting_rule_type start, alternative, permutation, sequence, term;
+ delimiting_rule_type grammar_, rule_;
+ delimiting_rule_type rule_name, primitive0_rule, alternative_rule;
+ rule<OutputIterator, nil()> nil;
+ rule<OutputIterator, scheme::utf8_string()> literal;
+ rule<OutputIterator, scheme::utf8_symbol(std::string)> symbol;
+ rule<OutputIterator, scheme::utf8_symbol()> any_symbol;
+
+ symbols<scheme::utf8_symbol> unary, directive0;
+ symbols<scheme::utf8_symbol> primitive0, primitive1, primitive2;
+ };
+}}
+
+#endif
+
+
+

Added: branches/release/libs/spirit/example/scheme/qi/qiexpr_parser.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/qi/qiexpr_parser.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,332 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_QIEXPR_PARSER)
+#define BOOST_SPIRIT_QIEXPR_PARSER
+
+#include <string>
+
+#include <boost/cstdint.hpp>
+#include <boost/detail/iterator.hpp>
+#include <boost/spirit/include/qi.hpp>
+#include <boost/spirit/include/phoenix_core.hpp>
+#include <boost/spirit/include/phoenix_stl.hpp>
+#include <boost/spirit/include/phoenix_statement.hpp>
+#include <boost/spirit/include/phoenix_operator.hpp>
+
+#include <utree/utree.hpp>
+#include <utree/operators.hpp>
+#include <input/string.hpp>
+#include <qi/component_names.hpp>
+
+///////////////////////////////////////////////////////////////////////////////
+namespace boost { namespace spirit { namespace traits
+{
+ template <typename Out>
+ void print_attribute(Out& out, scheme::utree const& val);
+}}}
+
+///////////////////////////////////////////////////////////////////////////////
+namespace scheme { namespace qi
+{
+ using boost::spirit::ascii::space;
+ using boost::spirit::ascii::char_;
+ using boost::spirit::qi::grammar;
+ using boost::spirit::qi::rule;
+ using boost::spirit::qi::symbols;
+ using boost::spirit::qi::eol;
+ using boost::spirit::qi::_val;
+ using boost::spirit::qi::_1;
+ using boost::spirit::qi::_2;
+ using boost::spirit::qi::lexeme;
+ using boost::phoenix::push_back;
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Iterator>
+ struct qiexpr_white_space : grammar<Iterator>
+ {
+ qiexpr_white_space() : qiexpr_white_space::base_type(start)
+ {
+ start =
+ space // tab/space/cr/lf
+ | "//" >> *(char_ - eol) >> eol // comments
+ | "/*" >> *(char_ - "*/") >> "*/"
+ ;
+ }
+
+ rule<Iterator> start;
+ };
+
+ namespace detail
+ {
+ ///////////////////////////////////////////////////////////////////////
+ // return true if the utree instance represents a list whose first
+ // element is a symbol node equal to the second argument
+ inline bool is_list_node(utree const& u, utf8_symbol const& symbol)
+ {
+ if (u.which() != utree_type::list_type)
+ return false;
+ return u.front() == symbol;
+ }
+
+ inline bool is_list_node(utree const& u, utree const& symbol)
+ {
+ if (u.which() != utree_type::list_type)
+ return false;
+ if (symbol.which() == utree_type::list_type)
+ return u.front() == symbol.front();
+ return u.front() == symbol;
+ }
+
+ ///////////////////////////////////////////////////////////////////////
+ // ensure the given utree instance represents a list whose first
+ // element is the symbol this function object has been constructed from
+ struct make_list_node
+ {
+ template <typename T1, typename T2 = nil>
+ struct result { typedef void type; };
+
+ explicit make_list_node(char const* symbol_)
+ : symbol(symbol_)
+ {}
+
+ // If called with one parameter the given node needs to be
+ // converted into a list whose first element is the symbol.
+ //
+ // i.e:
+ // lit: ("abc") --> (lit "abc")
+ void operator()(utree& u) const
+ {
+ u.push_front(symbol);
+ }
+
+ // If called with two parameters we ensure the given node is a
+ // (new) list whose first element is the symbol and we append the
+ // given element to that list.
+ //
+ // i.e.:
+ // >>: (char_), (char_ "abc") --> (>> (char_) (char_ "abc"))
+ // >>: (>> (char_ "a")), (char_) --> (>> (char_ "a") (char_))
+ void operator()(utree& val, utree const& element) const
+ {
+ if (!is_list_node(val, symbol)) {
+ utree u;
+ u.push_back(symbol);
+ if (val.which() != utree_type::nil_type)
+ u.push_back(val);
+ val = u;
+ }
+ val.push_back(element);
+ }
+
+ utf8_symbol symbol;
+ };
+
+ ///////////////////////////////////////////////////////////////////////
+ struct make_directive_node
+ {
+ template <typename T1, typename T2, typename T3>
+ struct result { typedef void type; };
+
+ void operator()(utree& val, utree const& element, utree const& sym) const
+ {
+ if (!is_list_node(val, sym)) {
+ utree u;
+ u.push_back(sym);
+ if (val.which() != utree_type::nil_type)
+ u.push_back(val);
+ val = u;
+ }
+ val.push_back(element);
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////
+ // this creates a scheme definition:
+ //
+ // i.e. (define (_1) exp)
+ struct make_define_node
+ {
+ template <typename T1, typename T2, typename T3>
+ struct result { typedef void type; };
+
+ explicit make_define_node() : define_("define") {}
+
+ void operator()(utree& val, utree const& name, utree const& exp) const
+ {
+ val.push_back(define_);
+ utree n;
+ n.push_back(name);
+ val.push_back(n);
+ val.push_back(exp);
+ }
+
+ utf8_symbol define_;
+ };
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Iterator>
+ struct qiexpr_parser
+ : grammar<Iterator, qiexpr_white_space<Iterator>, utree()>
+ {
+ typedef typename boost::detail::iterator_traits<Iterator>::value_type
+ char_type;
+
+ qiexpr_parser() : qiexpr_parser::base_type(rhs)
+ {
+ namespace phoenix = boost::phoenix;
+ typedef phoenix::function<detail::make_list_node> make_list_type;
+ typedef phoenix::function<detail::make_directive_node> make_directive_type;
+ typedef phoenix::function<detail::make_define_node> make_define_type;
+
+ make_directive_type make_directive = detail::make_directive_node();
+
+ make_define_type make_define = detail::make_define_node();
+
+ make_list_type make_sequence = detail::make_list_node("qi:>>");
+ make_list_type make_permutation = detail::make_list_node("qi:^");
+ make_list_type make_alternative = detail::make_list_node("qi:|");
+
+ make_list_type make_kleene = detail::make_list_node("qi:*");
+ make_list_type make_plus = detail::make_list_node("qi:+");
+ make_list_type make_optional = detail::make_list_node("qi:-");
+ make_list_type make_and_pred = detail::make_list_node("qi:&");
+ make_list_type make_not_pred = detail::make_list_node("qi:!");
+
+ make_list_type make_literal = detail::make_list_node("qi:lit");
+
+ // grammar definition
+ grammar_ = +rule_
+ ;
+
+ // rule definition
+ rule_ =
+ (symbol >> '=' >> alternative)
+ [
+ make_define(_val, _1, _2)
+ ]
+ ;
+
+ // right hand side of a rule (any parser expression)
+ rhs = -alternative;
+
+ // A | B
+ alternative =
+ permutation [ _val = _1 ]
+ >> *( "|" >> permutation [ make_alternative(_val, _1) ] )
+ ;
+
+ // A ^ B
+ permutation =
+ sequence [ _val = _1 ]
+ >> *( "^" >> sequence [ make_permutation(_val, _1) ] )
+ ;
+
+ // A >> B
+ sequence =
+ unary_term [ _val = _1 ]
+ >> *( ">>" >> unary_term [ make_sequence(_val, _1) ] )
+ ;
+
+ // unary operators
+ unary_term =
+ "*" >> unary_term [ make_kleene(_val, _1) ]
+ | "+" >> unary_term [ make_plus(_val, _1) ]
+ | "-" >> unary_term [ make_optional(_val, _1) ]
+ | "&" >> unary_term [ make_and_pred(_val, _1) ]
+ | "!" >> unary_term [ make_not_pred(_val, _1) ]
+ | term [ _val = _1 ]
+ ;
+
+ // A, (A)
+ term =
+ primitive
+ | directive
+ | '(' >> alternative >> ')'
+ ;
+
+ // any parser directive
+ directive =
+ (directive0 >> '[' >> alternative >> ']')
+ [
+ make_directive(_val, _2, _1)
+ ]
+ ;
+
+ // any primitive parser
+ primitive %=
+ primitive2 >> '(' >> literal >> ',' >> literal >> ')'
+ | primitive1 >> '(' >> literal >> ')'
+ | primitive0 // taking no parameter
+ | literal [ make_literal(_val) ]
+ ;
+
+ // a literal (either 'x' or "abc")
+ literal =
+ string_lit [ phoenix::push_back(_val, _1) ]
+ | string_lit.char_lit [ phoenix::push_back(_val, _1) ]
+ ;
+
+ std::string exclude = std::string(" ();\"\x01-\x1f\x7f") + '\0';
+ symbol = lexeme[+(~char_(exclude))];
+
+ // fill the symbol tables with all known primitive parser names
+ std::string name("qi:");
+ for (char const* const* p = primitives0; *p; ++p)
+ {
+ utree u;
+ u.push_back(utf8_symbol(name + *p));
+ primitive0.add(*p, u);
+ }
+
+ for (char const* const* p = primitives1; *p; ++p)
+ {
+ utree u;
+ u.push_back(utf8_symbol(name + *p));
+ primitive1.add(*p, u);
+ }
+
+ for (char const* const* p = primitives2; *p; ++p)
+ {
+ utree u;
+ u.push_back(utf8_symbol(name + *p));
+ primitive2.add(*p, u);
+ }
+
+ for (char const* const* p = directives0; *p; ++p)
+ {
+ utree u = utree(utf8_symbol(name + *p));
+ directive0.add(*p, u);
+ }
+
+ BOOST_SPIRIT_DEBUG_NODE(grammar_);
+ BOOST_SPIRIT_DEBUG_NODE(rule_);
+ BOOST_SPIRIT_DEBUG_NODE(rhs);
+ BOOST_SPIRIT_DEBUG_NODE(directive);
+ BOOST_SPIRIT_DEBUG_NODE(primitive);
+ BOOST_SPIRIT_DEBUG_NODE(unary_term);
+ BOOST_SPIRIT_DEBUG_NODE(term);
+ BOOST_SPIRIT_DEBUG_NODE(literal);
+ BOOST_SPIRIT_DEBUG_NODE(symbol);
+ BOOST_SPIRIT_DEBUG_NODE(alternative);
+ BOOST_SPIRIT_DEBUG_NODE(permutation);
+ BOOST_SPIRIT_DEBUG_NODE(sequence);
+ }
+
+ typedef rule<Iterator, qiexpr_white_space<Iterator>, utree()> rule_type;
+
+ rule_type grammar_, rule_;
+ rule_type rhs, directive, primitive, unary_term, term, literal;
+ rule_type alternative, permutation, sequence;
+ rule<Iterator, utf8_symbol()> symbol;
+
+ symbols<char_type, utree> directive0, directive1;
+ symbols<char_type, utree> primitive0, primitive1, primitive2;
+ scheme::input::string<Iterator> string_lit;
+ };
+}}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/scheme/compiler.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/scheme/compiler.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,673 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_SCHEME_COMPILER)
+#define BOOST_SPIRIT_SCHEME_COMPILER
+
+#include <vector>
+#include <map>
+#include <exception>
+
+#include <boost/bind.hpp>
+#include <boost/tuple/tuple.hpp>
+#include <boost/lexical_cast.hpp>
+#include <scheme/intrinsics.hpp>
+#include <scheme/interpreter.hpp>
+#include <input/parse_sexpr.hpp>
+
+namespace scheme
+{
+///////////////////////////////////////////////////////////////////////////////
+// Exceptions
+///////////////////////////////////////////////////////////////////////////////
+ struct scheme_exception : std::exception {};
+
+ struct compilation_error : std::exception
+ {
+ ~compilation_error() throw() {}
+ virtual const char* what() const throw()
+ {
+ return "scheme: Compilation error.";
+ }
+ };
+
+ struct identifier_expected : scheme_exception
+ {
+ ~identifier_expected() throw() {}
+ virtual const char* what() const throw()
+ {
+ return "scheme: Identifier expected.";
+ }
+ };
+
+ struct identifier_not_found : scheme_exception
+ {
+ std::string msg;
+ identifier_not_found(std::string const& id)
+ : msg("scheme: Identifier (" + id + ") not found.") {}
+ ~identifier_not_found() throw() {}
+
+ virtual const char* what() const throw()
+ {
+ return msg.c_str();;
+ }
+ };
+
+ struct duplicate_identifier : scheme_exception
+ {
+ std::string msg;
+ duplicate_identifier(std::string const& id)
+ : msg("scheme: Duplicate identifier (" + id + ").") {}
+ ~duplicate_identifier() throw() {}
+
+ virtual const char* what() const throw()
+ {
+ return msg.c_str();
+ }
+ };
+
+ struct body_already_defined : scheme_exception
+ {
+ std::string msg;
+ body_already_defined(std::string const& id)
+ : msg("scheme: Multiple definition (" + id + ").") {}
+ ~body_already_defined() throw() {}
+
+ virtual const char* what() const throw()
+ {
+ return msg.c_str();
+ }
+ };
+
+ struct incorrect_arity : scheme_exception
+ {
+ std::string msg;
+ incorrect_arity(std::string const& id, int arity, bool fixed)
+ : msg("scheme: Invalid number of parameters to function call ("
+ + id + ").")
+ {
+ if (!fixed)
+ msg += std::string(" Expecting at least ");
+ else
+ msg += std::string(" Expecting ");
+
+ msg += boost::lexical_cast<std::string>(arity) + " arguments.";
+ }
+ ~incorrect_arity() throw() {}
+
+ virtual const char* what() const throw()
+ {
+ return msg.c_str();
+ }
+ };
+
+ struct function_application_expected : scheme_exception
+ {
+ std::string msg;
+ function_application_expected(utree const& got)
+ {
+ // $$$ TODO: add got to message $$$
+ msg = "scheme: Function application expected";
+ }
+ ~function_application_expected() throw() {}
+
+ virtual const char* what() const throw()
+ {
+ return msg.c_str();
+ }
+ };
+
+ struct no_body : scheme_exception
+ {
+ ~no_body() throw() {}
+ virtual const char* what() const throw()
+ {
+ return "scheme: No expression in body.";
+ }
+ };
+
+///////////////////////////////////////////////////////////////////////////////
+// The environment
+///////////////////////////////////////////////////////////////////////////////
+ typedef boost::function<function(actor_list const&)> compiled_function;
+
+ class environment
+ {
+ public:
+
+ environment(environment* parent = 0)
+ : outer(parent),
+ depth(parent? parent->depth + 1 : 0)
+ {}
+
+ template <typename Function>
+ void define(std::string const& name, Function const& f, int arity, bool fixed)
+ {
+ if (definitions.find(name) != definitions.end())
+ throw duplicate_identifier(name);
+ definitions[name] = boost::make_tuple(compiled_function(f), arity, fixed);
+ }
+
+ boost::tuple<compiled_function*, int, bool>
+ find(std::string const& name)
+ {
+ std::map<std::string, map_element>::iterator
+ i = definitions.find(name);
+ if (i != definitions.end())
+ return boost::make_tuple(
+ &boost::get<0>(i->second),
+ boost::get<1>(i->second),
+ boost::get<2>(i->second)
+ );
+ else if (outer != 0)
+ return outer->find(name);
+ return boost::make_tuple((compiled_function*)0, 0, false);
+ }
+
+ void undefine(std::string const& name)
+ {
+ definitions.erase(name);
+ }
+
+ bool defined(std::string const& name)
+ {
+ return definitions.find(name) != definitions.end();
+ }
+
+ void forward_declare(std::string const& name, function* f)
+ {
+ forwards[name] = f;
+ }
+
+ function* find_forward(std::string const& name)
+ {
+ std::map<std::string, function*>::iterator
+ iter = forwards.find(name);
+ if (iter == forwards.end())
+ return 0;
+ else
+ return iter->second;
+ }
+
+ environment* parent() const { return outer; }
+ int level() const { return depth; }
+
+ private:
+
+ typedef boost::tuple<compiled_function, int, bool> map_element;
+
+ environment* outer;
+ std::map<std::string, map_element> definitions;
+ std::map<std::string, function*> forwards;
+ int depth;
+ };
+
+///////////////////////////////////////////////////////////////////////////////
+// The compiler
+///////////////////////////////////////////////////////////////////////////////
+ function compile(
+ utree const& ast,
+ environment& env,
+ actor_list& fragments,
+ int parent_line,
+ std::string const& source_file = "");
+
+ struct external_function : composite<external_function>
+ {
+ // we must hold f by reference because functions can be recursive
+ boost::reference_wrapper<function const> f;
+ int level;
+
+ 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, level));
+ }
+ };
+
+ struct compiler
+ {
+ typedef function result_type;
+ environment& env;
+ actor_list& fragments;
+ int line;
+ std::string source_file;
+
+ compiler(
+ environment& env,
+ actor_list& fragments,
+ int line,
+ std::string const& source_file = "")
+ : env(env), fragments(fragments),
+ line(line), source_file(source_file)
+ {
+ }
+
+ function operator()(nil) const
+ {
+ return scheme::val(utree());
+ }
+
+ template <typename T>
+ function operator()(T const& val) const
+ {
+ return scheme::val(utree(val));
+ }
+
+ function operator()(utf8_symbol_range const& str) const
+ {
+ std::string name(str.begin(), str.end());
+ boost::tuple<compiled_function*, int, bool> r = env.find(name);
+ if (boost::get<0>(r))
+ {
+ actor_list flist;
+ return (*boost::get<0>(r))(flist);
+ }
+ throw identifier_not_found(name);
+ return function();
+ }
+
+ function make_lambda(
+ std::vector<std::string> const& args,
+ bool fixed_arity,
+ utree const& body) const
+ {
+ environment local_env(&this->env);
+ 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, local_env.level()), 0, false);
+ else
+ local_env.define(args[i],
+ boost::bind(arg, i, local_env.level()), 0, false);
+ }
+
+ actor_list flist;
+ if (body.size() == 0)
+ return function();
+ //~ throw no_body();
+
+ BOOST_FOREACH(utree const& item, body)
+ {
+ function f = compile(item, local_env, fragments, line, source_file);
+ if (!is_define(item))
+ flist.push_back(f);
+ }
+ if (flist.size() > 1)
+ return protect(block(flist));
+ else
+ return protect(flist.front());
+ }
+
+ static bool is_define(utree const& item)
+ {
+ if (item.which() != utree_type::list_type ||
+ item.begin()->which() != utree_type::symbol_type)
+ return false;
+ return get_symbol(*item.begin()) == "define";
+ }
+
+ function define_function(
+ std::string const& name,
+ std::vector<std::string>& args,
+ bool fixed_arity,
+ utree const& body) const
+ {
+ try
+ {
+ function* fp = 0;
+ if (env.defined(name))
+ {
+ fp = env.find_forward(name);
+ if (fp != 0 && !fp->empty())
+ throw body_already_defined(name);
+ }
+
+ if (fp == 0)
+ {
+ fragments.push_back(function());
+ fp = &fragments.back();
+ env.define(name, external_function(*fp, env.level()), args.size(), fixed_arity);
+ }
+
+ function lambda = make_lambda(args, fixed_arity, body);
+ if (!lambda.empty())
+ {
+ // unprotect (eval returns a function)
+ *fp = lambda();
+ }
+ else
+ {
+ // allow forward declaration of scheme functions
+ env.forward_declare(name, fp);
+ }
+ return *fp;
+ }
+ catch (std::exception const&)
+ {
+ env.undefine(name);
+ throw;
+ }
+ }
+
+ function operator()(utree::const_range const& range) const
+ {
+ typedef utree::const_range::iterator iterator;
+
+ if (range.begin()->which() != utree_type::symbol_type)
+ throw function_application_expected(*range.begin());
+
+ std::string name(get_symbol(*range.begin()));
+
+ if (name == "quote")
+ {
+ iterator i = range.begin(); ++i;
+ return scheme::val(*i);
+ }
+
+ if (name == "define")
+ {
+ std::string fname;
+ std::vector<std::string> args;
+ bool fixed_arity = true;
+
+ iterator i = range.begin(); ++i;
+ if (i->which() == utree_type::list_type)
+ {
+ // (define (f x) ...body...)
+ utree const& decl = *i++;
+ iterator di = decl.begin();
+ fname = get_symbol(*di++);
+ while (di != decl.end())
+ {
+ std::string sym = get_symbol(*di++);
+ if (sym == ".")
+ // check that . is one pos behind the last arg
+ fixed_arity = false;
+ else
+ args.push_back(sym);
+ }
+ }
+ else
+ {
+ // (define f ...body...)
+ fname = get_symbol(*i++);
+
+ // (define f (lambda (x) ...body...))
+ if (i != range.end()
+ && i->which() == utree_type::list_type
+ && get_symbol((*i)[0]) == "lambda")
+ {
+ utree const& arg_names = (*i)[1];
+ iterator ai = arg_names.begin();
+ while (ai != arg_names.end())
+ {
+ std::string sym = get_symbol(*ai++);
+ if (sym == ".")
+ // check that . is one pos behind the last arg
+ fixed_arity = false;
+ else
+ args.push_back(sym);
+ };
+
+ iterator bi = i->begin(); ++bi; ++bi; // (*i)[2]
+ utree body(utree::const_range(bi, i->end()), shallow);
+ return define_function(fname, args, fixed_arity, body);
+ }
+ }
+
+ utree body(utree::const_range(i, range.end()), shallow);
+ return define_function(fname, args, fixed_arity, body);
+ }
+
+ 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;
+ bool fixed_arity = true;
+
+ while (ai != arg_names.end())
+ {
+ std::string sym = get_symbol(*ai++);
+ if (sym == ".")
+ // check that . is one pos behind the last arg
+ fixed_arity = false;
+ else
+ args.push_back(sym);
+ }
+
+ utree body(utree::const_range(i, range.end()), shallow);
+ return make_lambda(args, fixed_arity, body);
+ }
+
+ // (f x)
+ 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;
+ iterator i = range.begin(); ++i;
+ int size = 0;
+ for (; i != range.end(); ++i, ++size)
+ {
+ flist.push_back(
+ compile(*i, env, fragments, line, source_file));
+ }
+
+ // Arity check
+ if (!fixed_arity) // non-fixed arity
+ {
+ if (size < arity)
+ throw incorrect_arity(name, arity, false);
+ }
+ else // fixed arity
+ {
+ if (size != arity)
+ throw incorrect_arity(name, arity, true);
+ }
+ return (*cf)(flist);
+ }
+ else
+ {
+ throw identifier_not_found(name);
+ }
+
+ // Can't reach here
+ throw compilation_error();
+ return function();
+ }
+
+ function operator()(function_base const& pf) const
+ {
+ // Can't reach here. Surely, at this point, we don't have
+ // utree functions yet. The utree AST should be pure data.
+ throw compilation_error();
+ return function();
+ }
+
+ static std::string get_symbol(utree const& s)
+ {
+ if (s.which() != utree_type::symbol_type)
+ throw identifier_expected();
+ utf8_symbol_range symbol = s.get<utf8_symbol_range>();
+ return std::string(symbol.begin(), symbol.end());
+ }
+ };
+
+ inline function compile(
+ utree const& ast,
+ environment& env,
+ actor_list& fragments,
+ int parent_line,
+ std::string const& source_file)
+ {
+ int line = (ast.which() == utree_type::list_type)
+ ? ast.tag() : parent_line;
+
+ try
+ {
+ return utree::visit(ast,
+ compiler(env, fragments, line, source_file));
+ }
+ catch (scheme_exception const& x)
+ {
+ if (source_file != "")
+ std::cerr << source_file;
+
+ if (line != -1)
+ std::cerr << '(' << line << ')';
+
+ std::cerr << " : Error! " << x.what() << std::endl;
+ throw compilation_error();
+ }
+
+ return function();
+ }
+
+ void compile_all(
+ utree const& ast,
+ environment& env,
+ actor_list& results,
+ actor_list& fragments,
+ std::string const& source_file = "")
+ {
+ int line = (ast.which() == utree_type::list_type)
+ ? ast.tag() : 1;
+ BOOST_FOREACH(utree const& program, ast)
+ {
+ scheme::function f;
+ try
+ {
+ 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&)
+ {
+ continue; // try the next expression
+ }
+ results.push_back(f);
+ }
+ }
+
+ void build_basic_environment(environment& env)
+ {
+ env.define("if", if_, 3, true);
+ env.define("begin", block, 1, false);
+ env.define("list", list, 1, false);
+ env.define("display", display, 1, true);
+ 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);
+ env.define("-", minus, 2, false);
+ env.define("*", times, 2, false);
+ env.define("/", divide, 2, false);
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ // interpreter
+ ///////////////////////////////////////////////////////////////////////////
+ struct interpreter
+ {
+ template <typename Source>
+ interpreter(
+ Source& in,
+ std::string const& source_file = "",
+ environment* envp = 0)
+ {
+ if (envp == 0)
+ build_basic_environment(env);
+ else
+ env = *envp;
+
+ if (input::parse_sexpr_list(in, program, source_file))
+ {
+ compile_all(program, env, flist, fragments, source_file);
+ }
+ }
+
+ interpreter(
+ utree const& program,
+ environment* envp = 0)
+ {
+ if (envp == 0)
+ build_basic_environment(env);
+ else
+ env = *envp;
+
+ compile_all(program, env, flist, fragments);
+ }
+
+ function operator[](std::string const& name)
+ {
+ 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;
+
+ 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;
+ utree program;
+ actor_list fragments;
+ actor_list flist;
+ };
+}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/scheme/detail/composite_call.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/scheme/detail/composite_call.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,47 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+==============================================================================*/
+#ifndef BOOST_PP_IS_ITERATING
+#ifndef SCHEME_FUNCTION_COMPOSER_CALL_HPP
+#define SCHEME_FUNCTION_COMPOSER_CALL_HPP
+
+#include <boost/preprocessor/iterate.hpp>
+#include <boost/preprocessor/repetition/enum_params.hpp>
+#include <boost/preprocessor/repetition/enum_binary_params.hpp>
+#include <boost/preprocessor/repetition/repeat.hpp>
+
+#define SCHEME_PUSH_ELEMENT(z, n, _) elements.push_back(as_function(_##n));
+
+#define BOOST_PP_ITERATION_PARAMS_1 \
+ (3, (3, BOOST_PP_DEC(SCHEME_COMPOSITE_LIMIT), \
+ "scheme/detail/composite_call.hpp"))
+#include BOOST_PP_ITERATE()
+
+#undef SCHEME_PUSH_ELEMENT
+
+#endif
+
+///////////////////////////////////////////////////////////////////////////////
+//
+// Preprocessor vertical repetition code
+//
+///////////////////////////////////////////////////////////////////////////////
+#else // defined(BOOST_PP_IS_ITERATING)
+
+#define N BOOST_PP_ITERATION()
+
+ template <BOOST_PP_ENUM_PARAMS(N, typename A)>
+ function operator()(BOOST_PP_ENUM_BINARY_PARAMS(N, A, const& _)) const
+ {
+ actor_list elements;
+ BOOST_PP_REPEAT(N, SCHEME_PUSH_ELEMENT, _);
+ return derived()(elements);
+ }
+
+#undef N
+#endif // defined(BOOST_PP_IS_ITERATING)
+
+

Added: branches/release/libs/spirit/example/scheme/scheme/detail/function_call.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/scheme/detail/function_call.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,47 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+==============================================================================*/
+#ifndef BOOST_PP_IS_ITERATING
+#ifndef SCHEME_FUNCTION_CALL_HPP
+#define SCHEME_FUNCTION_CALL_HPP
+
+#include <boost/preprocessor/iterate.hpp>
+#include <boost/preprocessor/repetition/enum_params.hpp>
+#include <boost/preprocessor/repetition/enum_binary_params.hpp>
+#include <boost/preprocessor/repetition/repeat.hpp>
+
+#define SCHEME_PUSH_ELEMENT(z, n, _) elements[n] = _##n;
+
+#define BOOST_PP_ITERATION_PARAMS_1 \
+ (3, (3, BOOST_PP_DEC(SCHEME_COMPOSITE_LIMIT), \
+ "scheme/detail/function_call.hpp"))
+#include BOOST_PP_ITERATE()
+
+#undef SCHEME_PUSH_ELEMENT
+
+#endif
+
+///////////////////////////////////////////////////////////////////////////////
+//
+// Preprocessor vertical repetition code
+//
+///////////////////////////////////////////////////////////////////////////////
+#else // defined(BOOST_PP_IS_ITERATING)
+
+#define N BOOST_PP_ITERATION()
+
+ template <BOOST_PP_ENUM_PARAMS(N, typename A)>
+ utree operator()(BOOST_PP_ENUM_BINARY_PARAMS(N, A, const& _)) const
+ {
+ boost::array<utree, N> elements;
+ BOOST_PP_REPEAT(N, SCHEME_PUSH_ELEMENT, _);
+ return derived()(get_range(elements));
+ }
+
+#undef N
+#endif // defined(BOOST_PP_IS_ITERATING)
+
+

Added: branches/release/libs/spirit/example/scheme/scheme/interpreter.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/scheme/interpreter.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,551 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_SCHEME_INTERPRETER)
+#define BOOST_SPIRIT_SCHEME_INTERPRETER
+
+#include <list>
+#include <boost/function.hpp>
+#include <boost/foreach.hpp>
+#include <boost/array.hpp>
+#include <boost/scoped_array.hpp>
+#include <boost/preprocessor/repetition/enum_params.hpp>
+#include <utree/utree.hpp>
+
+#define SCHEME_COMPOSITE_LIMIT 10
+
+#if defined(BOOST_MSVC)
+# pragma warning(push)
+# pragma warning(disable: 4018)
+#endif
+
+namespace scheme
+{
+///////////////////////////////////////////////////////////////////////////////
+// The runtime interpreter
+///////////////////////////////////////////////////////////////////////////////
+
+ ///////////////////////////////////////////////////////////////////////////
+ // typedefs
+ ///////////////////////////////////////////////////////////////////////////
+ struct function;
+ typedef std::list<function> actor_list;
+
+ ///////////////////////////////////////////////////////////////////////////
+ // actor
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Derived>
+ struct actor
+ {
+ typedef utree result_type;
+ typedef actor<Derived> base_type;
+
+ utree operator()(scope const& env) const
+ {
+ return derived().eval(env);
+ }
+
+ utree operator()() const
+ {
+ return derived().eval(scope());
+ }
+
+ template <typename A0>
+ utree operator()(A0 const& _0) const
+ {
+ boost::array<utree, 1> elements;
+ elements[0] = _0;
+ return derived().eval(get_range(elements));
+ }
+
+ template <typename A0, typename A1>
+ utree operator()(A0 const& _0, A1 const& _1) const
+ {
+ boost::array<utree, 2> elements;
+ elements[0] = _0;
+ elements[1] = _1;
+ return derived().eval(get_range(elements));
+ }
+
+ // More operators
+ #include <scheme/detail/function_call.hpp>
+
+ template <std::size_t n>
+ static scope
+ get_range(boost::array<utree, n>& array)
+ {
+ return scope(array.begin(), array.end());
+ }
+
+ Derived const& derived() const
+ {
+ return *static_cast<Derived const*>(this);
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // function
+ ///////////////////////////////////////////////////////////////////////////
+ struct function : actor<function>
+ {
+ utree f;
+ function()
+ : f() {}
+
+ function(utree const& f)
+ : f(f) {}
+
+ template <typename F>
+ function(F const& f)
+ : f(stored_function<F>(f))
+ {
+ }
+
+ bool empty() const
+ {
+ return f.which() != utree_type::function_type;
+ }
+
+ utree eval(scope const& env) const
+ {
+ return f.eval(env);
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // values
+ ///////////////////////////////////////////////////////////////////////////
+ struct value_function : actor<value_function>
+ {
+ utree val;
+ value_function(utree const& val) : val(val) {}
+
+ utree eval(scope const& /*env*/) const
+ {
+ return utree(boost::ref(val));
+ }
+ };
+
+ struct value
+ {
+ typedef function result_type;
+ function operator()(utree const& val) const
+ {
+ return function(value_function(val));
+ }
+ };
+
+ value const val = {};
+
+ inline function protect(function const& f)
+ {
+ return val(f.f);
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ // arguments
+ ///////////////////////////////////////////////////////////////////////////
+ template <bool scoped = true>
+ struct argument_function : actor<argument_function<scoped> >
+ {
+ std::size_t 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 arg.eval(*eptr);
+ }
+ };
+
+ template <> // scoped = false
+ struct argument_function<false> : actor<argument_function<false> >
+ {
+ std::size_t n;
+ argument_function(std::size_t n, std::size_t level = 0)
+ : n(n)
+ {}
+
+ utree eval(scope const& env) const
+ {
+ scope const* eptr = &env;
+ utree const& arg = (*eptr)[n];
+ if (arg.which() != utree_type::function_type)
+ return utree(boost::ref(arg));
+ else
+ return arg.eval(*eptr);
+ }
+ };
+
+ template <bool scoped = true>
+ struct argument
+ {
+ typedef function result_type;
+ function operator()(std::size_t n, std::size_t level = 0) const
+ {
+ return function(argument_function<scoped>(n, level));
+ }
+ };
+
+ // scoped arg
+ argument<true> const arg = {};
+
+ // unscoped arg
+ argument<false> const unscoped_arg = {};
+
+ // unscoped args
+ function const _1 = unscoped_arg(0);
+ function const _2 = unscoped_arg(1);
+ function const _3 = unscoped_arg(2);
+ function const _4 = unscoped_arg(3);
+ function const _5 = unscoped_arg(4);
+ function const _6 = unscoped_arg(5);
+ function const _7 = unscoped_arg(6);
+ function const _8 = unscoped_arg(7);
+ function const _9 = unscoped_arg(8);
+ function const _10 = unscoped_arg(10);
+
+ ///////////////////////////////////////////////////////////////////////////
+ // variable arguments.
+ // Collects the arguments from n to last in a utree list.
+ ///////////////////////////////////////////////////////////////////////////
+ template <bool scoped = true>
+ struct vararg_function : actor<vararg_function<scoped> >
+ {
+ std::size_t level;
+ std::size_t 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 result;
+ 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;
+ }
+ };
+
+ template <> // scoped = false
+ struct vararg_function<false> : actor<vararg_function<false> >
+ {
+ std::size_t n;
+ vararg_function(std::size_t n, std::size_t level = 0)
+ : n(n)
+ {}
+
+ utree eval(scope const& env) const
+ {
+ scope const* eptr = &env;
+ utree result;
+ 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;
+ }
+ };
+
+ template <bool scoped = true>
+ struct vararg
+ {
+ typedef function result_type;
+ function operator()(std::size_t n, std::size_t level = 0) const
+ {
+ return function(vararg_function<scoped>(n, level));
+ }
+ };
+
+ // scoped varg
+ vararg<true> const varg = {};
+
+ // unscoped varg
+ vararg<false> const unscoped_varg = {};
+
+ // unscoped vargs
+ function const _1_ = unscoped_varg(0);
+ function const _2_ = unscoped_varg(1);
+ function const _3_ = unscoped_varg(2);
+ function const _4_ = unscoped_varg(3);
+ function const _5_ = unscoped_varg(4);
+ function const _6_ = unscoped_varg(5);
+ function const _7_ = unscoped_varg(6);
+ function const _8_ = unscoped_varg(7);
+ function const _9_ = unscoped_varg(8);
+ function const _10_ = unscoped_varg(10);
+
+ ///////////////////////////////////////////////////////////////////////////
+ // composite
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Derived>
+ struct composite
+ {
+ typedef function result_type;
+ typedef composite<Derived> base_type;
+
+ function operator()(actor_list const& elements) const
+ {
+ return derived().compose(elements);
+ }
+
+ template <typename A0>
+ function operator()(A0 const& _0) const
+ {
+ actor_list elements;
+ elements.push_back(as_function(_0));
+ return derived().compose(elements);
+ }
+
+ template <typename A0, typename A1>
+ function operator()(A0 const& _0, A1 const& _1) const
+ {
+ actor_list elements;
+ elements.push_back(as_function(_0));
+ elements.push_back(as_function(_1));
+ return derived().compose(elements);
+ }
+
+ // More operators
+ #include <scheme/detail/composite_call.hpp>
+
+ Derived const& derived() const
+ {
+ return *static_cast<Derived const*>(this);
+ }
+
+ template <typename T>
+ static function as_function(T const& val)
+ {
+ return scheme::val(utree(val));
+ }
+
+ static function const& as_function(function const& f)
+ {
+ return f;
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // unary_function
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Derived>
+ struct unary_function : actor<unary_function<Derived> >
+ {
+ function a;
+ typedef unary_function<Derived> base_type;
+
+ unary_function(function const& a)
+ : a(a)
+ {
+ BOOST_ASSERT(!a.empty());
+ }
+
+ utree eval(scope const& env) const
+ {
+ return derived().eval(a(env));
+ }
+
+ Derived const& derived() const
+ {
+ return *static_cast<Derived const*>(this);
+ }
+ };
+
+ template <typename Function>
+ struct unary_composite : composite<unary_composite<Function> >
+ {
+ function compose(actor_list const& elements) const
+ {
+ return function(Function(elements.front()));
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // binary_function
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Derived>
+ struct binary_function : actor<binary_function<Derived> >
+ {
+ function a;
+ function b;
+ typedef binary_function<Derived> base_type;
+
+ binary_function(function const& a, function const& b)
+ : a(a), b(b)
+ {
+ BOOST_ASSERT(!a.empty());
+ BOOST_ASSERT(!b.empty());
+ }
+
+ utree eval(scope const& env) const
+ {
+ return derived().eval(a(env), b(env));
+ }
+
+ Derived const& derived() const
+ {
+ return *static_cast<Derived const*>(this);
+ }
+ };
+
+ template <typename Function>
+ struct binary_composite : composite<binary_composite<Function> >
+ {
+ function compose(actor_list const& elements) const
+ {
+ actor_list::const_iterator i = elements.begin();
+ function a = *i++;
+ function b = *i;
+ return function(Function(a, b));
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // nary_function
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Derived>
+ struct nary_function : actor<nary_function<Derived> >
+ {
+ actor_list elements;
+ typedef nary_function<Derived> base_type;
+
+ nary_function(actor_list const& elements)
+ : elements(elements)
+ {
+ BOOST_FOREACH(function const& element, elements)
+ {
+ BOOST_ASSERT(!element.empty());
+ }
+ }
+
+ utree eval(scope const& env) const
+ {
+ BOOST_ASSERT(!elements.empty());
+ actor_list::const_iterator i = elements.begin();
+ 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(env)))
+ break; // allow short-circuit evaluation
+ }
+ return result;
+ }
+
+ Derived const& derived() const
+ {
+ return *static_cast<Derived const*>(this);
+ }
+ };
+
+ template <typename Function>
+ struct nary_composite : composite<nary_composite<Function> >
+ {
+ function compose(actor_list const& elements) const
+ {
+ return function(Function(elements));
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // lambda
+ ///////////////////////////////////////////////////////////////////////////
+ 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, int level = 0)
+ : elements(elements), f(f), level(level) {}
+
+ typedef utree result_type;
+ 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>
+ fargs(new utree[elements.size()]);
+ std::size_t i = 0;
+ BOOST_FOREACH(function const& element, elements)
+ {
+ fargs[i++] = element(env);
+ }
+ utree* fi = fargs.get();
+ return f.get()(scope(fi, fi+elements.size(), outer));
+ }
+ else
+ {
+ return f.get()(scope(0, 0, outer));
+ }
+ }
+ };
+
+ struct lambda : composite<lambda>
+ {
+ function f;
+
+ lambda() : f() {}
+ lambda(function const& f) : f(f) {}
+
+ function compose(actor_list const& elements) const
+ {
+ return function(lambda_function(f, elements));
+ }
+
+ lambda& operator=(lambda const& other)
+ {
+ f = other.f;
+ return *this;
+ }
+
+ lambda& operator=(function const& f_)
+ {
+ f = f_;
+ return *this;
+ }
+ };
+}
+
+#if defined(BOOST_MSVC)
+# pragma warning(pop)
+#endif
+
+#endif

Added: branches/release/libs/spirit/example/scheme/scheme/intrinsics.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/scheme/intrinsics.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,220 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_SCHEME_INTRINSICS)
+#define BOOST_SPIRIT_SCHEME_INTRINSICS
+
+#include <scheme/interpreter.hpp>
+#include <utree/operators.hpp>
+#include <iostream>
+
+namespace scheme
+{
+ ///////////////////////////////////////////////////////////////////////////
+ // if
+ ///////////////////////////////////////////////////////////////////////////
+ struct if_function : actor<if_function>
+ {
+ function cond;
+ function then;
+ function else_;
+ if_function(
+ function const& cond, function const& then, function const& else_)
+ : cond(cond), then(then), else_(else_)
+ {
+ BOOST_ASSERT(!cond.empty());
+ BOOST_ASSERT(!then.empty());
+ BOOST_ASSERT(!else_.empty());
+ }
+
+ typedef utree result_type;
+ utree eval(scope const& env) const
+ {
+ return cond(env).get<bool>() ? then(env) : else_(env);
+ }
+ };
+
+ struct if_composite : composite<if_composite>
+ {
+ function compose(actor_list const& elements) const
+ {
+ actor_list::const_iterator i = elements.begin();
+ function if_ = *i++;
+ function then = *i++;
+ function else_ = *i;
+ return function(if_function(if_, then, else_));
+ }
+ };
+
+ if_composite const if_ = if_composite();
+
+ ///////////////////////////////////////////////////////////////////////////
+ // list
+ ///////////////////////////////////////////////////////////////////////////
+ struct list_function : actor<list_function>
+ {
+ actor_list elements;
+ list_function(actor_list const& elements)
+ : elements(elements)
+ {
+ BOOST_FOREACH(function const& element, elements)
+ {
+ BOOST_ASSERT(!element.empty());
+ }
+ }
+
+ utree eval(scope const& env) const
+ {
+ utree result;
+ BOOST_FOREACH(function const& element, elements)
+ {
+ result.push_back(element(env));
+ }
+ return result;
+ }
+ };
+
+ struct list_composite : composite<list_composite>
+ {
+ function compose(actor_list const& elements) const
+ {
+ return function(list_function(elements));
+ }
+ };
+
+ list_composite const list = list_composite();
+
+ ///////////////////////////////////////////////////////////////////////////
+ // block
+ ///////////////////////////////////////////////////////////////////////////
+ struct block_function : actor<block_function>
+ {
+ actor_list elements;
+ block_function(actor_list const& elements)
+ : elements(elements)
+ {
+ BOOST_FOREACH(function const& element, elements)
+ {
+ BOOST_ASSERT(!element.empty());
+ }
+ }
+
+ utree eval(scope const& env) const
+ {
+ BOOST_ASSERT(!elements.empty());
+ actor_list::const_iterator end = elements.end(); --end;
+ boost::iterator_range<actor_list::const_iterator>
+ head_elements(elements.begin(), end);
+ BOOST_FOREACH(function const& element, head_elements)
+ {
+ element(env);
+ }
+ return (*end)(env);
+ }
+ };
+
+ struct block_composite : composite<block_composite>
+ {
+ function compose(actor_list const& elements) const
+ {
+ return function(block_function(elements));
+ }
+ };
+
+ block_composite const block = block_composite();
+
+ ///////////////////////////////////////////////////////////////////////////
+ // SCHEME_UNARY_INTRINSIC
+ ///////////////////////////////////////////////////////////////////////////
+#define SCHEME_UNARY_INTRINSIC(name, expression) \
+ struct name##_function : unary_function<name##_function> \
+ { \
+ name##_function(function const& a) \
+ : base_type(a) {} \
+ \
+ utree eval(utree const& element) const \
+ { \
+ return expression; \
+ } \
+ }; \
+ \
+ struct name##_composite : unary_composite<name##_function> {}; \
+ name##_composite const name = name##_composite() \
+ /***/
+
+ ///////////////////////////////////////////////////////////////////////////
+ // SCHEME_BINARY_INTRINSIC
+ ///////////////////////////////////////////////////////////////////////////
+#define SCHEME_BINARY_INTRINSIC(name, expression) \
+ struct name##_function \
+ : binary_function<name##_function> \
+ { \
+ name##_function(function const& a, function const& b) \
+ : base_type(a, b) {} \
+ \
+ typedef utree result_type; \
+ utree eval(utree const& a, utree const& b) const \
+ { \
+ return expression; \
+ } \
+ }; \
+ \
+ struct name##_composite \
+ : binary_composite<name##_function> {}; \
+ \
+ name##_composite const name = name##_composite() \
+ /***/
+
+ ///////////////////////////////////////////////////////////////////////////
+ // SCHEME_NARY_INTRINSIC
+ ///////////////////////////////////////////////////////////////////////////
+#define SCHEME_NARY_INTRINSIC(name, expression) \
+ struct name##_function : nary_function<name##_function> \
+ { \
+ name##_function(actor_list const& elements) \
+ : base_type(elements) {} \
+ \
+ bool eval(utree& result, utree const& element) const \
+ { \
+ expression; \
+ return true; \
+ } \
+ }; \
+ \
+ struct name##_composite : nary_composite<name##_function> {}; \
+ name##_composite const name = name##_composite() \
+ /***/
+
+ ///////////////////////////////////////////////////////////////////////////
+ // unary intrinsics
+ ///////////////////////////////////////////////////////////////////////////
+ SCHEME_UNARY_INTRINSIC(display, (std::cout << element, utree()));
+ SCHEME_UNARY_INTRINSIC(front, element.front());
+ SCHEME_UNARY_INTRINSIC(back, element.back());
+ SCHEME_UNARY_INTRINSIC(rest, utree_functions::rest(element));
+
+ ///////////////////////////////////////////////////////////////////////////
+ // 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
+
+ SCHEME_BINARY_INTRINSIC(less_than_equal, a <= b);
+ less_than_equal_composite const lte = less_than_equal; // synonym
+
+ ///////////////////////////////////////////////////////////////////////////
+ // nary intrinsics
+ ///////////////////////////////////////////////////////////////////////////
+ SCHEME_NARY_INTRINSIC(plus, result = result + element);
+ SCHEME_NARY_INTRINSIC(minus, result = result - element);
+ SCHEME_NARY_INTRINSIC(times, result = result * element);
+ SCHEME_NARY_INTRINSIC(divide, result = result / element);
+}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/sexpr_output_test.txt
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/sexpr_output_test.txt 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1 @@
+( 123.45 true false 255 63 "this is a € string" "Τη γλώσσα μου έδωσαν ελληνική" b123456789abcdef123456789abcdef ( 92 ( "another string" apple Sîne ) ) )
\ No newline at end of file

Added: branches/release/libs/spirit/example/scheme/support/line_pos_iterator.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/support/line_pos_iterator.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,148 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_LINE_POS_ITERATOR)
+#define BOOST_SPIRIT_LINE_POS_ITERATOR
+
+#include <boost/iterator/iterator_adaptor.hpp>
+#include <boost/range/iterator_range.hpp>
+
+namespace scheme
+{
+ ///////////////////////////////////////////////////////////////////////////
+ // line_pos_iterator: a lighweight line position iterator. This iterator
+ // adapter only stores the current line number, nothing else. Unlike
+ // spirit classic's position_iterator, it does not store the column
+ // number and does not need an end iterator. The current column can be
+ // computed, if needed. Some line oriented utilities are provided
+ // including computation of the current column.
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Iterator>
+ class line_pos_iterator
+ : public boost::iterator_adaptor<
+ line_pos_iterator<Iterator> // Derived
+ , Iterator // Base
+ , boost::use_default // Value
+ , boost::forward_traversal_tag // CategoryOrTraversal
+ >
+ {
+ public:
+
+ line_pos_iterator()
+ : line_pos_iterator::iterator_adaptor_(),
+ line(1), prev(0) {}
+
+ explicit line_pos_iterator(Iterator base)
+ : line_pos_iterator::iterator_adaptor_(base),
+ line(1), prev(0) {}
+
+ std::size_t position() const
+ {
+ return line;
+ }
+
+ private:
+
+ friend class boost::iterator_core_access;
+ void increment()
+ {
+ typename std::iterator_traits<Iterator>::reference
+ ref = *(this->base());
+ switch (ref)
+ {
+ case '\r':
+ if (prev != '\n')
+ ++line;
+ break;
+ case '\n':
+ if (prev != '\r')
+ ++line;
+ break;
+ default:
+ break;
+ }
+ prev = ref;
+ ++this->base_reference();
+ }
+
+ std::size_t line;
+ typename std::iterator_traits<Iterator>::value_type prev;
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Utilities
+ ///////////////////////////////////////////////////////////////////////////
+
+ // Get the line position. Returns -1 if Iterator is not a line_pos_iterator.
+ template <typename Iterator>
+ inline int get_line(Iterator i)
+ {
+ return -1;
+ }
+
+ template <typename Iterator>
+ inline int get_line(line_pos_iterator<Iterator> i)
+ {
+ return i.position();
+ }
+
+ // Get an iterator to the beginning of the line. Applicable to any
+ // iterator.
+ template <typename Iterator>
+ inline Iterator
+ get_line_start(Iterator lower_bound, Iterator current)
+ {
+ Iterator latest = lower_bound;
+ for (Iterator i = lower_bound; i != current; ++i)
+ {
+ switch (*i)
+ {
+ case '\r':
+ case '\n':
+ latest = i;
+ }
+ }
+ return latest;
+ }
+
+ // Get the iterator range containing the current line. Applicable to
+ // any iterator.
+ template <typename Iterator>
+ inline boost::iterator_range<Iterator>
+ get_current_line(
+ Iterator lower_bound, Iterator current, Iterator upper_bound)
+ {
+ Iterator first = get_line_start(lower_bound, current);
+ Iterator last = get_line_start(current, upper_bound);
+ if (last == current)
+ last = upper_bound;
+ return boost::iterator_range<Iterator>(first, last);
+ }
+
+ // Get the current column. Applicable to any iterator.
+ template <typename Iterator>
+ inline std::size_t
+ get_column(
+ Iterator lower_bound, Iterator current, int tabs = 4)
+ {
+ std::size_t column = 1;
+ Iterator first = get_line_start(lower_bound, current);
+ for (Iterator i = first; i != current; ++i)
+ {
+ switch (*i)
+ {
+ case '\t':
+ column += tabs - (column - 1) % tabs;
+ break;
+ default:
+ ++column;
+ }
+ }
+ return column;
+ }
+}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/test/Jamfile
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/test/Jamfile 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,35 @@
+#==============================================================================
+# Copyright (c) 2001-2007 Joel de Guzman
+#
+# Distributed under the Boost Software License, Version 1.0. (See accompanying
+# file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+#==============================================================================
+project spirit-scheme-tests
+ : requirements
+ <toolset>gcc:<c++-template-depth>300
+ <include>../
+ :
+ :
+ ;
+
+# bring in rules for testing
+# [ run sources : cmdlineargs : input files : requirements : name ]
+
+import testing ;
+
+{
+ test-suite utree :
+
+ # run utree tests
+ [ run utree/utree_test.cpp : : : : ]
+ [ run scheme/scheme_test1.cpp : : : : ]
+ [ run scheme/scheme_test2.cpp : scheme/scheme_test.scm test1 test2 test3 test4 : : : ]
+ [ run scheme/scheme_test3.cpp : : : : ]
+
+ ;
+}
+
+
+
+
+

Added: branches/release/libs/spirit/example/scheme/test/qi/calc.scm
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/test/qi/calc.scm 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,24 @@
+; The calculator in spirit.scheme
+
+(define expression) ; forward declaration
+
+(define factor
+ (qi:|
+ (qi:int_)
+ (qi:>> (qi:char_ "(") (expression) (qi:char_ ")"))
+ (qi:>> (qi:char_ "-") (factor))
+ (qi:>> (qi:char_ "+") (factor))))
+
+(define term
+ (qi:>> (factor)
+ (qi:*
+ (qi:|
+ (qi:>> (qi:char_ "*") (factor))
+ (qi:>> (qi:char_ "/") (factor))))))
+
+(define expression
+ (qi:>> (term)
+ (qi:*
+ (qi:|
+ (qi:>> (qi:char_ "+") (term))
+ (qi:>> (qi:char_ "-") (term))))))
\ No newline at end of file

Added: branches/release/libs/spirit/example/scheme/test/qi/qi_interpreter.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/test/qi/qi_interpreter.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,656 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#include <boost/detail/lightweight_test.hpp>
+#include <boost/config/warning_disable.hpp>
+
+#include <input/sexpr.hpp>
+#include <input/parse_sexpr_impl.hpp>
+#include <scheme/compiler.hpp>
+#include <utree/io.hpp>
+#include <boost/spirit/include/qi.hpp>
+
+#include <iostream>
+#include <fstream>
+#include <strstream>
+#include <map>
+
+#include "../../../../test/qi/test.hpp"
+
+#define SCHEME_QI_COMPILER_LIMIT 20
+
+namespace scheme { namespace qi
+{
+ ///////////////////////////////////////////////////////////////////////////
+ // parser compiler
+ ///////////////////////////////////////////////////////////////////////////
+ namespace qi = boost::spirit::qi;
+ namespace spirit = boost::spirit;
+
+ typedef qi::rule<char const*> skipper_type;
+ typedef qi::rule<char const*, skipper_type> rule_type;
+
+ ///////////////////////////////////////////////////////////////////////////
+ // All rule are stored here. Rules are held in the utree by its id;
+ // i.e. its index in the vector.
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Rule>
+ class rule_fragments
+ {
+ public:
+
+ rule_fragments()
+ : index(0)
+ {
+ };
+
+ int new_rule()
+ {
+ rules[index];
+ std::stringstream str;
+ str << qi::what(expr);
+ rules[index].name(str.str());
+ return index++;
+ }
+
+ template <typename Expr>
+ void define_rule(int id, Expr const& expr)
+ {
+ rules[id] = expr;
+ }
+
+ Rule const& operator[](int id) const
+ {
+ typename std::map<int, Rule>::const_iterator
+ iter = rules.find(id);
+ BOOST_ASSERT(iter != rules.end());
+ return iter->second;
+ }
+
+ Rule const& operator[](utree const& id) const
+ {
+ return (*this)[id.get<int>()];
+ }
+
+ private:
+
+ int index;
+ std::map<int, Rule> rules;
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Composes primitive parsers held by index. Handles the compilation of
+ // primitive (nullary) parsers such as int_, double_, alpha, space and all
+ // those that require no arguments.
+ ///////////////////////////////////////////////////////////////////////////
+ struct primitive_parser_composite : composite<primitive_parser_composite>
+ {
+ int id;
+ primitive_parser_composite(int id)
+ : id(id)
+ {
+ }
+
+ function compose(actor_list const& elements) const
+ {
+ return val(id);
+ }
+ };
+
+ template <typename Fragments, typename Expr>
+ inline primitive_parser_composite
+ make_primitive_parser_composite(Fragments& fragments, Expr const& expr)
+ {
+ int id = fragments.new_rule();
+ fragments.define_rule(id, expr);
+ return primitive_parser_composite(id);
+ }
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Handles the compilation of char_
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Fragments>
+ struct char_function : actor<char_function<Fragments> >
+ {
+ mutable int id;
+ function a;
+ function b;
+ Fragments& fragments;
+ char_function(
+ Fragments& fragments, function const& a, function const& b)
+ : id(-1), a(a), b(b), fragments(fragments)
+ {
+ }
+
+ void define() const
+ {
+ // char_
+ fragments.define_rule(id, qi::char_);
+ }
+
+ void define(utree const& a) const
+ {
+ // $$$ use exceptions here $$$.
+ BOOST_ASSERT(a.which() == utree_type::string_type);
+
+ utf8_string_range a_ = a.get<utf8_string_range>();
+ if (a_.size() == 1)
+ {
+ // char_('x')
+ fragments.define_rule(id, qi::char_(a_[0]));
+ }
+ else
+ {
+ // char_("some-regex")
+ fragments.define_rule(id,
+ qi::char_(std::string(a_.begin(), a_.end())));
+ }
+ }
+
+ void define(utree const& a, utree const& b) const
+ {
+ // $$$ use exceptions here $$$.
+ BOOST_ASSERT(a.which() == utree_type::string_type);
+ BOOST_ASSERT(b.which() == utree_type::string_type);
+
+ utf8_string_range a_ = a.get<utf8_string_range>();
+ utf8_string_range b_ = b.get<utf8_string_range>();
+ // $$$ use exceptions here $$$.
+ BOOST_ASSERT(a_.size() == 1);
+ BOOST_ASSERT(b_.size() == 1);
+
+ // char_('x', 'y')
+ fragments.define_rule(id, qi::char_(a_[0], b_[0]));
+ }
+
+ utree eval(scope const& env) const
+ {
+ if (id != -1)
+ return id;
+ id = fragments.new_rule();
+
+ if (a.empty())
+ define();
+ else if (b.empty())
+ define(a(env));
+ else
+ define(a(env), b(env));
+
+ return id;
+ }
+ };
+
+ template <typename Fragments>
+ struct char_composite
+ : composite<char_composite<Fragments> >
+ {
+ Fragments& fragments;
+ char_composite(Fragments& fragments)
+ : fragments(fragments) {}
+
+ function compose(actor_list const& elements) const
+ {
+ typedef char_function<Fragments> function_type;
+ actor_list::const_iterator i = elements.begin();
+
+ function empty;
+ function const& a = (i == elements.end())? empty : *i++;
+ function const& b = (i == elements.end())? empty : *i;
+ return function(function_type(fragments, a, b));
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Handles the compilation of kleene *a
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Fragments>
+ struct kleene_function : actor<kleene_function<Fragments> >
+ {
+ mutable int id;
+ function a;
+ Fragments& fragments;
+ kleene_function(
+ Fragments& fragments, function const& a)
+ : id(-1), a(a), fragments(fragments)
+ {
+ }
+
+ void define(utree const& a) const
+ {
+ fragments.define_rule(id, *fragments[a]); // *a
+ }
+
+ utree eval(scope const& env) const
+ {
+ if (id != -1)
+ return id;
+ id = fragments.new_rule();
+ define(a(env));
+ return id;
+ }
+ };
+
+ template <typename Fragments>
+ struct kleene_composite
+ : composite<kleene_composite<Fragments> >
+ {
+ Fragments& fragments;
+ kleene_composite(Fragments& fragments)
+ : fragments(fragments) {}
+
+ function compose(actor_list const& elements) const
+ {
+ typedef kleene_function<Fragments> function_type;
+ return function(function_type(fragments, elements.front()));
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Handles the compilation of difference a - b
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Fragments>
+ struct difference_function : actor<difference_function<Fragments> >
+ {
+ mutable int id;
+ function a;
+ function b;
+ Fragments& fragments;
+ difference_function(
+ Fragments& fragments, function const& a, function const& b)
+ : id(-1), a(a), b(b), fragments(fragments)
+ {
+ }
+
+ void define(utree const& a, utree const& b) const
+ {
+ fragments.define_rule(id,
+ fragments[a] - fragments[b]); // a - b
+ }
+
+ utree eval(scope const& env) const
+ {
+ if (id != -1)
+ return id;
+ id = fragments.new_rule();
+ define(a(env), b(env));
+ return id;
+ }
+ };
+
+ template <typename Fragments>
+ struct difference_composite
+ : composite<difference_composite<Fragments> >
+ {
+ Fragments& fragments;
+ difference_composite(Fragments& fragments)
+ : fragments(fragments) {}
+
+ function compose(actor_list const& elements) const
+ {
+ typedef difference_function<Fragments> function_type;
+ actor_list::const_iterator i = elements.begin();
+
+ function const& a = *i++;
+ function const& b = *i;
+ return function(function_type(fragments, a, b));
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Handles the compilation of sequence a >> b
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Fragments>
+ struct sequence_function : actor<sequence_function<Fragments> >
+ {
+ mutable int id;
+ actor_list elements;
+ Fragments& fragments;
+ sequence_function(
+ Fragments& fragments, actor_list const& elements)
+ : id(-1), elements(elements), fragments(fragments)
+ {
+ }
+
+ void define(utree const& a, utree const& b) const
+ {
+ // a >> b
+ fragments.define_rule(id,
+ fragments[a] >> fragments[b]);
+ }
+
+ void define(utree const& a, utree const& b, utree const& c) const
+ {
+ // a >> b >> c
+ fragments.define_rule(id,
+ fragments[a] >> fragments[b] >> fragments[c]);
+ }
+
+ void define(utree const& a, utree const& b, utree const& c,
+ utree const& d) const
+ {
+ // a >> b >> c >> d
+ fragments.define_rule(id,
+ fragments[a] >> fragments[b] >> fragments[c] >>
+ fragments[d]);
+ }
+
+ void define(utree const& a, utree const& b, utree const& c,
+ utree const& d, utree const& e) const
+ {
+ // a >> b >> c >> d >> e
+ fragments.define_rule(id,
+ fragments[a] >> fragments[b] >> fragments[c] >>
+ fragments[d] >> fragments[e]);
+ }
+
+ utree eval(scope const& env) const
+ {
+ if (id != -1)
+ return id;
+ id = fragments.new_rule();
+
+ actor_list::const_iterator i = elements.begin();
+ switch (elements.size())
+ {
+ case 2:
+ {
+ function const& a = *i++;
+ function const& b = *i;
+ define(a(env), b(env));
+ break;
+ }
+ case 3:
+ {
+ function const& a = *i++;
+ function const& b = *i++;
+ function const& c = *i;
+ define(a(env), b(env), c(env));
+ break;
+ }
+ case 4:
+ {
+ function const& a = *i++;
+ function const& b = *i++;
+ function const& c = *i++;
+ function const& d = *i;
+ define(a(env), b(env), c(env), d(env));
+ break;
+ }
+ case 5:
+ {
+ function const& a = *i++;
+ function const& b = *i++;
+ function const& c = *i++;
+ function const& d = *i++;
+ function const& e = *i;
+ define(a(env), b(env), c(env), d(env), e(env));
+ break;
+ }
+
+ // $$$ Use Boost PP using SCHEME_QI_COMPILER_LIMIT $$$
+ }
+ return id;
+ }
+ };
+
+ template <typename Fragments>
+ struct sequence_composite
+ : composite<sequence_composite<Fragments> >
+ {
+ Fragments& fragments;
+ sequence_composite(Fragments& fragments)
+ : fragments(fragments) {}
+
+ function compose(actor_list const& elements) const
+ {
+ typedef sequence_function<Fragments> function_type;
+ return function(function_type(fragments, elements));
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Handles the compilation of alternatives a | b
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Fragments>
+ struct alternative_function : actor<alternative_function<Fragments> >
+ {
+ mutable int id;
+ actor_list elements;
+ Fragments& fragments;
+ alternative_function(
+ Fragments& fragments, actor_list const& elements)
+ : id(-1), elements(elements), fragments(fragments)
+ {
+ }
+
+ void define(utree const& a, utree const& b) const
+ {
+ // a | b
+ fragments.define_rule(id,
+ fragments[a] | fragments[b]);
+ }
+
+ void define(utree const& a, utree const& b, utree const& c) const
+ {
+ // a | b | c
+ fragments.define_rule(id,
+ fragments[a] | fragments[b] | fragments[c]);
+ }
+
+ void define(utree const& a, utree const& b, utree const& c,
+ utree const& d) const
+ {
+ // a | b | c | d
+ fragments.define_rule(id,
+ fragments[a] | fragments[b] | fragments[c] |
+ fragments[d]);
+ }
+
+ void define(utree const& a, utree const& b, utree const& c,
+ utree const& d, utree const& e) const
+ {
+ // a | b | c | d | e
+ fragments.define_rule(id,
+ fragments[a] | fragments[b] | fragments[c] |
+ fragments[d] | fragments[e]);
+ }
+
+ utree eval(scope const& env) const
+ {
+ if (id != -1)
+ return id;
+ id = fragments.new_rule();
+
+ actor_list::const_iterator i = elements.begin();
+ switch (elements.size())
+ {
+ case 2:
+ {
+ function const& a = *i++;
+ function const& b = *i;
+ define(a(env), b(env));
+ break;
+ }
+ case 3:
+ {
+ function const& a = *i++;
+ function const& b = *i++;
+ function const& c = *i;
+ define(a(env), b(env), c(env));
+ break;
+ }
+ case 4:
+ {
+ function const& a = *i++;
+ function const& b = *i++;
+ function const& c = *i++;
+ function const& d = *i;
+ define(a(env), b(env), c(env), d(env));
+ break;
+ }
+ case 5:
+ {
+ function const& a = *i++;
+ function const& b = *i++;
+ function const& c = *i++;
+ function const& d = *i++;
+ function const& e = *i;
+ define(a(env), b(env), c(env), d(env), e(env));
+ break;
+ }
+
+ // $$$ Use Boost PP using SCHEME_QI_COMPILER_LIMIT $$$
+ }
+ return id;
+ }
+ };
+
+ template <typename Fragments>
+ struct alternative_composite
+ : composite<alternative_composite<Fragments> >
+ {
+ Fragments& fragments;
+ alternative_composite(Fragments& fragments)
+ : fragments(fragments) {}
+
+ function compose(actor_list const& elements) const
+ {
+ typedef alternative_function<Fragments> function_type;
+ return function(function_type(fragments, elements));
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Build our scheme compiler environment.
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Fragments>
+ void build_environment(Fragments& fragments, environment& env)
+ {
+ build_basic_environment(env);
+
+ env.define("qi:space",
+ make_primitive_parser_composite(fragments, qi::space), 0, true);
+
+ env.define("qi:alpha",
+ make_primitive_parser_composite(fragments, qi::alpha), 0, true);
+
+ env.define("qi:int_",
+ make_primitive_parser_composite(fragments, qi::int_), 0, true);
+
+ env.define("qi:char_",
+ char_composite<Fragments>(fragments), 0, false);
+
+ env.define("qi:*",
+ kleene_composite<Fragments>(fragments), 1, true);
+
+ env.define("qi:-",
+ difference_composite<Fragments>(fragments), 2, true);
+
+ env.define("qi:>>",
+ sequence_composite<Fragments>(fragments), 2, false);
+
+ env.define("qi:|",
+ alternative_composite<Fragments>(fragments), 2, false);
+ }
+}}
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main()
+{
+ using scheme::utree;
+ using scheme::interpreter;
+ using scheme::environment;
+ using scheme::qi::build_environment;
+ using scheme::qi::rule_fragments;
+ using scheme::qi::rule_type;
+ using spirit_test::test;
+
+ environment env;
+ rule_fragments<rule_type> fragments;
+ build_environment(fragments, env);
+
+ scheme::qi::skipper_type space = boost::spirit::qi::space;
+
+ {
+ utree src =
+ "(define charx (qi:char_ \"x\"))"
+ "(define integer (qi:int_))"
+ "(define nonzero (qi:- (qi:int_) (qi:char_ \"0\")))"
+ "(define integers (qi:* (qi:int_)))"
+ "(define intpair (qi:>> "
+ "(qi:char_ \"(\") "
+ "(qi:int_) "
+ "(qi:char_ \",\") "
+ "(qi:int_) "
+ "(qi:char_ \")\")))"
+ ;
+ interpreter parser(src, "parse.scm", &env);
+
+ BOOST_TEST(test("z", fragments[parser["qi:char_"]()], space));
+ BOOST_TEST(test("x", fragments[parser["charx"]()], space));
+ BOOST_TEST(!test("y", fragments[parser["charx"]()], space));
+ BOOST_TEST(test("1234", fragments[parser["integer"]()], space));
+ BOOST_TEST(!test("x1234", fragments[parser["integer"]()], space));
+ BOOST_TEST(test("1 2 3 4", fragments[parser["integers"]()], space));
+ BOOST_TEST(test("1", fragments[parser["nonzero"]()], space));
+ BOOST_TEST(!test("0", fragments[parser["nonzero"]()], space));
+ BOOST_TEST(test("(1, 2)", fragments[parser["intpair"]()], space));
+ BOOST_TEST(!test("(1, x)", fragments[parser["intpair"]()], space));
+ }
+
+ {
+ char const* filename = filename = "calc.scm";
+ std::ifstream in(filename, std::ios_base::in);
+
+ BOOST_TEST(in);
+
+ // Ignore the BOM marking the beginning of a UTF-8 file in Windows
+ char c = in.peek();
+ if (c == '\xef')
+ {
+ char s[3];
+ in >> s[0] >> s[1] >> s[2];
+ s[3] = '\0';
+ BOOST_TEST(s != std::string("\xef\xbb\xbf"));
+ }
+
+ interpreter parser(in, filename, &env);
+ rule_type calc = fragments[parser["expression"]()].alias();
+ std::string str;
+
+ while (std::getline(std::cin, str))
+ {
+ if (str.empty() || str[0] == 'q' || str[0] == 'Q')
+ break;
+
+ char const* iter = str.c_str();
+ char const* end = iter + strlen(iter);
+ bool r = phrase_parse(iter, end, calc, space);
+
+ if (r && iter == end)
+ {
+ std::cout << "-------------------------\n";
+ std::cout << "Parsing succeeded\n";
+ std::cout << "-------------------------\n";
+ }
+ else
+ {
+ std::string rest(iter, end);
+ std::cout << "-------------------------\n";
+ std::cout << "Parsing failed\n";
+ std::cout << "stopped at: \": " << rest << "\"\n";
+ std::cout << "-------------------------\n";
+ }
+ }
+
+ }
+
+ return boost::report_errors();
+}
+
+

Added: branches/release/libs/spirit/example/scheme/test/scheme/scheme_test.scm
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/test/scheme/scheme_test.scm 2010-07-04 12:30:38 EDT (Sun, 04 Jul 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 ))))
+

Added: branches/release/libs/spirit/example/scheme/test/scheme/scheme_test1.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/test/scheme/scheme_test1.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,49 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#include <boost/detail/lightweight_test.hpp>
+#include <boost/config/warning_disable.hpp>
+
+#include <input/parse_sexpr_impl.hpp>
+#include <scheme/compiler.hpp>
+#include <utree/io.hpp>
+#include <iostream>
+#include <fstream>
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main()
+{
+ using scheme::utree;
+
+ { // testing the c++ side
+
+ using scheme::if_;
+ using scheme::plus;
+ using scheme::times;
+ using scheme::minus;
+ using scheme::lte;
+ using scheme::_1;
+ using scheme::_2;
+ using scheme::lambda;
+
+ BOOST_TEST(plus(11, 22, 33) () == utree(66));
+ BOOST_TEST(plus(11, 22, _1) (33) == utree(66));
+ BOOST_TEST(plus(11, _1, _2) (22, 33) == utree(66));
+ BOOST_TEST(plus(11, plus(_1, _2)) (22, 33) == utree(66));
+
+ lambda factorial;
+ factorial = if_(lte(_1, 0), 1, times(_1, factorial(minus(_1, 1))));
+
+ BOOST_TEST(factorial(_1) (10) == utree(3628800));
+ }
+
+ return boost::report_errors();
+}
+
+
+

Added: branches/release/libs/spirit/example/scheme/test/scheme/scheme_test2.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/test/scheme/scheme_test2.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,57 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#include <boost/detail/lightweight_test.hpp>
+#include <boost/config/warning_disable.hpp>
+
+#include <input/parse_sexpr_impl.hpp>
+#include <scheme/compiler.hpp>
+#include <utree/io.hpp>
+#include <iostream>
+#include <fstream>
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main(int argc, char **argv)
+{
+ using scheme::utree;
+
+ BOOST_TEST(argc > 1);
+ char const* filename = filename = argv[1];
+ std::ifstream in(filename, std::ios_base::in);
+
+ BOOST_TEST(in);
+
+ // Ignore the BOM marking the beginning of a UTF-8 file in Windows
+ char c = in.peek();
+ if (c == '\xef')
+ {
+ char s[3];
+ in >> s[0] >> s[1] >> s[2];
+ s[3] = '\0';
+ BOOST_TEST(s != std::string("\xef\xbb\xbf"));
+ }
+
+ using scheme::interpreter;
+ using scheme::_1;
+
+ 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();
+}
+
+

Added: branches/release/libs/spirit/example/scheme/test/scheme/scheme_test3.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/test/scheme/scheme_test3.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,50 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#include <boost/detail/lightweight_test.hpp>
+#include <boost/config/warning_disable.hpp>
+
+#include <input/sexpr.hpp>
+#include <input/parse_sexpr_impl.hpp>
+#include <scheme/compiler.hpp>
+#include <utree/io.hpp>
+
+///////////////////////////////////////////////////////////////////////////////
+// Main program
+///////////////////////////////////////////////////////////////////////////////
+int main()
+{
+ using scheme::interpreter;
+ using scheme::utree;
+
+ {
+ utree src = "(define n 123)";
+ scheme::interpreter program(src);
+ BOOST_TEST(program["n"]() == 123);
+ }
+
+ {
+ utree src = "(define (factorial n) (if (<= n 0) 1 (* n (factorial (- n 1)))))";
+ scheme::interpreter program(src);
+ BOOST_TEST(program["factorial"](10) == 3628800);
+ }
+
+ {
+ // test forward declaration (a scheme extension)
+ utree src =
+ "(define (dbl n))" // multiple forward declarations allowed
+ "(define (dbl n))"
+ "(define foo (dbl 10))"
+ "(define (dbl n) (* n 2))"
+ ;
+ scheme::interpreter program(src);
+ BOOST_TEST(program["foo"](10) == 20);
+ }
+
+ return boost::report_errors();
+}
+
+

Added: branches/release/libs/spirit/example/scheme/test/sexpr_output_test.txt
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/test/sexpr_output_test.txt 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1 @@
+( 123.45 true false 255 63 "this is a € string" "Τη γλώσσα μου έδωσαν ελληνική" b0123456789abcdef0123456789abcdef ( 92 ( "another string" apple Sîne ) ) )
\ No newline at end of file

Added: branches/release/libs/spirit/example/scheme/test/utree/utree_test.cpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/test/utree/utree_test.cpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,339 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#include <boost/detail/lightweight_test.hpp>
+#include <boost/config/warning_disable.hpp>
+
+#include <utree/utree.hpp>
+#include <utree/operators.hpp>
+#include <utree/io.hpp>
+#include <iostream>
+#include <sstream>
+#include <cstdlib>
+
+inline void check(scheme::utree const& val, std::string expected)
+{
+ std::stringstream s;
+ s << val;
+ BOOST_ASSERT(s.str() == expected + " ");
+}
+
+struct one_two_three
+{
+ scheme::utree operator()(scheme::scope) const
+ {
+ return scheme::utree(123);
+ }
+};
+
+int main()
+{
+ using scheme::utree;
+
+ {
+ // test the size
+ std::cout << "size of utree is: "
+ << sizeof(scheme::utree) << " bytes" << std::endl;
+ }
+
+ {
+ utree val;
+ check(val, "<nil>");
+ }
+
+ {
+ utree val(true);
+ check(val, "true");
+ }
+
+ {
+ utree val(123);
+ check(val, "123");
+ }
+
+ {
+ // single element string
+ utree val('x');
+ check(val, "\"x\"");
+ }
+
+ {
+ utree val(123.456);
+ check(val, "123.456");
+ }
+
+ {
+ utree val("Hello, World");
+ check(val, "\"Hello, World\"");
+ utree val2;
+ val2 = val;
+ check(val2, "\"Hello, World\"");
+ utree val3("Hello, World. Chuckie is back!!!");
+ val = val3;
+ check(val, "\"Hello, World. Chuckie is back!!!\"");
+
+ utree val4("Apple");
+ utree val5("Apple");
+ BOOST_TEST(val4 == val5);
+
+ utree val6("ApplePie");
+ BOOST_TEST(val4 < val6);
+ }
+
+ {
+ utree val;
+ val.push_back(123);
+ val.push_back("Chuckie");
+ BOOST_TEST(val.size() == 2);
+ utree val2;
+ val2.push_back(123.456);
+ val2.push_back("Mah Doggie");
+ val.push_back(val2);
+ BOOST_TEST(val.size() == 3);
+ check(val, "( 123 \"Chuckie\" ( 123.456 \"Mah Doggie\" ) )");
+ check(val.front(), "123");
+
+ utree val3;
+ val3.swap(val);
+ BOOST_TEST(val3.size() == 3);
+ check(val, "<nil>");
+ val3.swap(val);
+ check(val, "( 123 \"Chuckie\" ( 123.456 \"Mah Doggie\" ) )");
+ val.push_back("another string");
+ BOOST_TEST(val.size() == 4);
+ check(val, "( 123 \"Chuckie\" ( 123.456 \"Mah Doggie\" ) \"another string\" )");
+ val.pop_front();
+ check(val, "( \"Chuckie\" ( 123.456 \"Mah Doggie\" ) \"another string\" )");
+ utree::iterator i = val.begin();
+ ++++i;
+ val.insert(i, "Right in the middle");
+ BOOST_TEST(val.size() == 4);
+ check(val, "( \"Chuckie\" ( 123.456 \"Mah Doggie\" ) \"Right in the middle\" \"another string\" )");
+ val.pop_back();
+ check(val, "( \"Chuckie\" ( 123.456 \"Mah Doggie\" ) \"Right in the middle\" )");
+ BOOST_TEST(val.size() == 3);
+ utree::iterator it = val.end(); --it;
+ val.erase(it);
+ check(val, "( \"Chuckie\" ( 123.456 \"Mah Doggie\" ) )");
+ BOOST_TEST(val.size() == 2);
+
+ val.insert(val.begin(), val2.begin(), val2.end());
+ check(val, "( 123.456 \"Mah Doggie\" \"Chuckie\" ( 123.456 \"Mah Doggie\" ) )");
+ BOOST_TEST(val.size() == 4);
+ }
+
+ {
+ utree val;
+ val.insert(val.end(), 123);
+ val.insert(val.end(), "Mia");
+ val.insert(val.end(), "Chuckie");
+ val.insert(val.end(), "Poly");
+ val.insert(val.end(), "Mochi");
+ check(val, "( 123 \"Mia\" \"Chuckie\" \"Poly\" \"Mochi\" )");
+ }
+
+ {
+ utree a, b;
+ BOOST_TEST(a == b);
+ a = 123;
+ BOOST_TEST(a != b);
+ b = 123;
+ BOOST_TEST(a == b);
+ a = 100.00;
+ BOOST_TEST(a < b);
+
+ b = a = utree();
+ BOOST_TEST(a == b);
+ a.push_back(1);
+ a.push_back("two");
+ a.push_back(3.0);
+ b.push_back(1);
+ b.push_back("two");
+ b.push_back(3.0);
+ BOOST_TEST(a == b);
+ b.push_back(4);
+ BOOST_TEST(a != b);
+ BOOST_TEST(a < b);
+ }
+
+ {
+ utree a;
+ a.push_back(1);
+ a.push_back(2);
+ a.push_back(3);
+ a.push_back(4);
+ a.push_back(5);
+ a.push_back(6);
+ a.push_back(7);
+ a.push_back(8);
+ a.push_back(9);
+ a.push_back(10);
+ a.push_back(11);
+ a.push_back(12);
+
+ BOOST_TEST(a[0] == utree(1));
+ BOOST_TEST(a[1] == utree(2));
+ BOOST_TEST(a[2] == utree(3));
+ BOOST_TEST(a[3] == utree(4));
+ BOOST_TEST(a[4] == utree(5));
+ BOOST_TEST(a[5] == utree(6));
+ BOOST_TEST(a[6] == utree(7));
+ BOOST_TEST(a[7] == utree(8));
+ BOOST_TEST(a[8] == utree(9));
+ BOOST_TEST(a[9] == utree(10));
+ BOOST_TEST(a[10] == utree(11));
+ BOOST_TEST(a[11] == utree(12));
+ }
+
+ {
+ // test empty list
+ utree a;
+ a.push_back(1);
+ a.pop_front();
+ check(a, "( )");
+
+ // the other way around
+ utree b;
+ b.push_front(1);
+ b.pop_back();
+ check(b, "( )");
+ }
+
+ { // test references
+ utree val(123);
+ utree ref(boost::ref(val));
+ check(ref, "123");
+ BOOST_TEST(ref == utree(123));
+
+ val.clear();
+ val.push_back(1);
+ val.push_back(2);
+ val.push_back(3);
+ val.push_back(4);
+ check(ref, "( 1 2 3 4 )");
+ BOOST_TEST(ref[0] == utree(1));
+ BOOST_TEST(ref[1] == utree(2));
+ BOOST_TEST(ref[2] == utree(3));
+ BOOST_TEST(ref[3] == utree(4));
+ }
+
+ { // put it in an array
+
+ utree vals[] = {
+ utree(123),
+ utree("Hello, World"),
+ utree(123.456)
+ };
+
+ check(vals[0], "123");
+ check(vals[1], "\"Hello, World\"");
+ check(vals[2], "123.456");
+ }
+
+ { // operators
+
+ BOOST_TEST((utree(true) && utree(true)) == utree(true));
+ BOOST_TEST((utree(true) || utree(false)) == utree(true));
+ BOOST_TEST(!utree(true) == utree(false));
+
+ BOOST_TEST((utree(456) + utree(123)) == utree(456 + 123));
+ BOOST_TEST((utree(456) + utree(123.456)) == utree(456 + 123.456));
+ BOOST_TEST((utree(456) - utree(123)) == utree(456 - 123));
+ BOOST_TEST((utree(456) - utree(123.456)) == utree(456 - 123.456));
+ BOOST_TEST((utree(456) * utree(123)) == utree(456 * 123));
+ BOOST_TEST((utree(456) * utree(123.456)) == utree(456 * 123.456));
+ BOOST_TEST((utree(456) / utree(123)) == utree(456 / 123));
+ BOOST_TEST((utree(456) / utree(123.456)) == utree(456 / 123.456));
+ BOOST_TEST((utree(456) % utree(123)) == utree(456 % 123));
+ BOOST_TEST(-utree(456) == utree(-456));
+
+ BOOST_TEST((utree(456) & utree(123)) == utree(456 & 123));
+ BOOST_TEST((utree(456) | utree(123)) == utree(456 | 123));
+ BOOST_TEST((utree(456) ^ utree(123)) == utree(456 ^ 123));
+ BOOST_TEST((utree(456) << utree(3)) == utree(456 << 3));
+ BOOST_TEST((utree(456) >> utree(2)) == utree(456 >> 2));
+ BOOST_TEST(~utree(456) == utree(~456));
+ }
+
+ { // test reference iterator
+ utree val;
+ val.push_back(1);
+ val.push_back(2);
+ val.push_back(3);
+ val.push_back(4);
+ check(val, "( 1 2 3 4 )");
+
+ utree::ref_iterator b = val.ref_begin();
+ utree::ref_iterator e = val.ref_end();
+
+ utree ref(boost::make_iterator_range(b, e));
+ BOOST_TEST(ref[0] == utree(1));
+ BOOST_TEST(ref[1] == utree(2));
+ BOOST_TEST(ref[2] == utree(3));
+ BOOST_TEST(ref[3] == utree(4));
+ check(ref, "( 1 2 3 4 )");
+ }
+
+ {
+ // check the tag
+ utree x;
+ x.tag(123);
+ BOOST_TEST(x.tag() == 123);
+ }
+
+ {
+ // test functions
+ utree f = scheme::stored_function<one_two_three>();
+ f.eval(scheme::scope());
+ }
+
+ {
+ // shallow ranges
+ utree val;
+ val.push_back(1);
+ val.push_back(2);
+ val.push_back(3);
+ val.push_back(4);
+
+ utree::iterator i = val.begin(); ++i;
+ utree alias(utree::range(i, val.end()), scheme::shallow);
+
+ check(alias, "( 2 3 4 )");
+ BOOST_TEST(alias.size() == 3);
+ BOOST_TEST(alias.front() == 2);
+ BOOST_TEST(alias.back() == 4);
+ BOOST_TEST(!alias.empty());
+ BOOST_TEST(alias[1] == 3);
+ }
+
+ {
+ // shallow string ranges
+
+ using scheme::utf8_string_range;
+ using scheme::shallow;
+
+ char const* s = "Hello, World";
+ utree val(utf8_string_range(s, s + strlen(s)), shallow);
+ check(val, "\"Hello, World\"");
+
+ utf8_string_range r = val.get<utf8_string_range>();
+ utf8_string_range pf(r.begin()+1, r.end()-1);
+ val = utree(pf, shallow);
+ check(val, "\"ello, Worl\"");
+ }
+
+ {
+ // any pointer
+
+ using scheme::any_ptr;
+
+ int n = 123;
+ utree up = any_ptr(&n);
+ BOOST_TEST(*up.get<int*>() == 123);
+ }
+
+ return boost::report_errors();
+}

Added: branches/release/libs/spirit/example/scheme/todo.txt
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/todo.txt 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,5 @@
+Sexpr:
+- allow scheme-ish #t and #f
+- write parser and generator for binary on disk representation of sexpr
+- implement quote in sexpr grammar (e.g. 'sym '(1 2 3 4 5))
+- investigate storing and retrieving polymorphic pointers from utree

Added: branches/release/libs/spirit/example/scheme/utree/detail/utree_detail1.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/utree/detail/utree_detail1.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,148 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_UTREE_DETAIL1)
+#define BOOST_SPIRIT_UTREE_DETAIL1
+
+#include <boost/type_traits/alignment_of.hpp>
+
+namespace scheme { namespace detail
+{
+ template <typename UTreeX, typename UTreeY>
+ struct visit_impl;
+
+ struct index_impl;
+
+ template <typename T>
+ struct get_impl;
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Our POD double linked list. Straightforward implementation.
+ // This implementation is very primitive and is not meant to be
+ // used stand-alone. This is the internal data representation
+ // of lists in our utree.
+ ///////////////////////////////////////////////////////////////////////////
+ struct list // keep this a POD!
+ {
+ struct node;
+
+ template <typename Value>
+ class node_iterator;
+
+ void free();
+ void copy(list const& other);
+ void default_construct();
+
+ template <typename T>
+ void insert_before(T const& val, node* node);
+
+ template <typename T>
+ void insert_after(T const& val, node* node);
+
+ template <typename T>
+ void push_front(T const& val);
+
+ template <typename T>
+ void push_back(T const& val);
+
+ void pop_front();
+ void pop_back();
+ node* erase(node* pos);
+
+ node* first;
+ node* last;
+ std::size_t size;
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // A range of utree(s) using an iterator range (begin/end) of node(s)
+ ///////////////////////////////////////////////////////////////////////////
+ struct range
+ {
+ list::node* first;
+ list::node* last;
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // A range of char*s
+ ///////////////////////////////////////////////////////////////////////////
+ struct string_range
+ {
+ char const* first;
+ char const* last;
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // A void* plus type_info
+ ///////////////////////////////////////////////////////////////////////////
+ struct void_ptr
+ {
+ void* p;
+ std::type_info const* i;
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Our POD fast string. This implementation is very primitive and is not
+ // meant to be used stand-alone. This is the internal data representation
+ // of strings in our utree. This is deliberately a POD to allow it to be
+ // placed in a union. This POD fast string specifically utilizes
+ // (sizeof(list) * alignment_of(list)) - (2 * sizeof(char)). In a 32 bit
+ // system, this is 14 bytes. The two extra bytes are used by utree to store
+ // management info.
+ //
+ // It is a const string (i.e. immutable). It stores the characters directly
+ // if possible and only uses the heap if the string does not fit. Null
+ // characters are allowed, making it suitable to encode raw binary. The
+ // string length is encoded in the first byte if the string is placed in-situ,
+ // else, the length plus a pointer to the string in the heap are stored.
+ ///////////////////////////////////////////////////////////////////////////
+ struct fast_string // Keep this a POD!
+ {
+ static std::size_t const
+ buff_size = (sizeof(list) + boost::alignment_of<list>::value)
+ / sizeof(char);
+
+ static std::size_t const
+ small_string_size = buff_size-sizeof(char);
+
+ static std::size_t const
+ max_string_len = small_string_size - 1;
+
+ struct heap_store
+ {
+ char* str;
+ std::size_t size;
+ };
+
+ union
+ {
+ char buff[buff_size];
+ heap_store heap;
+ };
+
+ int get_type() const;
+ void set_type(int t);
+ bool is_heap_allocated() const;
+
+ std::size_t size() const;
+ char const* str() const;
+
+ template <typename Iterator>
+ void construct(Iterator f, Iterator l);
+
+ void swap(fast_string& other);
+ void free();
+ void copy(fast_string const& other);
+
+ char& info();
+ char info() const;
+
+ short tag() const;
+ void tag(short tag);
+ };
+}}
+
+#endif

Added: branches/release/libs/spirit/example/scheme/utree/detail/utree_detail2.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/utree/detail/utree_detail2.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,1368 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+ Copyright (c) 2001-2010 Hartmut Kaiser
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_UTREE_DETAIL2)
+#define BOOST_SPIRIT_UTREE_DETAIL2
+
+#if defined(BOOST_MSVC)
+# pragma warning(push)
+# pragma warning(disable: 4800)
+#endif
+
+#include <boost/type_traits/remove_pointer.hpp>
+#include <boost/type_traits/is_pointer.hpp>
+#include <boost/utility/enable_if.hpp>
+
+namespace scheme { namespace detail
+{
+ inline char& fast_string::info()
+ {
+ return buff[small_string_size];
+ }
+
+ inline char fast_string::info() const
+ {
+ return buff[small_string_size];
+ }
+
+ inline int fast_string::get_type() const
+ {
+ return info() >> 1;
+ }
+
+ inline void fast_string::set_type(int t)
+ {
+ info() = (t << 1) | (info() & 1);
+ }
+
+ inline short fast_string::tag() const
+ {
+ // warning the tag is not allowed for fast_string!!! it's only
+ // placed here to avoid excess padding.
+ return (int(buff[small_string_size-2]) << 8) + buff[small_string_size-1];
+ }
+
+ inline void fast_string::tag(short tag)
+ {
+ // warning the tag is not allowed for fast_string!!! it's only
+ // placed here to avoid excess padding.
+ buff[small_string_size-2] = tag >> 8;
+ buff[small_string_size-1] = tag & 0xff;
+ }
+
+ inline bool fast_string::is_heap_allocated() const
+ {
+ return info() & 1;
+ }
+
+ inline std::size_t fast_string::size() const
+ {
+ if (is_heap_allocated())
+ return heap.size;
+ else
+ return max_string_len - buff[small_string_size - 1];
+ }
+
+ inline char const* fast_string::str() const
+ {
+ if (is_heap_allocated())
+ return heap.str;
+ else
+ return buff;
+ }
+
+ template <typename Iterator>
+ inline void fast_string::construct(Iterator f, Iterator l)
+ {
+ unsigned const size = l-f;
+ char* str;
+ if (size < small_string_size)
+ {
+ // if it fits, store it in-situ; small_string_size minus the length
+ // of the string is placed in buff[small_string_size - 1]
+ str = buff;
+ buff[small_string_size - 1] = static_cast<char>(max_string_len - size);
+ info() &= ~0x1;
+ }
+ else
+ {
+ // else, store it in the heap
+ str = new char[size + 1]; // add one for the null char
+ heap.str = str;
+ heap.size = size;
+ info() |= 0x1;
+ }
+ for (std::size_t i = 0; i != size; ++i)
+ {
+ *str++ = *f++;
+ }
+ *str = '\0'; // add the null char
+ }
+
+ inline void fast_string::swap(fast_string& other)
+ {
+ std::swap(*this, other);
+ }
+
+ inline void fast_string::free()
+ {
+ if (is_heap_allocated())
+ {
+ delete [] heap.str;
+ heap.str = 0;
+ }
+ }
+
+ inline void fast_string::copy(fast_string const& other)
+ {
+ construct(other.str(), other.str() + other.size());
+ }
+
+ struct list::node : boost::noncopyable
+ {
+ template <typename T>
+ node(T const& val, node* next, node* prev)
+ : val(val), next(next), prev(prev) {}
+
+ void unlink()
+ {
+ prev->next = next;
+ next->prev = prev;
+ }
+
+ utree val;
+ node* next;
+ node* prev;
+ };
+
+ template <typename Value>
+ class list::node_iterator
+ : public boost::iterator_facade<
+ node_iterator<Value>
+ , Value
+ , boost::bidirectional_traversal_tag
+ >
+ {
+ public:
+
+ node_iterator()
+ : node(0) {}
+
+ node_iterator(list::node* node, list::node* prev)
+ : node(node), prev(prev) {}
+
+ private:
+
+ friend class boost::iterator_core_access;
+ friend class scheme::utree;
+
+ void increment()
+ {
+ if (node != 0) // not at end
+ {
+ prev = node;
+ node = node->next;
+ }
+ }
+
+ void decrement()
+ {
+ if (prev != 0) // not at begin
+ {
+ node = prev;
+ prev = prev->prev;
+ }
+ }
+
+ bool equal(node_iterator const& other) const
+ {
+ return node == other.node;
+ }
+
+ typename node_iterator::reference dereference() const
+ {
+ return node->val;
+ }
+
+ list::node* node;
+ list::node* prev;
+ };
+
+ template <typename Value>
+ class list::node_iterator<boost::reference_wrapper<Value> >
+ : public boost::iterator_facade<
+ node_iterator<boost::reference_wrapper<Value> >
+ , boost::reference_wrapper<Value>
+ , boost::bidirectional_traversal_tag
+ >
+ {
+ public:
+
+ node_iterator()
+ : node(0), prev(0), curr(nil_node) {}
+
+ node_iterator(list::node* node, list::node* prev)
+ : node(node), prev(prev), curr(node ? node->val : nil_node) {}
+
+ private:
+
+ friend class boost::iterator_core_access;
+ friend class scheme::utree;
+
+ void increment()
+ {
+ if (node != 0) // not at end
+ {
+ prev = node;
+ node = node->next;
+ curr = boost::ref(node ? node->val : nil_node);
+ }
+ }
+
+ void decrement()
+ {
+ if (prev != 0) // not at begin
+ {
+ node = prev;
+ prev = prev->prev;
+ curr = boost::ref(node ? node->val : nil_node);
+ }
+ }
+
+ bool equal(node_iterator const& other) const
+ {
+ return node == other.node;
+ }
+
+ typename node_iterator::reference dereference() const
+ {
+ return curr;
+ }
+
+ list::node* node;
+ list::node* prev;
+
+ static Value nil_node;
+ mutable boost::reference_wrapper<Value> curr;
+ };
+
+ template <typename Value>
+ Value list::node_iterator<boost::reference_wrapper<Value> >::nil_node = Value();
+
+ inline void list::free()
+ {
+ node* p = first;
+ while (p != last)
+ {
+ node* next = p->next;
+ delete p;
+ p = next;
+ }
+ first = last = 0;
+ size = 0;
+ }
+
+ inline void list::copy(list const& other)
+ {
+ first = last = 0;
+ size = 0;
+ node* p = other.first;
+ while (p != 0)
+ {
+ push_back(p->val);
+ p = p->next;
+ }
+ }
+
+ inline void list::default_construct()
+ {
+ first = last = 0;
+ size = 0;
+ }
+
+ template <typename T>
+ inline void list::insert_before(T const& val, node* np)
+ {
+ BOOST_ASSERT(np != 0);
+ node* new_node = new node(val, np, np->prev);
+ if (np->prev)
+ np->prev->next = new_node;
+ else
+ first = new_node;
+ np->prev = new_node;
+ ++size;
+ }
+
+ template <typename T>
+ inline void list::insert_after(T const& val, node* np)
+ {
+ BOOST_ASSERT(np != 0);
+ node* new_node = new node(val, np->next, np);
+ if (np->next)
+ np->next->prev = new_node;
+ else
+ last = new_node;
+ np->next = new_node;
+ ++size;
+ }
+
+ template <typename T>
+ inline void list::push_front(T const& val)
+ {
+ detail::list::node* new_node;
+ if (first == 0)
+ {
+ new_node = new detail::list::node(val, 0, 0);
+ first = last = new_node;
+ ++size;
+ }
+ else
+ {
+ insert_before(val, first);
+ }
+ }
+
+ template <typename T>
+ inline void list::push_back(T const& val)
+ {
+ if (last == 0)
+ push_front(val);
+ else
+ insert_after(val, last);
+ }
+
+ inline void list::pop_front()
+ {
+ BOOST_ASSERT(size != 0);
+ if (first == last) // there's only one item
+ {
+ delete first;
+ size = 0;
+ first = last = 0;
+ }
+ else
+ {
+ node* np = first;
+ first = first->next;
+ first->prev = 0;
+ delete np;
+ --size;
+ }
+ }
+
+ inline void list::pop_back()
+ {
+ BOOST_ASSERT(size != 0);
+ if (first == last) // there's only one item
+ {
+ delete first;
+ size = 0;
+ first = last = 0;
+ }
+ else
+ {
+ node* np = last;
+ last = last->prev;
+ last->next = 0;
+ delete np;
+ --size;
+ }
+ }
+
+ inline list::node* list::erase(node* pos)
+ {
+ BOOST_ASSERT(pos != 0);
+ if (pos == first)
+ {
+ pop_front();
+ return first;
+ }
+ else if (pos == last)
+ {
+ pop_back();
+ return 0;
+ }
+ else
+ {
+ node* next(pos->next);
+ pos->unlink();
+ delete pos;
+ --size;
+ return next;
+ }
+ }
+
+ template <typename F, typename X>
+ struct bind_impl // simple binder for binary visitation (we don't want to bring in the big guns)
+ {
+ typedef typename F::result_type result_type;
+ X& x; // always by reference
+ F f;
+ bind_impl(F f, X& x) : x(x), f(f) {}
+
+ template <typename Y>
+ typename F::result_type operator()(Y& y) const
+ {
+ return f(x, y);
+ }
+
+ template <typename Y>
+ typename F::result_type operator()(Y const& y) const
+ {
+ return f(x, y);
+ }
+ };
+
+ template <typename F, typename X>
+ bind_impl<F, X const> bind(F f, X const& x)
+ {
+ return bind_impl<F, X const>(f, x);
+ }
+
+ template <typename F, typename X>
+ bind_impl<F, X> bind(F f, X& x)
+ {
+ return bind_impl<F, X>(f, x);
+ }
+
+ template <typename UTreeX, typename UTreeY = UTreeX>
+ struct visit_impl
+ {
+ template <typename F>
+ typename F::result_type
+ static apply(UTreeX& x, F f) // single dispatch
+ {
+ typedef typename
+ boost::mpl::if_<boost::is_const<UTreeX>,
+ typename UTreeX::const_iterator,
+ typename UTreeX::iterator>::type
+ iterator;
+
+ typedef boost::iterator_range<iterator> list_range;
+ typedef utree_type type;
+
+ switch (x.get_type())
+ {
+ default:
+ BOOST_ASSERT(false); // can't happen
+
+ case type::nil_type:
+ nil arg;
+ return f(arg);
+
+ case type::bool_type:
+ return f(x.b);
+
+ case type::int_type:
+ return f(x.i);
+
+ case type::double_type:
+ return f(x.d);
+
+ case type::list_type:
+ return f(list_range(iterator(x.l.first, 0), iterator(0, x.l.last)));
+
+ case type::range_type:
+ return f(list_range(iterator(x.r.first, 0), iterator(0, x.r.last)));
+
+ case type::string_type:
+ return f(utf8_string_range(x.s.str(), x.s.size()));
+
+ case type::string_range_type:
+ return f(utf8_string_range(x.sr.first, x.sr.last));
+
+ case type::symbol_type:
+ return f(utf8_symbol_range(x.s.str(), x.s.size()));
+
+ case type::binary_type:
+ return f(binary_range(x.s.str(), x.s.size()));
+
+ case type::reference_type:
+ return apply(*x.p, f);
+
+ case type::any_type:
+ return f(any_ptr(x.v.p, x.v.i));
+
+ case type::function_type:
+ return f(*x.pf);
+ }
+ }
+
+ template <typename F>
+ typename F::result_type
+ static apply(UTreeX& x, UTreeY& y, F f) // double dispatch
+ {
+ typedef typename
+ boost::mpl::if_<boost::is_const<UTreeX>,
+ typename UTreeX::const_iterator,
+ typename UTreeX::iterator>::type
+ iterator;
+
+ typedef boost::iterator_range<iterator> list_range;
+ typedef utree_type type;
+
+ switch (x.get_type())
+ {
+ default:
+ BOOST_ASSERT(false); // can't happen
+
+ case type::nil_type:
+ nil x_;
+ return visit_impl::apply(y, detail::bind(f, x_));
+
+ case type::bool_type:
+ return visit_impl::apply(y, detail::bind(f, x.b));
+
+ case type::int_type:
+ return visit_impl::apply(y, detail::bind(f, x.i));
+
+ case type::double_type:
+ return visit_impl::apply(y, detail::bind(f, x.d));
+
+ case type::list_type:
+ return visit_impl::apply(
+ y, detail::bind<F, list_range>(f,
+ list_range(iterator(x.l.first, 0), iterator(0, x.l.last))));
+
+ case type::range_type:
+ return visit_impl::apply(
+ y, detail::bind<F, list_range>(f,
+ list_range(iterator(x.r.first, 0), iterator(0, x.r.last))));
+
+ case type::string_type:
+ return visit_impl::apply(y, detail::bind(
+ f, utf8_string_range(x.s.str(), x.s.size())));
+
+ case type::string_range_type:
+ return visit_impl::apply(y, detail::bind(
+ f, utf8_string_range(x.sr.first, x.sr.last)));
+
+ case type::symbol_type:
+ return visit_impl::apply(y, detail::bind(
+ f, utf8_symbol_range(x.s.str(), x.s.size())));
+
+ case type::binary_type:
+ return visit_impl::apply(y, detail::bind(
+ f, binary_range(x.s.str(), x.s.size())));
+
+ case type::reference_type:
+ return apply(*x.p, y, f);
+
+ case type::any_type:
+ return visit_impl::apply(
+ y, detail::bind(f, any_ptr(x.v.p, x.v.i)));
+
+ case type::function_type:
+ return visit_impl::apply(y, detail::bind(f, *x.pf));
+
+ }
+ }
+ };
+
+ struct index_impl
+ {
+ static utree& apply(list::node* node, std::size_t i)
+ {
+ for (; i > 0; --i)
+ node = node->next;
+ return node->val;
+ }
+
+ static utree const& apply(list::node const* node, std::size_t i)
+ {
+ for (; i > 0; --i)
+ node = node->next;
+ return node->val;
+ }
+ };
+}}
+
+namespace scheme
+{
+ template <typename F>
+ stored_function<F>::stored_function(F f)
+ : f(f)
+ {
+ }
+
+ template <typename F>
+ stored_function<F>::~stored_function()
+ {
+ };
+
+ template <typename F>
+ utree stored_function<F>::operator()(scope const& env) const
+ {
+ return f(env);
+ }
+
+ template <typename F>
+ function_base*
+ stored_function<F>::clone() const
+ {
+ return new stored_function<F>(*this);
+ }
+
+ inline utree::utree()
+ {
+ set_type(type::nil_type);
+ }
+
+ inline utree::utree(bool b) : b(b)
+ {
+ set_type(type::bool_type);
+ }
+
+ inline utree::utree(char c)
+ {
+ // char constructs a single element string
+ s.construct(&c, &c+1);
+ set_type(type::string_type);
+ }
+
+ inline utree::utree(unsigned int i) : i(i)
+ {
+ set_type(type::int_type);
+ }
+
+ inline utree::utree(int i) : i(i)
+ {
+ set_type(type::int_type);
+ }
+
+ inline utree::utree(double d) : d(d)
+ {
+ set_type(type::double_type);
+ }
+
+ inline utree::utree(char const* str)
+ {
+ s.construct(str, str + strlen(str));
+ set_type(type::string_type);
+ }
+
+ inline utree::utree(char const* str, std::size_t len)
+ {
+ s.construct(str, str + len);
+ set_type(type::string_type);
+ }
+
+ inline utree::utree(std::string const& str)
+ {
+ s.construct(str.begin(), str.end());
+ set_type(type::string_type);
+ }
+
+ template <typename Base, utree_type::info type_>
+ inline utree::utree(basic_string<Base, type_> const& bin)
+ {
+ s.construct(bin.begin(), bin.end());
+ set_type(type_);
+ }
+
+ inline utree::utree(boost::reference_wrapper<utree> ref)
+ : p(ref.get_pointer())
+ {
+ set_type(type::reference_type);
+ }
+
+ inline utree::utree(any_ptr const& p)
+ {
+ v.p = p.p;
+ v.i = p.i;
+ set_type(type::any_type);
+ }
+
+ template <typename F>
+ inline utree::utree(stored_function<F> const& pf)
+ : pf(new stored_function<F>(pf))
+ {
+ set_type(type::function_type);
+ }
+
+ template <typename Iter>
+ inline utree::utree(boost::iterator_range<Iter> r)
+ {
+ set_type(type::nil_type);
+ assign(r.begin(), r.end());
+ }
+
+ inline utree::utree(range r, shallow_tag)
+ {
+ this->r.first = r.begin().node;
+ this->r.last = r.end().prev;
+ set_type(type::range_type);
+ }
+
+ inline utree::utree(const_range r, shallow_tag)
+ {
+ this->r.first = r.begin().node;
+ this->r.last = r.end().prev;
+ set_type(type::range_type);
+ }
+
+ inline utree::utree(utf8_string_range const& str, shallow_tag)
+ {
+ this->sr.first = str.begin();
+ this->sr.last = str.end();
+ set_type(type::string_range_type);
+ }
+
+ inline utree::utree(utree const& other)
+ {
+ copy(other);
+ }
+
+ inline utree::~utree()
+ {
+ free();
+ }
+
+ inline utree& utree::operator=(utree const& other)
+ {
+ if (this != &other)
+ {
+ free();
+ copy(other);
+ }
+ return *this;
+ }
+
+ inline utree& utree::operator=(bool b_)
+ {
+ free();
+ b = b_;
+ set_type(type::bool_type);
+ return *this;
+ }
+
+ inline utree& utree::operator=(unsigned int i_)
+ {
+ free();
+ i = i_;
+ set_type(type::int_type);
+ return *this;
+ }
+
+ inline utree& utree::operator=(int i_)
+ {
+ free();
+ i = i_;
+ set_type(type::int_type);
+ return *this;
+ }
+
+ inline utree& utree::operator=(double d_)
+ {
+ free();
+ d = d_;
+ set_type(type::double_type);
+ return *this;
+ }
+
+ inline utree& utree::operator=(char const* s_)
+ {
+ free();
+ s.construct(s_, s_ + strlen(s_));
+ set_type(type::string_type);
+ return *this;
+ }
+
+ inline utree& utree::operator=(std::string const& s_)
+ {
+ free();
+ s.construct(s_.begin(), s_.end());
+ set_type(type::string_type);
+ return *this;
+ }
+
+ template <typename Base, utree_type::info type_>
+ inline utree& utree::operator=(basic_string<Base, type_> const& bin)
+ {
+ free();
+ s.construct(bin.begin(), bin.end());
+ set_type(type_);
+ return *this;
+ }
+
+ inline utree& utree::operator=(boost::reference_wrapper<utree> ref)
+ {
+ free();
+ p = ref.get_pointer();
+ set_type(type::reference_type);
+ return *this;
+ }
+
+ template <typename F>
+ utree& utree::operator=(stored_function<F> const& pf)
+ {
+ free();
+ pf = new stored_function<F>(pf);
+ set_type(type::function_type);
+ return *this;
+ }
+
+ template <typename Iter>
+ inline utree& utree::operator=(boost::iterator_range<Iter> r)
+ {
+ free();
+ assign(r.begin(), r.end());
+ return *this;
+ }
+
+ template <typename F>
+ typename F::result_type
+ inline utree::visit(utree const& x, F f)
+ {
+ return detail::visit_impl<utree const>::apply(x, f);
+ }
+
+ template <typename F>
+ typename F::result_type
+ inline utree::visit(utree& x, F f)
+ {
+ return detail::visit_impl<utree>::apply(x, f);
+ }
+
+ template <typename F>
+ typename F::result_type
+ inline utree::visit(utree const& x, utree const& y, F f)
+ {
+ return detail::visit_impl<utree const, utree const>::apply(x, y, f);
+ }
+
+ template <typename F>
+ typename F::result_type
+ inline utree::visit(utree const& x, utree& y, F f)
+ {
+ return detail::visit_impl<utree const, utree>::apply(x, y, f);
+ }
+
+ template <typename F>
+ typename F::result_type
+ inline utree::visit(utree& x, utree const& y, F f)
+ {
+ return detail::visit_impl<utree, utree const>::apply(x, y, f);
+ }
+
+ template <typename F>
+ typename F::result_type
+ inline utree::visit(utree& x, utree& y, F f)
+ {
+ return detail::visit_impl<utree, utree>::apply(x, y, f);
+ }
+
+ inline utree& utree::operator[](std::size_t i)
+ {
+ if (get_type() == type::reference_type)
+ return (*p)[i];
+ else if (get_type() == type::range_type)
+ return detail::index_impl::apply(r.first, i);
+
+ // otherwise...
+ BOOST_ASSERT(get_type() == type::list_type && size() > i);
+ return detail::index_impl::apply(l.first, i);
+ }
+
+ inline utree const& utree::operator[](std::size_t i) const
+ {
+ if (get_type() == type::reference_type)
+ return (*(utree const*)p)[i];
+ else if (get_type() == type::range_type)
+ return detail::index_impl::apply(r.first, i);
+
+ // otherwise...
+ BOOST_ASSERT(get_type() == type::list_type && size() > i);
+ return detail::index_impl::apply(l.first, i);
+ }
+
+ template <typename T>
+ inline void utree::push_front(T const& val)
+ {
+ if (get_type() == type::reference_type)
+ return p->push_front(val);
+ ensure_list_type();
+ l.push_front(val);
+ }
+
+ template <typename T>
+ inline void utree::push_back(T const& val)
+ {
+ if (get_type() == type::reference_type)
+ return p->push_back(val);
+ ensure_list_type();
+ l.push_back(val);
+ }
+
+ template <typename T>
+ inline utree::iterator utree::insert(iterator pos, T const& val)
+ {
+ if (get_type() == type::reference_type)
+ return p->insert(pos, val);
+ ensure_list_type();
+ if (pos == end())
+ {
+ push_back(val);
+ return begin();
+ }
+ else
+ {
+ l.insert_before(val, pos.node);
+ return utree::iterator(pos.node->prev, pos.node->prev->prev);
+ }
+ }
+
+ template <typename T>
+ inline void utree::insert(iterator pos, std::size_t n, T const& val)
+ {
+ if (get_type() == type::reference_type)
+ return p->insert(pos, n, val);
+ for (std::size_t i = 0; i != n; ++i)
+ insert(pos, val);
+ }
+
+ template <typename Iter>
+ inline void utree::insert(iterator pos, Iter first, Iter last)
+ {
+ if (get_type() == type::reference_type)
+ return p->insert(pos, first, last);
+ ensure_list_type();
+ while (first != last)
+ insert(pos, *first++);
+ }
+
+ template <typename Iter>
+ inline void utree::assign(Iter first, Iter last)
+ {
+ if (get_type() == type::reference_type)
+ return p->assign(first, last);
+ ensure_list_type();
+ clear();
+ while (first != last)
+ {
+ push_back(*first);
+ ++first;
+ }
+ }
+
+ inline void utree::clear()
+ {
+ if (get_type() == type::reference_type)
+ return p->clear();
+ // clear will always make this a nil type
+ free();
+ set_type(type::nil_type);
+ }
+
+ inline void utree::pop_front()
+ {
+ if (get_type() == type::reference_type)
+ return p->pop_front();
+ BOOST_ASSERT(get_type() == type::list_type);
+ l.pop_front();
+ }
+
+ inline void utree::pop_back()
+ {
+ if (get_type() == type::reference_type)
+ return p->pop_back();
+ BOOST_ASSERT(get_type() == type::list_type);
+ l.pop_back();
+ }
+
+ inline utree::iterator utree::erase(iterator pos)
+ {
+ if (get_type() == type::reference_type)
+ return p->erase(pos);
+ BOOST_ASSERT(get_type() == type::list_type);
+ detail::list::node* np = l.erase(pos.node);
+ return iterator(np, np?np->prev:l.last);
+ }
+
+ inline utree::iterator utree::erase(iterator first, iterator last)
+ {
+ if (get_type() == type::reference_type)
+ return p->erase(first, last);
+ while (first != last)
+ erase(first++);
+ return last;
+ }
+
+ inline utree::iterator utree::begin()
+ {
+ if (get_type() == type::reference_type)
+ return p->begin();
+ else if (get_type() == type::range_type)
+ return iterator(r.first, 0);
+
+ // otherwise...
+ ensure_list_type();
+ return iterator(l.first, 0);
+ }
+
+ inline utree::iterator utree::end()
+ {
+ if (get_type() == type::reference_type)
+ return p->end();
+ else if (get_type() == type::range_type)
+ return iterator(0, r.first);
+
+ // otherwise...
+ ensure_list_type();
+ return iterator(0, l.last);
+ }
+
+ inline utree::ref_iterator utree::ref_begin()
+ {
+ if (get_type() == type::reference_type)
+ return p->ref_begin();
+ else if (get_type() == type::range_type)
+ return ref_iterator(r.first, 0);
+
+ // otherwise...
+ ensure_list_type();
+ return ref_iterator(l.first, 0);
+ }
+
+ inline utree::ref_iterator utree::ref_end()
+ {
+ if (get_type() == type::reference_type)
+ return p->ref_end();
+ else if (get_type() == type::range_type)
+ return ref_iterator(0, r.first);
+
+ // otherwise...
+ ensure_list_type();
+ return ref_iterator(0, l.last);
+ }
+
+ inline utree::const_iterator utree::begin() const
+ {
+ if (get_type() == type::reference_type)
+ return ((utree const*)p)->begin();
+ else if (get_type() == type::range_type)
+ return const_iterator(r.first, 0);
+
+ // otherwise...
+ BOOST_ASSERT(get_type() == type::list_type);
+ return const_iterator(l.first, 0);
+ }
+
+ inline utree::const_iterator utree::end() const
+ {
+ if (get_type() == type::reference_type)
+ return ((utree const*)p)->end();
+ else if (get_type() == type::range_type)
+ return const_iterator(0, r.first);
+
+ // otherwise...
+ BOOST_ASSERT(get_type() == type::list_type);
+ return const_iterator(0, l.last);
+ }
+
+ inline bool utree::empty() const
+ {
+ if (get_type() == type::reference_type)
+ return ((utree const*)p)->empty();
+ else if (get_type() == type::range_type)
+ return r.first == 0;
+ else if (get_type() == type::list_type)
+ return l.size == 0;
+ return get_type() == type::nil_type;
+ }
+
+ inline std::size_t utree::size() const
+ {
+ if (get_type() == type::reference_type)
+ {
+ return ((utree const*)p)->size();
+ }
+ else if (get_type() == type::range_type)
+ {
+ std::size_t size = 0;
+ detail::list::node* n = r.first;
+ while (n)
+ {
+ n = n->next;
+ ++size;
+ }
+ return size;
+ }
+ else if (get_type() == type::list_type)
+ {
+ return l.size;
+ }
+ BOOST_ASSERT(get_type() == type::nil_type);
+ return 0;
+ }
+
+ inline utree_type::info utree::which() const
+ {
+ return get_type();
+ }
+
+ inline utree& utree::front()
+ {
+ if (get_type() == type::reference_type)
+ {
+ return p->front();
+ }
+ else if (get_type() == type::range_type)
+ {
+ BOOST_ASSERT(r.first != 0);
+ return r.first->val;
+ }
+
+ // otherwise...
+ BOOST_ASSERT(get_type() == type::list_type && l.first != 0);
+ return l.first->val;
+ }
+
+ inline utree& utree::back()
+ {
+ if (get_type() == type::reference_type)
+ {
+ return p->back();
+ }
+ else if (get_type() == type::range_type)
+ {
+ BOOST_ASSERT(r.last != 0);
+ return r.last->val;
+ }
+
+ // otherwise...
+ BOOST_ASSERT(get_type() == type::list_type && l.last != 0);
+ return l.last->val;
+ }
+
+ inline utree const& utree::front() const
+ {
+ if (get_type() == type::reference_type)
+ {
+ return ((utree const*)p)->front();
+ }
+ else if (get_type() == type::range_type)
+ {
+ BOOST_ASSERT(r.first != 0);
+ return r.first->val;
+ }
+
+ // otherwise...
+ BOOST_ASSERT(get_type() == type::list_type && l.first != 0);
+ return l.first->val;
+ }
+
+ inline utree const& utree::back() const
+ {
+ if (get_type() == type::reference_type)
+ {
+ return ((utree const*)p)->back();
+ }
+ else if (get_type() == type::range_type)
+ {
+ BOOST_ASSERT(r.last != 0);
+ return r.last->val;
+ }
+
+ // otherwise...
+ BOOST_ASSERT(get_type() == type::list_type && l.last != 0);
+ return l.last->val;
+ }
+
+ inline void utree::swap(utree& other)
+ {
+ s.swap(other.s);
+ }
+
+ inline utree::type::info utree::get_type() const
+ {
+ // the fast string holds the type info
+ return static_cast<utree::type::info>(s.get_type());
+ }
+
+ inline void utree::set_type(type::info t)
+ {
+ // the fast string holds the type info
+ s.set_type(t);
+ }
+
+ inline void utree::ensure_list_type()
+ {
+ if (get_type() == type::nil_type)
+ {
+ set_type(type::list_type);
+ l.default_construct();
+ }
+ else
+ {
+ BOOST_ASSERT(get_type() == type::list_type);
+ }
+ }
+
+ inline void utree::free()
+ {
+ switch (get_type())
+ {
+ case type::binary_type:
+ case type::symbol_type:
+ case type::string_type:
+ s.free();
+ break;
+ case type::list_type:
+ l.free();
+ break;
+ case type::function_type:
+ delete pf;
+ break;
+ default:
+ break;
+ };
+ }
+
+ inline void utree::copy(utree const& other)
+ {
+ set_type(other.get_type());
+ switch (other.get_type())
+ {
+ case type::nil_type:
+ break;
+ case type::bool_type:
+ b = other.b;
+ break;
+ case type::int_type:
+ i = other.i;
+ break;
+ case type::double_type:
+ d = other.d;
+ break;
+ case type::reference_type:
+ p = other.p;
+ break;
+ case type::any_type:
+ v = other.v;
+ break;
+ case type::range_type:
+ r = other.r;
+ break;
+ case type::string_range_type:
+ sr = other.sr;
+ break;
+ case type::function_type:
+ pf = other.pf->clone();
+ break;
+ case type::string_type:
+ case type::symbol_type:
+ case type::binary_type:
+ s.copy(other.s);
+ break;
+ case type::list_type:
+ l.copy(other.l);
+ s.tag(other.s.tag());
+ break;
+ }
+ }
+
+ template <typename T>
+ struct is_iterator_range
+ : boost::mpl::false_
+ {};
+
+ template <typename Iterator>
+ struct is_iterator_range<boost::iterator_range<Iterator> >
+ : boost::mpl::true_
+ {};
+
+ template <typename To>
+ struct utree_cast
+ {
+ typedef To result_type;
+
+ template <typename From>
+ To dispatch(From const& val, boost::mpl::true_) const
+ {
+ return To(val); // From is convertible to To
+ }
+
+ template <typename From>
+ To dispatch(From const& val, boost::mpl::false_) const
+ {
+ // From is NOT convertible to To !!!
+ throw std::bad_cast();
+ return To();
+ }
+
+ template <typename From>
+ To operator()(From const& val) const
+ {
+ // boost::iterator_range has a templated constructor, accepting
+ // any argument and hence any type is 'convertible' to it.
+ typedef typename boost::mpl::eval_if<
+ is_iterator_range<To>
+ , boost::is_same<From, To>, boost::is_convertible<From, To>
+ >::type is_convertible;
+ return dispatch(val, is_convertible());
+ }
+ };
+
+ template <typename T>
+ struct utree_cast<T*>
+ {
+ typedef T* result_type;
+
+ template <typename From>
+ T* operator()(From const& val) const
+ {
+ // From is NOT convertible to T !!!
+ throw std::bad_cast();
+ return 0;
+ }
+
+ T* operator()(any_ptr const& p) const
+ {
+ return p.get<T*>();
+ }
+ };
+
+ template <typename T>
+ inline T utree::get() const
+ {
+ return utree::visit(*this, utree_cast<T>());
+ }
+
+ inline utree& utree::deref()
+ {
+ return (get_type() == type::reference_type) ? *p : *this;
+ }
+
+ inline utree const& utree::deref() const
+ {
+ return (get_type() == type::reference_type) ? *p : *this;
+ }
+
+ inline short utree::tag() const
+ {
+ BOOST_ASSERT(get_type() == type::list_type);
+ return s.tag();
+ }
+
+ inline void utree::tag(short tag)
+ {
+ ensure_list_type();
+ s.tag(tag);
+ }
+
+ inline utree utree::eval(scope const& env) const
+ {
+ BOOST_ASSERT(get_type() == type::function_type);
+ return (*pf)(env);
+ }
+}
+
+#if defined(BOOST_MSVC)
+# pragma warning(pop)
+#endif
+#endif

Added: branches/release/libs/spirit/example/scheme/utree/io.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/utree/io.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,36 @@
+// Copyright (c) 2001-2010 Hartmut Kaiser
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+#if !defined(BOOST_SPIRIT_UTREE_IO)
+#define BOOST_SPIRIT_UTREE_IO
+
+#include <utree/utree.hpp>
+#include <utree/operators.hpp>
+
+#if defined(SCHEME_USE_SPIRIT_IO)
+
+#include <input/parse_sexpr_impl.hpp>
+#include <output/generate_sexpr_impl.hpp>
+
+namespace scheme
+{
+ // Printing
+ inline std::ostream& operator<<(std::ostream& out, utree const& x)
+ {
+ output::generate_sexpr(out, x);
+ return out;
+ }
+
+ // Parsing
+ inline std::istream& operator>>(std::istream& in, utree& x)
+ {
+ input::parse_sexpr(in, x);
+ return in;
+ }
+}
+
+#endif
+
+#endif

Added: branches/release/libs/spirit/example/scheme/utree/operators.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/utree/operators.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,591 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_UTREE_OPERATORS)
+#define BOOST_SPIRIT_UTREE_OPERATORS
+
+#include <utree/utree.hpp>
+#include <boost/preprocessor/cat.hpp>
+#include <boost/type_traits/is_arithmetic.hpp>
+#include <boost/type_traits/is_integral.hpp>
+
+#if defined(BOOST_MSVC)
+# pragma warning(push)
+# pragma warning(disable: 4804)
+# pragma warning(disable: 4805)
+#endif
+
+#include <exception>
+#include <utree/utree.hpp>
+#include <boost/preprocessor/cat.hpp>
+#include <boost/type_traits/is_arithmetic.hpp>
+#include <boost/type_traits/is_integral.hpp>
+
+namespace scheme
+{
+ struct utree_exception : std::exception {};
+
+ struct illegal_arithmetic_operation : utree_exception
+ {
+ virtual const char* what() const throw()
+ {
+ return "utree: Illegal arithmetic operation.";
+ }
+ };
+
+ struct illegal_integral_operation : utree_exception
+ {
+ virtual const char* what() const throw()
+ {
+ return "utree: Illegal integral operation.";
+ }
+ };
+
+ // Relational operators
+ bool operator==(utree const& a, utree const& b);
+ bool operator<(utree const& a, utree const& b);
+ bool operator!=(utree const& a, utree const& b);
+ bool operator>(utree const& a, utree const& b);
+ bool operator<=(utree const& a, utree const& b);
+ bool operator>=(utree const& a, utree const& b);
+
+ // Input and output
+ std::ostream& operator<<(std::ostream& out, utree const& x);
+ std::istream& operator>>(std::istream& in, utree& x);
+
+ std::ostream& operator<<(std::ostream& out, nil const& x);
+
+ // Logical operators
+ utree operator&&(utree const& a, utree const& b);
+ utree operator||(utree const& a, utree const& b);
+ utree operator!(utree const& a);
+
+ // Arithmetic operators
+ utree operator+(utree const& a, utree const& b);
+ utree operator-(utree const& a, utree const& b);
+ utree operator*(utree const& a, utree const& b);
+ utree operator/(utree const& a, utree const& b);
+ utree operator%(utree const& a, utree const& b);
+ utree operator-(utree const& a);
+
+ // Bitwise operators
+ utree operator&(utree const& a, utree const& b);
+ utree operator|(utree const& a, utree const& b);
+ utree operator^(utree const& a, utree const& b);
+ utree operator<<(utree const& a, utree const& b);
+ utree operator>>(utree const& a, utree const& b);
+ utree operator~(utree const& a);
+
+ // Implementation
+ struct utree_is_equal
+ {
+ typedef bool result_type;
+
+ template <typename A, typename B>
+ bool dispatch(const A&, const B&, boost::mpl::false_) const
+ {
+ return false; // cannot compare different types by default
+ }
+
+ template <typename A, typename B>
+ bool dispatch(const A& a, const B& b, boost::mpl::true_) const
+ {
+ return a == b; // for arithmetic types
+ }
+
+ template <typename A, typename B>
+ bool operator()(const A& a, const B& b) const
+ {
+ return dispatch(a, b,
+ boost::mpl::and_<
+ boost::is_arithmetic<A>,
+ boost::is_arithmetic<B> >());
+ }
+
+ template <typename T>
+ bool operator()(const T& a, const T& b) const
+ {
+ // This code works for lists
+ return a == b;
+ }
+
+ template <typename Base, utree_type::info type_>
+ bool operator()(
+ basic_string<Base, type_> const& a,
+ basic_string<Base, type_> const& b) const
+ {
+ return static_cast<Base const&>(a) == static_cast<Base const&>(b);
+ }
+
+ bool operator()(nil, nil) const
+ {
+ return true;
+ }
+
+ bool operator()(function_base const& a, function_base const& b) const
+ {
+ return false; // just don't allow comparison of functions
+ }
+ };
+
+ struct utree_is_less_than
+ {
+ typedef bool result_type;
+
+ template <typename A, typename B>
+ bool dispatch(const A&, const B&, boost::mpl::false_) const
+ {
+ return false; // cannot compare different types by default
+ }
+
+ template <typename A, typename B>
+ bool dispatch(const A& a, const B& b, boost::mpl::true_) const
+ {
+ return a < b; // for arithmetic types
+ }
+
+ template <typename A, typename B>
+ bool operator()(const A& a, const B& b) const
+ {
+ return dispatch(a, b,
+ boost::mpl::and_<
+ boost::is_arithmetic<A>,
+ boost::is_arithmetic<B> >());
+ }
+
+ template <typename T>
+ bool operator()(const T& a, const T& b) const
+ {
+ // This code works for lists
+ return a < b;
+ }
+
+ template <typename Base, utree_type::info type_>
+ bool operator()(
+ basic_string<Base, type_> const& a,
+ basic_string<Base, type_> const& b) const
+ {
+ return static_cast<Base const&>(a) < static_cast<Base const&>(b);
+ }
+
+ bool operator()(nil, nil) const
+ {
+ BOOST_ASSERT(false);
+ return false; // no less than comparison for nil
+ }
+
+ bool operator()(any_ptr const& a, any_ptr const& b) const
+ {
+ BOOST_ASSERT(false);
+ return false; // no less than comparison for any_ptr
+ }
+
+ bool operator()(function_base const& a, function_base const& b) const
+ {
+ BOOST_ASSERT(false);
+ return false; // no less than comparison of functions
+ }
+ };
+
+#if !defined(SCHEME_USE_SPIRIT_IO)
+
+ struct utree_print
+ {
+ typedef void result_type;
+
+ std::ostream& out;
+ utree_print(std::ostream& out) : out(out) {}
+
+ void operator()(scheme::nil) const
+ {
+ out << "<nil> ";
+ }
+
+ template <typename T>
+ void operator()(T val) const
+ {
+ out << val << ' ';
+ }
+
+ void operator()(bool b) const
+ {
+ out << (b ? "true" : "false") << ' ';
+ }
+
+ void operator()(binary_range const& b) const
+ {
+ out << "#";
+ out.width(2);
+ out.fill('0');
+
+ typedef binary_range::const_iterator iterator;
+ for (iterator i = b.begin(); i != b.end(); ++i)
+ out << std::hex << int((unsigned char)*i);
+ out << std::dec << "# ";
+ }
+
+ void operator()(utf8_string_range const& str) const
+ {
+ typedef utf8_string_range::const_iterator iterator;
+ iterator i = str.begin();
+ out << '"';
+ for (; i != str.end(); ++i)
+ out << *i;
+ out << "\" ";
+ }
+
+ void operator()(utf8_symbol_range const& str) const
+ {
+ typedef utf8_symbol_range::const_iterator iterator;
+ iterator i = str.begin();
+ for (; i != str.end(); ++i)
+ out << *i;
+ }
+
+ template <typename Iterator>
+ void operator()(boost::iterator_range<Iterator> const& range) const
+ {
+ typedef typename boost::iterator_range<Iterator>::const_iterator iterator;
+ (*this)('(');
+ for (iterator i = range.begin(); i != range.end(); ++i)
+ {
+ scheme::utree::visit(*i, *this);
+ }
+ (*this)(')');
+ }
+
+ void operator()(any_ptr const& p) const
+ {
+ return (*this)("<pointer>");
+ }
+
+ void operator()(function_base const& pf) const
+ {
+ return (*this)("<function>");
+ }
+ };
+#endif
+
+ template <typename Base>
+ struct logical_function
+ {
+ typedef utree result_type;
+
+ // In scheme, anything except false is true
+
+ // binary
+ utree operator()(bool a, bool b) const
+ {
+ return Base::eval(a, b); // for boolean types
+ }
+
+ // binary
+ template <typename A>
+ utree operator()(A const& a, bool b) const
+ {
+ return Base::eval(true, b);
+ }
+
+ // binary
+ template <typename B>
+ utree operator()(bool a, B const& b) const
+ {
+ return Base::eval(a, true);
+ }
+
+ // binary
+ template <typename A, typename B>
+ utree operator()(A const& a, B const& b) const
+ {
+ return Base::eval(true, true);
+ }
+
+ // unary
+ utree operator()(bool a) const
+ {
+ return Base::eval(a);
+ }
+
+ // unary
+ template <typename A>
+ utree operator()(A const& a) const
+ {
+ return Base::eval(true);
+ }
+ };
+
+ template <typename Base>
+ struct arithmetic_function
+ {
+ typedef utree result_type;
+
+ template <typename A, typename B>
+ utree dispatch(A const&, B const&, boost::mpl::false_) const
+ {
+ throw illegal_arithmetic_operation();
+ return utree(); // cannot apply to non-arithmetic types
+ }
+
+ template <typename A, typename B>
+ utree dispatch(A const& a, B const& b, boost::mpl::true_) const
+ {
+ return Base::eval(a, b); // for arithmetic types
+ }
+
+ // binary
+ template <typename A, typename B>
+ utree operator()(A const& a, B const& b) const
+ {
+ return dispatch(a, b,
+ boost::mpl::and_<
+ boost::is_arithmetic<A>,
+ boost::is_arithmetic<B> >());
+ }
+
+ template <typename A>
+ utree dispatch(A const&, boost::mpl::false_) const
+ {
+ throw illegal_arithmetic_operation();
+ return utree(); // cannot apply to non-arithmetic types
+ }
+
+ template <typename A>
+ utree dispatch(A const& a, boost::mpl::true_) const
+ {
+ return Base::eval(a); // for arithmetic types
+ }
+
+ // unary
+ template <typename A>
+ utree operator()(A const& a) const
+ {
+ return dispatch(a, boost::is_arithmetic<A>());
+ }
+ };
+
+ template <typename Base>
+ struct integral_function
+ {
+ typedef utree result_type;
+
+ template <typename A, typename B>
+ utree dispatch(A const&, B const&, boost::mpl::false_) const
+ {
+ throw illegal_integral_operation();
+ return utree(); // cannot apply to non-integral types
+ }
+
+ template <typename A, typename B>
+ utree dispatch(A const& a, B const& b, boost::mpl::true_) const
+ {
+ return Base::eval(a, b); // for integral types
+ }
+
+ // binary
+ template <typename A, typename B>
+ utree operator()(A const& a, B const& b) const
+ {
+ return dispatch(a, b,
+ boost::mpl::and_<
+ boost::is_integral<A>,
+ boost::is_integral<B> >());
+ }
+
+ template <typename A>
+ utree dispatch(A const&, boost::mpl::false_) const
+ {
+ throw illegal_integral_operation();
+ return utree(); // cannot apply to non-integral types
+ }
+
+ template <typename A>
+ utree dispatch(A const& a, boost::mpl::true_) const
+ {
+ return Base::eval(a); // for integral types
+ }
+
+ // unary
+ template <typename A>
+ utree operator()(A const& a) const
+ {
+ return dispatch(a, boost::is_integral<A>());
+ }
+ };
+
+#define SCHEME_CREATE_FUNCTION(name, expr, base) \
+ struct BOOST_PP_CAT(function_impl_, name) \
+ { \
+ template <typename A, typename B> \
+ static utree eval(A const& a, B const& b) \
+ { \
+ return utree(expr); \
+ } \
+ template <typename A> \
+ static utree eval(A const& a) \
+ { \
+ static int b; \
+ (void) b; \
+ return utree(expr); \
+ } \
+ }; \
+ base<BOOST_PP_CAT(function_impl_, name)> const \
+ BOOST_PP_CAT(base, BOOST_PP_CAT(_, name)) = {}; \
+ /***/
+
+#define SCHEME_CREATE_ARITHMETIC_FUNCTION(name, expr) \
+ SCHEME_CREATE_FUNCTION(name, expr, arithmetic_function) \
+ /***/
+
+#define SCHEME_CREATE_INTEGRAL_FUNCTION(name, expr) \
+ SCHEME_CREATE_FUNCTION(name, expr, integral_function) \
+ /***/
+
+#define SCHEME_CREATE_LOGICAL_FUNCTION(name, expr) \
+ SCHEME_CREATE_FUNCTION(name, expr, logical_function) \
+ /***/
+
+ inline bool operator==(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, utree_is_equal());
+ }
+
+ inline bool operator<(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, utree_is_less_than());
+ }
+
+ inline bool operator!=(utree const& a, utree const& b)
+ {
+ return !(a == b);
+ }
+
+ inline bool operator>(utree const& a, utree const& b)
+ {
+ return b < a;
+ }
+
+ inline bool operator<=(utree const& a, utree const& b)
+ {
+ return !(b < a);
+ }
+
+ inline bool operator>=(utree const& a, utree const& b)
+ {
+ return !(a < b);
+ }
+
+#if !defined(SCHEME_USE_SPIRIT_IO)
+ inline std::ostream& operator<<(std::ostream& out, utree const& x)
+ {
+ utree::visit(x, utree_print(out));
+ return out;
+ }
+#endif
+
+ inline std::ostream& operator<<(std::ostream& out, nil const& x)
+ {
+ return out;
+ }
+
+ SCHEME_CREATE_LOGICAL_FUNCTION(and_, a&&b);
+ SCHEME_CREATE_LOGICAL_FUNCTION(or_, a||b);
+ SCHEME_CREATE_LOGICAL_FUNCTION(not_, !a);
+
+ SCHEME_CREATE_ARITHMETIC_FUNCTION(plus, a+b);
+ SCHEME_CREATE_ARITHMETIC_FUNCTION(minus, a-b);
+ SCHEME_CREATE_ARITHMETIC_FUNCTION(times, a*b);
+ SCHEME_CREATE_ARITHMETIC_FUNCTION(divides, a/b);
+ SCHEME_CREATE_INTEGRAL_FUNCTION(modulus, a%b);
+ SCHEME_CREATE_ARITHMETIC_FUNCTION(negate, -a);
+
+ SCHEME_CREATE_INTEGRAL_FUNCTION(bitand_, a&b);
+ SCHEME_CREATE_INTEGRAL_FUNCTION(bitor_, a|b);
+ SCHEME_CREATE_INTEGRAL_FUNCTION(bitxor_, a^b);
+ SCHEME_CREATE_INTEGRAL_FUNCTION(shift_left, a<<b);
+ SCHEME_CREATE_INTEGRAL_FUNCTION(shift_right, a>>b);
+ SCHEME_CREATE_INTEGRAL_FUNCTION(invert, ~a);
+
+ inline utree operator&&(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, logical_function_and_);
+ }
+
+ inline utree operator||(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, logical_function_or_);
+ }
+
+ inline utree operator!(utree const& a)
+ {
+ return utree::visit(a, logical_function_not_);
+ }
+
+ inline utree operator+(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, arithmetic_function_plus);
+ }
+
+ inline utree operator-(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, arithmetic_function_minus);
+ }
+
+ inline utree operator*(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, arithmetic_function_times);
+ }
+
+ inline utree operator/(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, arithmetic_function_divides);
+ }
+
+ inline utree operator%(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, integral_function_modulus);
+ }
+
+ inline utree operator-(utree const& a)
+ {
+ return utree::visit(a, arithmetic_function_negate);
+ }
+
+ inline utree operator&(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, integral_function_bitand_);
+ }
+
+ inline utree operator|(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, integral_function_bitor_);
+ }
+
+ inline utree operator^(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, integral_function_bitxor_);
+ }
+
+ inline utree operator<<(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, integral_function_shift_left);
+ }
+
+ inline utree operator>>(utree const& a, utree const& b)
+ {
+ return utree::visit(a, b, integral_function_shift_right);
+ }
+
+ inline utree operator~(utree const& a)
+ {
+ return utree::visit(a, integral_function_invert);
+ }
+}
+
+#if defined(BOOST_MSVC)
+# pragma warning(pop)
+#endif
+
+#endif

Added: branches/release/libs/spirit/example/scheme/utree/utree.hpp
==============================================================================
--- (empty file)
+++ branches/release/libs/spirit/example/scheme/utree/utree.hpp 2010-07-04 12:30:38 EDT (Sun, 04 Jul 2010)
@@ -0,0 +1,464 @@
+/*=============================================================================
+ Copyright (c) 2001-2010 Joel de Guzman
+ Copyright (c) 2001-2010 Hartmut Kaiser
+
+ Distributed under the Boost Software License, Version 1.0. (See accompanying
+ file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+=============================================================================*/
+#if !defined(BOOST_SPIRIT_UTREE)
+#define BOOST_SPIRIT_UTREE
+
+#include <cstddef>
+#include <algorithm>
+#include <string>
+#include <ostream>
+#include <typeinfo>
+
+#include <boost/assert.hpp>
+#include <boost/noncopyable.hpp>
+#include <boost/iterator/iterator_facade.hpp>
+#include <boost/range/iterator_range.hpp>
+#include <boost/type_traits/remove_pointer.hpp>
+#include <boost/type_traits/is_polymorphic.hpp>
+#include <boost/utility/enable_if.hpp>
+#include <boost/ref.hpp>
+
+#include <utree/detail/utree_detail1.hpp>
+
+#if defined(BOOST_MSVC)
+# pragma warning(push)
+# pragma warning(disable: 4804)
+# pragma warning(disable: 4805)
+# pragma warning(disable: 4244)
+#endif
+
+namespace scheme
+{
+ ///////////////////////////////////////////////////////////////////////////
+ // Our utree can store these types. This enum tells us what type
+ // of data is stored in utree's discriminated union.
+ ///////////////////////////////////////////////////////////////////////////
+ struct utree_type
+ {
+ enum info
+ {
+ nil_type,
+ bool_type,
+ int_type,
+ double_type,
+ string_type,
+ string_range_type,
+ symbol_type,
+ binary_type,
+ list_type,
+ range_type,
+ reference_type,
+ any_type,
+ function_type
+ };
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // The nil type
+ ///////////////////////////////////////////////////////////////////////////
+ struct nil {};
+
+ ///////////////////////////////////////////////////////////////////////////
+ // A typed string with parametric Base storage. The storage can be any
+ // range or (stl container) of chars.
+ ///////////////////////////////////////////////////////////////////////////
+ template <typename Base, utree_type::info type_>
+ struct basic_string : Base
+ {
+ static utree_type::info const type = type_;
+
+ basic_string()
+ : Base() {}
+
+ basic_string(Base const& base)
+ : Base(base) {}
+
+ template <typename Iterator>
+ basic_string(Iterator bits, std::size_t len)
+ : Base(bits, bits + len) {}
+
+ template <typename Iterator>
+ basic_string(Iterator first, Iterator last)
+ : Base(first, last) {}
+
+ basic_string& operator=(basic_string const& other)
+ {
+ Base::operator=(other);
+ return *this;
+ }
+
+ basic_string& operator=(Base const& other)
+ {
+ Base::operator=(other);
+ return *this;
+ }
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Binary string
+ ///////////////////////////////////////////////////////////////////////////
+ typedef basic_string<
+ boost::iterator_range<char const*>,
+ utree_type::binary_type>
+ binary_range;
+
+ typedef basic_string<
+ std::string,
+ utree_type::binary_type>
+ binary_string;
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Our UTF-8 string
+ ///////////////////////////////////////////////////////////////////////////
+ typedef basic_string<
+ boost::iterator_range<char const*>,
+ utree_type::string_type>
+ utf8_string_range;
+
+ typedef basic_string<
+ std::string,
+ utree_type::string_type>
+ utf8_string;
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Our UTF-8 symbol (for identifiers)
+ ///////////////////////////////////////////////////////////////////////////
+ typedef basic_string<
+ boost::iterator_range<char const*>,
+ utree_type::symbol_type>
+ utf8_symbol_range;
+
+ typedef basic_string<
+ std::string,
+ utree_type::symbol_type>
+ utf8_symbol;
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Our function type
+ ///////////////////////////////////////////////////////////////////////////
+ class utree;
+ class scope;
+
+ struct function_base
+ {
+ virtual ~function_base() {};
+ virtual utree operator()(scope const& env) const = 0;
+ virtual function_base* clone() const = 0;
+ };
+
+ template <typename F>
+ struct stored_function : function_base
+ {
+ F f;
+ stored_function(F f = F());
+ virtual ~stored_function();
+ virtual utree operator()(scope const& env) const;
+ virtual function_base* clone() const;
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // Shallow tag. Instructs utree to hold an iterator_range
+ // as-is without deep copying the range.
+ ///////////////////////////////////////////////////////////////////////////
+ struct shallow_tag {};
+ shallow_tag const shallow = {};
+
+ ///////////////////////////////////////////////////////////////////////////
+ // A void* plus type_info
+ ///////////////////////////////////////////////////////////////////////////
+ class any_ptr
+ {
+ public:
+
+ template <typename Ptr>
+ typename boost::disable_if<
+ boost::is_polymorphic<
+ typename boost::remove_pointer<Ptr>::type>,
+ Ptr>::type
+ get() const
+ {
+ if (*i == typeid(Ptr))
+ {
+ return static_cast<Ptr>(p);
+ }
+ throw std::bad_cast();
+ }
+
+ template <typename T>
+ any_ptr(T* p)
+ : p(p), i(&typeid(T*))
+ {}
+
+ friend bool operator==(any_ptr const& a, any_ptr const& b)
+ {
+ return (a.p == b.p) && (*a.i == *b.i);
+ }
+
+ private:
+
+ // constructor is private
+ any_ptr(void* p, std::type_info const* i)
+ : p(p), i(i) {}
+
+ template <typename UTreeX, typename UTreeY>
+ friend struct detail::visit_impl;
+
+ friend class utree;
+
+ void* p;
+ std::type_info const* i;
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // The main utree (Universal Tree) class
+ // The utree is a hierarchical, dynamic type that can store:
+ // - a nil
+ // - a bool
+ // - an integer
+ // - a double
+ // - a string
+ // - a string range
+ // - a symbol (identifier)
+ // - binary data
+ // - a (doubly linked) list of utree
+ // - an iterator_range of list::iterator
+ // - a reference to a utree
+ // - a pointer or reference to any type
+ // - a function
+ //
+ // The utree has minimal memory footprint. The data structure size is
+ // 16 bytes on a 32-bit platform. Being a container of itself, it can
+ // represent tree structures.
+ ///////////////////////////////////////////////////////////////////////////
+ class utree
+ {
+ public:
+
+ typedef utree value_type;
+ typedef detail::list::node_iterator<utree> iterator;
+ typedef detail::list::node_iterator<utree const> const_iterator;
+ typedef detail::list::node_iterator<boost::reference_wrapper<utree> >
+ ref_iterator;
+ typedef utree& reference;
+ typedef utree const& const_reference;
+ typedef std::ptrdiff_t difference_type;
+ typedef std::size_t size_type;
+
+ typedef boost::iterator_range<iterator> range;
+ typedef boost::iterator_range<const_iterator> const_range;
+
+ utree();
+ utree(bool b);
+ utree(char c);
+ utree(unsigned int i);
+ utree(int i);
+ utree(double d);
+ utree(char const* str);
+ utree(char const* str, std::size_t len);
+ utree(std::string const& str);
+ utree(boost::reference_wrapper<utree> ref);
+ utree(any_ptr const& p);
+
+ template <typename Iter>
+ utree(boost::iterator_range<Iter> r);
+ utree(range r, shallow_tag);
+ utree(const_range r, shallow_tag);
+ utree(utf8_string_range const& str, shallow_tag);
+
+ template <typename F>
+ utree(stored_function<F> const& pf);
+
+ template <typename Base, utree_type::info type_>
+ utree(basic_string<Base, type_> const& str);
+
+ utree(utree const& other);
+ ~utree();
+
+ utree& operator=(utree const& other);
+ utree& operator=(bool b);
+ utree& operator=(unsigned int i);
+ utree& operator=(int i);
+ utree& operator=(double d);
+ utree& operator=(char const* s);
+ utree& operator=(std::string const& s);
+ utree& operator=(boost::reference_wrapper<utree> ref);
+
+ template <typename F>
+ utree& operator=(stored_function<F> const& pf);
+
+ template <typename Iter>
+ utree& operator=(boost::iterator_range<Iter> r);
+
+ template <typename Base, utree_type::info type_>
+ utree& operator=(basic_string<Base, type_> const& bin);
+
+ template <typename F>
+ typename F::result_type
+ static visit(utree const& x, F f);
+
+ template <typename F>
+ typename F::result_type
+ static visit(utree& x, F f);
+
+ template <typename F>
+ typename F::result_type
+ static visit(utree const& x, utree const& y, F f);
+
+ template <typename F>
+ typename F::result_type
+ static visit(utree& x, utree const& y, F f);
+
+ template <typename F>
+ typename F::result_type
+ static visit(utree const& x, utree& y, F f);
+
+ template <typename F>
+ typename F::result_type
+ static visit(utree& x, utree& y, F f);
+
+ template <typename T>
+ void push_back(T const& val);
+
+ template <typename T>
+ void push_front(T const& val);
+
+ template <typename T>
+ iterator insert(iterator pos, T const& x);
+
+ template <typename T>
+ void insert(iterator pos, std::size_t, T const& x);
+
+ template <typename Iter>
+ void insert(iterator pos, Iter first, Iter last);
+
+ template <typename Iter>
+ void assign(Iter first, Iter last);
+
+ void clear();
+ void pop_front();
+ void pop_back();
+ iterator erase(iterator pos);
+ iterator erase(iterator first, iterator last);
+
+ utree& front();
+ utree& back();
+ utree const& front() const;
+ utree const& back() const;
+
+ utree& operator[](std::size_t i);
+ utree const& operator[](std::size_t i) const;
+
+ void swap(utree& other);
+
+ iterator begin();
+ iterator end();
+ const_iterator begin() const;
+ const_iterator end() const;
+
+ ref_iterator ref_begin();
+ ref_iterator ref_end();
+
+ bool empty() const;
+ std::size_t size() const;
+
+ utree_type::info which() const;
+
+ template <typename T>
+ T get() const;
+
+ utree& deref();
+ utree const& deref() const;
+
+ short tag() const;
+ void tag(short tag);
+
+ utree eval(scope const& env) const;
+
+ private:
+
+ typedef utree_type type;
+
+ template <typename UTreeX, typename UTreeY>
+ friend struct detail::visit_impl;
+ friend struct detail::index_impl;
+
+ template <typename T>
+ friend struct detail::get_impl;
+
+ type::info get_type() const;
+ void set_type(type::info t);
+ void ensure_list_type();
+ void free();
+ void copy(utree const& other);
+
+ union
+ {
+ detail::fast_string s;
+ detail::list l;
+ detail::range r;
+ detail::string_range sr;
+ detail::void_ptr v;
+ bool b;
+ int i;
+ double d;
+ utree* p;
+ function_base* pf;
+ };
+ };
+
+ ///////////////////////////////////////////////////////////////////////////
+ // The scope
+ ///////////////////////////////////////////////////////////////////////////
+ class scope : public boost::iterator_range<utree*>
+ {
+ public:
+
+ scope(utree* first = 0,
+ utree* last = 0,
+ scope const* parent = 0)
+ : boost::iterator_range<utree*>(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)
+# pragma warning(pop)
+#endif
+
+#include <utree/detail/utree_detail2.hpp>
+
+// $$$ move this in its own file $$$
+namespace scheme { namespace utree_functions
+{
+ ///////////////////////////////////////////////////////////////////////////
+ // Extra functions
+ ///////////////////////////////////////////////////////////////////////////
+ inline utree rest(utree& x)
+ {
+ utree::iterator i = x.begin(); ++i;
+ return utree(utree::range(i, x.end()), shallow);
+ }
+
+ inline utree rest(utree const& x)
+ {
+ utree::const_iterator i = x.begin(); ++i;
+ return utree(utree::const_range(i, x.end()), shallow);
+ }
+}}
+
+#endif


Boost-Commit list run by bdawes at acm.org, david.abrahams at rcn.com, gregod at cs.rpi.edu, cpdaniel at pacbell.net, john at johnmaddock.co.uk