!267 definition and %get for rich-float

LiiiLabs · Mar 2, 2025 · 9b4500a · 9b4500a
1 parent 700fe03
commit 9b4500a
Show file tree

Hide file tree

Showing 3 changed files with 47 additions and 4 deletions.
diff --git a/GoldfishLang.tmu b/GoldfishLang.tmu
@@ -102,7 +102,7 @@
 
     \ \ option none
 
-    \ \ rich-integer rich-char rich-string
+    \ \ rich-integer rich-float rich-char rich-string
 
     \ \ rich-list range stack
 
@@ -1112,6 +1112,8 @@
 
     \ \ (cond ((integer? x) (rich-integer x))
 
+    \ \ \ \ \ \ \ \ ((float? x) (rich-float x))
+
     \ \ \ \ \ \ \ \ ((char? x) (rich-char (char-\<gtr\>integer x)))
 
     \ \ \ \ \ \ \ \ ((string? x) (rich-string x))
@@ -1122,7 +1124,7 @@
 
     \ \ \ \ \ \ \ \ ((hash-table? x) (rich-hash-table x))
 
-    \ \ \ \ \ \ \ \ (else (type-error "box: x must be integer?, char?, string?, list?, vector?, hash-table?"))))
+    \ \ \ \ \ \ \ \ (else (type-error "box: x must be integer?, float?, char?, string?, list?, vector?, hash-table?"))))
 
     \;
   </goldfish-chunk>
@@ -1375,6 +1377,38 @@
     \;
   </goldfish-chunk>
 
+  \;
+
+  <section|rich-float>
+
+  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
+    (define-case-class rich-float ((data float?))
+
+    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
+  </goldfish-chunk>
+
+  <subsection|选择器>
+
+  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
+    (define (%get) data)
+
+    \;
+  </goldfish-chunk>
+
+  <\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
+    (check ($ 12.2 :get) =\<gtr\> 12.2)
+
+    \;
+  </goldfish-chunk>
+
+  <subsection|结尾>
+
+  <\goldfish-chunk|goldfish/liii/lang.scm|true|true>
+    )
+
+    \;
+  </goldfish-chunk>
+
   <section|rich-char>
 
   <\goldfish-chunk|goldfish/liii/lang.scm|true|true>

diff --git a/goldfish/liii/lang.scm b/goldfish/liii/lang.scm
@@ -21,7 +21,7 @@
   @
   define-case-class case-class? == != chained-define display* object->string
   option none
-  rich-integer rich-char rich-string
+  rich-integer rich-float rich-char rich-string
   rich-list range stack
   rich-vector array rich-hash-table array-buffer
   box $
@@ -225,12 +225,13 @@
 
 (define (box x)
   (cond ((integer? x) (rich-integer x))
+        ((float? x) (rich-float x))
         ((char? x) (rich-char (char->integer x)))
         ((string? x) (rich-string x))
         ((list? x) (rich-list x))
         ((vector? x) (rich-vector x))
         ((hash-table? x) (rich-hash-table x))
-        (else (type-error "box: x must be integer?, char?, string?, list?, vector?, hash-table?"))))
+        (else (type-error "box: x must be integer?, float?, char?, string?, list?, vector?, hash-table?"))))
 
 (define ($ x . xs)
   (if (null? xs) (box x) (apply (box x) xs)))
@@ -268,6 +269,12 @@
 
 )
 
+(define-case-class rich-float ((data float?))
+
+(define (%get) data)
+
+)
+
 (define-case-class rich-char ((code-point integer?))
 
 (define (%digit?)

diff --git a/tests/goldfish/liii/lang-test.scm b/tests/goldfish/liii/lang-test.scm
@@ -226,6 +226,8 @@
 (check ($ (rich-integer :max-value) :sqrt) => 3037000499)
 (check-catch 'value-error ($ -1 :sqrt))
 
+(check ($ 12.2 :get) => 12.2)
+
 (check-true ((rich-char #x30) :equals (rich-char #x30)))
 (check-false ((rich-char #x31) :equals (rich-char #x30)))