├── .clang-format
├── .gitignore
├── README.md
├── cscript.lisp
├── double-vector
    ├── cscript.lisp
    ├── double-vector.asd
    ├── double-vector.cc
    └── double-vector.lisp
└── hello-world
    ├── cscript.lisp
    ├── hello-world.asd
    ├── hello-world.cc
    └── hello-world.lisp


/.clang-format:
--------------------------------------------------------------------------------
1 | ---
2 | Language: Cpp
3 | BasedOnStyle: LLVM
4 | ColumnLimit: 132
5 | SortIncludes: false
6 | WhitespaceSensitiveMacros: ['CL_LAMBDA', 'CL_DECLARE', 'CL_NAME', 'CL_LISPIFY_NAME']
7 | ...
8 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | # Compiled Object files
2 | *.o
3 | *.bc
4 | *.ll
5 | *~
6 | 
7 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | hello-world
 2 | ==========
 3 | 
 4 | Examples of exposing C++ to Clasp
 5 | 
 6 | To build this demo do the following steps:
 7 | 
 8 | 1. Clone this repository into the clasp/extensions directory
 9 | 2. Configure the build by running the following in the root of the Clasp repo
10 |    ```sh
11 |    ./koga --extensions=demo-clasp-cxx-interoperation
12 |    ```
13 | 3. Build Clasp by running
14 |    ```sh
15 |    ninja -C build
16 |    ```
17 | 
18 | To run the demos run `./build/boehmprecise/clasp` then execute either `(hw:demo)`
19 | or `(dv:demo)` in the Clasp REPL.


