X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=lispstrack.lisp;h=98f7bc0f5f217b6793a2ded92fb6fe08d7170fe2;hb=a6c50c8a33d0e918ca2b495328592832c88205cc;hp=3b96c3552f958cdb392add3f8285b7c1b48f75bd;hpb=fde8e35af42d48b703fafc91df3982e332bc64b6;p=jscl.git

diff --git a/lispstrack.lisp b/lispstrack.lisp
index 3b96c35..98f7bc0 100644
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -1,5 +1,26 @@
-;;; Library
-
+;;; lispstrack.lisp ---
+
+;; Copyright (C) 2012 David Vazquez
+;; Copyright (C) 2012 Raimon Grau
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; This code is executed when lispstrack compiles this file
+;;; itself. The compiler provides compilation of some special forms,
+;;; as well as funcalls and macroexpansion, but no functions. So, we
+;;; define the Lisp world from scratch. This code has to define enough
+;;; language to the compiler to be able to run.
 #+lispstrack
 (progn
  (eval-when-compile
@@ -8,18 +29,24 @@
                         `(eval-when-compile
                            (%compile-defmacro ',name '(lambda ,args ,@body))))))
 
- (defmacro defvar (name value)
+ (defmacro %defvar (name value)
    `(progn
       (eval-when-compile
         (%compile-defvar ',name))
       (setq ,name ,value)))
 
- (defmacro defun (name args &rest body)
+  (defmacro defvar (name value)
+    `(%defvar ,name ,value))
+
+ (defmacro %defun (name args &rest body)
    `(progn
       (eval-when-compile
         (%compile-defun ',name))
       (fsetq ,name (lambda ,args ,@body))))
 
+  (defmacro defun (name args &rest body)
+    `(%defun ,name ,args ,@body))
+
  (defvar *package* (new))
 
  (defvar nil (make-symbol "NIL"))
@@ -106,6 +133,16 @@
 
 #+lispstrack
 (progn
+  (defmacro defun (name args &rest body)
+    `(progn
+       (%defun ,name ,args ,@body)
+       ',name))
+
+  (defmacro defvar (name value)
+    `(progn
+       (%defvar ,name ,value)
+       ',name))
+
   (defun append-two (list1 list2)
     (if (null list1)
         list2
@@ -141,6 +178,9 @@
         (string-length seq)
         (list-length seq)))
 
+  (defun concat-two (s1 s2)
+    (concat-two s1 s2))
+
   (defun mapcar (func list)
     (if (null list)
         '()
@@ -212,6 +252,9 @@
   (defun <= (x y) (or (< x y) (= x y)))
   (defun >= (x y) (not (< x y)))
 
+  (defun plusp (x) (< 0 x))
+  (defun minusp (x) (< x 0))
+
   (defun listp (x)
     (or (consp x) (null x)))
 
@@ -305,6 +348,9 @@
     (equal s1 s2)))
 
 
+;;; The compiler offers some primitives and special forms which are
+;;; not found in Common Lisp, for instance, while. So, we grow Common
+;;; Lisp a bit to it can execute the rest of the file.
 #+common-lisp
 (progn
   (defmacro while (condition &body body)
@@ -312,6 +358,10 @@
          ((not ,condition))
        ,@body))
 
+  (defmacro eval-when-compile (&body body)
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       ,@body))
+
   (defun concat-two (s1 s2)
     (concatenate 'string s1 s2))
 
@@ -321,12 +371,15 @@
     (setf (cdr cons) new)))
 
 
+;;; At this point, no matter if Common Lisp or lispstrack is compiling
+;;; from here, this code will compile on both. We define some helper
+;;; functions now for string manipulation and so on. They will be
+;;; useful in the compiler, mostly.
+
 (defvar *newline* (string (code-char 10)))
 
 (defun concat (&rest strs)
-  (!reduce (lambda (s1 s2) (concat-two s1 s2))
-           strs
-           ""))
+  (!reduce #'concat-two strs ""))
 
 ;;; Concatenate a list of strings, with a separator
 (defun join (list separator)
@@ -356,13 +409,23 @@
                       digits)
               ""))))
 
+(defun print-to-string (form)
+  (cond
+    ((symbolp form) (symbol-name form))
+    ((integerp form) (integer-to-string form))
+    ((stringp form) (concat "\"" (escape-string form) "\""))
+    ((functionp form) (concat "#<FUNCTION>"))
+    ((listp form)
+     (concat "("
+             (join (mapcar #'print-to-string form)
+                   " ")
+             ")"))))
 
 ;;;; Reader
 
-;;; It is a basic Lisp reader. It does not use advanced stuff
-;;; intentionally, because we want to use it to bootstrap a simple
-;;; Lisp. The main entry point is the function `ls-read', which
-;;; accepts a strings as argument and return the Lisp expression.
+;;; The Lisp reader, parse strings and return Lisp objects. The main
+;;; entry points are `ls-read' and `ls-read-from-string'.
+
 (defun make-string-stream (string)
   (cons string 0))
 
@@ -498,6 +561,11 @@
 
 ;;;; Compiler
 
+;;; Translate the Lisp code to Javascript. It will compile the special
+;;; forms. Some primitive functions are compiled as special forms
+;;; too. The respective real functions are defined in the target (see
+;;; the beginning of this file) as well as some primitive functions.
+
 (defvar *compilation-unit-checks* '())
 
 (defvar *env* '())
@@ -514,7 +582,6 @@
 (defun mark-binding-as-declared (b)
   (setcar (cdddr b) t))
 
-
 (defvar *variable-counter* 0)
 (defun gvarname (symbol)
   (concat "v" (integer-to-string (incf *variable-counter*))))
@@ -560,7 +627,6 @@
 (defun lookup-function-translation (symbol env)
   (binding-translation (lookup-function symbol env)))
 
-
 (defvar *toplevel-compilations* nil)
 
 (defun %compile-defvar (name)
@@ -576,16 +642,17 @@
 (defun %compile-defmacro (name lambda)
   (push (make-binding name 'macro lambda t) *fenv*))
 
-
 (defvar *compilations* nil)
 
 (defun ls-compile-block (sexps env fenv)
   (join-trailing
-   (remove nil (mapcar (lambda (x)
-                         (ls-compile x env fenv))
-                       sexps))
-                 ";
-"))
+   (remove (lambda (x)
+             (or (null x)
+                 (and (stringp x)
+                      (zerop (length x)))))
+           (mapcar (lambda (x) (ls-compile x env fenv))  sexps))
+   (concat ";" *newline*)))
+
 (defmacro define-compilation (name args &rest body)
   ;; Creates a new primitive `name' with parameters args and
   ;; @body. The body can access to the local environment through the
@@ -651,7 +718,6 @@
            (ls-compile val env fenv)))
 
 ;;; Literals
-
 (defun escape-string (string)
   (let ((output "")
         (index 0)
@@ -703,14 +769,9 @@
     ((symbolp x)
      (lookup-function-translation x fenv))))
 
-#+common-lisp
-(defmacro eval-when-compile (&body body)
-  `(eval-when (:compile-toplevel :load-toplevel :execute)
-     ,@body))
-
 (define-compilation eval-when-compile (&rest body)
   (eval (cons 'progn body))
-  nil)
+  "")
 
 (defmacro define-transformation (name args form)
   `(define-compilation ,name ,args
@@ -927,6 +988,10 @@
   (compile-bool
    (concat "(" (ls-compile key env fenv) " in " (ls-compile object env fenv) ")")))
 
+(define-compilation functionp (x)
+  (compile-bool
+   (concat "(typeof " (ls-compile x env fenv) " == 'function')")))
+
 
 (defun macrop (x)
   (and (symbolp x) (eq (binding-type (lookup-function x *fenv*)) 'macro)))
@@ -972,14 +1037,16 @@
   (setq *toplevel-compilations* nil)
   (let ((code (ls-compile sexp nil nil)))
     (prog1
-        (concat  #+common-lisp (concat "/* " (princ-to-string sexp) " */")
-                (join (mapcar (lambda (x) (concat x ";" *newline*))
+        (concat (join (mapcar (lambda (x) (concat x ";" *newline*))
                               *toplevel-compilations*)
                "")
                 code)
       (setq *toplevel-compilations* nil))))
 
-;;; ----------------------------------------------------------
+
+;;; Once we have the compiler, we define the runtime environment and
+;;; interactive development (eval), which works calling the compiler
+;;; and evaluating the Javascript result globally.
 
 #+lispstrack
 (progn
@@ -999,7 +1066,6 @@
               (ls-compile-toplevel x nil nil))))
      (js-eval code)))
 
-
  ;; Set the initial global environment to be equal to the host global
  ;; environment at this point of the compilation.
  (eval-when-compile
@@ -1014,6 +1080,7 @@
  (js-eval
   (concat "var lisp = {};"
           "lisp.read = " (lookup-function-translation 'ls-read-from-string nil) ";" *newline*
+          "lisp.print = " (lookup-function-translation 'print-to-string nil) ";" *newline*
           "lisp.eval = " (lookup-function-translation 'eval nil) ";" *newline*
           "lisp.compile = " (lookup-function-translation 'ls-compile-toplevel nil) ";" *newline*
           "lisp.evalString = function(str){" *newline*
@@ -1023,6 +1090,10 @@
           "   return lisp.compile(lisp.read(str));" *newline*
           "}" *newline*)))
 
+
+;;; Finally, we provide a couple of functions to easily bootstrap
+;;; this. It just calls the compiler with this file as input.
+
 #+common-lisp
 (progn
   (defun read-whole-file (filename)