From 9a5cdde850ba5a6185d5524ebf8acc25dfd00762 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 30 Jun 2022 01:48:21 +0200
Subject: C parser add basic float support.

---
 module/c/parse.scm | 40 ++++++++++++++++++++++++++++++++++++++--
 1 file changed, 38 insertions(+), 2 deletions(-)

(limited to 'module/c/parse.scm')

diff --git a/module/c/parse.scm b/module/c/parse.scm
index 15240bc1..09ede544 100644
--- a/module/c/parse.scm
+++ b/module/c/parse.scm
@@ -42,6 +42,11 @@
                   "Invalid integer suffix ~s"
                   (list str) #f)))
 
+(define (parse-float-suffix str)
+  (case (string->symbol str)
+    ((f F) '(float))
+    ((l L) '(long double))))
+
 (define (group-body->type vars)
   (concatenate
    (map
@@ -63,6 +68,29 @@
     (bytevector-u8-set! bv (bytevector-length bv*) 0)
     bv))
 
+(define (parse-float-form float-form)
+  (let ((float-string
+         (fold (lambda (arg str)
+                 (string-append
+                  str
+                  (match arg
+                    (('float-integer ('base-10 n)) n)
+                    (('float-decimal ('base-10 n)) (string-append "." n))
+                    (('exponent "+"  ('base-10 n)) (string-append "e"  n))
+                    (('exponent      ('base-10 n)) (string-append "e"  n))
+                    (('exponent "-"  ('base-10 n)) (string-append "e-" n)))))
+               "" float-form)))
+    ;; exact->inexact is a no-op if we already have an inexact number, but
+    ;; ensures we get an inexact number when we have an exact number (which we
+    ;; can get from the "1." case). Returning an inexact number here is important
+    ;; to avoid arithmetic suprises later.
+    (exact->inexact
+     (or (string->number float-string)
+         (scm-error 'c-parse-error "parse-lexeme-tree"
+                    "Couldn't parse expression as float: ~s"
+                    (list `(float ,@args)) #f)))))
+
+
 (define (parse-lexeme-tree tree)
   (match tree
     ['() '()]
@@ -75,11 +103,19 @@
     [('integer n ('integer-suffix suffix))
      `(as-type
        ,(parse-integer-suffix suffix)
-       ,(parse-lexeme-tree n))
-     ]
+       ,(parse-lexeme-tree n))]
+
     [('integer n)
      (parse-lexeme-tree n)]
 
+
+    [('float args ... ('float-suffix suffix))
+     `(as-type ,(parse-float-suffix suffix)
+               ;; parse rest of float as if it lacked a suffix
+               ,(parse-lexeme-tree `(float ,@args)))]
+
+    [('float args ...) (parse-float-form args)]
+
     ;; Character literals, stored as raw integers
     ;; so mathematical operations keep working on them.
     [('char ('escaped-char ('base-8-char n)))
-- 
cgit v1.2.3