native: Add for ABCL, CCL, Clasp, CMUCL, ECL, and SBCL

code/benchmark/float-decimal.lisp

@@ -3,7 +3,9 @@
 (defvar *clients*
   '((:label "Burger-Dybvig 1" :initargs (quaviver/burger-dybvig:client-1))
     (:label "Burger-Dybvig 2" :initargs (quaviver/burger-dybvig:client-2))
-    (:label "Schubfach"       :initargs (quaviver/schubfach:client))))
+    (:label "Schubfach"       :initargs (quaviver/schubfach:client))
+    #+(or abcl ccl clasp cmucl ecl sbcl)
+    (:label "Native"          :initargs (quaviver/native:client))))
 
 (defun float-decimal ()
   (labels ((bench (clients limit key)

code/native/implementation.lisp

@@ -0,0 +1,29 @@
+(in-package #:quaviver/native)
+
+(defclass client () ())
+
+#+(or abcl ccl clasp cmucl ecl sbcl)
+(defmethod quaviver:float-decimal ((client client) value)
+  #+abcl
+  (multiple-value-bind (digits digits-length leading-point
+                        trailing-point position)
+      (system::flonum-to-string (abs value))
+    (declare (ignore leading-point trailing-point))
+    (values (remove nil (map 'vector #'digit-char-p digits))
+            (- position digits-length -1)
+            (floor (float-sign value))))
+  #+ccl
+  (multiple-value-bind (digits sign exponent)
+      (ccl::flonum-to-string value)
+    (values (map 'vector #'digit-char-p digits)
+            exponent
+            sign))
+  #+(or clasp cmucl ecl sbcl)
+  (multiple-value-bind (position digits)
+      #+clasp (core::float-to-digits nil value nil nil)
+      #+cmucl (lisp::flonum-to-digits value)
+      #+ecl   (si::float-to-digits nil value nil nil)
+      #+sbcl  (sb-impl::flonum-to-digits value)
+    (values (map 'vector #'digit-char-p digits)
+            (- position (length digits))
+            (floor (float-sign value)))))

code/native/packages.lisp

@@ -0,0 +1,3 @@
+(cl:defpackage #:quaviver/native
+  (:use #:common-lisp)
+  (:export #:client))

quaviver.asd

@@ -47,6 +47,21 @@
                 :components ((:file "packages")
                              (:file "implementation")))))
 
+(defsystem "quaviver/native"
+  :description "Current implementation's native algorithms"
+  :license "MIT"
+  :author ("Tarn W. Burton")
+  :version (:read-file-form "version.sexp")
+  :homepage "https://github.com/s-expressionists/Quaviver"
+  :bug-tracker "https://github.com/s-expressionists/Quaviver/issues"
+  :source-control (:git "https://github.com/s-expressionists/Quaviver.git")
+  :depends-on ("quaviver")
+  :components ((:module "code"
+                :pathname "code/native/"
+                :serial t
+                :components ((:file "packages")
+                             (:file "implementation")))))
+
 (defsystem "quaviver/burger-dybvig"
   :description "Burger Dybvig algorithm for Quaviver"
   :license "MIT"
@@ -132,6 +147,7 @@
                "cl-spark"
                "cl-ascii-table"
                "quaviver/burger-dybvig"
+               "quaviver/native"
                "quaviver/schubfach")
   :components ((:module "code"
                 :pathname "code/benchmark/"