Add parsing and writing

.github/workflows/test.yml

@@ -37,19 +37,19 @@ jobs:
       with:
         repository: s-expressionists/Incless
         path: incless
-        ref: quaviver
+        ref: quaviver3
     - name: Checkout Inravina
       uses: actions/checkout@v4
       with:
         repository: s-expressionists/Inravina
         path: inravina
-        ref: quaviver
+        ref: quaviver3
     - name: Checkout Invistra
       uses: actions/checkout@v4
       with:
         repository: s-expressionists/Invistra
         path: invistra
-        ref: quaviver
+        ref: quaviver3
     - name: Checkout Repository
       uses: actions/checkout@v4
       with:
@@ -58,6 +58,9 @@ jobs:
       run: |
         make-rc
         asdf-add
+    - name: Run Unit Tests
+      run: |
+        lisp -i ${{ matrix.lisp }} -e "(defparameter cl-user::*exit-on-test-failures* t)" -e "(ql:quickload :quaviver/unit-test)" -e "(parachute:test :quaviver/unit-test)"
     - name: Run ANSI Tests
       run: |
         lisp -i ${{ matrix.lisp }} -e "(ql:quickload :quaviver/ansi-test)" -e "(quaviver/ansi-test:test :exit t)"

code/bits-float-form.lisp

@@ -25,6 +25,10 @@
                                                            (storage-size 'short-float))))
      (coerce (ffi:slot (ffi:foreign-value u) 'value) 'short-float)))
 
