UNFINISHED syntax-extension: Rational float Literal

fixes #54

code/reader/tokens.lisp

@@ -47,7 +47,7 @@
       (:ratio-marker            #b01000000)
       ((:short-float-exponent-marker :single-float-exponent-marker
         :double-float-exponent-marker :long-float-exponent-marker
-        :float-exponent-marker)
+        :float-exponent-marker :custom-float-exponent-marker)
        #b10000000)))
 
   (declaim (type (simple-array (unsigned-byte 8) 1) +constituent-traits+))
@@ -77,7 +77,7 @@
                   (#\>         . :alphabetic) ("Oo"         . :alphadigit)
                   (#\?         . :alphabetic) ("Pp"         . :alphadigit)
                   (#\@         . :alphabetic) ("Qq"         . :alphadigit)
-                  (#\[         . :alphabetic) ("Rr"         . :alphadigit)
+                  (#\[         . :alphabetic) ("Rr"         . (:alphadigit :custom-float-exponent-marker))
                   (#\\         . :alphabetic) ("Ss"         . (:alphadigit :short-float-exponent-marker))
                   (#\]         . :alphabetic) ("Tt"         . :alphadigit)
                   (#\^         . :alphabetic) ("Uu"         . :alphadigit)
@@ -128,13 +128,14 @@
          ;; *READ-DEFAULT-FLOAT-FORMAT* may be some other type
          ;; specifier which the implementation chooses to allow.
          (t
-          (if (subtypep default-format 'float)
+          (if (subtypep default-format 'float) ; TODO maybe use (valid-state-value-p client '*read-default-float-format* default-format)? or is the protocol specified such that values returned by (state-value client '*read-default-float-format*) are by definition valid?
               default-format
               (values nil default-format))))))
     ((#\f #\F) 'single-float)
     ((#\s #\S) 'short-float)
     ((#\d #\D) 'double-float)
-    ((#\l #\L) 'long-float)))
+    ((#\l #\L) 'long-float)
+    ((#\r #\R) :custom)))
 
 (defmacro with-accumulators ((&rest specs) &body body)
   (loop for (name base) in specs
@@ -217,14 +218,14 @@
                         :report 'use-replacement-float-format))
                      (setf type 'single-float))
                    (if exponentp
-                       (make-literal client *float-kind*
+                       (make-literal client float-kind
                                      :type type
                                      :sign sign
                                      :decimal-mantissa (decimal-mantissa)
                                      :exponent-sign exponent-sign
                                      :exponent (exponent)
                                      :decimal-exponent decimal-exponent)
-                       (make-literal client *float-kind*
+                       (make-literal client float-kind
                                      :type type
                                      :sign sign
                                      :decimal-mantissa (decimal-mantissa)

code/syntax-extensions/README.md

@@ -3,7 +3,7 @@
 This directory contains source files each of which implements a syntax
 extension.
 
-## Extended package prefix
+## Extended Package Prefix Syntax
 
 Based on an
 [SBCL extension](https://sbcl.org/manual/index.html#Extended-Package-Prefix-Syntax),
@@ -31,7 +31,7 @@ bar"))
 ; => cl-user::bar
 ```
 
-## S-expression comments
+## S-expression Comments
 
 A reader macro, `s-expression-comment`, that is loosely based on
 [SRFI 62: S-expression comments](https://srfi.schemers.org/srfi-62/srfi-62.html).
@@ -47,3 +47,10 @@ for commenting out multiple arguments or keyword arguments:
 While this syntax extension could be implemented as a portable
 library, this particular implementation uses Eclector protocols in
 order to produce better error messages and parse results.
+
+## Decimal Syntax for Rationals
+
+Based on an
+[SBCL extension](https://sbcl.org/manual/index.html#Decimal-Syntax-for-Rationals),
+the syntax `12.34R56` can be used to denote a rational number.
+TODO what about `*read-default-float-format*`?

code/syntax-extensions/rational-float.lisp

@@ -0,0 +1,36 @@
+(cl:defpackage #:eclector.syntax-extensions.rational-float
+  (:use
+   #:cl)
+
+  (:export
+   ))
+
+(cl:in-package #:eclector.syntax-extensions.rational-float)
+
+(defclass client ()
+  ())
+
+#+TODO (defmethod eclector.reader::reader-float-format (client &optional exponent-marker)
+  (if (eql exponent-marker #\R)
+      'rational
+      (call-next-method)))
+
+(defmethod eclector.reader:make-literal ((client client)
+                                         (class  eclector.reader::float-kind)
+                                         &key type sign decimal-mantissa decimal-exponent
+                                              exponent-sign exponent)
+  (case type
+    (:custom (* (* sign decimal-mantissa)
+                (expt 10 (- (* exponent-sign exponent) decimal-exponent))))
+    (t       (call-next-method))))
+
+; eclector.reader::trait->index
+
+(let ((eclector.base:*client* (make-instance 'client)))
+  (eclector.reader:read-from-string "1.234R2"))
+(let ((eclector.base:*client* (make-instance 'client)))
+  (eclector.reader:call-with-state-value
+   eclector.base:*client*
+   (eclector.reader:read-from-string "1R")
+   '*read-default-float-format* :custom))
+;;; 1.234R2 => 617/5 (= 123.4)

eclector.syntax-extensions.asd

@@ -9,7 +9,8 @@
   :components  ((:module "syntax-extensions"
                  :pathname "code/syntax-extensions"
                  :components ((:file "extended-package-prefix")
-                              (:file "s-expression-comment"))))
+                              (:file "s-expression-comment")
+                              (:file "rational-float"))))
 
   :in-order-to ((test-op (test-op "eclector.syntax-extensions/test"))))
 
@@ -23,7 +24,8 @@
                  :serial t
                  :components ((:file "package")
                               (:file "extended-package-prefix")
-                              (:file "s-expression-comment"))))
+                              (:file "s-expression-comment")
+                              (:file "rational-float"))))
 
   :perform     (test-op (operation component)
                  (uiop:symbol-call '#:eclector.syntax-extensions.test '#:run-tests)))

test/syntax-extensions/rational-float.lisp

@@ -0,0 +1,13 @@
+(cl:defpackage #:eclector.syntax-extensions.rational-float.test
+  (:use
+   #:cl
+   #:fiveam))
+
+(cl:in-package #:eclector.syntax-extensions.rational-float.test)
+
+(def-suite* :eclector.syntax-extensions.rational-float
+  :in :eclector.syntax-extensions)
+
+(test smoke
+  "TODO"
+  (error "TODO"))