| /*============================================================================= |
| 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 |