-;;; 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
`(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"))
#+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
(string-length seq)
(list-length seq)))
+ (defun concat-two (s1 s2)
+ (concat-two s1 s2))
+
(defun mapcar (func list)
(if (null list)
'()
(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)))
(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)
((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))
(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)
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))
;;;; 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* '())
(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*))))
(defun lookup-function-translation (symbol env)
(binding-translation (lookup-function symbol env)))
-
(defvar *toplevel-compilations* nil)
(defun %compile-defvar (name)
(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
(ls-compile val env fenv)))
;;; Literals
-
(defun escape-string (string)
(let ((output "")
(index 0)
((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
(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)))
(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
(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
(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*
" 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)
projects / jscl.git / blobdiff