Add float support in reader and printer

diff --git a/src/boot.lisp b/src/boot.lisp
index 3454c65..2dca3a8 100644 (file)
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -410,6 +410,9 @@
 (defun integerp (x)
   (and (numberp x) (= (floor x) x)))
 
+(defun floatp (x)
+  (and (numberp x) (not (integerp x))))
+
 (defun plusp (x) (< 0 x))
 (defun minusp (x) (< x 0))
 

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 24c85ab..08932fc 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -28,6 +28,7 @@
                (cond
                  ((null arg) "")
                  ((integerp arg) (integer-to-string arg))
+                 ((floatp arg) (float-to-string arg))
                  ((stringp arg) arg)
                  (t (error "Unknown argument."))))
              args))
@@ -535,6 +536,7 @@
 (defun literal (sexp &optional recursive)
   (cond
     ((integerp sexp) (integer-to-string sexp))
+    ((floatp sexp) (float-to-string sexp))
     ((stringp sexp) (code "\"" (escape-string sexp) "\""))
     ((symbolp sexp)
      (or (cdr (assoc sexp *literal-symbols*))
@@ -1243,14 +1245,15 @@
         (fargs '())
         (prelude ""))
     (dolist (x args)
-      (if (numberp x)
-          (push (integer-to-string x) fargs)
-          (let ((v (code "x" (incf counter))))
-            (push v fargs)
-            (concatf prelude
-              (code "var " v " = " (ls-compile x) ";" *newline*
-                    "if (typeof " v " !== 'number') throw 'Not a number!';"
-                    *newline*)))))
+      (cond
+        ((floatp x) (push (float-to-string x) fargs))
+        ((numberp x) (push (integer-to-string x) fargs))
+        (t (let ((v (code "x" (incf counter))))
+             (push v fargs)
+             (concatf prelude
+               (code "var " v " = " (ls-compile x) ";" *newline*
+                     "if (typeof " v " !== 'number') throw 'Not a number!';"
+                     *newline*))))))
     (js!selfcall prelude (funcall function (reverse fargs)))))
 
 
@@ -1324,6 +1327,15 @@
   (type-check (("x" "number" x))
     "Math.floor(x)"))
 
+(define-builtin expt (x y)
+  (type-check (("x" "number" x)
+               ("y" "number" y))
+    "Math.pow(x, y)"))
+
+(define-builtin float-to-string (x)
+  (type-check (("x" "number" x))
+    "x.toString()"))
+
 (define-builtin cons (x y)
   (code "({car: " x ", cdr: " y "})"))
 

diff --git a/src/print.lisp b/src/print.lisp
index 9d36936..cc6c16c 100644 (file)
--- a/src/print.lisp
+++ b/src/print.lisp
@@ -33,6 +33,7 @@
                        (t (package-name package)))
                      ":" name)))))
     ((integerp form) (integer-to-string form))
+    ((floatp form) (float-to-string form))
     ((stringp form) (concat "\"" (escape-string form) "\""))
     ((functionp form)
      (let ((name (oget form "fname")))

diff --git a/src/read.lisp b/src/read.lisp
index 8f7fd71..587fc38 100644 (file)
--- a/src/read.lisp
+++ b/src/read.lisp
@@ -163,6 +163,76 @@
         (intern name package)
         (find-symbol name package))))
 
+(defun read-float (string)
+  (block nil
+    (let ((sign 1)
+          (integer-part nil)
+          (fractional-part nil)
+          (number 0)
+          (divisor 1)
+          (exponent-sign 1)
+          (exponent 0)
+          (size (length string))
+          (index 0))
+      (when (zerop size) (return))
+      ;; Optional sign
+      (case (char string index)
+        (#\+ (incf index))
+        (#\- (setq sign -1)
+             (incf index)))
+      (unless (< index size) (return))
+      ;; Optional integer part
+      (let ((value (digit-char-p (char string index))))
+        (when value
+          (setq integer-part t)
+          (while (and (< index size)
+                      (setq value (digit-char-p (char string index))))
+            (setq number (+ (* number 10) value))
+            (incf index))))
+      (unless (< index size) (return))
+      ;; Decimal point is mandatory if there's no integer part
+      (unless (or integer-part (char= #\. (char string index))) (return))
+      ;; Optional fractional part
+      (when (char= #\. (char string index))
+        (incf index)
+        (unless (< index size) (return))
+        (let ((value (digit-char-p (char string index))))
+          (when value
+            (setq fractional-part t)
+            (while (and (< index size)
+                        (setq value (digit-char-p (char string index))))
+              (setq number (+ (* number 10) value))
+              (setq divisor (* divisor 10))
+              (incf index)))))
+      ;; Either left or right part of the dot must be present
+      (unless (or integer-part fractional-part) (return))
+      ;; Exponent is mandatory if there is no fractional part
+      (when (and (= index size) (not fractional-part)) (return))
+      ;; Optional exponent part
+      (when (< index size)
+        ;; Exponent-marker
+        (unless (member (char-upcase (char string index))
+                        '(#\E #\S #\F #\D \#L))
+          (return))
+        (incf index)
+        (unless (< index size) (return))
+        ;; Optional exponent sign
+        (case (char string index)
+          (#\+ (incf index))
+          (#\- (setq exponent-sign -1)
+               (incf index)))
+        (unless (< index size) (return))
+        ;; Exponent digits
+        (let ((value (digit-char-p (char string index))))
+          (unless value (return))
+          (while (and (< index size)
+                      (setq value (digit-char-p (char string index))))
+            (setq exponent (+ (* exponent 10) value))
+            (incf index))))
+      (unless (= index size) (return))
+      ;; Everything went ok, we have a float
+      (/ (* sign (expt 10 (* exponent-sign exponent)) number) divisor))))
+
 
 (defun !parse-integer (string junk-allow)
   (block nil
@@ -237,6 +307,7 @@
       (t
        (let ((string (read-until stream #'terminalp)))
          (or (values (!parse-integer string nil))
+             (read-float string)
              (read-symbol string)))))))
 
 (defun ls-read (stream &optional (eof-error-p t) eof-value)

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 6b66792..1167cfb 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -53,7 +53,7 @@
           copy-list decf declaim defconstant define-setf-expander
           define-symbol-macro defmacro defparameter defun defvar
           digit-char digit-char-p disassemble do do* documentation
-          dolist dotimes ecase eq eql equal error eval every export
+          dolist dotimes ecase eq eql equal error eval every export expt
           fdefinition find-package find-symbol first flet fourth fset
           funcall function functionp gensym get-setf-expansion
           get-universal-time go identity if in-package incf integerp

diff --git a/src/utils.lisp b/src/utils.lisp
index 31afe28..d73a15d 100644 (file)
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -85,3 +85,9 @@
          (setq x (truncate x 10)))
        (mapconcat (lambda (x) (string (digit-char x)))
                  digits)))))
+
+(defun float-to-string (x)
+  #+ecmalisp
+  (float-to-string x)
+  #+common-lisp
+  (format nil "~f" x))