--------------------------------------------------------------------------------
/cscript.lisp:
--------------------------------------------------------------------------------
1 | (k:recurse #P"hello-world/"
2 |            #P"double-vector/")
3 | 


--------------------------------------------------------------------------------
/double-vector/cscript.lisp:
--------------------------------------------------------------------------------
1 | (k:sources :iclasp #~"double-vector.cc")
2 | 
3 | (k:systems :double-vector)
4 | 


--------------------------------------------------------------------------------
/double-vector/double-vector.asd:
--------------------------------------------------------------------------------
1 | (asdf:defsystem #:double-vector
2 |   :description "Double vector"
3 |   :version "0.0.1"
4 |   :author "Christian Schafmeister <chris.schaf@verizon.net>"
5 |   :licence "LGPL-3.0"
6 |   :depends-on ()
7 |   :serial t
8 |   :components ((:file "double-vector")))
9 | 


--------------------------------------------------------------------------------
/double-vector/double-vector.cc:
--------------------------------------------------------------------------------
  1 | //
  2 | // Set up a clasp.h include file with all the good stuff
  3 | //
  4 | #include <stdio.h>
  5 | #include <clasp/clasp.h>
  6 | #include <clasp/clbind/clbind.h>
  7 | #include <clasp/core/numbers.h>
  8 | #include <clasp/core/debugger.h>
  9 | #include <clasp/core/array.h>
 10 | #include <clasp/core/package.h>
 11 | #include <clasp/core/translators.h> // assorted translators for string etc
 12 | #include <clasp/core/cons.h>
 13 | 
 14 | #define DIAG
 15 | 
 16 | namespace dv {
 17 | class MismatchedDimension : public std::exception {};
 18 | 
 19 | class DoubleVector {
 20 | private:
 21 |   vector<double> values;
 22 | 
 23 | public:
 24 |   DoubleVector(int sz) { this->values.resize(sz); };
 25 | 
 26 |   DoubleVector(const vector<double> &arg) { this->fill(arg); }
 27 | 
 28 |   void fill(const vector<double> &arg) {
 29 |     this->values.resize(arg.size());
 30 |     for (int i = 0; i < arg.size(); ++i) {
 31 |       this->values[i] = arg[i];
 32 |     }
 33 |   }
 34 | 
 35 |   double &operator[](size_t idx) { return this->values[idx]; };
 36 | 
 37 |   const double &operator[](size_t idx) const { return this->values[idx]; };
 38 | 
 39 |   size_t dimension() const { return this->values.size(); };
 40 | 
 41 |   void set_dimension(int sz) { this->values.resize(sz, 0.0); };
 42 | 
 43 |   DoubleVector add(const DoubleVector &y) {
 44 |     if (this->dimension() != y.dimension()) {
 45 |       throw MismatchedDimension();
 46 |     }
 47 |     DoubleVector result(this->dimension());
 48 |     for (int i = 0; i < this->dimension(); ++i) {
 49 |       result[i] = (*this)[i] + y[i];
 50 |     }
 51 |     return result;
 52 |   }
 53 | 
 54 |   double vref(int i) {
 55 |     if (i < 0 || i >= this->dimension()) {
 56 |       SIMPLE_ERROR("Index out of bounds");
 57 |     }
 58 |     return this->values[i];
 59 |   };
 60 | 
 61 |   double setf_vref(double value, int i) {
 62 |     if (i < 0 || i >= this->dimension()) {
 63 |       SIMPLE_ERROR("Index out of bounds");
 64 |     }
 65 |     return this->values[i] = value;
 66 |   };
 67 | 
 68 |   double dot(const DoubleVector &y) {
 69 |     if (this->dimension() != y.dimension()) {
 70 |       throw MismatchedDimension();
 71 |     }
 72 |     double dot = 0.0;
 73 |     for (int i = 0; i < this->dimension(); ++i) {
 74 |       dot += (*this)[i] * y[i];
 75 |     }
 76 |     return dot;
 77 |   }
 78 | };
 79 | }; // namespace dv
 80 | 
 81 | namespace translate {
 82 | template <typename T> struct to_object<const vector<T> &> {
 83 |   static core::T_sp convert(const vector<T> &v) {
 84 |     core::SimpleVector_sp vec = core::SimpleVector_O::make(v.size());
 85 |     for (int i(0); i < v.size(); ++i) {
 86 |       (*vec)[i] = to_object<T>::convert(v[i]);
 87 |     }
 88 |     return vec;
 89 |   }
 90 | };
 91 | 
 92 | template <typename T> struct from_object<const vector<T> &> {
 93 |   typedef vector<T> DeclareType;
 94 |   DeclareType _v;
 95 |   from_object(core::T_sp obj) {
 96 |     if (obj.nilp()) {
 97 |       this->_v.clear();
 98 |     } else if (core::List_sp list = obj.asOrNull<core::List_V>()) {
 99 |       // Translate a CONS list of doubles into a vector<T>
100 |       this->_v.resize(core::cl__length(list));
101 |       size_t idx = 0;
102 |       for (auto c : list) {
103 |         if (oCar(c).notnilp()) {
104 |           this->_v[idx++] = from_object<T>(oCar(c))._v;
105 |         }
106 |       }
107 |     } else if (core::SimpleVector_sp vec = gc::As<core::SimpleVector_sp>(obj)) {
108 |       // Translate a VECTOR of doubles into a vector<T>
109 |       this->_v.resize(core::cl__length(vec));
110 |       for (size_t idx(0); idx < vec->length(); ++idx) {
111 |         this->_v[idx] = from_object<T>(vec->rowMajorAref(idx))._v;
112 |       }
113 |     } else {
114 |       SIMPLE_ERROR("Could not convert %s to vector<%s>", core::_rep_(obj), typeid(T).name());
115 |     }
116 |   }
117 | };
118 | }; // namespace translate
119 | 
120 | PACKAGE_USE("COMMON-LISP");
121 | PACKAGE_NICKNAME("DV");
122 | NAMESPACE_PACKAGE_ASSOCIATION(dv, DVPkg, "DOUBLE-VECTOR");
123 | 
124 | namespace dv {
125 | CL_EXPOSE
126 | void double_vector_startup() {
127 |   using namespace clbind;
128 |   package_ pkg(DVPkg);
129 |   scope_ &s = pkg.scope();
130 | 
131 |   class_<DoubleVector>(s, "double-vector")
132 |       .def_constructor("make-double-vector", constructor<int>(), "", "", "Create a DOUBLE-VECTOR of a specific size.")
133 |       .def("add", &DoubleVector::add, "Add two vectors together."_docstring)
134 |       .def("dot", &DoubleVector::dot, "Computer the dot product of two vectors."_docstring)
135 |       .def("setf_vref", &DoubleVector::setf_vref, noAutoExport(), "Set a specific component of a vector."_docstring)
136 |       .def("vref", &DoubleVector::vref, "Return a specific component of a vector."_docstring)
137 |       .def("dimension", &DoubleVector::dimension, "Return the dimension of a vector."_docstring);
138 | 
139 |   pkg.def(
140 |       "double-vector",
141 |       +[](core::Vaslist_sp args) {
142 |         DoubleVector res = DoubleVector(args->nargs());
143 |         for (size_t i = 0; args->nargs() > 0; i++) {
144 |           res[i] = core::clasp_to_float(args->next_arg());
145 |         }
146 |         return res;
147 |       },
148 |       "(core:&va-rest args)"_ll, "Create a double vector with specific components."_docstring);
149 | }
150 | }; // namespace dv
151 | 


--------------------------------------------------------------------------------
/double-vector/double-vector.lisp:
--------------------------------------------------------------------------------
 1 | (in-package #:double-vector)
 2 | 
 3 | (defmethod print-object ((object double-vector) stream)
 4 |   (print-unreadable-object (object stream :type t)
 5 |     (loop for i below (dimension object)
 6 |           unless (zerop i)
 7 |             do (write-char #\Space stream)
 8 |           do (write (vref object i) :stream stream)))
 9 |   object)
10 | 
11 | (defun (setf vref) (new-value object index)
12 |   (setf-vref object new-value index))
13 | 
14 | (defun demo ()
15 |   (let ((a (double-vector 1 2 3))
16 |         (b (double-vector 4 5 6)))
17 |     (format t "Dot product of ~s . ~s = ~a~%" a b (dot a b))
18 |     (format t "Vector sum of ~s + ~s = ~a~%" a b (add a b))))
19 | 
20 | (export 'demo)
21 | 


--------------------------------------------------------------------------------
/hello-world/cscript.lisp:
--------------------------------------------------------------------------------
1 | (k:sources :iclasp #~"hello-world.cc")
2 | 
3 | (k:systems :hello-world)
4 | 


--------------------------------------------------------------------------------
/hello-world/hello-world.asd:
--------------------------------------------------------------------------------
1 | (asdf:defsystem #:hello-world
2 |   :description "Hello World"
3 |   :version "0.0.1"
4 |   :author "Christian Schafmeister <chris.schaf@verizon.net>"
5 |   :licence "LGPL-3.0"
6 |   :depends-on ()
7 |   :serial t
8 |   :components ((:file "hello-world")))
9 | 


--------------------------------------------------------------------------------
/hello-world/hello-world.cc:
--------------------------------------------------------------------------------
 1 | //
 2 | // Set up a clasp.h include file with all the good stuff
 3 | //
 4 | #include <stdio.h>
 5 | #include <clasp/clasp.h>
 6 | 
 7 | void helloWorld() { printf("Hello World\nThis is C++ code being invoked from Clasp Common Lisp\n"); }
 8 | 
 9 | double addThreeNumbers(double x, double y, double z) { return x + y + z; }
10 | 
11 | float addThreeSingleFloats(float x, float y, float z) { return x + y + z; }
12 | 
13 | double addThreeNumbers_n_times(size_t n, double x, double y, double z) {
14 |   double result = 0.0;
15 |   for (size_t i(0); i < n; ++i) {
16 |     result += x + y + z;
17 |   }
18 |   return result;
19 | }
20 | 
21 | enum ColorEnum { red, green, blue };
22 | 
23 | void printColor(ColorEnum color) {
24 |   switch (color) {
25 |   case red:
26 |     printf("red\n");
27 |     break;
28 |   case green:
29 |     printf("green\n");
30 |     break;
31 |   case blue:
32 |     printf("blue\n");
33 |     break;
34 |   }
35 | }
36 | 
37 | // ------------------------------------------------------------
38 | //
39 | // Set this code up so that it can be loaded into Clasp
40 | //
41 | 
42 | PACKAGE_USE("COMMON-LISP");
43 | PACKAGE_NICKNAME("HW");
44 | NAMESPACE_PACKAGE_ASSOCIATION(hw, HWPkg, "HELLO-WORLD");
45 | 
46 | SYMBOL_EXPORT_SC_(HWPkg, STARcolorTranslatorSTAR);
47 | CLBIND_TRANSLATE_SYMBOL_TO_ENUM(ColorEnum, hw::_sym_STARcolorTranslatorSTAR);
48 | 
49 | namespace hw {
50 | CL_EXPOSE
51 | void hello_world_startup() {
52 |   printf("Entered %s:%d:%s\n", __FILE__, __LINE__, __FUNCTION__);
53 |   using namespace clbind;
54 |   package_ s(HWPkg);
55 |   // scope_ &s = pkg.scope();
56 |   s.def("hello-world-from-c++", &helloWorld, "The classic! Print \"Hello World\""_docstring);
57 |   s.def("addThreeNumbers", &addThreeNumbers, "(x cl:&optional (y 0.0) (z 0.0))"_ll,
58 |         "Add three numbers and return the result"_docstring);
59 |   s.def("addThreeSingleFloats", &addThreeSingleFloats, "Add three single precision floating point numbers"_docstring);
60 |   s.def("addThreeNumbers_n_times", &addThreeNumbers_n_times, "Add three numbers n number of times"_docstring);
61 |   enum_<ColorEnum>(s, hw::_sym_STARcolorTranslatorSTAR).value("red", red).value("green", green).value("blue", blue);
62 |   s.def("printColor", &printColor, "Print the color to stdout"_docstring);
63 | }
64 | 
65 | }; // namespace hw
66 | 


--------------------------------------------------------------------------------
/hello-world/hello-world.lisp:
--------------------------------------------------------------------------------
 1 | (in-package :hello-world)
 2 | 
 3 | (defun hello-world-from-lisp ()
 4 |   (format t "Hello World~%This is Lisp code being invoked from Clasp Common Lisp~%"))
 5 | 
 6 | (defun demo ()
 7 |   (hello-world-from-c++)
 8 |   (hello-world-from-lisp)
 9 |   (format t "The result of (hw:add-three-numbers 1 2.0 3) --> ~a~%" (add-three-numbers 1 2.0 3)))
10 | 
11 | (export '(hello-world-from-lisp demo))
12 | 


--------------------------------------------------------------------------------