Rename project to JSCL

[jscl.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 24c85ab..171e0c8 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -1,6 +1,6 @@
 ;;; compiler.lisp --- 
 
-;; Copyright (C) 2012, 2013 David Vazquez
+;; copyright (C) 2012, 2013 David Vazquez
 ;; Copyright (C) 2012 Raimon Grau
 
 ;; This program is free software: you can redistribute it and/or
@@ -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))
@@ -49,7 +50,7 @@
 ;;; of this function are available, because the Ecmalisp version is
 ;;; very slow and bootstraping was annoying.
 
-#+ecmalisp
+#+jscl
 (defun indent (&rest string)
   (let ((input (apply #'code string)))
     (let ((output "")
@@ -237,7 +238,7 @@
        (let ((b (global-binding name 'variable 'variable)))
          (push 'constant (binding-declarations b)))))))
 
-#+ecmalisp
+#+jscl
 (fset 'proclaim #'!proclaim)
 
 (defun %define-symbol-macro (name expansion)
@@ -245,7 +246,7 @@
     (push-to-lexenv b *environment* 'variable)
     name))
 
-#+ecmalisp
+#+jscl
 (defmacro define-symbol-macro (name expansion)
   `(%define-symbol-macro ',name ',expansion))
 
@@ -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*))
@@ -545,7 +547,7 @@
                        (code "{name: \"" (escape-string (symbol-name sexp))
                              "\", 'package': '" (package-name package) "'}")
                        (code "{name: \"" (escape-string (symbol-name sexp)) "\"}")))
-                 #+ecmalisp
+                 #+jscl
                  (let ((package (symbol-package sexp)))
                    (if (null package)
                        (code "{name: \"" (escape-string (symbol-name sexp)) "\"}")
@@ -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 "})"))
 
@@ -1578,7 +1590,7 @@
                   ;; us replace the list representation version of the
                   ;; function with the compiled one.
                   ;;
-                  #+ecmalisp (setf (binding-value macro-binding) compiled)
+                  #+jscl (setf (binding-value macro-binding) compiled)
                   #+common-lisp (setf (gethash macro-binding *macroexpander-cache*) compiled)
                   (setq expander compiled))))
              (values (apply expander (cdr form)) t))
@@ -1589,11 +1601,15 @@
 (defun compile-funcall (function args)
   (let* ((values-funcs (if *multiple-value-p* "values" "pv"))
          (arglist (concat "(" (join (cons values-funcs (mapcar #'ls-compile args)) ", ") ")")))
+    (unless (or (symbolp function)
+                (and (consp function)
+                     (eq (car function) 'lambda)))
+      (error "Bad function"))
     (cond
       ((translate-function function)
        (concat (translate-function function) arglist))
       ((and (symbolp function)
-            #+ecmalisp (eq (symbol-package function) (find-package "COMMON-LISP"))
+            #+jscl (eq (symbol-package function) (find-package "COMMON-LISP"))
             #+common-lisp t)
        (code (ls-compile `',function) ".fvalue" arglist))
       (t
@@ -1625,6 +1641,7 @@
              (t
               (ls-compile `(symbol-value ',sexp))))))
         ((integerp sexp) (integer-to-string sexp))
+        ((floatp sexp) (float-to-string sexp))
         ((stringp sexp) (code "\"" (escape-string sexp) "\""))
         ((arrayp sexp) (literal sexp))
         ((listp sexp)