Support standard library (scheme complex)

Signed-off-by: yamacir-kit <[email protected]>

README.md

@@ -105,9 +105,9 @@ sudo rm -rf /usr/local/share/meevax
 
 | Target Name        | Description
 |:-------------------|:--
-| `all` (default)    | Build shared-library `libmeevax.0.4.229.so` and executable `meevax`.
+| `all` (default)    | Build shared-library `libmeevax.0.4.230.so` and executable `meevax`.
 | `test`             | Test executable `meevax`.
-| `package`          | Generate debian package `meevax_0.4.229_amd64.deb`.
+| `package`          | Generate debian package `meevax_0.4.230_amd64.deb`.
 | `install`          | Copy files into `/usr/local` __(1)__.
 | `install.deb`      | `all` + `package` + `sudo apt install <meevax>.deb`
 | `safe-install.deb` | `all` + `test` + `package` + `sudo apt install <meevax>.deb`
@@ -122,7 +122,7 @@ __(1)__ Meevax installed by `make install` cannot be uninstalled by the system's
 ## Usage
 
 ```
-Meevax Lisp System, version 0.4.229
+Meevax Lisp System, version 0.4.230
 
 Usage: meevax [OPTION...] [FILE...]
 

VERSION

@@ -1 +1 @@
-0.4.229
+0.4.230

basis/r7rs.ss

@@ -436,13 +436,25 @@
   (export finite? infinite? nan? exp log sin cos tan asin acos atan sqrt))
 
 (define-library (scheme complex)
-  (export make-rectangular
-          make-polar
-          real-part
-          imag-part
-          angle
-          )
-  )
+  (import (meevax complex)
+          (scheme base)
+          (scheme inexact))
+
+  (export make-rectangular make-polar real-part imag-part magnitude angle)
+
+  (begin (define (make-polar magnitude angle)
+           (make-rectangular (* magnitude (cos angle))
+                             (* magnitude (sin angle))))
+
+         (define (magnitude z)
+           (let ((re (real-part z))
+                 (im (imag-part z)))
+             (sqrt (+ (* re re)
+                      (* im im)))))
+
+         (define (angle z)
+           (atan (imag-part z)
+                 (real-part z)))))
 
 (define-library (scheme cxr)
   (import (meevax pair))

include/meevax/kernel/number.hpp

@@ -436,20 +436,20 @@ inline namespace kernel
     return apply.at(type_index<2>(x.type(), y.type()))(x, y);
   }
 
-  template <typename T>
-  auto inexact_cast(T&& x) -> decltype(auto)
+  template <typename T = double, typename U, REQUIRES(std::is_floating_point<T>)>
+  auto inexact_cast(U&& x) -> decltype(auto)
   {
     if constexpr (std::is_same_v<std::decay_t<decltype(x)>, complex>)
     {
-      return std::complex<double>(std::forward<decltype(x)>(x));
+      return std::complex<T>(std::forward<decltype(x)>(x));
     }
     else if constexpr (std::is_floating_point_v<std::decay_t<decltype(x)>>)
     {
       return std::forward<decltype(x)>(x);
     }
     else
     {
-      return static_cast<double>(std::forward<decltype(x)>(x));
+      return static_cast<T>(std::forward<decltype(x)>(x));
     }
   }
 

src/kernel/library.cpp

@@ -59,6 +59,31 @@ inline namespace kernel
       library.export_("char-codepoint");
     });
 
+    define_library("(meevax complex)", [](library & library)
+    {
+      library.define<procedure>("make-rectangular", [](let const& xs)
+      {
+        assert(apply<is_real>(car(xs)));
+        assert(apply<is_real>(cadr(xs)));
+
+        return make<complex>(car(xs), cadr(xs));
+      });
+
+      library.define<procedure>("real-part", [](let const& xs)
+      {
+        return car(xs).as<complex>().real();
+      });
+
+      library.define<procedure>("imag-part", [](let const& xs)
+      {
+        return car(xs).as<complex>().imag();
+      });
+
+      library.export_("make-rectangular");
+      library.export_("real-part");
+      library.export_("imag-part");
+    });
+
     define_library("(meevax context)", [](library & library)
     {
       library.define<procedure>("emergency-exit", [](let const& xs)

src/main.cpp

@@ -35,6 +35,7 @@ auto main(int const argc, char const* const* const argv) -> int
       main.display_version();
       main.import_("(scheme base)");
       main.import_("(scheme char)");
+      main.import_("(scheme complex)");
       main.import_("(scheme cxr)");
       main.import_("(scheme eval)");
       main.import_("(scheme inexact)");