diff options
Diffstat (limited to 'third_party/immer/extra/guile')
19 files changed, 1370 insertions, 0 deletions
diff --git a/third_party/immer/extra/guile/CMakeLists.txt b/third_party/immer/extra/guile/CMakeLists.txt new file mode 100644 index 0000000000..99338060d6 --- /dev/null +++ b/third_party/immer/extra/guile/CMakeLists.txt @@ -0,0 +1,24 @@ + +find_package(PkgConfig) + +pkg_check_modules(Guile guile-2.2) + +if (NOT Guile_FOUND) + message(STATUS "Disabling Guile modules") + return() +endif() + +set(GUILE_EXTENSION_DIR ${CMAKE_CURRENT_BINARY_DIR}) +configure_file(immer.scm.in immer.scm) + +add_library(guile-immer SHARED EXCLUDE_FROM_ALL + src/immer.cpp) +target_include_directories(guile-immer PUBLIC + ${CMAKE_CURRENT_SOURCE_DIR} + ${CALLABLE_TRAITS_INCLUDE_DIR} + ${Guile_INCLUDE_DIRS}) +target_link_libraries(guile-immer PUBLIC + immer + ${Guile_LIBRARIES}) + +add_custom_target(guile DEPENDS guile-immer) diff --git a/third_party/immer/extra/guile/README.rst b/third_party/immer/extra/guile/README.rst new file mode 100644 index 0000000000..09cf8be644 --- /dev/null +++ b/third_party/immer/extra/guile/README.rst @@ -0,0 +1,144 @@ + +Guile bindings +============== + +This library includes experimental bindings bring efficient immutable +vectors for the `GNU Guile`_ Scheme implementation. The interface is +somewhat **incomplete**, but you can already do something interesting +things like: + +.. literalinclude:: ../extra/guile/example.scm + :language: scheme + :start-after: intro/start + :end-before: intro/end +.. + + **Do you want to help** making these bindings complete and production + ready? Drop a line at `immer@sinusoid.al + <mailto:immer@sinusoid.al>`_ or `open an issue on Github + <https://github.com/arximboldi/immer>`_ + +.. _GNU Guile: https://www.gnu.org/software/guile/ + +Installation +------------ + +.. highlight:: sh + +To install the software, you need `GNU Guile 2.2 +<https://www.gnu.org/software/guile/download/>`_. Then you have to +`clone the repository <https://github.com/arximboldi/immer>`_ and +inside the repository do something like:: + + mkdir build; cd build + cmake .. -DCMAKE_BUILD_TYPE=Release \ + -DGUILE_EXTENSION_DIR="<somewhere...>" + make guile + cp extra/guile/libguile-immer.so "<...the GUILE_EXTENSION_DIR>" + cp extra/guile/immer.scm "<somewhere in your GUILE_LOAD_PATH>" + +Benchmarks +---------- + +The library includes some quick and dirty benchmarks that show how +these vectors perform compared to *mutable vectors*, *lists*, and +*v-lists*. Once you have installed the library, you may run them by +executing the following in the project root:: + + guile extra/guile/benchmark.scm + +This is the output I get when running those: + +.. code-block:: scheme + :name: benchmark-output + + (define bench-size 1000000) + (define bench-samples 10) + ;;;; benchmarking creation... + ; evaluating: + (apply ivector (iota bench-size)) + ; average time: 0.0608697784 seconds + ; evaluating: + (apply ivector-u32 (iota bench-size)) + ; average time: 0.0567354933 seconds + ; evaluating: + (iota bench-size) + ; average time: 0.032995402 seconds + ; evaluating: + (apply vector (iota bench-size)) + ; average time: 0.0513594425 seconds + ; evaluating: + (apply u32vector (iota bench-size)) + ; average time: 0.0939185315 seconds + ; evaluating: + (list->vlist (iota bench-size)) + ; average time: 0.2369570977 seconds + ;;;; benchmarking iteration... + (define bench-ivector (apply ivector (iota bench-size))) + (define bench-ivector-u32 (apply ivector-u32 (iota bench-size))) + (define bench-list (iota bench-size)) + (define bench-vector (apply vector (iota bench-size))) + (define bench-u32vector (apply u32vector (iota bench-size))) + (define bench-vlist (list->vlist (iota bench-size))) + ; evaluating: + (ivector-fold + 0 bench-ivector) + ; average time: 0.035750341 seconds + ; evaluating: + (ivector-u32-fold + 0 bench-ivector-u32) + ; average time: 0.0363843682 seconds + ; evaluating: + (fold + 0 bench-list) + ; average time: 0.0271881423 seconds + ; evaluating: + (vector-fold + 0 bench-vector) + ; average time: 0.0405022349 seconds + ; evaluating: + (vlist-fold + 0 bench-vlist) + ; average time: 0.0424709098 seconds + ;;;; benchmarking iteration by index... + ; evaluating: + (let iter ((i 0) (acc 0)) + (if (< i (ivector-length bench-ivector)) + (iter (+ i 1) (+ acc (ivector-ref bench-ivector i))) + acc)) + ; average time: 0.2195658936 seconds + ; evaluating: + (let iter ((i 0) (acc 0)) + (if (< i (ivector-u32-length bench-ivector-u32)) + (iter (+ i 1) (+ acc (ivector-u32-ref bench-ivector-u32 i))) + acc)) + ; average time: 0.2205486326 seconds + ; evaluating: + (let iter ((i 0) (acc 0)) + (if (< i (vector-length bench-vector)) + (iter (+ i 1) (+ acc (vector-ref bench-vector i))) + acc)) + ; average time: 0.0097157637 seconds + ; evaluating: + (let iter ((i 0) (acc 0)) + (if (< i (u32vector-length bench-u32vector)) + (iter (+ i 1) (+ acc (u32vector-ref bench-u32vector i))) + acc)) + ; average time: 0.0733736008 seconds + ; evaluating: + (let iter ((i 0) (acc 0)) + (if (< i (vlist-length bench-vlist)) + (iter (+ i 1) (+ acc (vlist-ref bench-vlist i))) + acc)) + ; average time: 0.3220357243 seconds + ;;;; benchmarking concatenation... + ; evaluating: + (ivector-append bench-ivector bench-ivector) + ; average time: 1.63022e-5 seconds + ; evaluating: + (ivector-u32-append bench-ivector-u32 bench-ivector-u32) + ; average time: 1.63754e-5 seconds + ; evaluating: + (append bench-list bench-list) + ; average time: 0.0135592963 seconds + ; evaluating: + (vector-append bench-vector bench-vector) + ; average time: 0.0044506586 seconds + ; evaluating: + (vlist-append bench-vlist bench-vlist) + ; average time: 0.3227312512 seconds diff --git a/third_party/immer/extra/guile/benchmark.scm b/third_party/immer/extra/guile/benchmark.scm new file mode 100644 index 0000000000..463a8eb17d --- /dev/null +++ b/third_party/immer/extra/guile/benchmark.scm @@ -0,0 +1,168 @@ +;; +;; immer: immutable data structures for C++ +;; Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +;; +;; This software is distributed under the Boost Software License, Version 1.0. +;; See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +;; + +(use-modules (immer) + (fector) ; https://wingolog.org/pub/fector.scm + (srfi srfi-1) + (srfi srfi-43) + (ice-9 vlist) + (ice-9 pretty-print) + (rnrs bytevectors)) + +(define-syntax display-eval + (syntax-rules () + ((_ expr) + (begin (pretty-print 'expr + #:max-expr-width 72) + expr)))) + +(display-eval (define bench-size 1000000)) +(display-eval (define bench-samples 10)) + +(define (average . ns) + (/ (apply + ns) (length ns))) + +(define (generate-n n fn) + (unfold (lambda (x) (= x n)) + (lambda (x) (fn)) + (lambda (x) (+ x 1)) + 0)) + +(define-syntax benchmark + (syntax-rules () + ((_ expr) + (begin + (display "; evaluating: ") (newline) + (pretty-print 'expr + #:max-expr-width 72 + #:per-line-prefix " ") + (let* ((sample (lambda () + (gc) + (let* ((t0 (get-internal-real-time)) + (r expr) + (t1 (get-internal-real-time))) + (/ (- t1 t0) internal-time-units-per-second)))) + (samples (generate-n bench-samples sample)) + (result (apply average samples))) + (display "; average time: ") + (display (exact->inexact result)) + (display " seconds") + (newline)))))) + +(display ";;;; benchmarking creation...") (newline) + +(display-eval + (define (fector . args) + (persistent-fector (fold (lambda (v fv) (fector-push! fv v)) + (transient-fector) + args)))) + +(benchmark (apply ivector (iota bench-size))) +(benchmark (apply ivector-u32 (iota bench-size))) +(benchmark (iota bench-size)) +(benchmark (apply vector (iota bench-size))) +(benchmark (apply u32vector (iota bench-size))) +(benchmark (list->vlist (iota bench-size))) +(benchmark (apply fector (iota bench-size))) + +(display ";;;; benchmarking iteration...") (newline) + +(display-eval (define bench-ivector (apply ivector (iota bench-size)))) +(display-eval (define bench-ivector-u32 (apply ivector-u32 (iota bench-size)))) +(display-eval (define bench-list (iota bench-size))) +(display-eval (define bench-vector (apply vector (iota bench-size)))) +(display-eval (define bench-u32vector (apply u32vector (iota bench-size)))) +(display-eval (define bench-vlist (list->vlist (iota bench-size)))) +(display-eval (define bench-fector (apply fector (iota bench-size)))) +(display-eval (define bench-bytevector-u32 + (uint-list->bytevector (iota bench-size) + (native-endianness) + 4))) + +(benchmark (ivector-fold + 0 bench-ivector)) +(benchmark (ivector-u32-fold + 0 bench-ivector-u32)) +(benchmark (fold + 0 bench-list)) +(benchmark (vector-fold + 0 bench-vector)) +(benchmark (vlist-fold + 0 bench-vlist)) +(benchmark (fector-fold + bench-fector 0)) + +(display ";;;; benchmarking iteration by index...") (newline) + +(display-eval + (define-syntax iteration-by-index + (syntax-rules () + ((_ *length *ref *vector *step) + (let ((len (*length *vector))) + (let iter ((i 0) (acc 0)) + (if (< i len) + (iter (+ i *step) + (+ acc (*ref *vector i))) + acc))))))) + +(display-eval + (define-syntax iteration-by-index-truncate + (syntax-rules () + ((_ *length *ref *vector *step) + (let ((len (*length *vector))) + (let iter ((i 0) (acc 0)) + (if (< i len) + (iter (+ i *step) + (logand #xffffffffFFFFFFFF + (+ acc (*ref *vector i)))) + acc))))))) + +(benchmark (iteration-by-index ivector-length + ivector-ref + bench-ivector 1)) +(benchmark (iteration-by-index ivector-u32-length + ivector-u32-ref + bench-ivector-u32 1)) +(benchmark (iteration-by-index vector-length + vector-ref + bench-vector 1)) +(benchmark (iteration-by-index u32vector-length + u32vector-ref + bench-u32vector 1)) +(benchmark (iteration-by-index vlist-length + vlist-ref + bench-vlist 1)) +(benchmark (iteration-by-index fector-length + fector-ref + bench-fector 1)) +(benchmark (iteration-by-index bytevector-length + bytevector-u32-native-ref + bench-bytevector-u32 4)) + +(benchmark (iteration-by-index-truncate ivector-length + ivector-ref + bench-ivector 1)) +(benchmark (iteration-by-index-truncate ivector-u32-length + ivector-u32-ref + bench-ivector-u32 1)) +(benchmark (iteration-by-index-truncate vector-length + vector-ref + bench-vector 1)) +(benchmark (iteration-by-index-truncate u32vector-length + u32vector-ref + bench-u32vector 1)) +(benchmark (iteration-by-index-truncate vlist-length + vlist-ref + bench-vlist 1)) +(benchmark (iteration-by-index-truncate fector-length + fector-ref + bench-fector 1)) +(benchmark (iteration-by-index-truncate bytevector-length + bytevector-u32-native-ref + bench-bytevector-u32 4)) + +(display ";;;; benchmarking concatenation...") (newline) +(benchmark (ivector-append bench-ivector bench-ivector)) +(benchmark (ivector-u32-append bench-ivector-u32 bench-ivector-u32)) +(benchmark (append bench-list bench-list)) +(benchmark (vector-append bench-vector bench-vector)) +(benchmark (vlist-append bench-vlist bench-vlist)) diff --git a/third_party/immer/extra/guile/example.scm b/third_party/immer/extra/guile/example.scm new file mode 100644 index 0000000000..6649508ced --- /dev/null +++ b/third_party/immer/extra/guile/example.scm @@ -0,0 +1,51 @@ +;; +;; immer: immutable data structures for C++ +;; Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +;; +;; This software is distributed under the Boost Software License, Version 1.0. +;; See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +;; + +;; include:intro/start +(use-modules (immer) + (rnrs base)) + +(let ((v1 (ivector 1 "hola" 3 'que #:tal))) + (assert (eq? (ivector-ref v1 3) 'que)) + + (let* ((v2 (ivector-set v1 3 'what)) + (v2 (ivector-update v2 2 (lambda (x) (+ 1 x))))) + (assert (eq? (ivector-ref v1 2) 3)) + (assert (eq? (ivector-ref v1 3) 'que)) + (assert (eq? (ivector-ref v2 2) 4)) + (assert (eq? (ivector-ref v2 3) 'what)) + + (let ((v3 (ivector-push v2 "hehe"))) + (assert (eq? (ivector-length v3) 6)) + (assert (eq? (ivector-ref v3 (- (ivector-length v3) 1)) "hehe"))))) + +(let ((v (apply ivector (iota 10)))) + (assert (eq? (ivector-length v) 10)) + (assert (eq? (ivector-length (ivector-drop v 3)) 7)) + (assert (eq? (ivector-length (ivector-take v 3)) 3)) + (assert (eq? (ivector-length (ivector-append v v)) 20))) + +(let ((v1 (make-ivector 3)) + (v2 (make-ivector 3 ":)"))) + (assert (eq? (ivector-ref v1 2) + (vector-ref (make-vector 3) 2))) + (assert (eq? (ivector-ref v2 2) ":)"))) +;; include:intro/end + +;; Experiments + +(let ((d (dummy))) + (dummy-foo d) + (dummy-bar d 42)) +(gc) + +(func1) +(func2) +(func3 (dummy) 12) +(foo-func1) +(gc) diff --git a/third_party/immer/extra/guile/immer.scm.in b/third_party/immer/extra/guile/immer.scm.in new file mode 100644 index 0000000000..8624aabd5b --- /dev/null +++ b/third_party/immer/extra/guile/immer.scm.in @@ -0,0 +1,5 @@ +(define-module (immer)) + +;; The extension automatically exports the names via 'scm_c_export' +(load-extension "@GUILE_EXTENSION_DIR@/libguile-immer" + "init_immer") diff --git a/third_party/immer/extra/guile/scm/detail/convert.hpp b/third_party/immer/extra/guile/scm/detail/convert.hpp new file mode 100644 index 0000000000..4c87ff1856 --- /dev/null +++ b/third_party/immer/extra/guile/scm/detail/convert.hpp @@ -0,0 +1,58 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <scm/detail/util.hpp> + +#include <cstdint> +#include <type_traits> +#include <utility> + +#include <libguile.h> + +namespace scm { +namespace detail { + +template <typename T, typename Enable=void> +struct convert; + +template <typename T> +auto to_scm(T&& v) + -> SCM_DECLTYPE_RETURN( + convert<std::decay_t<T>>::to_scm(std::forward<T>(v))); + +template <typename T> +auto to_cpp(SCM v) + -> SCM_DECLTYPE_RETURN( + convert<std::decay_t<T>>::to_cpp(v)); + +} // namespace detail +} // namespace scm + +#define SCM_DECLARE_NUMERIC_TYPE(cpp_name__, scm_name__) \ + namespace scm { \ + namespace detail { \ + template <> \ + struct convert<cpp_name__> { \ + static cpp_name__ to_cpp(SCM v) { return scm_to_ ## scm_name__(v); } \ + static SCM to_scm(cpp_name__ v) { return scm_from_ ## scm_name__(v); } \ + }; \ + }} /* namespace scm::detail */ \ + /**/ + +SCM_DECLARE_NUMERIC_TYPE(float, double); +SCM_DECLARE_NUMERIC_TYPE(double, double); +SCM_DECLARE_NUMERIC_TYPE(std::int8_t, int8); +SCM_DECLARE_NUMERIC_TYPE(std::int16_t, int16); +SCM_DECLARE_NUMERIC_TYPE(std::int32_t, int32); +SCM_DECLARE_NUMERIC_TYPE(std::int64_t, int64); +SCM_DECLARE_NUMERIC_TYPE(std::uint8_t, uint8); +SCM_DECLARE_NUMERIC_TYPE(std::uint16_t, uint16); +SCM_DECLARE_NUMERIC_TYPE(std::uint32_t, uint32); +SCM_DECLARE_NUMERIC_TYPE(std::uint64_t, uint64); diff --git a/third_party/immer/extra/guile/scm/detail/define.hpp b/third_party/immer/extra/guile/scm/detail/define.hpp new file mode 100644 index 0000000000..08b6e76338 --- /dev/null +++ b/third_party/immer/extra/guile/scm/detail/define.hpp @@ -0,0 +1,36 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#ifndef SCM_AUTO_EXPORT +#define SCM_AUTO_EXPORT 1 +#endif + +#include <scm/detail/subr_wrapper.hpp> +#include <scm/list.hpp> + +namespace scm { +namespace detail { + +template <typename Tag, typename Fn> +static void define_impl(const std::string& name, Fn fn) +{ + using args_t = function_args_t<Fn>; + constexpr auto args_size = pack_size_v<args_t>; + constexpr auto has_rest = std::is_same<pack_last_t<args_t>, scm::args>{}; + constexpr auto arg_count = args_size - has_rest; + auto subr = (scm_t_subr) +subr_wrapper_aux<Tag>(fn, args_t{}); + scm_c_define_gsubr(name.c_str(), arg_count, 0, has_rest, subr); +#if SCM_AUTO_EXPORT + scm_c_export(name.c_str()); +#endif +} + +} // namespace detail +} // namespace scm diff --git a/third_party/immer/extra/guile/scm/detail/finalizer_wrapper.hpp b/third_party/immer/extra/guile/scm/detail/finalizer_wrapper.hpp new file mode 100644 index 0000000000..258249eb2c --- /dev/null +++ b/third_party/immer/extra/guile/scm/detail/finalizer_wrapper.hpp @@ -0,0 +1,62 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <scm/detail/invoke.hpp> +#include <scm/detail/function_args.hpp> +#include <scm/detail/convert.hpp> + +namespace scm { +namespace detail { +// this anonymous namespace should help avoiding registration clashes +// among translation units. +namespace { + +template <typename Tag, typename Fn> +auto finalizer_wrapper_impl(Fn fn, pack<>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] { invoke(fn_); }; +} +template <typename Tag, typename Fn, typename T1> +auto finalizer_wrapper_impl(Fn fn, pack<T1>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] (SCM a1) { invoke(fn_, to_cpp<T1>(a1)); }; +} +template <typename Tag, typename Fn, typename T1, typename T2> +auto finalizer_wrapper_impl(Fn fn, pack<T1, T2>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] (SCM a1, SCM a2) { + invoke(fn_, to_cpp<T1>(a1), to_cpp<T2>(a2)); + }; +} +template <typename Tag, typename Fn, typename T1, typename T2, typename T3> +auto finalizer_wrapper_impl(Fn fn, pack<T1, T2, T3>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] (SCM a1, SCM a2, SCM a3) { + invoke(fn_, to_cpp<T1>(a1), to_cpp<T2>(a2), to_cpp<T3>(a3)); + }; +} + +template <typename Tag, typename Fn> +auto finalizer_wrapper(Fn fn) +{ + return finalizer_wrapper_impl<Tag>(fn, function_args_t<Fn>{}); +} + +} // anonymous namespace +} // namespace detail +} // namespace scm diff --git a/third_party/immer/extra/guile/scm/detail/function_args.hpp b/third_party/immer/extra/guile/scm/detail/function_args.hpp new file mode 100644 index 0000000000..809e3eb197 --- /dev/null +++ b/third_party/immer/extra/guile/scm/detail/function_args.hpp @@ -0,0 +1,21 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <scm/detail/pack.hpp> +#include <boost/callable_traits/args.hpp> + +namespace scm { +namespace detail { + +template <typename Fn> +using function_args_t = boost::callable_traits::args_t<Fn, pack>; + +} // namespace detail +} // namespace scm diff --git a/third_party/immer/extra/guile/scm/detail/invoke.hpp b/third_party/immer/extra/guile/scm/detail/invoke.hpp new file mode 100644 index 0000000000..d9f2b37cce --- /dev/null +++ b/third_party/immer/extra/guile/scm/detail/invoke.hpp @@ -0,0 +1,39 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +// Adapted from the official std::invoke proposal: +// http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2014/n4169.html + +#include <type_traits> +#include <functional> + +namespace scm { +namespace detail { + +template <typename Functor, typename... Args> +std::enable_if_t< + std::is_member_pointer<std::decay_t<Functor>>::value, + std::result_of_t<Functor&&(Args&&...)>> +invoke(Functor&& f, Args&&... args) +{ + return std::mem_fn(f)(std::forward<Args>(args)...); +} + +template <typename Functor, typename... Args> +std::enable_if_t< + !std::is_member_pointer<std::decay_t<Functor>>::value, + std::result_of_t<Functor&&(Args&&...)>> +invoke(Functor&& f, Args&&... args) +{ + return std::forward<Functor>(f)(std::forward<Args>(args)...); +} + +} // namespace detail +} // namespace scm diff --git a/third_party/immer/extra/guile/scm/detail/pack.hpp b/third_party/immer/extra/guile/scm/detail/pack.hpp new file mode 100644 index 0000000000..9a1813570b --- /dev/null +++ b/third_party/immer/extra/guile/scm/detail/pack.hpp @@ -0,0 +1,52 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +namespace scm { +namespace detail { + +struct none_t; + +template <typename... Ts> +struct pack {}; + +template <typename Pack> +struct pack_size; + +template <typename... Ts> +struct pack_size<pack<Ts...>> +{ + static constexpr auto value = sizeof...(Ts); +}; + +template <typename Pack> +constexpr auto pack_size_v = pack_size<Pack>::value; + +template <typename Pack> +struct pack_last +{ + using type = none_t; +}; + +template <typename T, typename ...Ts> +struct pack_last<pack<T, Ts...>> + : pack_last<pack<Ts...>> +{}; + +template <typename T> +struct pack_last<pack<T>> +{ + using type = T; +}; + +template <typename Pack> +using pack_last_t = typename pack_last<Pack>::type; + +} // namespace detail +} // namespace scm diff --git a/third_party/immer/extra/guile/scm/detail/subr_wrapper.hpp b/third_party/immer/extra/guile/scm/detail/subr_wrapper.hpp new file mode 100644 index 0000000000..fc11ff1c51 --- /dev/null +++ b/third_party/immer/extra/guile/scm/detail/subr_wrapper.hpp @@ -0,0 +1,111 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <scm/detail/invoke.hpp> +#include <scm/detail/function_args.hpp> +#include <scm/detail/convert.hpp> + +namespace scm { +namespace detail { + +// this anonymous namespace should help avoiding registration clashes +// among translation units. +namespace { + +template <typename Tag, typename R, typename Fn> +auto subr_wrapper_impl(Fn fn, pack<R>, pack<>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] () -> SCM { return to_scm(invoke(fn_)); }; +} +template <typename Tag, typename Fn, typename R, typename T1> +auto subr_wrapper_impl(Fn fn, pack<R>, pack<T1>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] (SCM a1) -> SCM { + return to_scm(invoke(fn_, to_cpp<T1>(a1))); + }; +} +template <typename Tag, typename Fn, typename R, typename T1, typename T2> +auto subr_wrapper_impl(Fn fn, pack<R>, pack<T1, T2>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] (SCM a1, SCM a2) -> SCM { + return to_scm(invoke(fn_, to_cpp<T1>(a1), to_cpp<T2>(a2))); + }; +} +template <typename Tag, typename Fn, typename R, typename T1, typename T2, + typename T3> +auto subr_wrapper_impl(Fn fn, pack<R>, pack<T1, T2, T3>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] (SCM a1, SCM a2, SCM a3) -> SCM { + return to_scm(invoke(fn_, to_cpp<T1>(a1), to_cpp<T2>(a2), + to_cpp<T3>(a3))); + }; +} + +template <typename Tag, typename Fn> +auto subr_wrapper_impl(Fn fn, pack<void>, pack<>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] () -> SCM { invoke(fn_); return SCM_UNSPECIFIED; }; +} +template <typename Tag, typename Fn, typename T1> +auto subr_wrapper_impl(Fn fn, pack<void>, pack<T1>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] (SCM a1) -> SCM { + invoke(fn_, to_cpp<T1>(a1)); return SCM_UNSPECIFIED; + }; +} +template <typename Tag, typename Fn, typename T1, typename T2> +auto subr_wrapper_impl(Fn fn, pack<void>, pack<T1, T2>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] (SCM a1, SCM a2) -> SCM { + invoke(fn_, to_cpp<T1>(a1), to_cpp<T2>(a2)); + return SCM_UNSPECIFIED; + }; +} +template <typename Tag, typename Fn, typename T1, typename T2, typename T3> +auto subr_wrapper_impl(Fn fn, pack<void>, pack<T1, T2, T3>) +{ + check_call_once<Tag, Fn>(); + static const Fn fn_ = fn; + return [] (SCM a1, SCM a2, SCM a3) -> SCM { + invoke(fn_, to_cpp<T1>(a1), to_cpp<T2>(a2), to_cpp<T3>(a3)); + return SCM_UNSPECIFIED; + }; +} + +template <typename Tag, typename Fn, typename... Args> +auto subr_wrapper_aux(Fn fn, pack<Args...>) +{ + return subr_wrapper_impl<Tag>( + fn, pack<std::result_of_t<Fn(Args...)>>{}, pack<Args...>{}); +} + +template <typename Tag, typename Fn> +auto subr_wrapper(Fn fn) +{ + return subr_wrapper_aux<Tag>(fn, function_args_t<Fn>{}); +} + +} // anonymous namespace +} // namespace detail +} // namespace scm diff --git a/third_party/immer/extra/guile/scm/detail/util.hpp b/third_party/immer/extra/guile/scm/detail/util.hpp new file mode 100644 index 0000000000..fdc323722e --- /dev/null +++ b/third_party/immer/extra/guile/scm/detail/util.hpp @@ -0,0 +1,49 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <libguile.h> + +namespace scm { +namespace detail { + +#define SCM_DECLTYPE_RETURN(...) \ + decltype(__VA_ARGS__) \ + { return __VA_ARGS__; } \ + /**/ + +template <typename... Ts> +constexpr bool is_valid_v = true; + +template <typename... Ts> +using is_valid_t = void; + +template <typename... Ts> +void check_call_once() +{ + static bool called = false; + if (called) scm_misc_error (nullptr, "Double defined binding. \ +This may be caused because there are multiple C++ binding groups in the same \ +translation unit. You may solve this by using different type tags for each \ +binding group.", SCM_EOL); + called = true; +} + +struct move_sequence +{ + move_sequence() = default; + move_sequence(const move_sequence&) = delete; + move_sequence(move_sequence&& other) + { other.moved_from_ = true; }; + + bool moved_from_ = false; +}; + +} // namespace detail +} // namespace scm diff --git a/third_party/immer/extra/guile/scm/group.hpp b/third_party/immer/extra/guile/scm/group.hpp new file mode 100644 index 0000000000..69cd385820 --- /dev/null +++ b/third_party/immer/extra/guile/scm/group.hpp @@ -0,0 +1,88 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <scm/detail/define.hpp> +#include <string> + +namespace scm { +namespace detail { + +template <typename Tag, int Seq=0> +struct definer +{ + using this_t = definer; + using next_t = definer<Tag, Seq + 1>; + + std::string group_name_ = {}; + + definer() = default; + definer(definer&&) = default; + + template <int Seq2, + typename Enable=std::enable_if_t<Seq2 + 1 == Seq>> + definer(definer<Tag, Seq2>) + {} + + template <typename Fn> + next_t define(std::string name, Fn fn) && + { + define_impl<this_t>(name, fn); + return { std::move(*this) }; + } + + template <typename Fn> + next_t maker(Fn fn) && + { + define_impl<this_t>("make", fn); + return { std::move(*this) }; + } +}; + +template <typename Tag, int Seq=0> +struct group_definer +{ + using this_t = group_definer; + using next_t = group_definer<Tag, Seq + 1>; + + std::string group_name_ = {}; + + group_definer(std::string name) + : group_name_{std::move(name)} {} + + group_definer(group_definer&&) = default; + + template <int Seq2, + typename Enable=std::enable_if_t<Seq2 + 1 == Seq>> + group_definer(group_definer<Tag, Seq2>) + {} + + template <typename Fn> + next_t define(std::string name, Fn fn) && + { + define_impl<this_t>(group_name_ + "-" + name, fn); + return { std::move(*this) }; + } +}; + +} // namespace detail + +template <typename Tag=void> +detail::definer<Tag> group() +{ + return {}; +} + +template <typename Tag=void> +detail::group_definer<Tag> group(std::string name) +{ + return { std::move(name) }; +} + +} // namespace scm diff --git a/third_party/immer/extra/guile/scm/list.hpp b/third_party/immer/extra/guile/scm/list.hpp new file mode 100644 index 0000000000..dc162c2002 --- /dev/null +++ b/third_party/immer/extra/guile/scm/list.hpp @@ -0,0 +1,54 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <scm/val.hpp> +#include <iostream> + +namespace scm { + +struct list : detail::wrapper +{ + using base_t = detail::wrapper; + using base_t::base_t; + + using iterator = list; + using value_type = val; + + list() : base_t{SCM_EOL} {}; + list end() const { return {}; } + list begin() const { return *this; } + + explicit operator bool() { return handle_ != SCM_EOL; } + + val operator* () const { return val{scm_car(handle_)}; } + + list& operator++ () + { + handle_ = scm_cdr(handle_); + return *this; + } + + list operator++ (int) + { + auto result = *this; + result.handle_ = scm_cdr(handle_); + return result; + } +}; + +struct args : list +{ + using list::list; +}; + +} // namespace scm + +SCM_DECLARE_WRAPPER_TYPE(scm::list); +SCM_DECLARE_WRAPPER_TYPE(scm::args); diff --git a/third_party/immer/extra/guile/scm/scm.hpp b/third_party/immer/extra/guile/scm/scm.hpp new file mode 100644 index 0000000000..f4e4989a44 --- /dev/null +++ b/third_party/immer/extra/guile/scm/scm.hpp @@ -0,0 +1,14 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <scm/val.hpp> +#include <scm/list.hpp> +#include <scm/group.hpp> +#include <scm/type.hpp> diff --git a/third_party/immer/extra/guile/scm/type.hpp b/third_party/immer/extra/guile/scm/type.hpp new file mode 100644 index 0000000000..da53ed46ef --- /dev/null +++ b/third_party/immer/extra/guile/scm/type.hpp @@ -0,0 +1,153 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <scm/detail/finalizer_wrapper.hpp> +#include <scm/detail/define.hpp> +#include <string> + +namespace scm { +namespace detail { + +template <typename T> +struct foreign_type_storage +{ + static SCM data; +}; + +template <typename T> +SCM foreign_type_storage<T>::data = SCM_UNSPECIFIED; + +template <typename T> +struct convert_foreign_type +{ + using storage_t = foreign_type_storage<T>; + static T& to_cpp(SCM v) + { + assert(storage_t::data != SCM_UNSPECIFIED && + "can not convert to undefined type"); + scm_assert_foreign_object_type(storage_t::data, v); + return *(T*)scm_foreign_object_ref(v, 0); + } + + template <typename U> + static SCM to_scm(U&& v) + { + assert(storage_t::data != SCM_UNSPECIFIED && + "can not convert from undefined type"); + return scm_make_foreign_object_1( + storage_t::data, + new (scm_gc_malloc(sizeof(T), "scmpp")) T( + std::forward<U>(v))); + } +}; + +// Assume that every other type is foreign +template <typename T> +struct convert<T, + std::enable_if_t<!std::is_fundamental<T>::value && + // only value types are supported at + // the moment but the story might + // change later... + !std::is_pointer<T>::value>> + : convert_foreign_type<T> +{ +}; + +template <typename Tag, typename T, int Seq=0> +struct type_definer : move_sequence +{ + using this_t = type_definer; + using next_t = type_definer<Tag, T, Seq + 1>; + + std::string type_name_ = {}; + scm_t_struct_finalize finalizer_ = nullptr; + + type_definer(type_definer&&) = default; + + type_definer(std::string type_name) + : type_name_(std::move(type_name)) + {} + + ~type_definer() + { + if (!moved_from_) { + using storage_t = detail::foreign_type_storage<T>; + assert(storage_t::data == SCM_UNSPECIFIED); + storage_t::data = scm_make_foreign_object_type( + scm_from_utf8_symbol(("<" + type_name_ + ">").c_str()), + scm_list_1(scm_from_utf8_symbol("data")), + finalizer_); + } + } + + template <int Seq2, typename Enable=std::enable_if_t<Seq2 + 1 == Seq>> + type_definer(type_definer<Tag, T, Seq2> r) + : move_sequence{std::move(r)} + , type_name_{std::move(r.type_name_)} + , finalizer_{std::move(r.finalizer_)} + {} + + next_t constructor() && + { + define_impl<this_t>(type_name_, [] { return T{}; }); + return { std::move(*this) }; + } + + template <typename Fn> + next_t constructor(Fn fn) && + { + define_impl<this_t>(type_name_, fn); + return { std::move(*this) }; + } + + next_t finalizer() && + { + finalizer_ = (scm_t_struct_finalize) +finalizer_wrapper<Tag>( + [] (T& x) { x.~T(); }); + return { std::move(*this) }; + } + + template <typename Fn> + next_t finalizer(Fn fn) && + { + finalizer_ = (scm_t_struct_finalize) +finalizer_wrapper<Tag>(fn); + return { std::move(*this) }; + } + + next_t maker() && + { + define_impl<this_t>("make-" + type_name_, [] { return T{}; }); + return { std::move(*this) }; + } + + template <typename Fn> + next_t maker(Fn fn) && + { + define_impl<this_t>("make-" + type_name_, fn); + return { std::move(*this) }; + } + + template <typename Fn> + next_t define(std::string name, Fn fn) && + { + define_impl<this_t>(type_name_ + "-" + name, fn); + return { std::move(*this) }; + } +}; + +} // namespace detail + +template <typename Tag, typename T=Tag> +detail::type_definer<Tag, T> type(std::string type_name) +{ + return { type_name }; +} + +} // namespace scm diff --git a/third_party/immer/extra/guile/scm/val.hpp b/third_party/immer/extra/guile/scm/val.hpp new file mode 100644 index 0000000000..63d7189262 --- /dev/null +++ b/third_party/immer/extra/guile/scm/val.hpp @@ -0,0 +1,88 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#pragma once + +#include <scm/detail/convert.hpp> + +namespace scm { +namespace detail { + +template <typename T> +struct convert_wrapper_type +{ + static T to_cpp(SCM v) { return T{v}; } + static SCM to_scm(T v) { return v.get(); } +}; + +struct wrapper +{ + wrapper() = default; + wrapper(SCM hdl) : handle_{hdl} {} + SCM get() const { return handle_; } + operator SCM () const { return handle_; } + + bool operator==(wrapper other) { return handle_ == other.handle_; } + bool operator!=(wrapper other) { return handle_ != other.handle_; } + +protected: + SCM handle_ = SCM_UNSPECIFIED; +}; + +} // namespace detail + +struct val : detail::wrapper +{ + using base_t = detail::wrapper; + using base_t::base_t; + + template <typename T, + typename = std::enable_if_t< + (!std::is_same<std::decay_t<T>, val>{} && + !std::is_same<std::decay_t<T>, SCM>{})>> + val(T&& x) + : base_t(detail::to_scm(std::forward<T>(x))) + {} + + template <typename T, + typename = std::enable_if_t< + std::is_same<T, decltype(detail::to_cpp<T>(SCM{}))>{}>> + operator T() const { return detail::to_cpp<T>(handle_); } + + template <typename T, + typename = std::enable_if_t< + std::is_same<T&, decltype(detail::to_cpp<T>(SCM{}))>{}>> + operator T& () const { return detail::to_cpp<T>(handle_); } + + template <typename T, + typename = std::enable_if_t< + std::is_same<const T&, decltype(detail::to_cpp<T>(SCM{}))>{}>> + operator const T& () const { return detail::to_cpp<T>(handle_); } + + val operator() () const + { return val{scm_call_0(get())}; } + val operator() (val a0) const + { return val{scm_call_1(get(), a0)}; } + val operator() (val a0, val a1) const + { return val{scm_call_2(get(), a0, a1)}; } + val operator() (val a0, val a1, val a3) const + { return val{scm_call_3(get(), a0, a1, a3)}; } +}; + +} // namespace scm + +#define SCM_DECLARE_WRAPPER_TYPE(cpp_name__) \ + namespace scm { \ + namespace detail { \ + template <> \ + struct convert<cpp_name__> \ + : convert_wrapper_type<cpp_name__> {}; \ + }} /* namespace scm::detail */ \ + /**/ + +SCM_DECLARE_WRAPPER_TYPE(val); diff --git a/third_party/immer/extra/guile/src/immer.cpp b/third_party/immer/extra/guile/src/immer.cpp new file mode 100644 index 0000000000..7933447a8d --- /dev/null +++ b/third_party/immer/extra/guile/src/immer.cpp @@ -0,0 +1,153 @@ +// +// immer: immutable data structures for C++ +// Copyright (C) 2016, 2017, 2018 Juan Pedro Bolivar Puente +// +// This software is distributed under the Boost Software License, Version 1.0. +// See accompanying file LICENSE or copy at http://boost.org/LICENSE_1_0.txt +// + +#include <immer/flex_vector.hpp> +#include <immer/flex_vector_transient.hpp> +#include <immer/algorithm.hpp> +#include <scm/scm.hpp> +#include <iostream> + +namespace { + +struct guile_heap +{ + static void* allocate(std::size_t size) + { return scm_gc_malloc(size, "immer"); } + + static void* allocate(std::size_t size, immer::norefs_tag) + { return scm_gc_malloc_pointerless(size, "immer"); } + + template <typename ...Tags> + static void deallocate(std::size_t size, void* obj, Tags...) + { scm_gc_free(obj, size, "immer"); } +}; + +using guile_memory = immer::memory_policy< + immer::heap_policy<guile_heap>, + immer::no_refcount_policy, + immer::gc_transience_policy, + false>; + +template <typename T> +using guile_ivector = immer::flex_vector<T, guile_memory>; + +struct dummy +{ + SCM port_ = scm_current_warning_port(); + + dummy(dummy&&) + { scm_puts("~~ dummy move constructor\n", port_); } + + dummy() + { scm_puts("~~ dummy default constructor\n", port_); } + + ~dummy() + { scm_puts("~~ dummy finalized\n", port_); } + + void foo() + { scm_puts("~~ dummy foo\n", port_); } + + int bar(int x) + { + auto res = x + 42; + scm_puts("~~ dummy bar: ", port_); + scm_display(scm::val{res}, port_); + scm_newline(port_); + return res; + } +}; + +template <int I> +void func() +{ + auto port = scm_current_warning_port(); + scm_puts("~~ func", port); + scm_display(scm_from_int(I), port); + scm_newline(port); +} + +template <typename T = scm::val> +void init_ivector(std::string type_name = "") +{ + using namespace std::string_literals; + + using self_t = guile_ivector<T>; + using size_t = typename self_t::size_type; + + auto name = "ivector"s + (type_name.empty() ? ""s : "-" + type_name); + + scm::type<self_t>(name) + .constructor([] (scm::args rest) { + return self_t(rest.begin(), rest.end()); + }) + .maker([] (size_t n, scm::args rest) { + return self_t(n, rest ? *rest : scm::val{}); + }) + .define("ref", &self_t::operator[]) + .define("length", &self_t::size) + .define("set", [] (const self_t& v, size_t i, scm::val x) { + return v.set(i, x); + }) + .define("update", [] (const self_t& v, size_t i, scm::val fn) { + return v.update(i, fn); + }) + .define("push", [] (const self_t& v, scm::val x) { + return v.push_back(x); + }) + .define("take", [] (const self_t& v, size_t s) { + return v.take(s); + }) + .define("drop", [] (const self_t& v, size_t s) { + return v.drop(s); + }) + .define("append", [] (self_t v, scm::args rest) { + for (auto x : rest) + v = v + x; + return v; + }) + .define("fold", [] (scm::val fn, scm::val first, const self_t& v) { + return immer::accumulate(v, first, fn); + }) + ; +} + +} // anonymous namespace + +struct bar_tag_t {}; + +extern "C" +void init_immer() +{ + scm::type<dummy>("dummy") + .constructor() + .finalizer() + .define("foo", &dummy::foo) + .define("bar", &dummy::bar); + + scm::group() + .define("func1", func<1>); + + scm::group<bar_tag_t>() + .define("func2", func<2>) + .define("func3", &dummy::bar); + + scm::group("foo") + .define("func1", func<1>); + + init_ivector(); + init_ivector<std::uint8_t>("u8"); + init_ivector<std::uint16_t>("u16"); + init_ivector<std::uint32_t>("u32"); + init_ivector<std::uint64_t>("u64"); + init_ivector<std::int8_t>("s8"); + init_ivector<std::int16_t>("s16"); + init_ivector<std::int32_t>("s32"); + init_ivector<std::int64_t>("s64"); + init_ivector<float>("f32"); + init_ivector<double>("f64"); +} |