+#-quaviver/short-float
+(defmethod bits-float-form ((float-type (eql 'short-float)) value)
+  (bits-float-form 'single-float value))
+
 (defmethod bits-float-form ((float-type (eql 'single-float)) value)
   #+abcl
   `(system:make-single-float ,value)
@@ -137,3 +141,7 @@
                  (ffi:get-slot-value ,m 'long-float/uint128 'u)
                  ,n))
          (ffi:get-slot-value ,m 'long-float/uint128 'f)))))
+
+#-quaviver/long-float
+(defmethod bits-float-form ((float-type (eql 'long-float)) value)
+  (bits-float-form 'double-float value))

code/bits-float.lisp

@@ -7,6 +7,10 @@
 (defmethod bits-float ((float-type (eql 'short-float)) value)
   (%bits-float short-float value))
 
+#-quaviver/short-float
+(defmethod bits-float ((float-type (eql 'short-float)) value)
+  (%bits-float single-float value))
+
 (defmethod bits-float ((float-type (eql 'single-float)) value)
   (%bits-float single-float value))
 
@@ -16,3 +20,7 @@
 #+quaviver/long-float
 (defmethod bits-float ((float-type (eql 'long-float)) value)
   (%bits-float long-float value))
+
+#-quaviver/long-float
+(defmethod bits-float ((float-type (eql 'long-float)) value)
+  (%bits-float double-float value))

code/blub/implementation.lisp

@@ -0,0 +1,54 @@
+(in-package #:quaviver/blub)
+
+(defclass client () ())
+
+(quaviver:define-number-parser
+    (:client client :ratio nil :base 10)
+    ()
+  (:alternate? #\+
+               (:sequence? #\-
+                           (:set :sign -1)))
+  (:alternate (:sequence #\.
+                         (:set :integer nil)
+                         (:digits :fractional))
+              (:sequence (:digits :integral)
+                         (:sequence? #\.
+                                     (:sequence? (:assert :float t)
+                                                 (:digits :fractional)
+                                                 (:set :integer nil)))))
+  (:sequence? (:assert :float t)
+              #\e
+              (:set :integer nil)
+              (:alternate? #\+
+                           (:sequence? #\-
+                                       (:set :exponent-sign -1)))
+              (:digits :exponent)))
+
+(defmethod quaviver:write-number ((client client) (base (eql 10)) (value integer) stream)
+  (when (minusp value)
+    (write-char #\- stream))
+  (quaviver:write-digits base (abs value) stream)
+  value)
+
+(defmethod quaviver:write-number ((client client) (base (eql 10)) (value float) stream)
+  (multiple-value-bind (significand exponent sign)
+      (quaviver:float-integer client base value)
+    (when (keywordp exponent)
+      (error "Unable to represent ~a in ~a." exponent (client-standard client)))
+    (when (minusp sign)
+      (write-char #\- stream))
+    (let ((len (quaviver.math:ceiling-log-expt 10 2 (integer-length significand))))
+      (cond ((<= (- len) exponent -1)
+             (when (eql (- len) exponent)
+               (write-char #\0 stream))
+             (quaviver:write-digits base significand stream
+                                    :fractional-position (+ len exponent)
+                                    :fractional-marker #\.))
+            (t
+             (quaviver:write-digits base significand stream)
+             (unless (zerop exponent)
+               (write-char #\e stream)
+               (when (minusp exponent)
+                 (write-char #\- stream))
+               (quaviver:write-digits base (abs exponent) stream))))))
+  value)

code/blub/packages.lisp

@@ -0,0 +1,5 @@
+(in-package #:common-lisp-user)
+
+(defpackage #:quaviver/blub
+  (:use #:common-lisp)
+  (:export #:client))

code/c/implementation.lisp

@@ -0,0 +1,256 @@
+(in-package #:quaviver/c)
+
+(deftype c-c++-standard ()
+  '(member :c89 :c99 :c11 :c17 :c23
+           :c++98 :c++03 :c++11 :c++14 :c++17 :c++20 :c++23 :c++26))
+
+(defclass client ()
+  ((%standard :accessor client-standard
+              :initarg :standard
+              :initform :c++23
+              :type c-c++-standard)
+   (%binary-grouping :accessor binary-grouping
+                     :initarg :binary-grouping
+                     :initform #(4))
+   (%octal-grouping :accessor octal-grouping
+                    :initarg :octal-grouping
+                    :initform #(4))
+   (%hexadecimal-grouping :accessor hexadecimal-grouping
+                          :initarg :hexadecimal-grouping
+                          :initform #(4))
+   (%decimal-grouping :accessor decimal-grouping
+                      :initarg :decimal-grouping
+                      :initform #(-3 3))
+   (%exponent-grouping :accessor exponent-grouping
+                       :initarg :exponent-grouping
+                       :initform #(3))))
+
+(defun digit-grouping-p (client)
+  (and (member (client-standard client) '(:c23 :c++14 :c++17 :c++20 :c++23 :c++26))
+       t))
+
+(defun digit-separators (client)
+  (if (digit-grouping-p client)
+      "'"
+      ""))
+
+(defun group-marker (client)
+  (when (digit-grouping-p client)
+    #\'))
+
+(defun binary-integer-literals-p (client)
+  (and (member (client-standard client) '(:c23 :c++14 :c++17 :c++20 :c++23 :c++26))
+       t))
+
+(defun hexadecimal-float-literals-p (client)
+  (and (member (client-standard client) '(:c++17 :c++20 :c++23 :c++26))
+       t))
+
+(defun long-long-suffix-p (client)
+  (and (member (client-standard client) '(:c++11 :c++17 :c++20 :c++23 :c++26))
+       t))
+
+(defun size-suffix-p (client)
+  (and (member (client-standard client) '(:c++23 :c++26))
+       t))
+
+(defun float-size-suffix-p (client)
+  (and (member (client-standard client) '(:c++23 :c++26))
+       t))
+
+(quaviver:define-number-parser
+    (:client client :ratio nil :float-type 'double-float)
+    ()
+  (:alternate? #\+
+               (:sequence #\-
+                          (:set :sign -1)))
+  (:alternate (:sequence #\0
+                         (:alternate (:sequence (:assert 'binary-integer-literals-p)
+                                                (:assert :integer t)
+                                                #\b
+                                                (:set :integral-base 2
+                                                      :float nil)
+                                                (:digits :integral
+                                                         :ignore 'digit-separators))
+                                     (:sequence #\x
+                                                (:set :integral-base 16
+                                                      :fractional-base 16
+                                                      :exponent-base 10
+                                                      :base 2)
+                                                (:digits :integral
+                                                         :ignore 'digit-separators)
+                                                (:sequence? (:assert 'hexadecimal-float-literals-p)
+                                                            (:assert :float t)
+                                                            #\.
+                                                            (:set :integer nil)
+                                                            (:digits? :fractional
+                                                             :ignore 'digit-separators))
+                                                (:sequence? (:assert 'hexadecimal-float-literals-p)
+                                                            (:assert :float t)
+                                                            #\p
+                                                            (:set :integer nil)
+                                                            (:alternate? #\+
+                                                                         (:sequence #\-
+                                                                                    (:set :exponent-sign -1)))
+                                                            (:digits :exponent
+                                                                     :ignore 'digit-separators)))
+                                     (:sequence (:assert :integer t)
+                                                (:set :integral-base 8
+                                                      :float nil)
+                                                (:digits :integral
+                                                         :ignore 'digit-separators))))
+              (:sequence (:digits :integral
+                                  :leading-zeros nil
+                                  :ignore 'digit-separators)
+                         (:sequence? (:assert :float t)
+                                     #\.
+                                     (:set :integer nil)
+                                     (:digits? :fractional
+                                               :ignore 'digit-separators))
+                         (:sequence? (:assert :float t)
+                                     #\e
+                                     (:set :integer nil)
+                                     (:alternate? #\+
+                                                  (:sequence #\-
+                                                             (:set :exponent-sign -1)))
+                                     (:digits :exponent
+                                              :ignore 'digit-separators))
+                         (:sequence? (:assert :integer t)
+                                     (:set :float nil))))
+  (:alternate? (:sequence (:assert :float t)
+                          #\f
+                          (:set :float-type 'single-float)
+                          (:sequence? (:assert 'float-size-suffix-p)
+                                      (:alternate? (:sequence #\1
+                                                              (:alternate (:sequence #\6
+                                                                                     #+quaviver/short-float
+                                                                                     (:set :float-type 'short-float))
+                                                                          (:sequence "28"
+                                                                                     (:set :float-type
+                                                                                           #+quaviver/long-float
+                                                                                           'long-float
+                                                                                           #-quaviver/long-float
+                                                                                           'double-float))))
+                                                   (:sequence "32")
+                                                   (:sequence "64"
+                                                              (:set :float-type 'double-float)))))
+               (:sequence (:assert :float t)
+                          #\l
+                          #+quaviver/long-float
+                          (:set :float-type 'long-float))
+               (:sequence (:assert 'float-size-suffix-p)
+                          (:assert :float t)
+                          "bf16"
+                          (:set :float-type
+                                #+quaviver/short-float 'short-float
+                                #-quaviver/short-float 'single-float))
+               (:sequence (:assert :integer t)
+                          #\l
+                          (:sequence? (:assert 'long-long-suffix-p)
+                                      #\l)
+                          (:sequence? #\u))
+               (:sequence (:assert 'size-suffix-p)
+                          (:assert :integer t)
+                          #\z
+                          (:sequence? #\u))
+               (:sequence (:assert :integer t)
+                          #\u
+                          (:alternate? (:sequence #\l
+                                                  (:sequence? (:assert 'long-long-suffix-p)
+                                                              #\l))
+                                       (:sequence (:assert 'size-suffix-p)
+                                                  #\z)))))
+
+(defmethod quaviver:write-number ((client client) (base (eql 2)) (value integer) stream)
+  (unless (binary-integer-literals-p client)
+    (error "Cannot print base 2 integers in the ~a standard." (client-standard client)))
+  (when (minusp value)
+    (write-char #\- stream))
+  (write-string "0b" stream)
+  (quaviver:write-digits base (abs value) stream
+                         :digit-grouping (binary-grouping client)
+                         :group-marker (group-marker client))
+  value)
+
+(defmethod quaviver:write-number ((client client) (base (eql 8)) (value integer) stream)
+  (when (minusp value)
+    (write-char #\- stream))
+  (write-char #\0 stream)
+  (quaviver:write-digits base (abs value) stream
+                         :digit-grouping (octal-grouping client)
+                         :group-marker (group-marker client))
+  value)
+
+(defmethod quaviver:write-number ((client client) (base (eql 10)) (value integer) stream)
+  (when (minusp value)
+    (write-char #\- stream))
+  (quaviver:write-digits base (abs value) stream
+                         :digit-grouping (decimal-grouping client)
+                         :group-marker (group-marker client))
+  value)
+
+(defmethod quaviver:write-number ((client client) (base (eql 16)) (value integer) stream)
+  (when (minusp value)
+    (write-char #\- stream))
+  (write-string "0x" stream)
+  (quaviver:write-digits base (abs value) stream
+                         :digit-grouping (hexadecimal-grouping client)
+                         :group-marker (group-marker client))
+  value)
+
+(defun write-float-suffix (client value stream)
+  (declare (ignore client))
+  (typecase value
+    (single-float
+     (write-char #\f stream))
+    (long-float
+     (write-char #\l stream))))
+
+(defmethod quaviver:write-number ((client client) (base (eql 10)) (value float) stream)
+  (multiple-value-bind (significand exponent sign)
+      (quaviver:float-integer client base value)
+    (when (keywordp exponent)
+      (error "Unable to represent ~a in ~a." exponent (client-standard client)))
+    (when (minusp sign)
+      (write-char #\- stream))
+    (let ((len (quaviver.math:ceiling-log-expt 10 2 (integer-length significand))))
+      (cond ((<= (- len) exponent -1)
+             (quaviver:write-digits base significand stream
+                                    :fractional-position (+ len exponent)
+                                    :fractional-marker #\.
+                                    :digit-grouping (decimal-grouping client)
+                                    :group-marker (group-marker client)))
+            (t
+             (quaviver:write-digits base significand stream
+                                    :digit-grouping (decimal-grouping client)
+                                    :group-marker (group-marker client))
+             (unless (zerop exponent)
+               (write-char #\e stream)
+               (when (minusp exponent)
+                 (write-char #\- stream))
+               (quaviver:write-digits base (abs exponent) stream
+                                      :digit-grouping (exponent-grouping client)
+                                      :group-marker (group-marker client))))))
+    (write-float-suffix client value stream))
+  value)
+
+(defmethod quaviver:write-number ((client client) (base (eql 16)) (value float) stream)
+  (multiple-value-bind (significand exponent sign)
+      (quaviver:float-integer client 2 value)
+    (when (keywordp exponent)
+      (error "Unable to represent ~a in ~a." exponent (client-standard client)))
+    (when (minusp sign)
+      (write-char #\- stream))
+    (write-string "0x" stream)
+    (quaviver:write-digits 16 significand stream
+                           :digit-grouping (hexadecimal-grouping client)
+                           :group-marker (group-marker client))
+    (unless (zerop exponent)
+      (write-char #\p stream)
+      (when (minusp exponent)
+        (write-char #\- stream))
+      (quaviver:write-digits 10 (abs exponent) stream
+                             :digit-grouping (exponent-grouping client)
+                             :group-marker (group-marker client)))
+    (write-float-suffix client value stream))
+  value)

code/c/packages.lisp

@@ -0,0 +1,5 @@
+(in-package #:common-lisp-user)
+
+(defpackage #:quaviver/c
+  (:use #:common-lisp)
+  (:export #:client))