From: Alfredo Beaumont Date: Thu, 25 Apr 2013 14:31:09 +0000 (+0200) Subject: Add float support in reader and printer X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c4527d7a93b1b08528a8420479d30c38f931b9bd;p=jscl.git Add float support in reader and printer --- diff --git a/src/boot.lisp b/src/boot.lisp index 3454c65..2dca3a8 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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))