Squashed 'third_party/immer/' content from commit ad3e3556d
git-subtree-dir: third_party/immer git-subtree-split: ad3e3556d38bb75966dd24c61a774970a7c7957e
This commit is contained in:
Vincent Ambo
commit
7f19d64164
311 changed files with 74223 additions and 0 deletions
24
extra/guile/CMakeLists.txt
Normal file
24
extra/guile/CMakeLists.txt
Normal file
|
|
@ -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)
|
||||
144
extra/guile/README.rst
Normal file
144
extra/guile/README.rst
Normal file
|
|
@ -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
|
||||
168
extra/guile/benchmark.scm
Normal file
168
extra/guile/benchmark.scm
Normal file
|
|
@ -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))
|
||||
51
extra/guile/example.scm
Normal file
51
extra/guile/example.scm
Normal file
|
|
@ -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)
|
||||
5
extra/guile/immer.scm.in
Normal file
5
extra/guile/immer.scm.in
Normal file
|
|
@ -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")
|
||||
58
extra/guile/scm/detail/convert.hpp
Normal file
58
extra/guile/scm/detail/convert.hpp
Normal file
|
|
@ -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);
|
||||
36
extra/guile/scm/detail/define.hpp
Normal file
36
extra/guile/scm/detail/define.hpp
Normal file
|
|
@ -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
|
||||
62
extra/guile/scm/detail/finalizer_wrapper.hpp
Normal file
62
extra/guile/scm/detail/finalizer_wrapper.hpp
Normal file
|
|
@ -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
|
||||
21
extra/guile/scm/detail/function_args.hpp
Normal file
21
extra/guile/scm/detail/function_args.hpp
Normal file
|
|
@ -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
|
||||
39
extra/guile/scm/detail/invoke.hpp
Normal file
39
extra/guile/scm/detail/invoke.hpp
Normal file
|
|
@ -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
|
||||
52
extra/guile/scm/detail/pack.hpp
Normal file
52
extra/guile/scm/detail/pack.hpp
Normal file
|
|
@ -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
|
||||
111
extra/guile/scm/detail/subr_wrapper.hpp
Normal file
111
extra/guile/scm/detail/subr_wrapper.hpp
Normal file
|
|
@ -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
|
||||
49
extra/guile/scm/detail/util.hpp
Normal file
49
extra/guile/scm/detail/util.hpp
Normal file
|
|
@ -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
|
||||
88
extra/guile/scm/group.hpp
Normal file
88
extra/guile/scm/group.hpp
Normal file
|
|
@ -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
|
||||
54
extra/guile/scm/list.hpp
Normal file
54
extra/guile/scm/list.hpp
Normal file
|
|
@ -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);
|
||||
14
extra/guile/scm/scm.hpp
Normal file
14
extra/guile/scm/scm.hpp
Normal file
|
|
@ -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>
|
||||
153
extra/guile/scm/type.hpp
Normal file
153
extra/guile/scm/type.hpp
Normal file
|
|
@ -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
|
||||
88
extra/guile/scm/val.hpp
Normal file
88
extra/guile/scm/val.hpp
Normal file
|
|
@ -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);
|
||||
153
extra/guile/src/immer.cpp
Normal file
153
extra/guile/src/immer.cpp
Normal file
|
|
@ -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");
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue